Mega Code Archive
Save a font to the registry-a stream
<![CDATA[
type
FontRec = packed record
Color: TColor;
LogFont: TLogFont;
end;
// Save a font to the registry
// Eine Schrift in die Registry speichern
procedure SaveFontToReg(reg: TRegistry; const key, id: string; Font: TFont);
var
fRec: FontRec;
begin
if Windows.GetObject(Font.Handle, SizeOf(fRec.LogFont), @fRec.LogFont) > 0 then
begin
if reg.OpenKey(key, True) then
try
fRec.Color := Font.Color;
reg.WriteBinaryData(id, fRec, SizeOf(fRec));
finally
reg.CloseKey;
end;
end;
end;
// Load a font from the registry
// Eine Schrift von der Registry laden
procedure LoadFont(reg: TRegistry; const key, id: string; Font: TFont);
var
fRec: FontRec;
begin
if reg.OpenKey(key, False) then
try
if reg.ReadBinaryData(id, frec, SizeOf(fRec)) = SizeOf(fRec) then
Font.Handle := CreateFontIndirect(fRec.LogFont);
Font.Color := fRec.Color;
finally
reg.CloseKey;
end;
end;
// Save a font to a stream
// Eine Schrift in einen Stream speichern
procedure WriteFontToStream(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;
// Read a font from a stream
// Eine Schrift von einem Stream laden
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;
]]>