Guardar TFontStyle en tabla paradox

[GerTorresM]

Me parecio muy bueno tu código, tal solo una cosa como puedo guardar ek color y el Estilo ??

[ecfisa]

Hola GerTorresM.

Código Delphi [-]
procedure SaveFieldFont(aDataSet: TDataSet; aFont: TFont;
  const BlobFieldName: string);
var
  ms: TStream;
  LogFont: TLogFont;
  sColor: TColor;
begin
  ZeroMemory(@LogFont, SizeOf(LogFont));
  GetObject(aFont.Handle, SizeOf(LogFont), @LogFont);
  sColor := aFont.Color;
  ms := TMemoryStream.Create;
  try
    ms.WriteBuffer(LogFont, SizeOf(LogFont));
    ms.WriteBuffer(sColor, SizeOf(TColor));
    with aDataSet do
    begin
      if not (State in [dsEdit,dsInsert]) then Edit;
      TBlobField(FieldByName(BlobFieldName)).LoadFromStream(ms);
    end;
  finally
    ms.Free;
  end;
end;

procedure LoadFieldFont(aDataSet: TDataSet; aFont: TFont;
  const BlobFieldName: string);
var
  ms: TStream;
  LogFont: TLogFont;
  sColor: TColor;
begin
  ms := TMemoryStream.Create;
  try
    TBlobField(aDataSet.FieldByName(BlobFieldName)).SaveToStream(ms);
    ms.Seek(soFromBeginning, 0);
    ZeroMemory(@LogFont, SizeOf(LogFont));
    ms.ReadBuffer(LogFont, SizeOf(LogFont));
    ms.ReadBuffer(sColor, SizeOf(TColor));
    aFont.Color := sColor;
    aFont.Handle := CreateFontIndirect(LogFont);
    aFont.Height := LogFont.lfHeight;
    if Boolean(LogFont.lfItalic) then
      aFont.Style := aFont.Style + [fsItalic];
    if Boolean(LogFont.lfUnderline) then
      aFont.Style := aFont.Style + [fsUnderline];
    if Boolean(LogFont.lfStrikeOut) then
      aFont.Style := aFont.Style + [fsStrikeOut];
    if Boolean(LogFont.lfWeight and 700) then
      aFont.Style := aFont.Style + [fsBold];
  finally
    ms.Free;
  end;
end;

Ejemplo de uso:

Código Delphi [-]
procedure TForm1.FormCreate(Sender: TObject);
begin
  Table1.Open;
  Label1.Font.Name  := 'Segoe Print';
  Label1.Font.Size  := 18;
  Label1.Font.Color := clRed;
  Label1.Font.Style := [fsItalic, fsStrikeOut, fsBold];
  Label1.Caption    := 'Caption Label1';
end;

procedure TForm1.btSaveClick(Sender: TObject);
begin
  Table1.Edit;
  Table1.FieldByName('Texto').AsString := Label1.Caption;
  SaveFieldFont(Table1, Label1.Font, 'Fuente');
  Table1.Post;
end;

procedure TForm1.btLoadClick(Sender: TObject);
begin
  Label2.Caption := Table1.FieldByName('Texto').AsString;
  LoadFieldFont(Table1, Label2.Font, 'Fuente');
end;

Saludos