fix: DPI related scale glitches, mainly on completion proposal

Refs #2534

Author: ansgarbecker

source/connections.pas

@@ -1685,8 +1685,8 @@ procedure Tconnform.splitterMainMoved(Sender: TObject);
   // Resize bottom right buttons
   HorizSpace := PageControlDetails.Width - 2 * BorderWidth;
   ButtonWidth := Round(HorizSpace / 3);
-  ButtonWidth := Max(ButtonWidth, ScaleSize(50));
-  ButtonWidth := Min(ButtonWidth, ScaleSize(100));
+  ButtonWidth := Max(ButtonWidth, ScaleFromDesign(50));
+  ButtonWidth := Min(ButtonWidth, ScaleFromDesign(100));
   btnMore.Width := ButtonWidth;
   btnCancel.Width := ButtonWidth;
   btnOpen.Width := ButtonWidth;

source/data_sorting.pas

@@ -93,12 +93,12 @@ procedure TfrmDataSorting.DisplaySortingControls(Sender: TObject);
       Components[i].Free;
   end;
 
-  Margin := ScaleSize(3);
-  MarginBig := ScaleSize(Margin * 2);
-  Width1 := ScaleSize(15);
-  Width2 := ScaleSize(160);
-  Width3 := ScaleSize(23);
-  Width4 := ScaleSize(23);
+  Margin := ScaleFromDesign(3);
+  MarginBig := ScaleFromDesign(Margin * 2);
+  Width1 := ScaleFromDesign(15);
+  Width2 := ScaleFromDesign(160);
+  Width3 := ScaleFromDesign(23);
+  Width4 := ScaleFromDesign(23);
 
   // Set initial width to avoid resizing form to 0
   TopPos := pnlBevel.BorderWidth + MarginBig;

source/extra_controls.pas

@@ -8,7 +8,7 @@ interface
   Classes, SysUtils, Forms, Types, StdCtrls, Clipbrd, apphelpers,
   Graphics, Dialogs, ImgList, ComCtrls, Generics.Defaults,
   ExtCtrls, laz.VirtualTrees, RegExpr, Controls, EditBtn, Menus,
-  LCLIntf, Math;
+  LCLIntf, Math, LCLType;
 
 type
   // Form with a sizegrip in the lower right corner, without the need for a statusbar
@@ -23,8 +23,9 @@   TExtForm = class(TForm)
       class procedure InheritFont(AFont: TFont);
       class procedure SaveListSetup(List: TLazVirtualStringTree);
       class procedure RestoreListSetup(List: TLazVirtualStringTree);
-      function ScaleSize(x: Extended): Integer; overload;
-      class function ScaleSize(x: Extended; Control: TControl): Integer; overload;
+      class function GetCurrentPPI(Control: TControl): Integer;
+      function ScaleFromDesign(x: Extended): Integer; overload;
+      class function ScaleFromDesign(x: Extended; Control: TControl): Integer; overload;
       // Returns a PPI-aware width of a space character
       function Space(Multiply: Integer=1): Integer;
       class procedure PageControlTabHighlight(PageControl: TPageControl);
