How to save and restore font properties in the registry (2)

Problem/Question/Abstract:

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:


var
  lf: TLogfont;
begin
  fillchar(lf, sizeof(lf), 0);
  GetObject(font.handle, sizeof(lf), @lf);
  registry.WriteBinarydata(valuename, lf, sizeof(lf));
end;


Reading it back would go like this:


registry.ReadBinarydata(valuename, lf, sizeof(lf));
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.


type
  TFontWrapper = class(TComponent)
  private
    FFont: TFont;
    procedure SetFont(f: TFont);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Font: TFont read FFont write SetFont;
  end;

constructor TFontWrapper.Create(AOwner: TComponent);
begin
  inherited Create(aOwner);
  FFont := TFont.Create;
end;

destructor TFontWrapper.Destroy;
begin
  FFont.Free;
  inherited Destroy;
end;

procedure TFontWrapper.SetFont(f: TFont);
begin
  FFont.Assign(f);
end;

procedure TScratchMain.SpeedButton2Click(Sender: TObject);
const
  b: Boolean = False;
var
  fw: TFontWrapper;
  st: TFileStream;
begin
  if b then
  begin
    edit1.text := 'Loading font';
    fw := nil;
    st := TFileStream.Create('E:\A\test.str', fmOpenRead);
    try
      fw := TFontWrapper.Create(nil);
      st.ReadComponent(fw);
      memo1.font.assign(fw.font);
    finally
      fw.Free;
      st.Free;
    end;
  end
  else
  begin
    edit1.text := 'Saving font';
    fw := nil;
    st := TFileStream.Create('E:\A\test.str', fmCreate);
    try
      fw := TFontWrapper.Create(nil);
      fw.Font := Font;
      st.WriteComponent(fw);
    finally
      fw.Free;
      st.Free;
    end;
  end;
  b := not b;
end;