Enable padding in multiline tooltips with a derived THintWindow class

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;

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.