diff --git a/packages/Delphi12.1/heidisql.dpr b/packages/Delphi12.1/heidisql.dpr index 418f5132..b9d721e6 100644 --- a/packages/Delphi12.1/heidisql.dpr +++ b/packages/Delphi12.1/heidisql.dpr @@ -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; diff --git a/source/extra_controls.pas b/source/extra_controls.pas index df2a595e..a7c0555d 100644 --- a/source/extra_controls.pas +++ b/source/extra_controls.pas @@ -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.