How to save and restore font properties in the registry

Problem/Question/Abstract:

I tried to save user selected font settings in the registry. Therefore I declared a variable Wfont: TFont; and created it with Wfont := TFont.create; . All works fine, like setting a panel's font and so on, but when I try to write it to the registry using reg.writebinarydata('Font',wfont,sizeof(Tfont)), only 4 Bytes are stored. Ergo the font could not be loaded.

Answer:

Saving and restoring font properties in the registry:

uses
  typInfo, Registry;

function GetFontProp(anObj: TObject): TFont;
var
  PInfo: PPropInfo;
begin
  {try to get a pointer to the property information for a property with the name 'Font'. TObject.ClassInfo returns a pointer to the RTTI table, which we need to pass to GetPropInfo}
  PInfo := GetPropInfo(anObj.ClassInfo, 'font');
  Result := nil;
  if PInfo <> nil then
    {found a property with this name, check if it has the correct type}
    if (PInfo^.Proptype^.Kind = tkClass) and
      GetTypeData(PInfo^.Proptype^)^.ClassType.InheritsFrom(TFont) then
      Result := TFont(GetOrdProp(anObj, PInfo));
end;

function StyleToString(styles: TFontStyles): string;
var
  style: TFontStyle;
begin
  Result := '[';
  for style := Low(style) to High(style) do
  begin
    if style in styles then
    begin
      if Length(result) > 1 then
        result := result + ',';
      result := result + GetEnumname(typeInfo(TFontStyle), Ord(style));
    end;
  end;
  Result := Result + ']';
end;

function StringToStyle(S: string): TFontStyles;
var
  sl: TStringlist;
  style: TFontStyle;
  i: Integer;
begin
  Result := [];
  if Length(S) < 2 then
    Exit;
  if S[1] = '[' then
    Delete(S, 1, 1);
  if S[Length(S)] = ']' then
    Delete(S, Length(S), 1);
  if Length(S) = 0 then
    Exit;
  sl := TStringlist.Create;
  try
    sl.commatext := S;
    for i := 0 to sl.Count - 1 do
    begin
      try
        style := TFontStyle(GetEnumValue(Typeinfo(TFontStyle), sl[i]));
        Include(Result, style);
      except
      end;
    end;
  finally
    sl.free
  end;
end;

procedure SaveFontProperties(forControl: TControl; toIni: TRegInifile; const section:
  string);
var
  font: TFont;
  basename: string;
begin
  Assert(Assigned(toIni));
  font := GetFontProp(forControl);
  if not Assigned(font) then
    Exit;
  basename := forControl.Name + '.Font.';
  toIni.WriteInteger(Section, basename + 'Charset', font.charset);
  toIni.WriteString(Section, basename + 'Name', font.Name);
  toIni.WriteInteger(Section, basename + 'Size', font.size);
  toIni.WriteString(Section, basename + 'Color', '$' + IntToHex(font.color, 8));
  toIni.WriteString(Section, basename + 'Style', StyleToString(font.Style));
end;

procedure RestoreFontProperties(forControl: TControl; toIni: TRegInifile; const
  section: string);
var
  font: TFont;
  basename: string;
begin
  Assert(Assigned(toIni));
  font := GetFontProp(forControl);
  if not Assigned(font) then
    Exit;
  basename := forControl.Name + '.Font.';
  font.Charset := toIni.ReadInteger(Section, basename + 'Charset', font.charset);
  font.Name := toIni.ReadString(Section, basename + 'Name', font.Name);
  font.Size := toIni.ReadInteger(Section, basename + 'Size', font.size);
  font.Color := TColor(StrToInt(toIni.ReadString(Section, basename + 'Color', '$' +
    IntToHex(font.color, 8))));
  font.Style := StringToStyle(toIni.ReadString(Section, basename + 'Style',
    StyleToString(font.Style)));
end;