Storing Font information in the registry

Windows with Delphi
Windows API (94)
Windows Filesystem (41)
Windows Forms (69)
Windows Graphics (38)

See also:

Storing Font information in the registry - with one key only

This article has not been rated yet. After reading, feel free to leave comments and rate it.

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.

You don't like the formatting? Check out SourceCoder then!

Comments:

Email address (not necessary): Rate as	Hide my email when showing my comment. Please notify me once a day about new comments on this topic. Please provide a valid email address if you select this option.

It seems that you are from Washington, US . Info/ Feedback on this	Show city and country Show country only Hide my location
You can mark text as 'quoted' by putting [quote] .. [/quote] around it.
Please type in the code:
Add a picture: Please do not post inappropriate pictures. Inappropriate pictures include pictures of minors and nudity. The owner of this web site reserves the right to delete such material.


	Search: