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;
8   
9   
10  //Reading it back would go like this:
11  
12  
13  registry.ReadBinarydata(valuename, lf, sizeof(lf));
14  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.


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