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

LCL: hint window: fix default (theme) font after r54293 #2bac2f4e5a

Browse Source 
git-svn-id: trunk@54304 -
This commit is contained in:
ondrej 2017-02-28 09:10:14 +00:00
parent 87641c3ff9
commit 134d8be1e9
2 changed files with 26 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/forms.pp
View File

@ -895,6 +895,12 @@ type
procedure SetColor(Value: TColor); override;
function UseBGThemes: Boolean;
function UseFGThemes: Boolean;
private class var
FSysHintFont: TFont;
protected
class function SysHintFont: TFont;
public
class destructor Destroy;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

21
lcl/include/hintwindow.inc
View File

@ -20,6 +20,11 @@
const
HintBorderWidth = 2;
class destructor THintWindow.Destroy;
begin
FreeAndNil(FSysHintFont);
end;
constructor THintWindow.Create(AOwner: TComponent);
begin
// THintWindow has no resource => must be constructed using CreateNew
@ -63,6 +68,20 @@ begin
inc(FHintRect.Bottom, 4 * HintBorderWidth);
end;
class function THintWindow.SysHintFont: TFont;
begin
if (FSysHintFont = nil) then
begin
FSysHintFont := TFont.Create;
if not WidgetSet.InitStockFont(FSysHintFont, sfHint) then
begin
FSysHintFont.FontData := DefFontData;
FSysHintFont.Color := clInfoText;
end;
end;
Result := FSysHintFont;
end;
class procedure THintWindow.WSRegisterClass;
begin
inherited WSRegisterClass;
@ -108,7 +127,7 @@ end;
function THintWindow.UseFGThemes: Boolean;
begin
Result := (Font.Size = 0) and (Font.Name = '') and (Font.Color = clInfoText);
Result := Font.IsEqual(SysHintFont);
end;
procedure THintWindow.SetColor(Value: TColor);