Cambiar el tipo de letra en un QReport

[adebonis]

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]

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:

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]

para guardarlo: simplemente:

campo1.asstring:= FontToStr(Edit1.text);


En el BeforePrint cambiamos la fuente de QRDBTEXT1:

StrToFont(dtmImp.qryCampo1.AsString,QRDBtext1.Font);


mas o menos ;)

Saludos

[adebonis]

Estoy usando Delphi 5.

¿De donde has sacado la función StrToFont?

Adolfo de Bonis

[Lepe]

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]

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]

Hola.

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

[dec]

Hola,


¿De donde has sacado la función StrToFont?


Eso me gustaría saber a mi :).

No sé si sería ahí donde la encontraste Lepe, pero, en la librería "DelphiWorks (http://delphiworks.sourceforge.net/)", 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.