paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 14:29:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDEIntf: Allow to add sliced images to the image list editor of the multi-res imagelist (see https://forum.lazarus.freepascal.org/index.php/topic,43088.msg301126.html)

Browse Source 
git-svn-id: trunk@59440 -
This commit is contained in:
wp 2018-11-03 21:14:09 +00:00
parent fdd25c4c9c
commit cb566ae12d
2 changed files with 154 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

151
components/ideintf/imagelisteditor.lfm
View File

@ -14,7 +14,7 @@ object ImageListEditorDlg: TImageListEditorDlg
OnResize = FormResize OnResize = FormResize
OnShow = FormShow OnShow = FormShow
Position = poScreenCenter Position = poScreenCenter
LCLVersion = '1.9.0.0' LCLVersion = '2.1.0.0'
object GroupBoxR: TGroupBox object GroupBoxR: TGroupBox
AnchorSideLeft.Control = GroupBoxL AnchorSideLeft.Control = GroupBoxL
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
@ -22,24 +22,24 @@ object ImageListEditorDlg: TImageListEditorDlg
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = BtnPanel AnchorSideBottom.Control = BtnPanel
Left = 364 Left = 372
Height = 440 Height = 440
Top = 6 Top = 6
Width = 247 Width = 239
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Selected Image' Caption = 'Selected Image'
ClientHeight = 422 ClientHeight = 420
ClientWidth = 243 ClientWidth = 235
TabOrder = 1 TabOrder = 1
object LabelTransparent: TLabel object LabelTransparent: TLabel
AnchorSideLeft.Control = RadioGroup AnchorSideLeft.Control = RadioGroup
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = RadioGroup AnchorSideTop.Control = RadioGroup
Left = 86 Left = 93
Height = 14 Height = 24
Top = 316 Top = 304
Width = 91 Width = 97
Anchors = [akTop, akLeft, akBottom] Anchors = [akTop, akLeft, akBottom]
BorderSpacing.Left = 6 BorderSpacing.Left = 6
Caption = 'Transparent Color:' Caption = 'Transparent Color:'
@ -52,9 +52,9 @@ object ImageListEditorDlg: TImageListEditorDlg
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = RadioGroup AnchorSideBottom.Control = RadioGroup
Left = 6 Left = 6
Height = 304 Height = 292
Top = 6 Top = 6
Width = 231 Width = 223
HorzScrollBar.Increment = 1 HorzScrollBar.Increment = 1
HorzScrollBar.Page = 1 HorzScrollBar.Page = 1
HorzScrollBar.Smooth = True HorzScrollBar.Smooth = True
@ -74,9 +74,9 @@ object ImageListEditorDlg: TImageListEditorDlg
AnchorSideBottom.Control = GroupBoxR AnchorSideBottom.Control = GroupBoxR
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 6 Left = 6
Height = 100 Height = 110
Top = 316 Top = 304
Width = 74 Width = 81
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
AutoFill = True AutoFill = True
AutoSize = True AutoSize = True
@ -91,8 +91,8 @@ object ImageListEditorDlg: TImageListEditorDlg
ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1 ChildSizing.ControlsPerLine = 1
ClientHeight = 82 ClientHeight = 90
ClientWidth = 70 ClientWidth = 77
Enabled = False Enabled = False
ItemIndex = 0 ItemIndex = 0
Items.Strings = ( Items.Strings = (
@ -108,9 +108,9 @@ object ImageListEditorDlg: TImageListEditorDlg
AnchorSideLeft.Control = LabelTransparent AnchorSideLeft.Control = LabelTransparent
AnchorSideTop.Control = LabelTransparent AnchorSideTop.Control = LabelTransparent
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 86 Left = 93
Height = 22 Height = 22
Top = 334 Top = 332
Width = 96 Width = 96
Selected = clFuchsia Selected = clFuchsia
Style = [cbStandardColors, cbExtendedColors, cbIncludeDefault, cbCustomColor, cbPrettyNames] Style = [cbStandardColors, cbExtendedColors, cbIncludeDefault, cbCustomColor, cbPrettyNames]
@ -128,13 +128,13 @@ object ImageListEditorDlg: TImageListEditorDlg
Left = 6 Left = 6
Height = 440 Height = 440
Top = 6 Top = 6
Width = 352 Width = 360
Anchors = [akTop, akLeft, akBottom] Anchors = [akTop, akLeft, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Around = 6 BorderSpacing.Around = 6
Caption = 'Images' Caption = 'Images'
ClientHeight = 422 ClientHeight = 420
ClientWidth = 348 ClientWidth = 356
TabOrder = 0 TabOrder = 0
object BtnAdd: TButton object BtnAdd: TButton
Tag = 1 Tag = 1
@ -143,7 +143,7 @@ object ImageListEditorDlg: TImageListEditorDlg
AnchorSideTop.Control = ImageListBox AnchorSideTop.Control = ImageListBox
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 198 Left = 198
Height = 23 Height = 25
Top = 6 Top = 6
Width = 57 Width = 57
AutoSize = True AutoSize = True
@ -160,16 +160,16 @@ object ImageListEditorDlg: TImageListEditorDlg
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 198 Left = 198
Height = 23 Height = 25
Top = 141 Top = 180
Width = 51 Width = 53
AutoSize = True AutoSize = True
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 4 BorderSpacing.Top = 4
BorderSpacing.Right = 6 BorderSpacing.Right = 6
Caption = 'Clear' Caption = 'Clear'
OnClick = BtnClearClick OnClick = BtnClearClick
TabOrder = 3 TabOrder = 6
end end
object BtnDelete: TButton object BtnDelete: TButton
AnchorSideLeft.Control = ImageListBox AnchorSideLeft.Control = ImageListBox
@ -178,16 +178,16 @@ object ImageListEditorDlg: TImageListEditorDlg
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 198 Left = 198
Height = 23 Height = 25
Top = 114 Top = 151
Width = 57 Width = 59
AutoSize = True AutoSize = True
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 4 BorderSpacing.Top = 4
BorderSpacing.Right = 6 BorderSpacing.Right = 6
Caption = '&Delete' Caption = '&Delete'
OnClick = BtnDeleteClick OnClick = BtnDeleteClick
TabOrder = 2 TabOrder = 5
end end
object BtnMoveUp: TButton object BtnMoveUp: TButton
Tag = -1 Tag = -1
@ -197,16 +197,16 @@ object ImageListEditorDlg: TImageListEditorDlg
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 198 Left = 198
Height = 23 Height = 25
Top = 168 Top = 209
Width = 68 Width = 74
AutoSize = True AutoSize = True
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 4 BorderSpacing.Top = 4
BorderSpacing.Right = 6 BorderSpacing.Right = 6
Caption = 'Move Up' Caption = 'Move Up'
OnClick = BtnMoveUpDownClick OnClick = BtnMoveUpDownClick
TabOrder = 4 TabOrder = 7
end end
object BtnMoveDown: TButton object BtnMoveDown: TButton
Tag = 1 Tag = 1
@ -216,16 +216,16 @@ object ImageListEditorDlg: TImageListEditorDlg
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 198 Left = 198
Height = 23 Height = 25
Top = 195 Top = 238
Width = 82 Width = 90
AutoSize = True AutoSize = True
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 4 BorderSpacing.Top = 4
BorderSpacing.Right = 6 BorderSpacing.Right = 6
Caption = 'Move Down' Caption = 'Move Down'
OnClick = BtnMoveUpDownClick OnClick = BtnMoveUpDownClick
TabOrder = 5 TabOrder = 8
end end
object BtnSave: TButton object BtnSave: TButton
AnchorSideLeft.Control = ImageListBox AnchorSideLeft.Control = ImageListBox
@ -234,16 +234,16 @@ object ImageListEditorDlg: TImageListEditorDlg
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 198 Left = 198
Height = 23 Height = 25
Top = 222 Top = 267
Width = 62 Width = 59
AutoSize = True AutoSize = True
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 4 BorderSpacing.Top = 4
BorderSpacing.Right = 6 BorderSpacing.Right = 6
Caption = 'Save...' Caption = 'Save...'
OnClick = BtnSaveClick OnClick = BtnSaveClick
TabOrder = 6 TabOrder = 9
end end
object btnSaveAll: TButton object btnSaveAll: TButton
AnchorSideLeft.Control = ImageListBox AnchorSideLeft.Control = ImageListBox
@ -252,8 +252,8 @@ object ImageListEditorDlg: TImageListEditorDlg
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 198 Left = 198
Height = 23 Height = 25
Top = 249 Top = 296
Width = 76 Width = 76
AutoSize = True AutoSize = True
BorderSpacing.Left = 6 BorderSpacing.Left = 6
@ -261,17 +261,17 @@ object ImageListEditorDlg: TImageListEditorDlg
BorderSpacing.Right = 6 BorderSpacing.Right = 6
Caption = 'Save All...' Caption = 'Save All...'
OnClick = btnSaveAllClick OnClick = btnSaveAllClick
TabOrder = 7 TabOrder = 10
end end
object BtnReplace: TButton object BtnReplace: TButton
AnchorSideLeft.Control = ImageListBox AnchorSideLeft.Control = ImageListBox
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = BtnAddMoreResolutions AnchorSideTop.Control = BtnAddSliced
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 198 Left = 198
Height = 23 Height = 25
Top = 60 Top = 93
Width = 76 Width = 76
AutoSize = True AutoSize = True
BorderSpacing.Left = 6 BorderSpacing.Left = 6
@ -279,7 +279,7 @@ object ImageListEditorDlg: TImageListEditorDlg
BorderSpacing.Right = 6 BorderSpacing.Right = 6
Caption = '&Replace...' Caption = '&Replace...'
OnClick = BtnReplaceClick OnClick = BtnReplaceClick
TabOrder = 1 TabOrder = 3
end end
object ImageListBox: TListBox object ImageListBox: TListBox
AnchorSideLeft.Control = GroupBoxL AnchorSideLeft.Control = GroupBoxL
@ -287,7 +287,7 @@ object ImageListEditorDlg: TImageListEditorDlg
AnchorSideBottom.Control = GroupBoxL AnchorSideBottom.Control = GroupBoxL
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 6 Left = 6
Height = 410 Height = 408
Top = 6 Top = 6
Width = 186 Width = 186
Anchors = [akTop, akLeft, akBottom] Anchors = [akTop, akLeft, akBottom]
@ -297,7 +297,7 @@ object ImageListEditorDlg: TImageListEditorDlg
OnSelectionChange = ImageListBoxSelectionChange OnSelectionChange = ImageListBoxSelectionChange
Options = [] Options = []
Style = lbOwnerDrawFixed Style = lbOwnerDrawFixed
TabOrder = 8 TabOrder = 11
end end
object btnAddNewResolution: TButton object btnAddNewResolution: TButton
AnchorSideLeft.Control = ImageListBox AnchorSideLeft.Control = ImageListBox
@ -306,16 +306,16 @@ object ImageListEditorDlg: TImageListEditorDlg
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 198 Left = 198
Height = 23 Height = 25
Top = 276 Top = 325
Width = 130 Width = 138
AutoSize = True AutoSize = True
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 4 BorderSpacing.Top = 4
BorderSpacing.Right = 6 BorderSpacing.Right = 6
Caption = 'Add new resolution...' Caption = 'Add new resolution...'
OnClick = btnAddNewResolutionClick OnClick = btnAddNewResolutionClick
TabOrder = 9 TabOrder = 12
end end
object BtnReplaceAll: TButton object BtnReplaceAll: TButton
AnchorSideLeft.Control = ImageListBox AnchorSideLeft.Control = ImageListBox
@ -324,16 +324,16 @@ object ImageListEditorDlg: TImageListEditorDlg
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 198 Left = 198
Height = 23 Height = 25
Top = 87 Top = 122
Width = 144 Width = 152
AutoSize = True AutoSize = True
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 4 BorderSpacing.Top = 4
BorderSpacing.Right = 6 BorderSpacing.Right = 6
Caption = '&Replace all resolutions...' Caption = '&Replace all resolutions...'
OnClick = BtnReplaceClick OnClick = BtnReplaceClick
TabOrder = 10 TabOrder = 4
end end
object BtnAddMoreResolutions: TButton object BtnAddMoreResolutions: TButton
Tag = 1 Tag = 1
@ -343,16 +343,16 @@ object ImageListEditorDlg: TImageListEditorDlg
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 198 Left = 198
Height = 23 Height = 25
Top = 33 Top = 35
Width = 139 Width = 149
AutoSize = True AutoSize = True
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 4 BorderSpacing.Top = 4
BorderSpacing.Right = 6 BorderSpacing.Right = 6
Caption = 'Add more resolutions...' Caption = 'Add more resolutions...'
OnClick = BtnAddClick OnClick = BtnAddClick
TabOrder = 11 TabOrder = 1
end end
object btnDeleteResolution: TButton object btnDeleteResolution: TButton
AnchorSideLeft.Control = ImageListBox AnchorSideLeft.Control = ImageListBox
@ -361,16 +361,33 @@ object ImageListEditorDlg: TImageListEditorDlg
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 198 Left = 198
Height = 23 Height = 25
Top = 303 Top = 354
Width = 122 Width = 127
AutoSize = True AutoSize = True
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 4 BorderSpacing.Top = 4
BorderSpacing.Right = 6 BorderSpacing.Right = 6
Caption = 'Delete resolution ...' Caption = 'Delete resolution ...'
OnClick = btnDeleteResolutionClick OnClick = btnDeleteResolutionClick
TabOrder = 12 TabOrder = 13
end
object BtnAddSliced: TButton
AnchorSideLeft.Control = ImageListBox
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = BtnAddMoreResolutions
AnchorSideTop.Side = asrBottom
Left = 198
Height = 25
Top = 64
Width = 90
AutoSize = True
BorderSpacing.Left = 6
BorderSpacing.Top = 4
BorderSpacing.Right = 6
Caption = 'Add sliced...'
OnClick = BtnAddSlicedClick
TabOrder = 2
end end
end end
object BtnPanel: TButtonPanel object BtnPanel: TButtonPanel

71
components/ideintf/imagelisteditor.pp
View File

@ -61,6 +61,7 @@ type
BtnSave: TButton; BtnSave: TButton;
btnSaveAll: TButton; btnSaveAll: TButton;
BtnPanel: TButtonPanel; BtnPanel: TButtonPanel;
BtnAddSliced: TButton;
ColorBoxTransparent: TColorBox; ColorBoxTransparent: TColorBox;
GroupBoxL: TGroupBox; GroupBoxL: TGroupBox;
GroupBoxR: TGroupBox; GroupBoxR: TGroupBox;
@ -76,6 +77,7 @@ type
BtnAddMoreResolutions: TButton; BtnAddMoreResolutions: TButton;
btnDeleteResolution: TButton; btnDeleteResolution: TButton;
procedure BtnAddClick(Sender: TObject); procedure BtnAddClick(Sender: TObject);
procedure BtnAddSlicedClick(Sender: TObject);
procedure BtnClearClick(Sender: TObject); procedure BtnClearClick(Sender: TObject);
procedure BtnDeleteClick(Sender: TObject); procedure BtnDeleteClick(Sender: TObject);
procedure BtnReplaceClick(Sender: TObject); procedure BtnReplaceClick(Sender: TObject);
@ -116,6 +118,7 @@ type
procedure SaveToImageList; procedure SaveToImageList;
procedure AddImageToList(const FileName: String; AddType: TAddType); procedure AddImageToList(const FileName: String; AddType: TAddType);
procedure AddSlicedImagesToList(const FileName: String);
end; end;
//Editor call by Lazarus with 1 verbe only //Editor call by Lazarus with 1 verbe only
@ -372,6 +375,23 @@ begin
end; end;
end; end;
procedure TImageListEditorDlg.BtnAddSlicedClick(Sender: TObject);
begin
OpenDialog.Title := sccsILEdtOpenDialog;
if OpenDialog.Execute then
begin
ImageList.BeginUpdate;
ImageListBox.Items.BeginUpdate;
try
AddSlicedImagesToList(OpenDialog.Filename);
finally
ImageListBox.Items.EndUpdate;
ImageList.EndUpdate;
end;
ImageListBox.SetFocus;
end;
end;
procedure TImageListEditorDlg.btnDeleteResolutionClick(Sender: TObject); procedure TImageListEditorDlg.btnDeleteResolutionClick(Sender: TObject);
var var
TD: LCLTaskDialog.TTaskDialog; TD: LCLTaskDialog.TTaskDialog;
@ -618,6 +638,7 @@ begin
AlignButtons([ AlignButtons([
BtnAdd, BtnAdd,
BtnAddMoreResolutions, BtnAddMoreResolutions,
BtnAddSliced,
BtnReplace, BtnReplace,
BtnReplaceAll, BtnReplaceAll,
BtnDelete, BtnDelete,
@ -787,7 +808,8 @@ procedure TImageListEditorDlg.AddImageToList(const FileName: String;
var var
SrcBmp, DestBmp: TBitmap; SrcBmp, DestBmp: TBitmap;
Picture: TPicture; Picture: TPicture;
P: TGlyphInfo; P: TGlyphInfo = nil;
i, j: Integer;
begin begin
SaveDialog.InitialDir := ExtractFileDir(FileName); SaveDialog.InitialDir := ExtractFileDir(FileName);
SrcBmp := nil; SrcBmp := nil;
@ -845,6 +867,53 @@ begin
end; end;
end; end;
procedure TImageListEditorDlg.AddSlicedImagesToList(const FileName: String);
var
SrcBmp, DestBmp: TBitmap;
Picture: TPicture;
P: TGlyphInfo = nil;
i, j: Integer;
begin
SaveDialog.InitialDir := ExtractFileDir(FileName);
SrcBmp := nil;
ImageList.BeginUpdate;
Picture := TPicture.Create;
try
Picture.LoadFromFile(FileName);
if Picture.Graphic is TCustomIcon then begin
MessageDlg('Adding sliced icons is not supported.', mtError, [mbOK], 0);
exit;
end;
SrcBmp := TBitmap.Create;
SrcBmp.Assign(Picture.Graphic);
DestBmp := CreateGlyph(SrcBmp, SrcBmp.Width, SrcBmp.Height, gaNone, clDefault);
try
if (DestBmp.Width mod ImageList.Width = 0) and (DestBmp.Height mod ImageList.Height = 0) then
begin
j := ImageList.AddSliced(DestBmp, DestBmp.Width div ImageList.Width, DestBmp.Height div ImageList.Height);
for i:=j to ImageList.Count - 1 do begin
P := TGlyphInfo.Create;
ImageList.GetBitmap(i, P.Bitmap);
P.TransparentColor := clDefault;
P.Adjustment := gaNone;
ImageListbox.Items.AddObject('', P);
end;
ImageListbox.ItemIndex := ImageListbox.Count - 1;
end else
MessageDlg('Source image is not a multiple of ImageList.Width and .Height', mtError, [mbOK], 0);
finally
DestBmp.Free;
SrcBmp.Free;
end;
finally
Picture.Free;
ImageList.EndUpdate;
end;
end;
{ TImageListComponentEditor } { TImageListComponentEditor }
procedure TImageListComponentEditor.DoShowEditor; procedure TImageListComponentEditor.DoShowEditor;