paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-30 01:21:33 +01:00
Code Issues Packages Projects Releases Wiki Activity

lcl: THintWindow drawing:

Browse Source 
- remove TThemeServices.DrawTooltip, move content to DrawElement for teTooltip
  - call standard ThemeServices.DrawElement in THintWindow.Paint (now tooltips looks native on windows xp, vista, gtk, gtk2)

git-svn-id: trunk@19619 -
This commit is contained in:
paul 2009-04-25 14:40:54 +00:00
parent 38dd29e0b7
commit 7d97f14c33
3 changed files with 27 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/include/hintwindow.inc
View File

@ -97,10 +97,14 @@ end;
procedure THintWindow.Paint; procedure THintWindow.Paint;
var var
ARect: TRect; ARect: TRect;
Details: TThemedElementDetails;
begin begin
ARect := ClientRect; ARect := ClientRect;
if Color = clInfoBk then // draw using themes if Color = clInfoBk then // draw using themes
ThemeServices.DrawTooltip(Canvas.Handle, ARect) begin
Details := ThemeServices.GetElementDetails(tttStandardLink);
ThemeServices.DrawElement(Canvas.Handle, Details, ARect);
end
else else
begin begin
Canvas.Brush.Color := Color; Canvas.Brush.Color := Color;

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

@ -49,7 +49,6 @@ type
const S: String; R: TRect; Flags, Flags2: Cardinal); override; const S: String; R: TRect; Flags, Flags2: Cardinal); override;
procedure DrawText(ACanvas: TPersistent; Details: TThemedElementDetails; procedure DrawText(ACanvas: TPersistent; Details: TThemedElementDetails;
const S: String; R: TRect; Flags, Flags2: Cardinal); override; 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 ContentRect(DC: HDC; Details: TThemedElementDetails; BoundingRect: TRect): TRect; override;
function HasTransparentParts(Details: TThemedElementDetails): Boolean; override; function HasTransparentParts(Details: TThemedElementDetails): Boolean; override;
@ -182,10 +181,23 @@ begin
end; end;
procedure TWin32ThemeServices.DrawElement(DC: HDC; Details: TThemedElementDetails; const R: TRect; ClipRect: PRect = nil); procedure TWin32ThemeServices.DrawElement(DC: HDC; Details: TThemedElementDetails; const R: TRect; ClipRect: PRect = nil);
var
ARect: TRect;
Brush: HBrush;
begin begin
if ThemesEnabled then if ThemesEnabled then
begin
with Details do with Details do
DrawThemeBackground(Theme[Element], DC, Part, State, R, ClipRect) DrawThemeBackground(Theme[Element], DC, Part, State, R, ClipRect);
if (Details.Element = teToolTip) and (Details.Part = TTP_STANDARD) and (WindowsVersion < wvVista) then
begin
// use native background on windows vista
ARect := ContentRect(DC, Details, R);
Brush := CreateSolidBrush(ColorToRGB(clInfoBk));
FillRect(DC, ARect, Brush);
DeleteObject(Brush);
end;
end
else else
inherited; inherited;
end; end;
@ -318,26 +330,4 @@ begin
inherited; inherited;
end; 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. end.

19
lcl/themes.pas
View File

@ -467,7 +467,6 @@ type
Bounds: PRect = nil); Bounds: PRect = nil);
procedure DrawText(DC: HDC; Details: TThemedElementDetails; const S: String; R: TRect; Flags, Flags2: Cardinal); virtual; overload; 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 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; function HasTransparentParts(Details: TThemedElementDetails): Boolean; virtual;
procedure PaintBorder(Control: TObject; EraseLRCorner: Boolean); virtual; procedure PaintBorder(Control: TObject; EraseLRCorner: Boolean); virtual;
@ -2021,6 +2020,14 @@ begin
end; end;
end; end;
end; end;
teToolTip:
begin
if Details.Part = TTP_STANDARD then
begin
FillWithColor(ARect, clInfoBk);
LCLIntf.DrawEdge(DC, ARect, BDR_RAISEDOUTER, BF_RECT);
end;
end;
end; end;
end; end;
@ -2211,16 +2218,6 @@ begin
Canvas.Font.Color := OldColor; Canvas.Font.Color := OldColor;
end; 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; function TThemeServices.HasTransparentParts(Details: TThemedElementDetails): Boolean;