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

LCL: Fix wrong font size when there are numbers in name, issue #21775, patch from cobines

Browse Source 
git-svn-id: trunk@37258 -
This commit is contained in:
juha 2012-05-12 13:40:10 +00:00
parent 67d1097c03
commit dee0c332d7
3 changed files with 63 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/graphics.pp
View File

@ -1948,7 +1948,7 @@ function ClearXLFDHeight(const LongFontName: string): string;
function ClearXLFDPitch(const LongFontName: string): string; 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 XLFDNameToPangoFontDescStr(const LongFontName: string;
out aFamily,aStyle:String; out aSize: Integer); out aFamily,aStyle:String; out aSize: Integer);
// graphics // graphics

79
lcl/include/font.inc
View File

@ -503,22 +503,11 @@ begin
Result:=(MinusCnt=14); Result:=(MinusCnt=14);
end; end;
// split a given fontName into Pango Font description components // If font name is in X Logical Font Description format then split it into
// font name is supposed to follow this layout: // string components from which Pango Font description can be created.
// [FAMILY-LIST][STYLE-LIST][SIZE] procedure XLFDNameToPangoFontDescStr(const LongFontName: string;
// where:
// [FAMILY-LIST] is a comma separated list of families optionally
// ended by a comma
// [STYLE-LIST] is white space separated list of words where each word
// describe one of style, variant, slant, weight or stretch
// [SIZE] is a decimal number (size in points) (... and points in PANGO_UNITS)
// any of these options may be absent.
procedure FontNameToPangoFontDescStr(const LongFontName: string;
out aFamily,aStyle: string; out aSize: Integer); out aFamily,aStyle: string; out aSize: Integer);
var
ParsePos: Integer;
procedure addStyle(const s: string); procedure addStyle(const s: string);
begin begin
if (s<>'') and (s<>'*') and (s<>'r') then begin if (s<>'') and (s<>'*') and (s<>'r') then begin
@ -530,62 +519,16 @@ var
end; end;
end; end;
function GetSize: string;
var
c: char;
validblank: boolean;
function IsBlank: boolean;
begin
result := c in [#0..' '];
end;
function IsDigit: boolean;
begin
result := c in ['0'..'9'];
end;
begin
Result := '';
validblank := true;
ParsePos := Length(LongFontname);
while ParsePos>0 do begin
c := longFontName[ParsePos];
if IsBlank then
if ValidBlank then begin
dec(ParsePos);
continue
end else
break;
ValidBlank := false;
if IsDigit then begin
Result := C + Result;
dec(ParsePos);
end else
break;
end;
end;
begin begin
aStyle := ''; aStyle := '';
aFamily := ''; aFamily := ExtractXLFDItem(LongFontName, XLFD_FAMILY);
aSize := 0; if aFamily='*' then
if IsFontNameXLogicalFontDesc(LongFontName) then begin aFamily:='';
aFamily := ExtractXLFDItem(LongFontName, XLFD_FAMILY); aSize := StrToIntDef(ExtractXLFDItem(LongFontName, XLFD_POINTSIZE),0) div 10;
if aFamily='*' then addStyle( ExtractXLFDItem(LongFontName, XLFD_STYLENAME ));
aFamily:=''; addStyle( ExtractXLFDItem(LongFontname, XLFD_WEIGHTNAME));
aSize := StrToIntDef(ExtractXLFDItem(LongFontName, XLFD_POINTSIZE),0) div 10; addStyle( ExtractXLFDItem(LongFontname, XLFD_SLANT));
addStyle( ExtractXLFDItem(LongFontName, XLFD_STYLENAME )); addStyle( ExtractXLFDItem(LongFontname, XLFD_WidthName));
addStyle( ExtractXLFDItem(LongFontname, XLFD_WEIGHTNAME));
addStyle( ExtractXLFDItem(LongFontname, XLFD_SLANT));
addStyle( ExtractXLFDItem(LongFontname, XLFD_WidthName));
end else begin
// this could go through, but we want to know at least the pointSize from
// the fontname
aSize := StrToIntDef(GetSize,0);
aFamily := Copy(LongFontName, 1, ParsePos);
// todo: parse aFamily to separate Family and Style
end;
end; end;
{ TFont } { TFont }

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

@ -1412,73 +1412,79 @@ begin
exit; exit;
end; end;
FontNameToPangoFontDescStr(ALongFontname, aFamily, aStyle, aSize); if IsFontNameXLogicalFontDesc(ALongFontName) then
begin
XLFDNameToPangoFontDescStr(ALongFontname, aFamily, aStyle, aSize);
if aSize > 0 then
FullString := IntToStr(aSize)
else
FullString := '';
FullString := AFamily + ',' + aStyle + ' ' + FullString;
PangoDesc := pango_font_description_from_string(PChar(FullString));
end
else
begin
aSize := 0;
aFamily := ALongFontName;
if aFamily = 'default' then
begin
CurFont := GetDefaultGtkFont(False);
if PANGO_IS_LAYOUT(CurFont) then
begin
PangoDesc := pango_layout_get_font_description(CurFont);
if PangoDesc = nil then
PangoDesc := pango_context_get_font_description(pango_layout_get_context(CurFont));
aFamily := StrPas(pango_font_description_get_family(PangoDesc));
if lfHeight = 0 then
begin
aSize := pango_font_description_get_size(PangoDesc);
if not pango_font_description_get_size_is_absolute(PangoDesc) then
aSize := aSize div PANGO_SCALE;
end;
end;
end;
PangoDesc := pango_font_description_new;
pango_font_description_set_family(PangoDesc, PChar(aFamily));
if aSize <> 0 then
pango_font_description_set_size(PangoDesc, aSize);
end;
// 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
// but there is no way to know this at this point. // but there is no way to know this at this point.
// setting the size, this could be done in two ways // setting the size, this could be done in two ways
// method 1: fontdesc using fontname like "helvetica 12" // method 1: fontdesc using fontname like "helvetica 12"
// method 2: fontdesc using fontname like "helvetica" and later modify size // method 2: fontdesc using fontname like "helvetica" and later modify size
// to obtain consistent font sizes method 2 should be used // to obtain consistent font sizes method 2 should be used
// for method 1 converting lfheight to fontsize can lead to rounding errors // for method 1 converting lfheight to fontsize can lead to rounding errors
// for example, font size=12, lfheight=-12 (75dpi), at 75 dpi aSize=11 // for example, font size=12, lfheight=-12 (75dpi), at 75 dpi aSize=11
// so we would get a font "helvetica 11" instead of "helvetica 12" // so we would get a font "helvetica 11" instead of "helvetica 12"
// size information, and later modify font size // size information, and later modify font size
// using method 2 // using method 2
if aFamily = 'default' then if (aSize = 0) and (lfHeight <> 0) then
begin begin
CurFont := GetDefaultGtkFont(False); // a size is not specified, try to calculate one based on lfHeight
if PANGO_IS_LAYOUT(CurFont) then // NOTE: in gtk2.8 is possible to use pango_font_description_set_absolute_size
begin // which would be great with the given lfheight value, but older gtk2 version
PangoDesc := pango_layout_get_font_description(CurFont); // doesn't have this function
if PangoDesc = nil then aSize := abs(lfHeight) * PANGO_SCALE;
PangoDesc := pango_context_get_font_description(pango_layout_get_context(CurFont)); pango_font_description_set_absolute_size(PangoDesc, aSize);
aFamily := StrPas(pango_font_description_get_family(PangoDesc));
if (aSize = 0) and (lfHeight = 0) then
begin
aSize := pango_font_description_get_size(PangoDesc);
if not pango_font_description_get_size_is_absolute(PangoDesc) then
aSize := aSize div PANGO_SCALE;
end;
end;
end; end;
if (aSize = 0) and (lfHeight = 0) then
FullString := '10' // use some default: TODO: find out the default size of the widget
else
if aSize > 0 then
FullString := IntToStr(aSize)
else
FullString := '';
FullString := AFamily + ' ' + aStyle + ' ' + FullString;
PangoDesc := pango_font_description_from_string(PChar(FullString));
if lfWeight <> FW_DONTCARE then if lfWeight <> FW_DONTCARE then
pango_font_description_set_weight(PangoDesc, lfWeight); pango_font_description_set_weight(PangoDesc, lfWeight);
if lfItalic <> 0 then if lfItalic <> 0 then
pango_font_description_set_style(PangoDesc, PANGO_STYLE_ITALIC); pango_font_description_set_style(PangoDesc, PANGO_STYLE_ITALIC);
if (aSize=0) and (lfHeight<>0) then
begin
// a size is not specified, try to calculate one based on lfHeight
// and use this value not in the font name but set this value appart
// NOTE: in gtk2.8 is possible to use pango_font_description_set_absolute_size
// which would be great with the given lfheight value, but older gtk2 version
// doesn't have this function
if lfHeight < 0 then
aSize := -lfHeight * PANGO_SCALE
else
aSize := lfHeight * PANGO_SCALE;
pango_font_description_set_absolute_size(PangoDesc, aSize);
end;
// create font // create font
// TODO: use context widget (CreateFontIndirectEx needs a parameter for this: Context: HWnd) // TODO: use context widget (CreateFontIndirectEx needs a parameter for this: Context: HWnd)
GdiObject := NewGdiObject(gdiFont); GdiObject := NewGdiObject(gdiFont);