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.
1 WriteString(key, Font.FaceName);
2 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.
3
4 // saves/ reads a font to/ from the registry
5 //
6 // read like this:
7 // fEditorFont := TFont.Create;
8 // fEditorFont.name := 'Courier New';
9 // fEditorFont.Size := 10;
10 // LoadFont(sKey, 'Editor', fEditorFont);
11 //
12 // and save like this:
13 // SaveFont(sKey, 'Editor', fEditorFont);
14 unit sFontStorage;
15 interface
16 uses
17 Graphics, Windows, Registry;
18
19 procedure LoadFont(const sKey, sItemID: string; var aFont: TFont);
20 procedure SaveFont(const sKey, sItemID: string; aFont: TFont);
21
22 implementation
23
24 type
25 TFontDescription = packed record
26 Color: TColor;
27 LogFont: TLogFont;
28 end;
29
30 procedure LoadFont(const sKey, sItemID: string; var aFont: TFont);
31 var
32 iSiz: Integer;
33 FontDesc: TFontDescription;
34 begin
35 with TRegistry.Create do
36 begin
37 if OpenKey(sKey, False) then
38 try
39 iSiz := SizeOf(FontDesc);
40 if ReadBinaryData(sItemID, FontDesc, iSiz) = SizeOf(FontDesc) then
41 begin
42 aFont.Handle := CreateFontIndirect(FontDesc.LogFont);
43 end;
44 aFont.Color := FontDesc.Color;
45 finally
46 CloseKey;
47 end;
48 // free the registry object
49 Free;
50 end;
51 end;
52
53 procedure SaveFont(const sKey, sItemID: string; aFont: TFont);
54 var
55 iSiz: Integer;
56 FontDesc: TFontDescription;
57 begin
58 with TRegistry.Create do
59 begin
60 iSiz := SizeOf(FontDesc.LogFont);
61 if GetObject(aFont.Handle, iSiz, @FontDesc.LogFont) > 0 then
62 begin
63 f OpenKey(sKey, True) then
64 try
65 FontDesc.Color := aFont.Color;
66 WriteBinaryData(sItemID, FontDesc, SizeOf(FontDesc));
67 finally
68 CloseKey;
69 end;
70 end;
71 // free the registry object
72 Free;
73 end;
74 end;
75
76 end.
|
