Author: William Gerbert 

I was just wondering what the best way to save a particular font to the registry 
would be. Do I have to save each of its attributes separately? Is there an easier 
way than storing it to the registry, perhaps? Seems like such a simple issue, but 
other than saving and loading each attribute separately, I can't think of a way to 
do it at one time!

Answer:

You can do it by getting a TLogfont record filled and save that to a binary key:


1   var
2     lf: TLogfont;
3   begin
4     fillchar(lf, sizeof(lf), 0);
5     GetObject(font.handle, sizeof(lf), @lf);
6     registry.WriteBinarydata(valuename, lf, sizeof(lf));
7   end;



Reading it back would go like this:


registry.ReadBinarydata(valuename, lf, sizeof(lf));
font.handle := CreateFontIndirect(lf);


A probably more Kylix-compatible method would be to create a non-visual wrapper 
component for a TFont and stream that, e.g. to a memory stream. The streams content 
could then be saved to a binary registry key.


8   type
9     TFontWrapper = class(TComponent)
10    private
11      FFont: TFont;
12      procedure SetFont(f: TFont);
13    public
14      constructor Create(AOwner: TComponent); override;
15      destructor Destroy; override;
16    published
17      property Font: TFont read FFont write SetFont;
18    end;
19  
20  constructor TFontWrapper.Create(AOwner: TComponent);
21  begin
22    inherited Create(aOwner);
23    FFont := TFont.Create;
24  end;
25  
26  destructor TFontWrapper.Destroy;
27  begin
28    FFont.Free;
29    inherited Destroy;
30  end;
31  
32  procedure TFontWrapper.SetFont(f: TFont);
33  begin
34    FFont.Assign(f);
35  end;
36  
37  procedure TScratchMain.SpeedButton2Click(Sender: TObject);
38  const
39    b: Boolean = False;
40  var
41    fw: TFontWrapper;
42    st: TFileStream;
43  begin
44    if b then
45    begin
46      edit1.text := 'Loading font';
47      fw := nil;
48      st := TFileStream.Create('E:\A\test.str', fmOpenRead);
49      try
50        fw := TFontWrapper.Create(nil);
51        st.ReadComponent(fw);
52        memo1.font.assign(fw.font);
53      finally
54        fw.Free;
55        st.Free;
56      end;
57    end
58    else
59    begin
60      edit1.text := 'Saving font';
61      fw := nil;
62      st := TFileStream.Create('E:\A\test.str', fmCreate);
63      try
64        fw := TFontWrapper.Create(nil);
65        fw.Font := Font;
66        st.WriteComponent(fw);
67      finally
68        fw.Free;
69        st.Free;
70      end;
71    end;
72    b := not b;
73  end;