本例效果图:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Grids; type TForm1 = class(TForm) StringGrid1: TStringGrid; procedure StringGrid1Click(Sender: TObject); procedure FormCreate(Sender: TObject); end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); var FontCount,i: Integer; begin {获取字体总数} FontCount := Screen.Fonts.Count; {设置行列} StringGrid1.RowCount := FontCount + 1; StringGrid1.ColCount := 1; StringGrid1.FixedCols := 0; StringGrid1.DefaultColWidth := 128; StringGrid1.DefaultRowHeight := 18; {跟随拖动与选定效果} StringGrid1.Options := StringGrid1.Options + [goThumbTracking,goDrawFocusSelected]; {设置标题与字号} StringGrid1.Cells[0,0] := '字体名称'; StringGrid1.Font.Size := 9; {写入字体名称} for i := 0 to FontCount - 1 do StringGrid1.Cells[0,i+1] := Screen.Fonts[i]; end; {随当前字体变化} procedure TForm1.StringGrid1Click(Sender: TObject); begin with StringGrid1 do Font.Name := Cells[Col,Row]; end; end.