opensource/HeidiSQL
1
0
Fork 0
mirror of https://github.com/HeidiSQL/HeidiSQL.git synced 2025-08-06 18:24:26 +08:00
Code Issues Packages Projects Releases Wiki Activity

Enable padding in multiline tooltips with a derived THintWindow class

Browse Source
This commit is contained in:
Ansgar Becker
2025-02-17 20:09:05 +01:00
parent a81be3f4c6
commit b345b611a2
2 changed files with 81 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
packages/Delphi12.1/heidisql.dpr vendored
View File

@ -97,6 +97,9 @@ begin
// Issue #3064: Ignore TFont, so "Default" on mainform for WinXP users does not get broken.
gnugettext.TP_GlobalIgnoreClass(TFont);
// Enable padding in customized tooltips
HintWindowClass := TExtHintWindow;
Application.Initialize;
Application.Title := APPNAME;
Application.UpdateFormatSettings := False;

79
source/extra_controls.pas
View File

@ -6,7 +6,7 @@ uses
System.Classes, System.SysUtils, Vcl.Forms, Winapi.Windows, Winapi.Messages, System.Types, Vcl.StdCtrls, Vcl.Clipbrd,
SizeGrip, apphelpers, Vcl.Graphics, Vcl.Dialogs, gnugettext, Vcl.ImgList, Vcl.VirtualImageList, Vcl.ComCtrls,
Winapi.ShLwApi, Vcl.ExtCtrls, VirtualTrees, VirtualTrees.Types, SynRegExpr, Vcl.Controls, Winapi.ShlObj,
SynEditMiscClasses, SynUnicode;
SynEditMiscClasses, SynUnicode, Vcl.Themes, Vcl.GraphUtil;
type
// Form with a sizegrip in the lower right corner, without the need for a statusbar
@ -96,6 +96,15 @@ type
procedure InitiateAction; override;
end;
TExtHintWindow = class(THintWindow)
private
const Padding: Integer = 8;
protected
procedure Paint; override;
public
function CalcHintRect(MaxWidth: Integer; const AHint: string; AData: TCustomData): TRect; override;
end;
implementation
@ -720,4 +729,72 @@ begin
end;
end;
{ TExtHintWindow }
function TExtHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: TCustomData): TRect;
begin
Result := inherited;
// Customized: enlarge surrounding rect to make space for padding
if AHint.Contains(SLineBreak) then begin
Result.Right := Result.Right + 2 * ScaleValue(Padding);
Result.Bottom := Result.Bottom + 2 * ScaleValue(Padding);
end;
end;
procedure TExtHintWindow.Paint;
var
R, ClipRect: TRect;
LColor: TColor;
LStyle: TCustomStyleServices;
LDetails: TThemedElementDetails;
LGradientStart, LGradientEnd, LTextColor: TColor;
begin
R := ClientRect;
LStyle := StyleServices(Screen.ActiveForm);
LTextColor := Screen.HintFont.Color;
if LStyle.Enabled then
begin
ClipRect := R;
InflateRect(R, 4, 4);
if TOSVersion.Check(6) and LStyle.IsSystemStyle then
begin
// Paint Windows gradient background
LStyle.DrawElement(Canvas.Handle, LStyle.GetElementDetails(tttStandardNormal), R, ClipRect);
end
else
begin
LDetails := LStyle.GetElementDetails(thHintNormal);
if LStyle.GetElementColor(LDetails, ecGradientColor1, LColor) and (LColor <> clNone) then
LGradientStart := LColor
else
LGradientStart := clInfoBk;
if LStyle.GetElementColor(LDetails, ecGradientColor2, LColor) and (LColor <> clNone) then
LGradientEnd := LColor
else
LGradientEnd := clInfoBk;
if LStyle.GetElementColor(LDetails, ecTextColor, LColor) and (LColor <> clNone) then
LTextColor := LColor
else
LTextColor := Screen.HintFont.Color;
GradientFillCanvas(Canvas, LGradientStart, LGradientEnd, R, gdVertical);
end;
R := ClipRect;
end;
Inc(R.Left, 2);
Inc(R.Top, 2);
// Customized: move inner rect right+down to add padding to outer edge
if String(Caption).Contains(SLineBreak) then begin
Inc(R.Left, ScaleValue(Padding));
Inc(R.Top, ScaleValue(Padding));
end;
Canvas.Font.Color := LTextColor;
DrawText(Canvas.Handle, Caption, -1, R, DT_LEFT or DT_NOPREFIX or
DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
end;
end.