Сохранение свойств шрифтов

Code:

uses...Registry;

procedure SaveFontToRegistry(Font: TFont; SubKey: string);

var

R: TRegistry;

FontStyleInt: byte;

FS: TFontStyles;

begin

R := TRegistry.Create;

try

   FS := Font.Style;

   Move(FS, FontStyleInt, 1);

   R.OpenKey(SubKey, True);

   R.WriteString('Font Name', Font.Name);

   R.WriteInteger('Color', Font.Color);

   R.WriteInteger('CharSet', Font.Charset);

   R.WriteInteger('Size', Font.Size);

   R.WriteInteger('Style', FontStyleInt);

finally

   R.Free;

end;

end;

function ReadFontFromRegistry(Font: TFont; SubKey: string): boolean;

var

R: TRegistry;

FontStyleInt: byte;

FS: TFontStyles;

begin

R := TRegistry.Create;

try

   result := R.OpenKey(SubKey, false); if not result then exit;

   Font.Name := R.ReadString('Font Name');

   Font.Color := R.ReadInteger('Color');

   Font.Charset := R.ReadInteger('CharSet');

   Font.Size := R.ReadInteger('Size');

   FontStyleInt := R.ReadInteger('Style');

   Move(FontStyleInt, FS, 1);

   Font.Style := FS;

finally

   R.Free;

end;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

if FontDialog1.Execute then

   begin

     SaveFontToRegistry(FontDialog1.Font, 'Delphi Kingdom\Fonts');

   end;

end;

procedure TForm1.Button2Click(Sender: TObject);

var

NFont: TFont;

begin

NFont := TFont.Create;

if ReadFontFromRegistry(NFont, 'Delphi Kingdom\Fonts') then

   begin //здесь добавить проверку - существует ли шрифт

     Label1.Font.Assign(NFont);

     NFont.Free;

   end;

end;