完整範例 - Fontlist (3/10)

　　在界面設計好後，我們便要對程序的實現進行一個整體規劃。雖然程序的功能總是一個一個加上去的，但是程序的整體思路卻應該儘早規劃，這可以為將來程序的發展預留空間，也可以避免大量修改原來代碼。

　　在 OOP 編程中，程序的規劃主要體現在 Object 上，以下是我們對所用 object 的定義：

type
  tFontData = record
    Filename, Fontname: string;
  end;
  tFontDatas= array of tFontData;

  TForm1 = class(TForm)
    ....
    SavePictureDialog1: TSavePictureDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure btnSystemClick(Sender: TObject);
    procedure btnFolderClick(Sender: TObject);
    procedure btnSelectFolderClick(Sender: TObject);
    procedure btnSaveBmpClick(Sender: TObject);
    ....
  private
    FSystemFonts: tFontDatas;
    FFolderFonts: tFontDatas;
    FFonts: ^tFontDatas;
    FFolder: String;
    FShowSystemFont: Boolean;
    procedure SetFolder(const Value: String);
    procedure SetShowSystemFont(const Value: Boolean);

    function  SelectFolder: string;
    procedure GetSystemFonts;
    procedure GetFolderFonts;
    procedure UpdateFonts;
    procedure SaveAsBitmap(const Filename: string);
  public
    property Folder: String read FFolder write SetFolder;
    property ShowSystemFont: Boolean read FShowSystemFont write SetShowSystemFont;
  end;

　　在這裏我們增加了對四個TButton被按下時的處理，以及FormCreate、FormResize的處理。我們還增加了ShowSystemFont、Folder兩個屬性，前者表示顯示的是系統字型還是目錄內字錄，後者指定字型所在目錄。

　　此外我們定義了三個tFontDatas相關的變量，顧名思義，FSystemFonts將會列出所有系統字型，FFolderFonts則是Folder內的字型。FFonts指向目前所用的tFontDatas，可以指向FFolderFonts或FSystemFonts，視ShowSystemFont而定。以後我們的操作將通過此指針完成，這樣可以大大簡化代碼，不必因為ShowSystemFont不同而分開處理。

　　最後還有五個private函數，它們都是未完成的部分，在下面會一一細說。

procedure TForm1.FormCreate(Sender: TObject);
begin
  Grid.ColWidths[0]:=Grid.ClientWidth;
  FFolder:='';
  SetLength(FFolderFonts,0);
  GetSystemFonts;
  FShowSystemFont:=false;
  ShowSystemFont:=true;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  Grid.SetBounds(Grid.Left, Grid.Top, ClientWidth-16, ClientHeight-Grid.Top-8);
  Grid.ColWidths[0]:=Grid.ClientWidth;
end;

　　FormCreate是一些簡單的初始化。第2、3、5行都是多餘的，因為這本來便是初始化的值。第一行是改變欄寬，盡量使用所有空間，第4行呼叫GetSystemFonts取得所有系統字型，第6行則設定屬性使之顯示系統字型。

　　使用者改變form的大小時，FormResize使Grid的大小和欄寬隨之改變。這是運行時載圖。

procedure TForm1.btnSystemClick(Sender: TObject);
begin
  ShowSystemFont:=true;
end;

procedure TForm1.btnFolderClick(Sender: TObject);
begin
  ShowSystemFont:=false;
end;

procedure TForm1.btnSelectFolderClick(Sender: TObject);
begin
  Folder:=SelectFolder;
end;

procedure TForm1.btnSaveBmpClick(Sender: TObject);
begin
  if SavePictureDialog1.Execute then
    SaveAsBitmap(SavePictureDialog1.Filename)
end;

　　對TButton的處理，實在簡單得很，只是把相關屬性設定便可以了，簡潔明瞭，這便是 OOP 的好處。這裏用到兩個函數，分別是SelectFolder和SaveAsBitmap，前者的功能是要求使用者選擇目錄（目錄如果是空白表示使用者按了「取消」鍵），後者則把目前的字型樣本儲成.bmp檔案。相應地，我們在 form 中增加了一個tSavePictureDialog。

procedure TForm1.SetFolder(const Value: String);
begin
  if Value='' then exit;
  FFolder:=Value;
  GetFolderFonts;
  if not ShowSystemFont then
  begin
    FFonts:=@FFolderFonts;
    UpdateFonts;
  end;
end;

procedure TForm1.SetShowSystemFont(const Value: Boolean);
begin
  if FShowSystemFont=Value then exit;
  if not Value then
  begin
    if FFolder='' then Folder:=SelectFolder;
    if FFolder='' then exit;
  end;

  FShowSystemFont:=Value;
  btnSystem.enabled:=not FShowSystemFont;
  btnFolder.enabled:=FShowSystemFont;
  btnSelectFolder.enabled:=not FShowSystemFont;
  if FShowSystemFont
    then Caption:='Fontlist - System fonts'
    else Caption:=format('Fontlist - Fonts in "%s"',[FFolder]);

  if FShowSystemFont
    then FFonts:=@FSystemFonts
    else FFonts:=@FFolderFonts;
  UpdateFonts;
end;

