[Decoding]

Вот пример из DRKB

Код:

 
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;