完整範例 - Fontlist (4/10)

　　因為目錄字型的處理比較复雜，所以我們暫時將它們放在一旁，首先著手處理系統字型。本篇及下兩篇將講解字型樣本的繪畫，然後將講解如何將字型樣本儲存成.bmp檔案。在所有功能都做好後，我們才著手處理目錄字型。而本篇的目標，便是能做到下圖的效果。

　　說目錄字型處理比較复雜，是因為我們必須找出該目錄的所有字型，將之載入，然後找出對應的字型名，與之相比，系統字型早已裝載，Delphi 甚至將它們封裝在Screen變量中，使用起來很方便。

procedure TForm1.GetSystemFonts;
var
  i, l: integer;
begin
  SetLength(fSystemFonts,Screen.Fonts.Count);
  l:=0;
  for i:=0 to Screen.Fonts.Count-1 do
    if Screen.Fonts[i][1]<>'@' then
    begin
      fSystemFonts[l].Fontname:=Screen.Fonts[i];
      fSystemFonts[l].Filename:='';
      inc(l);
    end;
  SetLength(fSystemFonts,l);
end;

　　對於系統字型，文件名並不易求，我們只是簡單地把它們設為空白。這裏要注意的是大部分中文字型，例如細明體，在Screen.fonts中出現兩份，其中一個是「細明體」，另一個是「@細明體」，後者用於直排文字，在此沒有必要重复，所以全部忽略了。

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

　　UpdateFonts是字型改變後的處理，其實不多，只是相應改變Grid的列數和要求它重畫。

　　字型樣本繪畫在Grid上，要處理Grid的OnDrawCell，以下是其定義。

type
  TForm1 = class(TForm)
    ....
    procedure GridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
  private
    procedure DrawCell(Canvas: tCanvas; Rect: tRect; Row: integer; Selected: boolean);
    ....
  end;

　　GridDrawCell只是呼叫DrawCell，多了層轉折的原因，是為了多一層靈活性，以後將會解釋。

procedure TForm1.GridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  DrawCell(Grid.Canvas, Rect, ARow, gdSelected in State);
end;

　　為了讓字型樣本足夠大，我們還需要在初始化時設定列高。同時，在Object Inspector中將Grid.GridWidth設為0，否則兩列之間有橫線。

procedure TForm1.FormCreate(Sender: TObject);
begin
  Grid.DefaultRowHeight:=32;
  Grid.DoubleBuffered:=true;
  ....
end;

　　DoubleBuffered:=true防止Grid閃爍。以下是真正的繪畫方法，首先是一些常量的定義：

const
  FontBgColorHl = clNavy;
  FontBgColor0  = $00d0eFFF;
  FontBgColor1  = $00eFd0FF;
  FontColorHl   = clWhite;
  FontColor0    = clBlack;
  FontColor1    = clBlack;

procedure TForm1.DrawCell(Canvas: tCanvas; Rect: tRect; Row: integer;
  Selected: boolean);
begin
  with Canvas do
  begin
    if Selected
       then Brush.Color:=FontBgColorHl
       else if Row mod 2=0
         then Brush.Color:=FontBgColor0
         else Brush.Color:=FontBgColor1;
    FillRect(rect);
    if Row>=Length(fFonts^) then exit;

    if Selected
       then Font.Color:=FontColorHl
       else if Row mod 2=0
         then Font.Color:=FontColor0
         else Font.Color:=FontColor1;
    SetBkMode(Handle, TRANSPARENT);
    Font.Name:=fFonts^[Row].Fontname;
    Font.Height:=Rect.Bottom-Rect.Top-4;
    Textout(Rect.Left+2, Rect.Top+2,
            '詩中天地闊。Poem is lovely. - '+fFonts^[Row].Fontname);
  end;
end;

　　DrawCell首先根據是否被選中，以及列數奇偶設定背景色，填滿，然後改變文字的色彩和字型，最後打印出「詩中天地闊。Poem is lovely.」及字型名稱。這裏有兩點應該注意：1）SetBkMode(Handle, TRANSPARENT);使打印出來的文字沒有背景。2）我們使用了Font.Height而不是Font.Size，這是必須的。雖然Windows說在同一設備上兩者之間有固定比例，但是這是忽略了字型的External leading的情況，如下圖，如果設定的是Font.Size，有些字便會超出格外。

　　基本上這便是我們本篇要做的工作，看來還不錯，不過有些字型顯示成亂碼了，讓我們在下一篇處理吧。