Author: Tomas Rutkauskas
Storing Font information in the registry - with one key only
Answer:
If you came in a situation to store font information in the registry, because you
want to allow your users to customize your application, then you may have faced the
fact that the TRegistry class does not provide WriteFont(), ReadFont() functions.
The first thought would be to make a sub key for each item in your application and
write the font information as a combination of Strings and Integers.
WriteString(key, Font.FaceName);
WriteInteger(key, Font.Size);
Obviously not the most elegant code. Here's an elegant solution - store the font
information as binary data! The Windows API provides a TLogFont structure that
describes a font. It includes all properties that the Borland TFont class provides
except the font's color. We'll use an extended logical description that contains
the Windows (T)LogFont and the color. For information on TLogFont open help file
Win32.hlp and search for LogFont.
1 // saves/ reads a font to/ from the registry
2 //
3 // read like this:
4 // fEditorFont := TFont.Create;
5 // fEditorFont.name := 'Courier New';
6 // fEditorFont.Size := 10;
7 // LoadFont(sKey, 'Editor', fEditorFont);
8 //
9 // and save like this:
10 // SaveFont(sKey, 'Editor', fEditorFont);
11 unit sFontStorage;
12 interface
13 uses
14 Graphics, Windows, Registry;
15
16 procedure LoadFont(const sKey, sItemID: string; var aFont: TFont);
17 procedure SaveFont(const sKey, sItemID: string; aFont: TFont);
18
19 implementation
20
21 type
22 TFontDescription = packed record
23 Color: TColor;
24 LogFont: TLogFont;
25 end;
26
27 procedure LoadFont(const sKey, sItemID: string; var aFont: TFont);
28 var
29 iSiz: Integer;
30 FontDesc: TFontDescription;
31 begin
32 with TRegistry.Create do
33 begin
34 if OpenKey(sKey, False) then
35 try
36 iSiz := SizeOf(FontDesc);
37 if ReadBinaryData(sItemID, FontDesc, iSiz) = SizeOf(FontDesc) then
38 begin
39 aFont.Handle := CreateFontIndirect(FontDesc.LogFont);
40 end;
41 aFont.Color := FontDesc.Color;
42 finally
43 CloseKey;
44 end;
45 // free the registry object
46 Free;
47 end;
48 end;
49
50 procedure SaveFont(const sKey, sItemID: string; aFont: TFont);
51 var
52 iSiz: Integer;
53 FontDesc: TFontDescription;
54 begin
55 with TRegistry.Create do
56 begin
57 iSiz := SizeOf(FontDesc.LogFont);
58 if GetObject(aFont.Handle, iSiz, @FontDesc.LogFont) > 0 then
59 begin
60 f OpenKey(sKey, True) then
61 try
62 FontDesc.Color := aFont.Color;
63 WriteBinaryData(sItemID, FontDesc, SizeOf(FontDesc));
64 finally
65 CloseKey;
66 end;
67 end;
68 // free the registry object
69 Free;
70 end;
71 end;
72
73 end.
|
