paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-07 01:06:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL, GTK2: Font with number got wrong size part 2, issue #21775, patch from G. Zakrzewski"

Browse Source 
git-svn-id: trunk@38098 -
This commit is contained in:
juha 2012-07-31 20:04:31 +00:00
parent 89415fa392
commit 8fae5b8320
3 changed files with 37 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/graphics.pp
View File

@ -1946,7 +1946,7 @@ function ClearXLFDPitch(const LongFontName: string): string;
function ClearXLFDStyle(const LongFontName: string): string; function ClearXLFDStyle(const LongFontName: string): string;
function XLFDHeightIsSet(const LongFontName: string): boolean; function XLFDHeightIsSet(const LongFontName: string): boolean;
procedure FontNameToPangoFontDescStr(const LongFontName: string; procedure FontNameToPangoFontDescStr(const LongFontName: string;
out aFamily,aStyle:String; out aSize: Integer); out aFamily,aStyle:String; out aSize: Integer; out aSizeInPixels: Boolean);
// graphics // graphics
type type

25
lcl/include/font.inc
View File

@ -514,7 +514,7 @@ end;
// [SIZE] is a decimal number (size in points) (... and points in PANGO_UNITS) // [SIZE] is a decimal number (size in points) (... and points in PANGO_UNITS)
// any of these options may be absent. // any of these options may be absent.
procedure FontNameToPangoFontDescStr(const LongFontName: string; procedure FontNameToPangoFontDescStr(const LongFontName: string;
out aFamily,aStyle: string; out aSize: Integer); out aFamily,aStyle: string; out aSize: Integer; out aSizeInPixels: Boolean);
var var
ParsePos: Integer; ParsePos: Integer;
@ -533,7 +533,7 @@ var
function GetSize: string; function GetSize: string;
var var
c: char; c: char;
validblank: boolean; ValidBlank, CheckPixelsNeeded: boolean;
InitPos: Integer; InitPos: Integer;
function IsBlank: boolean; function IsBlank: boolean;
@ -548,7 +548,8 @@ var
begin begin
Result := ''; Result := '';
validblank := true; ValidBlank := True;
CheckPixelsNeeded := True;
ParsePos := Length(LongFontname); ParsePos := Length(LongFontname);
InitPos := ParsePos; InitPos := ParsePos;
while ParsePos>0 do begin while ParsePos>0 do begin
@ -560,16 +561,29 @@ var
continue continue
end else end else
break; break;
ValidBlank := false; ValidBlank := False;
if CheckPixelsNeeded then
begin
CheckPixelsNeeded := False;
aSizeInPixels := (ParsePos > 2) and (longFontName[ParsePos - 1] = 'p')
and (longFontName[ParsePos] = 'x');
if aSizeInPixels then
begin
dec(ParsePos, 2);
Continue;
end;
end;
if IsDigit then begin if IsDigit then begin
Result := C + Result; Result := C + Result;
dec(ParsePos); dec(ParsePos);
end else begin end else begin
if not IsBlank then if not IsBlank and (C <> ',')then
begin begin
Result := ''; Result := '';
ParsePos := InitPos; ParsePos := InitPos;
end; end;
if C = ',' then
dec(ParsePos);
break; break;
end; end;
end; end;
@ -579,6 +593,7 @@ begin
aStyle := ''; aStyle := '';
aFamily := ''; aFamily := '';
aSize := 0; aSize := 0;
aSizeInPixels := False;
if IsFontNameXLogicalFontDesc(LongFontName) then begin if IsFontNameXLogicalFontDesc(LongFontName) then begin
aFamily := ExtractXLFDItem(LongFontName, XLFD_FAMILY); aFamily := ExtractXLFDItem(LongFontName, XLFD_FAMILY);
if aFamily='*' then if aFamily='*' then

22
lcl/interfaces/gtk2/gtk2winapi.inc
View File

@ -1355,6 +1355,7 @@ var
GdiObject: PGdiObject; GdiObject: PGdiObject;
FullString, aFamily, aStyle, ALongFontName: String; FullString, aFamily, aStyle, ALongFontName: String;
aSize: Integer; aSize: Integer;
aSizeInPixels: Boolean;
PangoDesc: PPangoFontDescription; PangoDesc: PPangoFontDescription;
CachedFont: TGtkFontCacheDescriptor; CachedFont: TGtkFontCacheDescriptor;
AttrList: PPangoAttrList; AttrList: PPangoAttrList;
@ -1410,7 +1411,7 @@ begin
exit; exit;
end; end;
FontNameToPangoFontDescStr(ALongFontname, aFamily, aStyle, aSize); FontNameToPangoFontDescStr(ALongFontname, aFamily, aStyle, aSize, aSizeInPixels);
// if font specified size, prefer this instead of 'possibly' inaccurate // if font specified size, prefer this instead of 'possibly' inaccurate
// lfHeight note that lfHeight may actually have a most accurate value // lfHeight note that lfHeight may actually have a most accurate value
@ -1450,19 +1451,28 @@ begin
FullString := '10' // use some default: TODO: find out the default size of the widget FullString := '10' // use some default: TODO: find out the default size of the widget
else else
if aSize > 0 then if aSize > 0 then
FullString := IntToStr(aSize) begin
FullString := IntToStr(aSize);
if aSizeInPixels then
FullString := FullString + 'px';
end
else else
FullString := ''; FullString := '';
FullString := AFamily + ', ' + aStyle + ' ' + FullString; if Pos(',', AFamily) > 0 then
FullString := AFamily + ' ' + aStyle + ' ' + FullString
else
FullString := AFamily + ', ' + aStyle + ' ' + FullString;
PangoDesc := pango_font_description_from_string(PChar(FullString)); PangoDesc := pango_font_description_from_string(PChar(FullString));
if lfWeight <> FW_DONTCARE then if (pango_font_description_get_weight(PangoDesc) = PANGO_WEIGHT_NORMAL)
and (lfWeight <> FW_DONTCARE) then
pango_font_description_set_weight(PangoDesc, lfWeight); pango_font_description_set_weight(PangoDesc, lfWeight);
if lfItalic <> 0 then if (pango_font_description_get_style (PangoDesc) = PANGO_STYLE_NORMAL)
and (lfItalic <> 0) then
pango_font_description_set_style(PangoDesc, PANGO_STYLE_ITALIC); pango_font_description_set_style(PangoDesc, PANGO_STYLE_ITALIC);
aStyle := pango_font_description_to_string(PangoDesc);
if (aSize=0) and (lfHeight<>0) then if (aSize=0) and (lfHeight<>0) then
begin begin
// a size is not specified, try to calculate one based on lfHeight // a size is not specified, try to calculate one based on lfHeight