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

lcl: update font on Height change. Change the size only is not correct since LogFont contains lfHeight = Height. fixes bug #0013727

Browse Source 
git-svn-id: trunk@20010 -
This commit is contained in:
paul 2009-05-17 13:57:24 +00:00
parent 331b3f8019
commit f977ee640b
4 changed files with 21 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/graphics.pp
View File

@ -516,7 +516,7 @@ type
procedure SetColor(Value: TColor); procedure SetColor(Value: TColor);
procedure SetFlags(Index: integer; AValue: boolean); override; procedure SetFlags(Index: integer; AValue: boolean); override;
procedure SetFPColor(const AValue: TFPColor); override; procedure SetFPColor(const AValue: TFPColor); override;
procedure SetHeight(value: Integer); procedure SetHeight(Avalue: Integer);
procedure SetName(AValue: string); override; procedure SetName(AValue: string); override;
procedure SetOrientation(AValue: Integer); procedure SetOrientation(AValue: Integer);
procedure SetPitch(Value: TFontPitch); procedure SetPitch(Value: TFontPitch);

24
lcl/include/font.inc
View File

@ -835,13 +835,25 @@ end;
Sets the height of a font Sets the height of a font
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure TFont.SetHeight(Value: Integer); procedure TFont.SetHeight(AValue: Integer);
begin begin
if FHeight = Value then Exit; // Don't update Size only. The LogFont contains a lfHeight value and on Windows,
// set Size first. This will set FHeight to a rounded equivalent // Qt and Carbon it is the main parameter which determins the font height.
Size := -MulDiv(Value, 72, FPixelsPerInch); if Height <> AValue then
// store the real FHeight begin
FHeight := Value; BeginUpdate;
try
FreeReference;
FHeight := AValue;
// update size to equivalent value
inherited SetSize(-MulDiv(AValue, 72, FPixelsPerInch));
if IsFontNameXLogicalFontDesc(Name) then
Name := ClearXLFDHeight(Name);
Changed;
finally
EndUpdate;
end;
end;
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------

2
lcl/include/winapi.inc
View File

@ -123,7 +123,7 @@ end;
function CreateFontIndirectEx(const LogFont: TLogFont; function CreateFontIndirectEx(const LogFont: TLogFont;
const LongFontName: string): HFONT; const LongFontName: string): HFONT;
begin begin
Result := WidgetSet.CreateFontIndirectEx(LogFont,LongFontName); Result := WidgetSet.CreateFontIndirectEx(LogFont, LongFontName);
end; end;
function CreateIconIndirect(IconInfo: PIconInfo): HICON; function CreateIconIndirect(IconInfo: PIconInfo): HICON;

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

@ -188,7 +188,7 @@ begin
// NOTE: in gtk2.8 is possible to use pango_font_description_set_absolute_size // 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 // which would be great with the given lfheight value, but older gtk2 version
// doesn't have this function // doesn't have this function
if lfHeight<0 then if lfHeight < 0 then
aSize := -MulDiv(lfheight, 72, ScreenInfo.PixelsPerInchY) * PANGO_SCALE aSize := -MulDiv(lfheight, 72, ScreenInfo.PixelsPerInchY) * PANGO_SCALE
else else
aSize := lfHeight * PANGO_SCALE; aSize := lfHeight * PANGO_SCALE;