How to save a TFont in a stream

Mirror

How to save a TFont in a stream (Views: 300)

Problem/Question/Abstract:

How can I save a font (including all its properties like color, angle, etc.) to a stream?

Answer:

{ ... }
type
  FontRec = packed record
    Color: TColor;
    LogFont: TLogFont;
  end;

procedure ReadFont(s: TStream; font: TFont);
var
  fRec: FontRec;
  sz: integer;
begin
  s.Read(sz, SizeOf(Integer));
  if sz = SizeOf(fRec.LogFont) then
  begin
    s.Read(fRec, SizeOf(fRec));
    font.Handle := CreateFontIndirect(fRec.LogFont);
    font.Color := fRec.Color;
  end;
end;

procedure WriteFont(s: TStream; font: TFont);
var
  fRec: FontRec;
  sz: integer;
begin
  sz := SizeOf(fRec.LogFont);
  if Windows.GetObject(font.Handle, sz, @fRec.LogFont) > 0 then
  begin
    s.Write(sz, SizeOf(Integer));
    fRec.Color := font.Color;
    s.Write(fRec, SizeOf(fRec));
  end
  else
  begin
    sz := 0;
    s.Write(sz, SizeOf(Integer));
  end;
end;

<< Back to main page