@@ -270,21 +271,46 @@ procedure TExtForm.FilterNodesByEdit(Edit: TEditButton; Tree: TLazVirtualStringT
 end;
 
 
-function TExtForm.ScaleSize(x: Extended): Integer;
+class function TExtForm.GetCurrentPPI(Control: TControl): Integer;
+var
+  P: TPoint;
+  Mon: TMonitor;
+begin
+  P := Control.ClientToScreen(Point(0, 0));
+  Mon := Screen.MonitorFromPoint(P, mdNearest);
+  Result := Mon.PixelsPerInch;
+end;
+
+
+function TExtForm.ScaleFromDesign(x: Extended): Integer;
 begin
-  // Shorthand for dpi scaling hardcoded width/height values of controls
-  Result := ScaleSize(x, Self);
+  // Shorthand for DPI upscaling hardcoded width/height values of controls
+  Result := ScaleFromDesign(x, Self);
 end;
 
-class function TExtForm.ScaleSize(x: Extended; Control: TControl): Integer;
+class function TExtForm.ScaleFromDesign(x: Extended; Control: TControl): Integer;
+var
+  frm: TCustomForm;
 begin
   // Same as above for callers without a form
-  Result := Control.Scale96ToForm(Round(x));
+  if Control is TCustomForm then
+    frm := TCustomForm(Control)
+  else
+    frm := GetParentForm(Control);
+  if frm = nil then
+    Result := Round(x)
+  else
+    Result := Round(x * GetCurrentPPI(Control) / frm.DesignTimePPI);
 end;
 
 function TExtForm.Space(Multiply: Integer=1): Integer;
+var
+  CurPpi: Integer;
 begin
   Result := Canvas.TextWidth(' ') * Multiply;
+  CurPpi := GetCurrentPPI(Self);
+  if CurPpi <> Canvas.Font.PixelsPerInch then
+    Result := MulDiv(Result, CurPpi, Canvas.Font.PixelsPerInch);
 end;
 
 
@@ -344,7 +370,7 @@ procedure TExtComboBox.Change;
     HintText := Items[ItemIndex];
     HintWidth := Canvas.TextWidth(HintText);
     if HintWidth > Width then begin
-      Padding := TExtForm.ScaleSize(10, Self);
+      Padding := TExtForm.ScaleFromDesign(10, Self);
       HintRect := Rect(
         P.X + Padding,
         P.Y + Padding * 2,

source/grideditlinks.pas

@@ -1038,7 +1038,7 @@ constructor TSetEditorLink.Create(Tree: TVirtualStringTree; AllowEdit: Boolean;
   FPanel.Hide;
   FPanel.Parent := FParentForm;
   FPanel.ParentBackground := False;
-  FPanel.Height := TExtForm.ScaleSize(150, FParentForm);
+  FPanel.Height := TExtForm.ScaleFromDesign(150, FParentForm);
   FPanel.OnExit := DoEndEdit;
 
   FCheckList := TCheckListBox.Create(FPanel);
@@ -1129,7 +1129,7 @@ procedure TSetEditorLink.SetBounds(R: TRect); stdcall;
 
   FBtnOk.Width := (FPanel.Width - 3*margin) div 2;
   FBtnOk.Left := margin;
-  FBtnOk.Height := TExtForm.ScaleSize(24, FParentForm);
+  FBtnOk.Height := TExtForm.ScaleFromDesign(24, FParentForm);
   FBtnOk.Top := FPanel.Height - 2*margin - FBtnOk.Height;
   FBtnOk.Enabled := FAllowEdit;
 
@@ -1198,7 +1198,7 @@ constructor TInplaceEditorLink.Create(Tree: TVirtualStringTree; AllowEdit: Boole
   FButton.AnchorSideBottom.Control := FPanel;
   FButton.AnchorSideBottom.Side := asrBottom;
   FButton.Anchors := [akTop, akRight, akBottom];
-  FButton.Constraints.MaxWidth := TExtForm.ScaleSize(20, FPanel);
+  FButton.Constraints.MaxWidth := TExtForm.ScaleFromDesign(20, FPanel);
   FButton.TabStop := False;
   FButton.Caption := '...';
   FButton.Hint := _('Edit text in popup editor ...');
@@ -1316,7 +1316,7 @@ constructor TColumnDefaultEditorLink.Create(Tree: TVirtualStringTree; AllowEdit:
   inherited;
 
   // Margin between controls and to edge of panel
-  m := TExtForm.ScaleSize(5, FParentForm);
+  m := TExtForm.ScaleFromDesign(5, FParentForm);
 
   FPanel := TPanel.Create(FParentForm);
   FPanel.Hide;
@@ -1414,7 +1414,7 @@ constructor TColumnDefaultEditorLink.Create(Tree: TVirtualStringTree; AllowEdit:
 
   FBtnOk := TButton.Create(FPanel);
   FBtnOk.Parent := FPanel;
-  FBtnOk.Width := TExtForm.ScaleSize(60, FParentForm);
+  FBtnOk.Width := TExtForm.ScaleFromDesign(60, FParentForm);
   FBtnOk.Top := FRadioAutoInc.Top + FRadioAutoInc.Height + m;
   FBtnOk.Left := FPanel.Width - 3*m - 2*FBtnOk.Width - 2*FPanel.BorderWidth;
   FBtnOk.OnClick := BtnOkClick;

source/main.lfm

@@ -20351,7 +20351,6 @@ object MainForm: TMainForm
     Position = 0
     LinesInWindow = 6
     OnSearchPosition = SynCompletionProposalSearchPosition
-    OnPositionChanged = SynCompletionProposalChange
     SelectedColor = clHighlight
     CaseSensitive = False
     Width = 350

source/main.pas

@@ -1226,7 +1226,6 @@   TMainForm = class(TExtForm)
     procedure menuCopyColumnNamesClick(Sender: TObject);
     procedure menuCloseTabOnDblClickClick(Sender: TObject);
     procedure TimerRefreshTimer(Sender: TObject);
-    procedure SynCompletionProposalChange(Sender: TObject);
     procedure SynMemoQuerySpecialLineColors(Sender: TObject; Line: Integer;
       var Special: Boolean; var FG, BG: TColor);
     procedure SynMemoSQLLogSpecialLineColors(Sender: TObject; Line: Integer;
@@ -1802,8 +1801,8 @@ procedure TMainForm.FormDestroy(Sender: TObject);
   AppSettings.WriteString(asDelimiter, FDelimiter);
   AppSettings.WriteInt(asQuerymemoheight, ScaleFormToDesign(pnlQueryMemo.Height));
   AppSettings.WriteInt(asQueryhelperswidth, ScaleFormToDesign(pnlQueryHelpers.Width));
-  AppSettings.WriteInt(asCompletionProposalWidth, ScaleFormToDesign(SynCompletionProposal.TheForm.Width));
-  AppSettings.WriteInt(asCompletionProposalNbLinesInWindow, SynCompletionProposal.LinesInWindow);
+  AppSettings.WriteInt(asCompletionProposalWidth, SynCompletionProposal.TheForm.ScaleFormToDesign(SynCompletionProposal.TheForm.Width));
+  AppSettings.WriteInt(asCompletionProposalNbLinesInWindow, SynCompletionProposal.TheForm.ScaleFormToDesign(SynCompletionProposal.LinesInWindow));
   AppSettings.WriteInt(asDbtreewidth, ScaleFormToDesign(pnlLeft.width));
   AppSettings.WriteBool(asGroupTreeObjects, actGroupObjects.Checked);
   AppSettings.WriteInt(asDataPreviewHeight, ScaleFormToDesign(pnlPreview.Height));
@@ -2075,11 +2074,8 @@ procedure TMainForm.FormCreate(Sender: TObject);
   end;
 
   // Completion proposal window
-  // The proposal form gets scaled a second time when it shows its form with Scaled=True.
-  // We already store and restore the dimensions DPI aware.
-  {SynCompletionProposal.Form.Scaled := False;}
-  SynCompletionProposal.TheForm.Width := Max(AppSettings.ReadInt(asCompletionProposalWidth), 50);
-  SynCompletionProposal.LinesInWindow := AppSettings.ReadInt(asCompletionProposalNbLinesInWindow);
+  SynCompletionProposal.TheForm.Width := Min(Max(AppSettings.ReadInt(asCompletionProposalWidth), 50), 350);
+  SynCompletionProposal.LinesInWindow := Min(AppSettings.ReadInt(asCompletionProposalNbLinesInWindow), 10);
   FProposalItems := TProposalItemList.Create;
   FProposalTriggeredByDot := False;
 
@@ -3598,22 +3594,26 @@ function TMainForm.SynCompletionProposalMeasureItem(const AKey: string;
 var
   i, X, Y: Integer;
   Item: TProposalItem;
+  ItemWidth: Integer;
 begin
   // Calculate how much vertical and horizontal space the control reserves for this row
   FProposalLeftWidth := 0;
 
   ACanvas.Font.Style := [];
   for i := 0 to SynCompletionProposal.ItemList.Count - 1 do begin
     Item := FProposalItems[SynCompletionProposal.IndexFromVisibleIndex(i)];
-    FProposalLeftWidth := Max(FProposalLeftWidth, ACanvas.TextWidth(Item.LeftText));
+    ItemWidth := ACanvas.TextWidth(Item.LeftText);
+    // Canvas is not yet scaled to the current PPI
+    ItemWidth := MulDiv(ItemWidth, Monitor.PixelsPerInch, ACanvas.Font.PixelsPerInch);
+    FProposalLeftWidth := Max(FProposalLeftWidth, ItemWidth);
   end;
 
   Item := FProposalItems[SynCompletionProposal.IndexFromVisibleIndex(Index)];
-  X := Space + ImageListMain.WidthForPPI[16, PixelsPerInch]
+  X := Space + ImageListMain.WidthForPPI[16, ACanvas.Font.PixelsPerInch]
     + Space + FProposalLeftWidth
     + Space(2) + ACanvas.TextWidth(Item.CenterText)
     + IfThen(Item.RightText.IsEmpty, 0, Space(2) + ACanvas.TextWidth(Item.RightText));
-  Y := Max(ImageListMain.HeightForPPI[16, PixelsPerInch] + 2, ACanvas.TextHeight('Wy')) + Space;
+  Y := Max(ImageListMain.HeightForPPI[16, ACanvas.Font.PixelsPerInch] + 2, ACanvas.TextHeight('Wy')) + Space;
   Result := Point(X, Y);
 end;
 
@@ -3626,11 +3626,11 @@ function TMainForm.SynCompletionProposalPaintItem(const AKey: string;
   It := FProposalItems[SynCompletionProposal.IndexFromVisibleIndex(Index)];
 
   if (It.ImageIndex >= 0) and (It.ImageIndex < ImageListMain.Count) then
-    ImageListMain.Draw(ACanvas, X + Space, Y + 1, It.ImageIndex, True);
+    ImageListMain.DrawForControl(ACanvas, X + Space, Y + 1, It.ImageIndex, ImageListMain.Width, SynCompletionProposal.TheForm, True);
 
   ACanvas.Brush.Style := bsClear;
 
-  X1 := X + Space + ImageListMain.WidthForPPI[16, PixelsPerInch] + Space;
+  X1 := X + Space + ImageListMain.WidthForPPI[16, ACanvas.Font.PixelsPerInch] + Space;
   ACanvas.Font.Style := [];
   ACanvas.Font.Color := IfThen(Selected, clHighlightText, It.LeftColor);
   ACanvas.TextOut(X1, Y + 1, It.LeftText);
@@ -6808,30 +6808,6 @@ procedure TMainForm.KillProcess(Sender: TObject);
 end;
 
 
-procedure TMainForm.SynCompletionProposalChange(Sender: TObject);
-{var
-  Proposal: TSynCompletion;
-  SelectedFuncName: String;
-  SQLFunc: TSQLFunction;}
-begin
-  {Proposal := Sender as TSynCompletionProposal;
-  if (AIndex >= 0) and (AIndex < Proposal.ItemList.Count) then begin
-    Proposal.Title := Proposal.InsertItem(AIndex);
-    // Show function description in hint panel
-    ShowStatusMsg('', 0);
-    SelectedFuncName := RegExprGetMatch('...
-    if not SelectedFuncName.IsEmpty then begin
-      for SQLFunc in ActiveConnection.SQLFunctions do begin
-        if SQLFunc.Name.ToUpper = SelectedFuncName.ToUpper then begin
-          ShowStatusMsg(SQLFunc.Description.Replace(SLineBreak, ' '), 0);
-          Break;
-        end;
-      end;
-    end;
-  end;}
-end;
-
-
 { Proposal about to insert a String into synmemo }
 procedure TMainForm.SynCompletionProposalCodeCompletion(var Value: string;
   SourceValue: string; var SourceStart, SourceEnd: TPoint; KeyChar: TUTF8Char;

source/table_editor.pas

@@ -342,7 +342,7 @@ procedure TfrmTableEditor.Init(Obj: TDBObject);
   FLoaded := False;
 
   // Fix control width and position, broken when opening a second table. See issue #1959
-  //comboCollation.Left := lblCollation.Left + TExtForm.ScaleSize(150, Self);
+  //comboCollation.Left := lblCollation.Left + TExtForm.ScaleFromDesign(150, Self);
   //comboCollation.Width := comboRowFormat.Width;
   comboCollation.Items := DBObject.Connection.CollationList;
   //chkCharsetConvert.Left := comboCollation.Left + comboCollation.Width + 10;

source/trigger_editor.pas

@@ -273,7 +273,7 @@ procedure TfrmTriggerEditor.SynCompletionProposalStatementExecute(Sender: TObjec
   // Propose column names from referencing table
   {Proposal := Sender as TSynCompletion;
   Proposal.Font.Assign(Font);
-  Proposal.ItemHeight := TExtForm.ScaleSize(PROPOSAL_ITEM_HEIGHT, Self);
+  Proposal.ItemHeight := TExtForm.ScaleFromDesign(PROPOSAL_ITEM_HEIGHT, Self);
   Token := UpperCase(Proposal.PreviousToken);
   Proposal.InsertList.Clear;
   Proposal.ItemList.Clear;