本例效果图:
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.