Author: William Gerbert

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:

1   uses
2     typInfo, Registry;
3   
4   function GetFontProp(anObj: TObject): TFont;
5   var
6     PInfo: PPropInfo;
7   begin
8     {try to get a pointer to the property information for a property with the name 
9   'Font'. TObject.ClassInfo returns a pointer to the RTTI table, which we need to 
10  pass to GetPropInfo}
11    PInfo := GetPropInfo(anObj.ClassInfo, 'font');
12    Result := nil;
13    if PInfo <> nil then
14      {found a property with this name, check if it has the correct type}
15      if (PInfo^.Proptype^.Kind = tkClass) and
16        GetTypeData(PInfo^.Proptype^)^.ClassType.InheritsFrom(TFont) then
17        Result := TFont(GetOrdProp(anObj, PInfo));
18  end;
19  
20  function StyleToString(styles: TFontStyles): string;
21  var
22    style: TFontStyle;
23  begin
24    Result := '[';
25    for style := Low(style) to High(style) do
26    begin
27      if style in styles then
28      begin
29        if Length(result) > 1 then
30          result := result + ',';
31        result := result + GetEnumname(typeInfo(TFontStyle), Ord(style));
32      end;
33    end;
34    Result := Result + ']';
35  end;
36  
37  function StringToStyle(S: string): TFontStyles;
38  var
39    sl: TStringlist;
40    style: TFontStyle;
41    i: Integer;
42  begin
43    Result := [];
44    if Length(S) < 2 then
45      Exit;
46    if S[1] = '[' then
47      Delete(S, 1, 1);
48    if S[Length(S)] = ']' then
49      Delete(S, Length(S), 1);
50    if Length(S) = 0 then
51      Exit;
52    sl := TStringlist.Create;
53    try
54      sl.commatext := S;
55      for i := 0 to sl.Count - 1 do
56      begin
57        try
58          style := TFontStyle(GetEnumValue(Typeinfo(TFontStyle), sl[i]));
59          Include(Result, style);
60        except
61        end;
62      end;
63    finally
64      sl.free
65    end;
66  end;
67  
68  procedure SaveFontProperties(forControl: TControl; toIni: TRegInifile; const 
69  section:
70    string);
71  var
72    font: TFont;
73    basename: string;
74  begin
75    Assert(Assigned(toIni));
76    font := GetFontProp(forControl);
77    if not Assigned(font) then
78      Exit;
79    basename := forControl.Name + '.Font.';
80    toIni.WriteInteger(Section, basename + 'Charset', font.charset);
81    toIni.WriteString(Section, basename + 'Name', font.Name);
82    toIni.WriteInteger(Section, basename + 'Size', font.size);
83    toIni.WriteString(Section, basename + 'Color', '$' + IntToHex(font.color, 8));
84    toIni.WriteString(Section, basename + 'Style', StyleToString(font.Style));
85  end;
86  
87  procedure RestoreFontProperties(forControl: TControl; toIni: TRegInifile; const
88    section: string);
89  var
90    font: TFont;
91    basename: string;
92  begin
93    Assert(Assigned(toIni));
94    font := GetFontProp(forControl);
95    if not Assigned(font) then
96      Exit;
97    basename := forControl.Name + '.Font.';
98    font.Charset := toIni.ReadInteger(Section, basename + 'Charset', font.charset);
99    font.Name := toIni.ReadString(Section, basename + 'Name', font.Name);
100   font.Size := toIni.ReadInteger(Section, basename + 'Size', font.size);
101   font.Color := TColor(StrToInt(toIni.ReadString(Section, basename + 'Color', '$' +
102     IntToHex(font.color, 8))));
103   font.Style := StringToStyle(toIni.ReadString(Section, basename + 'Style',
104     StyleToString(font.Style)));
105 end;