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

lcl: start native drawing of tooltip windows

Browse Source 
- add TThemeServices.DrawTooltip
  - reimplement tooltip drawing through ThemeServices in case of color = clInfoBk
  - implement native tooltip drawing in ThemeServices for Windows with enabled themes

git-svn-id: trunk@19616 -
This commit is contained in:
paul 2009-04-25 12:56:04 +00:00
parent 22260a35b9
commit 793393a8d6
4 changed files with 47 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/forms.pp
View File

@ -40,7 +40,7 @@ uses
Classes, SysUtils, Types, TypInfo, Math,
AvgLvlTree, Maps, LCLVersion, LCLStrConsts, LCLType, LCLProc, LCLIntf,
FileUtil, InterfaceBase, LResources, GraphType, Graphics, Menus, LMessages,
CustomTimer, ActnList, ClipBrd, CustApp, HelpIntfs, LCLClasses, Controls
CustomTimer, ActnList, ClipBrd, CustApp, HelpIntfs, LCLClasses, Controls, Themes
{$ifndef wince},gettext{$endif}// remove ifdefs when gettext is fixed and a new fpc is released
;

19
lcl/include/hintwindow.inc
View File

@ -34,6 +34,7 @@ begin
Parent := nil;
Color := clInfoBk;
Canvas.Font := Screen.HintFont;
Canvas.Brush.Style := bsClear;
BorderStyle := bsNone;
Caption := 'THintWindow';
SetInitialBounds(0,0,GetControlClassDefaultSize.X,GetControlClassDefaultSize.Y);
@ -90,7 +91,7 @@ begin
if FAutoHideTimer <> nil then
TCustomTimer(FAutoHideTimer).Enabled := False;
if Visible then
Visible := False;//Hide;
Visible := False;
end;
procedure THintWindow.Paint;
@ -98,12 +99,16 @@ var
ARect: TRect;
begin
ARect := ClientRect;
Canvas.Brush.Color := Color;
//DebugLn(['THintWindow.Paint Canvas.Brush.Color=',dbgs(Canvas.Brush.Color)]);
Canvas.Pen.Width := 1;
Canvas.FillRect(ARect);
DrawEdge(Canvas.Handle, ARect, BDR_RAISEDOUTER, BF_RECT);
InflateRect(ARect,-2*HintBorderWidth,-2*HintBorderWidth);
if Color = clInfoBk then // draw using themes
ThemeServices.DrawTooltip(Canvas.Handle, 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);
DrawText(Canvas.GetUpdatedHandle([csFontValid]),
PChar(Caption), Length(Caption), ARect,
DT_NOPREFIX or DT_CENTER or DT_VCENTER or DT_WORDBREAK);

23
lcl/interfaces/win32/win32themes.pas
View File

@ -49,6 +49,7 @@ type
const S: String; R: TRect; Flags, Flags2: Cardinal); override;
procedure DrawText(ACanvas: TPersistent; Details: TThemedElementDetails;
const S: String; R: TRect; Flags, Flags2: Cardinal); override;
procedure DrawTooltip(DC: HDC; ARect: TRect); override;
function ContentRect(DC: HDC; Details: TThemedElementDetails; BoundingRect: TRect): TRect; override;
function HasTransparentParts(Details: TThemedElementDetails): Boolean; override;
@ -317,4 +318,26 @@ begin
inherited;
end;
procedure TWin32ThemeServices.DrawTooltip(DC: HDC; ARect: TRect);
var
Details: TThemedElementDetails;
Brush: HBrush;
begin
if ThemesEnabled then
begin
Details := GetElementDetails(tttStandardNormal);
DrawElement(DC, Details, ARect);
if WindowsVersion < wvVista then
begin
// use native background on windows vista
ARect := ContentRect(DC, Details, ARect);
Brush := CreateSolidBrush(ColorToRGB(clInfoBk));
FillRect(DC, ARect, Brush);
DeleteObject(Brush);
end;
end
else
inherited DrawTooltip(DC, ARect);
end;
end.

11
lcl/themes.pas
View File

@ -467,6 +467,7 @@ type
Bounds: PRect = nil);
procedure DrawText(DC: HDC; Details: TThemedElementDetails; const S: String; R: TRect; Flags, Flags2: Cardinal); virtual; overload;
procedure DrawText(ACanvas: TPersistent; Details: TThemedElementDetails; const S: String; R: TRect; Flags, Flags2: Cardinal); virtual; overload;
procedure DrawTooltip(DC: HDC; ARect: TRect); virtual;
function HasTransparentParts(Details: TThemedElementDetails): Boolean; virtual;
procedure PaintBorder(Control: TObject; EraseLRCorner: Boolean); virtual;
@ -2210,6 +2211,16 @@ begin
Canvas.Font.Color := OldColor;
end;
procedure TThemeServices.DrawTooltip(DC: HDC; ARect: TRect);
var
Brush: HBrush;
begin
Brush := CreateSolidBrush(ColorToRGB(clInfoBk));
FillRect(DC, ARect, Brush);
DeleteObject(Brush);
LCLIntf.DrawEdge(DC, ARect, BDR_RAISEDOUTER, BF_RECT or BF_ADJUST);
end;
//----------------------------------------------------------------------------------------------------------------------
function TThemeServices.HasTransparentParts(Details: TThemedElementDetails): Boolean;