paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 13:38:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
wp_xyz 2024-12-30 12:06:31 +01:00
parent d1bef150c4
commit 0f2d6ec40d
2 changed files with 58 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
components/ideintf/actionseditor.lfm
View File

@ -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'

52
components/ideintf/actionseditor.pas
View File

@ -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.ItemHeight := FActionList.Images.Height + Scale96ToFont(4);
(lstActionName as TImgListbox).Images := FActionList.Images;
end;
FillCategories;
//FillActionByCategory(-1);