IDEIntf: Fix scaling of action names listbox in ActionList component editor

(cherry picked from commit 0f2d6ec40d)

components/ideintf/actionseditor.lfm

@@ -9,14 +9,14 @@ object ActionListEditor: TActionListEditor
   ClientHeight = 315
   ClientWidth = 404
   KeyPreview = True
+  Position = poScreenCenter
+  LCLVersion = '4.99.0.0'
   OnClose = ActionListEditorClose
   OnCreate = FormCreate
   OnHide = FormHide
   OnKeyDown = ActionListEditorKeyDown
   OnKeyPress = ActionListEditorKeyPress
   OnShow = FormShow
-  Position = poScreenCenter
-  LCLVersion = '2.3.0.0'
   object PanelDescr: TPanel
     Left = 0
     Height = 26
@@ -52,22 +52,6 @@ object ActionListEditor: TActionListEditor
     AutoSnap = False
     OnCanResize = SplitterCanResize
   end
-  object lstActionName: TListBox
-    Left = 157
-    Height = 261
-    Top = 54
-    Width = 247
-    Align = alClient
-    ItemHeight = 0
-    OnClick = lstActionNameClick
-    OnDblClick = lstActionNameDblClick
-    OnDrawItem = lstActionNameDrawItem
-    OnKeyDown = lstActionNameKeyDown
-    OnMouseDown = lstActionNameMouseDown
-    PopupMenu = PopMenuActions
-    Style = lbOwnerDrawFixed
-    TabOrder = 1
-  end
   object lstCategory: TListBox
     Left = 0
     Height = 261
@@ -75,10 +59,10 @@ object ActionListEditor: TActionListEditor
     Width = 152
     Align = alLeft
     ItemHeight = 0
+    PopupMenu = PopMenuActions
+    TabOrder = 1
     OnClick = lstCategoryClick
     OnMouseDown = lstActionNameMouseDown
-    PopupMenu = PopMenuActions
-    TabOrder = 2
   end
   object ToolBar1: TToolBar
     Left = 0
@@ -93,7 +77,7 @@ object ActionListEditor: TActionListEditor
     EdgeOuter = esNone
     ParentShowHint = False
     ShowHint = True
-    TabOrder = 4
+    TabOrder = 3
     object btnAdd: TToolButton
       Left = 1
       Top = 0
@@ -114,12 +98,12 @@ object ActionListEditor: TActionListEditor
       Style = tbsDivider
     end
     object btnUp: TToolButton
-      Left = 70
+      Left = 68
       Top = 0
       Action = ActMoveUp
     end
     object btnDown: TToolButton
-      Left = 96
+      Left = 94
       Top = 0
       Action = ActMoveDown
     end
@@ -129,31 +113,31 @@ object ActionListEditor: TActionListEditor
     Top = 260
     object ActDelete: TAction
       Category = 'AddDelete'
+      ShortCut = 46
       OnExecute = ActDeleteExecute
       OnUpdate = ActDeleteUpdate
-      ShortCut = 46
     end
     object ActNew: TAction
       Category = 'AddDelete'
-      OnExecute = ActNewExecute
       ShortCut = 45
+      OnExecute = ActNewExecute
     end
     object ActNewStd: TAction
       Category = 'AddDelete'
-      OnExecute = ActNewStdExecute
       ShortCut = 16429
+      OnExecute = ActNewStdExecute
     end
     object ActMoveUp: TAction
       Category = 'MoveUpDown'
+      ShortCut = 16422
       OnExecute = ActMoveUpDownExecute
       OnUpdate = ActMoveUpUpdate
-      ShortCut = 16422
     end
     object ActMoveDown: TAction
       Category = 'MoveUpDown'
+      ShortCut = 16424
       OnExecute = ActMoveUpDownExecute
       OnUpdate = ActMoveDownUpdate
-      ShortCut = 16424
     end
     object ActPanelDescr: TAction
       Category = 'Panels'

components/ideintf/actionseditor.pas

@@ -88,7 +88,6 @@ type
     lblCategory: TLabel;
     lblName: TLabel;
     lstCategory: TListBox;
