通过注册表读取设置字体

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure WriteFontToRegistry(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ReadFontFromRegistry(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private-Deklarationen }
    Font : TFont;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
TFontRegData = record
  Name : string[100];
  Size : integer;
  Color : TColor;
  Style : set of TFontStyle;
  Charset : byte;
  Height : integer;
  Pitch : TFontPitch;
  PixelsPerInch : integer;
end;

// Before writing font data to the registry you have to copy all needed
// data to a record of fixed size

procedure PrepareFontDataForRegistry(Font : TFont;var RegData : TFontRegData);
begin
  { Copy font data to record for saving to registry }
  with RegData do
  begin
    Name:=Font.Name;
    Size:=Font.Size;
    Color:=Font.Color;
    Style:=Font.Style;
    Charset:=Font.Charset;
    Height:=Font.Height;
    Pitch:=Font.Pitch;
    PixelsperInch:=Font.PixelsPerInch;
  end;
end;

procedure PrepareFontfromRegData(Font : TFont;RegData : TFontRegData);
begin
  { Set font data to values read from registry }
  with Font do
  begin
    Name:=RegData.Name;
    Size:=RegData.Size;
    Color:=RegData.Color;
    Style:=RegData.Style;
    Charset:=RegData.Charset;
    Height:=RegData.Height;
    Pitch:=RegData.Pitch;
    PixelsperInch:=RegData.PixelsPerInch;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Font:=TFont.Create;
  Font.Name:='Arial';
end;

procedure TForm1.WriteFontToRegistry(Sender: TObject);
  var
  rd : TFontRegData;
  reg : TRegistry;

begin
  PrepareFontDataForRegistry(Font,rd);
  Reg:=TRegistry.Create;
  Reg.OpenKey('Software\Test',true);
  Reg.WriteBinaryData('FontData',rd,Sizeof(rd));
  reg.Free;
end;

procedure TForm1.ReadFontFromRegistry(Sender: TObject);
  var
  rd : TFontRegData;
  reg : TRegistry;

begin
  Reg:=TRegistry.Create;
  Reg.OpenKey('Software\Test',true);
  if Reg.ValueExists('FontData') then
    Reg.ReadBinaryData('FontData',rd,Sizeof(rd));
  reg.Free;
  PrepareFontFromRegData(Font,rd);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Font.Free;
end;

end.