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;