Cambiar el tipo de letra en un QReport

adebonis · #1 19-02-2005

Hola.

¿Alguien sabe cómo se puede modificar el tipo de letra (fuente) de los componentes de un Reporte (QReport) en tiempo de ejecución?

Topos los componentes tienen la propiedad ParentFont a True y no se cómo asignar una fuente a la propiedad Font.name del QReport.

Gracias.

[Lepe] · #2 20-02-2005

hace unas semanas me hizo falta eso mismo, pero guardando en la base de datos la fuente que se ha de usar, encontré un ejemplo en internet y lo adapté a mis necesidades:

Código Delphi [-]unit LpFont;

interface

uses Graphics,sysutils, types,windows;
const SALTOLINEA = #10#13;
type TInclude= (iName,iSize,iStyle);
type TSetOfInclude = set of TInclude;
const descripcion:array [TInclude] of string =('Fuente: ',
                                               'Tamaño: ',
                                               'Estilo: ');

{-----------------------------------------------------------------------------
  Procedure: FontToStr
  Author:    Lepe
  Date:      08-feb-2005
  Arguments: Font: TFont
  Result:    string

  Devuelve una cadena de estilo:Times New Roman,0,16711680,16,7
  que sigue el patron:
  Nombre, charset, color, tamaño, Negrita + cursiva + subrayado
-----------------------------------------------------------------------------}
function FontToStr(Font: TFont):string;

{-----------------------------------------------------------------------------
  Procedure: StrToFont
  Author:    Lupas
  Date:      08-feb-2005
  Arguments: str: string; FontToModify: TFont
  Result:    None

  Dada una fuente en formato:Times New Roman,0,16711680,16,7
  aplica los valores al parametro FontToModify
-----------------------------------------------------------------------------}
procedure StrToFont(str: string; FontToModify: TFont);

{-----------------------------------------------------------------------------
  Procedure: StrFontToText
  Author:    Lepe
  Date:      08-feb-2005
  Arguments: str: string;
             const UseBreakLine:Boolean = True;
             const Options:TSetOfInclude=[iName,iSize,iStyle]
  Result:    string

  Dada un string: Times New Roman,0,16711680,16,7
  devuelve un String más descriptivo:
   Fuente: MS Sans Serif; Tamaño: 24; Estilo:  Negrita  Cursiva  Subrayado

   Si UsebreakLine:
    Fuente: MS Sans Serif;
    Tamaño: 24;
    Estilo:  Negrita  Cursiva  Subrayado

   El texto 'Fuente' 'Tamaño' 'Estilo' salen siempre
-----------------------------------------------------------------------------}
function StrFontToText(str: string;const UseBreakLine:Boolean = True;
                  const Options:TSetOfInclude=[iName,iSize,iStyle]):string;


function FontWidthInPixels(SurfaceToPaint:THandle; Str:string;var TheWidth:integer):Boolean;
function FontHeigthInPixels(SurfaceToPaint:THandle; Str:string; var TheHeight : integer):boolean;
function FontDimensionInPixels(SurfaceToPaint:THandle; Str:string;var TheSize : Tsize):Boolean;

implementation

function FontDimensionInPixels(SurfaceToPaint:THandle; Str:string;var TheSize : Tsize):Boolean;
begin
  Result := windows.GetTextExtentPoint32(SurfaceToPaint,PChar(str),Length(Str),TheSize)
end;


function FontHeigthInPixels(SurfaceToPaint:THandle; Str:string; var TheHeight : integer):Boolean;
var s:TSize;
begin
  Result := FontDimensionInPixels(SurfaceToPaint,Str,S);
  if Result then TheHeight := s.cy;
end;

function FontWidthInPixels(SurfaceToPaint:THandle; Str:string;var TheWidth:integer):Boolean;
var s:TSize;
begin
  Result := fontdimensioninPixels(SurfaceToPaint,Str,S);
  if Result then TheWidth:= s.cx;
end;

function FontToStr(Font: TFont):string;
begin
  if Assigned(Font) then
    Result:= Font.Name + ',' +
             IntToStr(Font.CharSet) + ',' +
             IntToStr(Font.Color) + ',' +
             IntToStr(Font.Size) + ',' +
             IntToStr(Byte(Font.Style))
  else
    Result := ',,,,';
end;

procedure StrToFont(str: string; FontToModify: TFont);
var s, Data: string;
    i: Integer;
