No hay respuestas en este tema

[sir.dev.a.lot]

[TRUCO DELPHI] Salvar una Fuente/Font al registro o a un Stream.

delphi

type
	  FontRec = packed record
	    Color: TColor;
	    LogFont: TLogFont;
	  end;
 
	// Salva la fuente al Registro
	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;
 
	// Carga la fuente desde el Registro
	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;
 
	// Guarda la fuente a un 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;
 
	// Carga la Fuente desde un Stream
	procedure ReadFont(s: TStream; Font: TFont);
	var
	  fRec: FontRec;
	  sz: integer;
	begin
	  s.read(sz, SizeOf(Integer));

Codigo restante.

delphi

if sz = SizeOf(fRec.LogFont) then
 
  begin
 
    s.read(fRec, SizeOf(fRec));
 
    Font.Handle := CreateFontIndirect(fRec.LogFont);
 
    Font.Color  := fRec.Color;
 
  end;
 
end;

Saludos!