推荐订阅源

把字体保存到注册表或流中

［ 作者：hubdog    转贴自：本站原创    点击数：201    更新时间：2004-7-7    文章录入：delphilxh ］

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

// Save a font to the registry 保存到注册表
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 读取注册表
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 保存到流
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 从流中读出
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;