Сохранить объект 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