Guardar TFontStyle en tabla paradox
 

Hola, tengo la siguiente definicion:

Código Delphi [-]
  RegRangos= Record
               R1,R2,R3,R4: Byte;
               ColorR1,ColorR2,ColorR3,ColorR4,ColorR5:TColor;
               Amalgamas : Integer;  //para decir si la medicion en TING comienza en amalgamas
               ColorAli1,ColorAli2,ColorAli3:TColor;
             end;

  EstiLineas = Record
                   FuenteName : String[100];
                   FuenteSize : Integer;
                   FuenteEstilo : TFontStyles;
                   FuenteColor : Integer;
                 End;

y defino:
  RegistroRangos: file of RegRangos;
  RegistroLineas: file of EstiLineas;

y quisiera, en vez de generar un fichero, tener los datos en un registro de una tabla paradox (delphi 6, paradox 7). Pero no se como definir el tipo de dato que le puedo poner al campo FuenteEstilo.

Gracias.

Hola tarco35.

Tenes que usar un tipo Blob, que en Paradox se declara como Binary.

Código Delphi [-]
procedure SaveFieldFont(aDataSet: TDataSet; aFont: TFont;
  const BlobFieldName: string);
var
  ms: TStream;
  LogFont: TLogFont;
begin
  ZeroMemory(@LogFont, SizeOf(LogFont));
  GetObject(aFont.Handle, SizeOf(LogFont), @LogFont);
  ms  := TMemoryStream.Create;
  try
    ms.WriteBuffer(LogFont, SizeOf(LogFont));
    with aDataSet do
    begin
      if not (State in [dsEdit,dsInsert]) then Edit; // (sólo por precaución :) )
      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;
begin
  ms := TMemoryStream.Create;
  try
    TBlobField(aDataSet.FieldByName(BlobFieldName)).SaveToStream(ms);
    ms.Position := 0;
    ZeroMemory(@LogFont, SizeOf(LogFont));
    ms.Read(LogFont, sizeof(LogFont));
    aFont.Handle := CreateFontIndirect(LogFont);
  finally
    ms.Free;
  end;
end;

Ejemplo de uso:

Código Delphi [-]
procedure TForm1.btSaveFontClick(Sender: TObject);
begin
  Label1.Font.Name := 'Segoe Print';
  Label1.Font.Size := 18;
  Table1.Append;
  Table1.FieldByName('Texto').AsString := 'Un texto de prueba para Label2';
  SaveFieldFont(Table1, Label1.Font, 'Fuente');
  //...
  Table1.Post;
end;

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

Saludos :)

Gracias por el aporte. un saludo.

Tu ejemplo al 100%
 

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

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 :)