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

lcl: hint window: render user-defined font.

Browse Source 
git-svn-id: trunk@52383 -
This commit is contained in:
ondrej 2016-05-24 18:36:28 +00:00
parent 28488723c3
commit 69fd011685
2 changed files with 38 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/forms.pp
View File

@ -863,7 +863,8 @@ type
procedure DoShowWindow; override;
procedure UpdateRegion;
procedure SetColor(Value: TColor); override;
function UseThemes: Boolean;
function UseBGThemes: Boolean;
function UseFGThemes: Boolean;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

66
lcl/include/hintwindow.inc
View File

@ -95,7 +95,7 @@ begin
if not HandleAllocated then
Exit;
if UseThemes then
if UseBGThemes then
begin
Details := ThemeServices.GetElementDetails(tttStandardNormal);
ARect := ClientRect;
@ -106,13 +106,18 @@ begin
SetWindowRgn(Handle, 0, False);
end;
function THintWindow.UseFGThemes: Boolean;
begin
Result := (Font.Size = 0) and (Font.Name = '') and (Font.Color = clInfoText);
end;
procedure THintWindow.SetColor(Value: TColor);
begin
inherited SetColor(Value);
UpdateRegion;
end;
function THintWindow.UseThemes: Boolean;
function THintWindow.UseBGThemes: Boolean;
begin
Result := (Color = clInfoBk) or (Color = clDefault);
end;
@ -157,37 +162,38 @@ begin
end;
procedure THintWindow.Paint;
procedure DrawWithThemes(ARect: TRect);
var
Details: TThemedElementDetails;
begin
// draw using themes
Details := ThemeServices.GetElementDetails(tttStandardNormal);
ThemeServices.DrawElement(Canvas.Handle, Details, ARect);
// ARect := ThemeServices.ContentRect(Canvas.Handle, Details, ARect);
InflateRect(ARect, -2 * HintBorderWidth, -2 * HintBorderWidth);
ThemeServices.DrawText(Canvas, Details, Caption, ARect, GetDrawTextFlags, 0);
end;
procedure DrawNormal(ARect: TRect);
begin
Canvas.Brush.Color := Color;
Canvas.Pen.Width := 1;
Canvas.FillRect(ARect);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDOUTER, BF_RECT);
InflateRect(ARect, -2 * HintBorderWidth, -2 * HintBorderWidth);
DrawText(Canvas.GetUpdatedHandle([csFontValid]), PChar(Caption),
Length(Caption), ARect, GetDrawTextFlags);
end;
var
ThemeBG, ThemeFG: Boolean;
Details: TThemedElementDetails;
ARect: TRect;
begin
if ControlCount > 0 then
inherited Paint // The window has a custom control.
else if UseThemes then
DrawWithThemes(ClientRect)
else
DrawNormal(ClientRect);
begin
ThemeBG := UseBGThemes;
ThemeFG := UseFGThemes;
ARect := ClientRect;
if ThemeBG or ThemeFG then
Details := ThemeServices.GetElementDetails(tttStandardNormal);
if ThemeBG then
ThemeServices.DrawElement(Canvas.Handle, Details, ARect)
else
begin
Canvas.Brush.Color := Color;
Canvas.Pen.Width := 1;
Canvas.FillRect(ARect);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDOUTER, BF_RECT);
end;
InflateRect(ARect, -2 * HintBorderWidth, -2 * HintBorderWidth);
if ThemeFG then
ThemeServices.DrawText(Canvas, Details, Caption, ARect, GetDrawTextFlags, 0)
else
DrawText(Canvas.GetUpdatedHandle([csFontValid]), PChar(Caption),
Length(Caption), ARect, GetDrawTextFlags);
end;
end;
procedure THintWindow.SetBounds(ALeft, ATop, AWidth, AHeight: integer);
@ -268,7 +274,7 @@ begin
Flags := DT_CALCRECT or DT_NOPREFIX or DT_WORDBREAK;
if UseRightToLeftAlignment then Flags := Flags or DT_RTLREADING;
uh := Canvas.GetUpdatedHandle([csFontValid]);
if UseThemes then
if UseFGThemes then
Result := ThemeServices.GetTextExtent(uh,
ThemeServices.GetElementDetails(tttStandardNormal), AHint, Flags, @Result)
else