begin
  if not Assigned(FontToModify) then
    raise Exception.Create('se necesita una fuente creada.');
  s := str;
  try
    i := Pos(',', s);
    if i > 0 then
    begin
      {Name}
      Data := Trim(Copy(s, 1, i-1));
      if Data <> '' then
        FontToModify.Name := Data;
      Delete(s, 1, i);
      i := Pos(',', s);
      if i > 0 then
      begin
        {CharSet}
        Data := Trim(Copy(s, 1, i-1));
        if Data <> '' then
          FontToModify.Charset := TFontCharSet(StrToIntDef(Data, FontToModify.Charset));
        Delete(s, 1, i);
        i := Pos(',', s);
        if i > 0 then
        begin
          {Color}
          Data := Trim(Copy(s, 1, i-1));
          if Data <> '' then
            FontToModify.Color := TColor(StrToIntDef(Data, FontToModify.Color));
          Delete(s, 1, i);
          i := Pos(',', s);
          if i > 0 then
          begin
           {Size}
           Data := Trim(Copy(s, 1, i-1));
           if Data <> '' then
             FontToModify.Size := StrToIntDef(Data, FontToModify.Size);
           Delete(s, 1, i);
           {Style}
           Data := Trim(s);
           if Data <> '' then
             FontToModify.Style := TFontStyles(Byte(StrToIntDef(Data, Byte(FontToModify.Style))));
          end
        end
      end
    end;
  except
  end;
end;

function StrFontToText(str: string;const UseBreakLine:Boolean = True;
const Options:TSetOfInclude=[iName,iSize,iStyle]):string;
var s, Data: string;
    i: Integer;
    Style:TFontStyles;
begin
  s := str;
  try
    i := Pos(',', s);
    if i > 0 then
    begin
      {Name}
      Data := Trim(Copy(s, 1, i-1));
      if Data <> '' then
        if iname in Options then
        Result := Result + descripcion[iname]+Data+';';
        if UseBreakLine then
          Result := Result + SALTOLINEA;
      Delete(s, 1, i);
      i := Pos(',', s);
      if i > 0 then
      begin
        {CharSet}
        Data := Trim(Copy(s, 1, i-1));
        Delete(s, 1, i);
        i := Pos(',', s);
        if i > 0 then
        begin
          {Color}
          Data := Trim(Copy(s, 1, i-1));
          Delete(s, 1, i);
          i := Pos(',', s);
          if i > 0 then
          begin
           {Size}
           Data := Trim(Copy(s, 1, i-1));
           if Data <> '' then
             if isize in Options then
               Result := Result + descripcion [isize ]+Data+';' ;
           if UseBreakLine then
             Result := Result + SALTOLINEA;
           Delete(s, 1, i);
           {Style}
           Data := Trim(s);
           if Data <> '' then
           begin
             Style := TFontStyles(Byte(StrToIntDef(Data,0)));
             if StrToIntDef(Data,0) <> 0 then
              if istyle in Options then
              begin
                 Result := Result + descripcion[istyle];
                 if fsbold in Style then
                  Result := Result+ ' Negrita ';
                 if fsitalic in Style then
                  Result := Result + ' Cursiva ';
                 if fsunderline in Style then
                  Result := Result + ' Subrayado ';
                 if UseBreakLine then
                   Result := Result + SALTOLINEA;
              end;
           end;
          end
        end
      end;
      // quitamos el ultimo salto de linea;
      if UseBreakLine then
        Delete(Result,Length(Result)-Length(SALTOLINEA),Length(SALTOLINEA));
    end;
  except
  end;
end;
end.

[Lepe] · #3 20-02-2005

para guardarlo: simplemente:

Código Delphi [-] campo1.asstring:= FontToStr(Edit1.text);

En el BeforePrint cambiamos la fuente de QRDBTEXT1:

Código Delphi [-] StrToFont(dtmImp.qryCampo1.AsString,QRDBtext1.Font);

mas o menos

Saludos

adebonis · #4 24-02-2005

Estoy usando Delphi 5.

¿De donde has sacado la función StrToFont?

Adolfo de Bonis

[Lepe] · #5 24-02-2005

Eso me gustaría saber a mi

.

La verdad es que anduve por muchos sitios buscando y bajando codigos distintos, hasta encontrar ese.

Yo uso delphi 6

Tienes algun problema?

adebonis · #6 26-02-2005

Hola.

Ya he conseguido que funcionara perfectamente. Va muy bien pero...

el caso es que me cambia sin problemas el Tamaño y el Estilo, pero la Fuente únicamente me la cambia cuando NO es TrueType.

¿Sabes algo de eso? Gracias

adebonis · #7 26-02-2005

Hola.

Era un pequeño error. Funciona perfectamente. Gracias.

dec · #8 30-08-2005

Hola,

Cita:

Empezado por adebonis

¿De donde has sacado la función StrToFont?

Cita:

Empezado por Lepe

Eso me gustaría saber a mi

.

No sé si sería ahí donde la encontraste Lepe, pero, en la librería "DelphiWorks", concretamente en la unidad "dwConvert.pas" se encuentra una función "dwFontToStr" y otra "dwStrToFont", así como "dwStrToFontStyle" y "dwStrToFontPitch", entre no pocas más funciones.