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: ');
function FontToStr(Font: TFont):string;
procedure StrToFont(str: string; FontToModify: TFont);
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
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
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
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
Data := Trim(Copy(s, 1, i-1));
if Data <> '' then
FontToModify.Size := StrToIntDef(Data, FontToModify.Size);
Delete(s, 1, i);
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
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
Data := Trim(Copy(s, 1, i-1));
Delete(s, 1, i);
i := Pos(',', s);
if i > 0 then
begin
Data := Trim(Copy(s, 1, i-1));
Delete(s, 1, i);
i := Pos(',', s);
if i > 0 then
begin
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);
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;
if UseBreakLine then
Delete(Result,Length(Result)-Length(SALTOLINEA),Length(SALTOLINEA));
end;
except
end;
end;
end.