Сохранить объект TFont в реестре

Материал из DRKB

Сохранить объект TFont в реестре[править | править код]

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
    SaveFontToRegistry(FontDialog1.Font, 'Delphi Kingdom\Fonts');
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;

ID: 02294


Примечание от Vit: вообще-то надо было бы читать свойства TFont через RTTI, а не перечислением... ибо в этом случае во-первых если в будущих версиях дельфи класс TFont будет изменён или дополнен, то код всё равно будет работать правильно, а во-вторых такой код сохранял бы значения полей любых классов, а не только TFont...


Source: http://delphiworld.narod.ru/
ID: 02294