　　這部分是主篇的重點，它處理了ShowSystemFont和Folder兩個屬性改變時，程序所作出的反應。當Folder變化時，我們要做的東西比較少，首先是我們要讀取Folder內的字型（GetFolderFonts），其次是如果ShowSystemFont是false時，表示目前顯示的是目錄下的字型，我們便要更新顯示的字型（UpdateFonts）。

　　SetShowSystemFont長一點點，首先如果顯示目錄字型而目錄尚未設定，它會要求使用者選擇目錄，否則便顯示系統字型。然後它會把不適用的TButton禁用和改變標題。最後它會設定合適的tFontDatas，然後更新顯示的字型。

function TForm1.SelectFolder: string;
begin
  result:='c:\';
end;

procedure TForm1.GetSystemFonts;
begin

end;

procedure TForm1.GetFolderFonts;
begin

end;

procedure TForm1.UpdateFonts;
begin
  btnSavebmp.enabled:=length(FFonts^)>0;
end;

procedure TForm1.SaveAsBitmap(const Filename: string);
begin

end;

end.

　　以上是未完成的部分，實際上是程序的真正核心。不過雖然核心部分幾乎全是空白，程序的架構卻已經完整了。

　　下面是完整的pas代碼。

fontu.pas顯示代碼

unit Fontu;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, ExtDlgs;

type
  tFontData = record
    Filename, Fontname: string;
  end;
  tFontDatas= array of tFontData;

  TForm1 = class(TForm)
    btnSystem: TButton;
    btnFolder: TButton;
    btnSelectFolder: TButton;
    btnSaveBmp: TButton;
    btnClose: TButton;
    Grid: TDrawGrid;
    SavePictureDialog1: TSavePictureDialog;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure btnSystemClick(Sender: TObject);
    procedure btnFolderClick(Sender: TObject);
    procedure btnSelectFolderClick(Sender: TObject);
    procedure btnSaveBmpClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
  private
    FSystemFonts: tFontDatas;
    FFolderFonts: tFontDatas;
    FFonts: ^tFontDatas;
    FFolder: String;
    FShowSystemFont: Boolean;
    procedure SetFolder(const Value: String);
    procedure SetShowSystemFont(const Value: Boolean);

    function  SelectFolder: string;
    procedure GetSystemFonts;
    procedure GetFolderFonts;
    procedure UpdateFonts;
    procedure SaveAsBitmap(const Filename: string);
  public
    property Folder: String read FFolder write SetFolder;
    property ShowSystemFont: Boolean read FShowSystemFont write SetShowSystemFont;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

// Published methods

procedure TForm1.FormCreate(Sender: TObject);
begin
  Grid.ColWidths[0]:=Grid.ClientWidth;
  FFolder:='';
  SetLength(FFolderFonts,0);
  GetSystemFonts;
  FShowSystemFont:=false;
  ShowSystemFont:=true;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  Grid.SetBounds(Grid.Left, Grid.Top, ClientWidth-16, ClientHeight-Grid.Top-8);
  Grid.ColWidths[0]:=Grid.ClientWidth;
end;

procedure TForm1.btnSystemClick(Sender: TObject);
begin
  ShowSystemFont:=true;
end;

procedure TForm1.btnFolderClick(Sender: TObject);
begin
  ShowSystemFont:=false;
end;

procedure TForm1.btnSelectFolderClick(Sender: TObject);
begin
  Folder:=SelectFolder;
end;

procedure TForm1.btnSaveBmpClick(Sender: TObject);
begin
  if SavePictureDialog1.Execute then
    SaveAsBitmap(SavePictureDialog1.Filename)
end;

procedure TForm1.btnCloseClick(Sender: TObject);
begin
  Close;
end;

// Private methods

procedure TForm1.SetFolder(const Value: String);
begin
  if Value='' then exit;
  FFolder:=Value;
  GetFolderFonts;
  if not ShowSystemFont then
  begin
    FFonts:=@FFolderFonts;
    UpdateFonts;
  end;
end;

procedure TForm1.SetShowSystemFont(const Value: Boolean);
begin
  if FShowSystemFont=Value then exit;
  if not Value then
  begin
    if FFolder='' then Folder:=SelectFolder;
    if FFolder='' then exit;
  end;

  FShowSystemFont:=Value;
  btnSystem.enabled:=not FShowSystemFont;
  btnFolder.enabled:=FShowSystemFont;
  btnSelectFolder.enabled:=not FShowSystemFont;
  if FShowSystemFont
    then Caption:='Fontlist - System fonts'
    else Caption:=format('Fontlist - Fonts in "%s"',[FFolder]);

  if FShowSystemFont
    then FFonts:=@FSystemFonts
    else FFonts:=@FFolderFonts;
  UpdateFonts;
end;

function TForm1.SelectFolder: string;
begin
  result:='c:\';
end;

procedure TForm1.GetSystemFonts;
begin

end;

procedure TForm1.GetFolderFonts;
begin

end;

procedure TForm1.UpdateFonts;
begin
  btnSavebmp.enabled:=length(FFonts^)>0;
end;

procedure TForm1.SaveAsBitmap(const Filename: string);
begin

end;

end.