Mega Code Archive
Storing font information in the registry - with one key only
<![CDATA[
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.
// saves/ reads a font to/ from the registry
//
// read like this:
// fEditorFont := TFont.Create;
// fEditorFont.name := 'Courier New';
// fEditorFont.Size := 10;
// LoadFont(sKey, 'Editor', fEditorFont);
//
// and save like this:
// SaveFont(sKey, 'Editor', fEditorFont);
unit sFontStorage;
interface
uses
Graphics, Windows, Registry;
procedure LoadFont(const sKey, sItemID: string; var aFont: TFont);
procedure SaveFont(const sKey, sItemID: string; aFont: TFont);
implementation
type
TFontDescription = packed record
Color: TColor;
LogFont: TLogFont;
end;
procedure LoadFont(const sKey, sItemID: string; var aFont: TFont);
var
iSiz: Integer;
FontDesc: TFontDescription;
begin
with TRegistry.Create do
begin
if OpenKey(sKey, False) then
try
iSiz := SizeOf(FontDesc);
if ReadBinaryData(sItemID, FontDesc, iSiz)=SizeOf(FontDesc) then
begin
aFont.Handle := CreateFontIndirect(FontDesc.LogFont);
end;
aFont.Color := FontDesc.Color;
finally
CloseKey;
end;
// free the registry object
Free;
end;
end;
procedure SaveFont(const sKey, sItemID: string; aFont: TFont);
var
iSiz: Integer;
FontDesc: TFontDescription;
begin
with TRegistry.Create do
begin
iSiz := SizeOf(FontDesc.LogFont);
if GetObject(aFont.Handle, iSiz, @FontDesc.LogFont)>0 then
begin
f OpenKey(sKey, True) then
try
FontDesc.Color := aFont.Color;
WriteBinaryData(sItemID, FontDesc, SizeOf(FontDesc));
finally
CloseKey;
end;
end;
// free the registry object
Free;
end;
end;
end.
]]>