-    lstActionName: TListBox;
     MenuItem1: TMenuItem;
     MenuItem2: TMenuItem;
     mItemActListPanelDescr: TMenuItem;
@@ -151,6 +150,7 @@ type
     FActionList: TActionList;
     FCompDesigner: TComponentEditorDesigner;
     FCompEditor: TActionListComponentEditor;
+    lstActionName: TListbox;
     procedure AddCategoryActions(aCategory: String);
     function CategoryIndexOf(Category: String): Integer;
     function IsValidCategory(Category: String): Boolean;
@@ -263,7 +263,28 @@ implementation
 
 var
   EditorForms : TList = nil;
-  
+
+type
+  TImgListbox = class(TListbox)
+  private
+    FImages: TCustomImageList;
+  public
+    function CalculateStandardItemHeight: Integer; override;
+    property Images: TCustomImageList read FImages write FImages;
+  end;
+
+function TImgListbox.CalculateStandardItemHeight: Integer;
+var
+  hImg: Integer;
+begin
+  Result := inherited;
+  if Assigned(FImages) and (Style <> lbOwnerDrawVariable) then
+  begin
+    hImg := FImages.HeightForPPI[0, Font.PixelsPerInch] + 4;
+    if hImg > Result then Result := hImg;
+  end;
+end;
+
 procedure InitFormsList;
 begin
   EditorForms:=TList.Create;
@@ -412,6 +433,20 @@ end;
 
 procedure TActionListEditor.FormCreate(Sender: TObject);
 begin
+  lstActionName := TImgListbox.Create(self);
+  with TImgListbox(lstActionName) do
+  begin
+    Parent := self;
+    Align := alClient;
+    PopupMenu := PopMenuActions;
+    Style := lbOwnerDrawFixed;
+    OnClick := @lstActionNameClick;
+    OnDblClick := @lstActionNameDblClick;
+    OnDrawItem := @lstActionNameDrawItem;
+    OnKeyDown := @lstActionNameKeyDown;
+    OnMouseDown := @lstActionNameMouseDown;
+  end;
+
   ToolBar1.Images := IDEImages.Images_16;
   btnAdd.ImageIndex := IDEImages.GetImageIndex('laz_add');
   btnDelete.ImageIndex := IDEImages.GetImageIndex('laz_delete');
@@ -762,6 +797,8 @@ var
   ACanvas: TCanvas;
   R: TRect;
   dh: Integer;
+  hImg: Integer;
+  ppi: Integer;
   Imgs: TCustomImageList;
   AAction: TCustomAction;
   S: String;
@@ -788,11 +825,15 @@ begin
     AAction := TCustomAction(lb.Items.Objects[Index]);
     R.Right := R.Left + dh;
     if AAction.ImageIndex <> -1 then
-      Imgs.Draw(ACanvas, R.Left, R.Top + (dh-Imgs.Height) div 2, AAction.ImageIndex);
+    begin
+      ppi := lb.Font.PixelsPerInch;
+      hImg := Imgs.HeightForPPI[0, ppi];
+      Imgs.DrawForPPI(ACanvas, R.Left, R.Top + (dh-hImg) div 2, AAction.ImageIndex, 0, ppi, lb.GetCanvasScaleFactor);
+    end;
     Inc(R.Left, dh + 2);
   end;
   S := lb.Items[Index];
-  ACanvas.TextOut(R.Left, R.Top + (dh-Canvas.TextHeight(S)) div 2, S);
+  ACanvas.TextOut(R.Left, R.Top + (dh-ACanvas.TextHeight(S)) div 2, S);
   if odFocused in State then
     ACanvas.DrawFocusRect(ARect);
 end;
@@ -908,8 +949,7 @@ begin
   if FActionList<>nil then
   begin
     FreeNotification(FActionList);
-    if FActionList.Images<>nil then
+    (lstActionName as TImgListbox).Images := FActionList.Images;
-      lstActionName.ItemHeight := FActionList.Images.Height + Scale96ToFont(4);
   end;
   FillCategories;
   //FillActionByCategory(-1);