From 1c42b91f5bc27193fa9f23624af71f0b9a0a9045 Mon Sep 17 00:00:00 2001 From: ondrej Date: Thu, 11 Jan 2018 13:17:19 +0000 Subject: [PATCH] IdeIntf: High-DPI ImageList: image list editor multiple resolution support git-svn-id: branches/HiDPIImageList@57055 - --- components/ideintf/imagelisteditor.lfm | 301 ++++++----- components/ideintf/imagelisteditor.pp | 646 +++++++++++++++--------- components/ideintf/objinspstrconsts.pas | 7 + 3 files changed, 583 insertions(+), 371 deletions(-) diff --git a/components/ideintf/imagelisteditor.lfm b/components/ideintf/imagelisteditor.lfm index b0a0144a5e..5af0916641 100644 --- a/components/ideintf/imagelisteditor.lfm +++ b/components/ideintf/imagelisteditor.lfm @@ -1,17 +1,17 @@ object ImageListEditorDlg: TImageListEditorDlg Left = 453 - Height = 379 + Height = 424 Top = 144 - Width = 616 + Width = 671 BorderIcons = [biSystemMenu, biHelp] Caption = 'ImagesList Editor' - ClientHeight = 379 - ClientWidth = 616 + ClientHeight = 424 + ClientWidth = 671 Constraints.MinHeight = 345 Constraints.MinWidth = 520 OnClose = FormClose OnCreate = FormCreate - OnDestroy = FormDestroy + OnResize = FormResize Position = poScreenCenter LCLVersion = '1.9.0.0' object GroupBoxR: TGroupBox @@ -20,50 +20,48 @@ object ImageListEditorDlg: TImageListEditorDlg AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = BtnPanel Left = 376 - Height = 334 + Height = 380 Top = 6 - Width = 234 + Width = 289 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Around = 6 Caption = 'Selected Image' - ClientHeight = 307 - ClientWidth = 230 + ClientHeight = 360 + ClientWidth = 285 TabOrder = 1 object LabelTransparent: TLabel Left = 110 Height = 15 - Top = 200 - Width = 111 + Top = 253 + Width = 97 Anchors = [akLeft, akBottom] BorderSpacing.Around = 6 Caption = 'Transparent Color:' ParentColor = False end - object LabelSize: TLabel - Left = 6 - Height = 1 - Top = 6 - Width = 1 - ParentColor = False - end object Preview: TScrollBox Left = 6 - Height = 159 - Top = 32 - Width = 217 + Height = 238 + Top = 6 + Width = 272 + HorzScrollBar.Increment = 1 HorzScrollBar.Page = 1 + HorzScrollBar.Smooth = True + HorzScrollBar.Tracking = True + VertScrollBar.Increment = 1 VertScrollBar.Page = 1 + VertScrollBar.Smooth = True + VertScrollBar.Tracking = True Anchors = [akTop, akLeft, akRight, akBottom] - BorderSpacing.Around = 6 - Color = clGrayText + BorderSpacing.Around = 4 + Color = clDefault ParentColor = False TabOrder = 0 - OnPaint = PreviewPaint end object RadioGroup: TRadioGroup Left = 7 Height = 105 - Top = 197 + Top = 250 Width = 96 Anchors = [akLeft, akBottom] AutoFill = True @@ -77,7 +75,7 @@ object ImageListEditorDlg: TImageListEditorDlg ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 - ClientHeight = 78 + ClientHeight = 85 ClientWidth = 92 Enabled = False ItemIndex = 0 @@ -94,8 +92,8 @@ object ImageListEditorDlg: TImageListEditorDlg AnchorSideTop.Control = LabelTransparent AnchorSideTop.Side = asrBottom Left = 110 - Height = 29 - Top = 221 + Height = 22 + Top = 274 Width = 96 Selected = clFuchsia Style = [cbStandardColors, cbExtendedColors, cbIncludeDefault, cbCustomColor, cbPrettyNames] @@ -110,180 +108,233 @@ object ImageListEditorDlg: TImageListEditorDlg AnchorSideTop.Control = Owner AnchorSideBottom.Control = BtnPanel Left = 6 - Height = 334 + Height = 380 Top = 6 Width = 364 Anchors = [akTop, akLeft, akBottom] BorderSpacing.Around = 6 Caption = 'Images' - ClientHeight = 307 + ClientHeight = 360 ClientWidth = 360 TabOrder = 0 - object TreeView: TTreeView - AnchorSideLeft.Control = GroupBoxL - AnchorSideTop.Control = GroupBoxL - Left = 6 - Height = 296 - Top = 6 - Width = 186 - Anchors = [akTop, akLeft, akRight, akBottom] - BorderSpacing.Around = 6 - HideSelection = False - Images = ImageList - ReadOnly = True - RowSelect = True - ShowButtons = False - ShowLines = False - ShowRoot = False - TabOrder = 0 - OnDeletion = TreeViewDeletion - OnSelectionChanged = TreeViewSelectionChanged - Options = [tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoReadOnly, tvoRowSelect, tvoToolTips] - end object BtnAdd: TButton Tag = 1 - AnchorSideLeft.Control = TreeView AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = GroupBoxL AnchorSideRight.Control = GroupBoxL AnchorSideRight.Side = asrBottom - Left = 198 - Height = 25 - Top = 6 + Left = 200 + Height = 23 + Top = 4 Width = 156 - Anchors = [akTop, akLeft, akRight] - BorderSpacing.Around = 6 + Anchors = [akTop, akRight] + BorderSpacing.Top = 4 + BorderSpacing.Right = 4 Caption = 'Add...' OnClick = BtnAddClick - TabOrder = 1 + TabOrder = 0 end object BtnClear: TButton - AnchorSideLeft.Control = TreeView - AnchorSideLeft.Side = asrBottom + AnchorSideLeft.Control = BtnAdd AnchorSideTop.Control = BtnDelete AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = GroupBoxL + AnchorSideRight.Control = BtnAdd AnchorSideRight.Side = asrBottom - Left = 198 - Height = 25 - Top = 99 + Left = 200 + Height = 23 + Top = 139 Width = 156 Anchors = [akTop, akLeft, akRight] - BorderSpacing.Around = 6 + BorderSpacing.Top = 4 Caption = 'Clear' OnClick = BtnClearClick - TabOrder = 4 + TabOrder = 3 end object BtnDelete: TButton - AnchorSideLeft.Control = TreeView - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = BtnReplace + AnchorSideLeft.Control = BtnAdd + AnchorSideTop.Control = BtnReplaceAll AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = GroupBoxL + AnchorSideRight.Control = BtnAdd AnchorSideRight.Side = asrBottom - Left = 198 - Height = 25 - Top = 68 + Left = 200 + Height = 23 + Top = 112 Width = 156 Anchors = [akTop, akLeft, akRight] - BorderSpacing.Around = 6 + BorderSpacing.Top = 4 Caption = '&Delete' OnClick = BtnDeleteClick - TabOrder = 3 + TabOrder = 2 end object BtnMoveUp: TButton Tag = -1 - AnchorSideLeft.Control = TreeView - AnchorSideLeft.Side = asrBottom + AnchorSideLeft.Control = BtnAdd AnchorSideTop.Control = BtnClear AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = GroupBoxL + AnchorSideRight.Control = BtnAdd AnchorSideRight.Side = asrBottom - Left = 198 - Height = 25 - Top = 130 + Left = 200 + Height = 23 + Top = 166 Width = 156 Anchors = [akTop, akLeft, akRight] - BorderSpacing.Around = 6 + BorderSpacing.Top = 4 Caption = 'Move Up' OnClick = BtnMoveUpClick - TabOrder = 5 + TabOrder = 4 end object BtnMoveDown: TButton Tag = 1 - AnchorSideLeft.Control = TreeView - AnchorSideLeft.Side = asrBottom + AnchorSideLeft.Control = BtnAdd AnchorSideTop.Control = BtnMoveUp AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = GroupBoxL + AnchorSideRight.Control = BtnAdd AnchorSideRight.Side = asrBottom - Left = 198 - Height = 25 - Top = 161 + Left = 200 + Height = 23 + Top = 193 Width = 156 Anchors = [akTop, akLeft, akRight] - BorderSpacing.Around = 6 + BorderSpacing.Top = 4 Caption = 'Move Down' OnClick = BtnMoveUpClick - TabOrder = 6 + TabOrder = 5 end object BtnSave: TButton - AnchorSideLeft.Control = TreeView - AnchorSideLeft.Side = asrBottom + AnchorSideLeft.Control = BtnAdd AnchorSideTop.Control = BtnMoveDown AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = GroupBoxL + AnchorSideRight.Control = BtnAdd AnchorSideRight.Side = asrBottom - Left = 198 - Height = 25 - Top = 192 + Left = 200 + Height = 23 + Top = 220 Width = 156 Anchors = [akTop, akLeft, akRight] - BorderSpacing.Around = 6 + BorderSpacing.Top = 4 Caption = 'Save...' OnClick = BtnSaveClick - TabOrder = 7 + TabOrder = 6 end object btnSaveAll: TButton - AnchorSideLeft.Control = TreeView - AnchorSideLeft.Side = asrBottom + AnchorSideLeft.Control = BtnAdd AnchorSideTop.Control = BtnSave AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = GroupBoxL + AnchorSideRight.Control = BtnAdd AnchorSideRight.Side = asrBottom - Left = 198 - Height = 25 - Top = 223 + Left = 200 + Height = 23 + Top = 247 Width = 156 Anchors = [akTop, akLeft, akRight] - BorderSpacing.Around = 6 + BorderSpacing.Top = 4 Caption = 'Save All...' OnClick = btnSaveAllClick - TabOrder = 8 + TabOrder = 7 end object BtnReplace: TButton - AnchorSideLeft.Control = TreeView - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = BtnAdd + AnchorSideLeft.Control = BtnAdd + AnchorSideTop.Control = BtnAddMoreResolutions AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = GroupBoxL + AnchorSideRight.Control = BtnAdd AnchorSideRight.Side = asrBottom - Left = 198 - Height = 25 - Top = 37 + Left = 200 + Height = 23 + Top = 58 Width = 156 Anchors = [akTop, akLeft, akRight] - BorderSpacing.Around = 6 + BorderSpacing.Top = 4 Caption = '&Replace...' OnClick = BtnReplaceClick - TabOrder = 2 + TabOrder = 1 + end + object ImageListBox: TListBox + AnchorSideLeft.Control = GroupBoxL + AnchorSideTop.Control = GroupBoxL + Left = 4 + Height = 351 + Top = 4 + Width = 188 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Around = 4 + ItemHeight = 0 + OnDrawItem = ImageListBoxDrawItem + OnSelectionChange = ImageListBoxSelectionChange + Options = [] + Style = lbOwnerDrawFixed + TabOrder = 8 + end + object btnAddNewResolution: TButton + AnchorSideLeft.Control = BtnAdd + AnchorSideTop.Control = btnSaveAll + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = BtnAdd + AnchorSideRight.Side = asrBottom + Left = 200 + Height = 23 + Top = 274 + Width = 156 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + Caption = 'Add new resolution...' + OnClick = btnAddNewResolutionClick + TabOrder = 9 + end + object BtnReplaceAll: TButton + AnchorSideLeft.Control = BtnAdd + AnchorSideTop.Control = BtnReplace + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = BtnAdd + AnchorSideRight.Side = asrBottom + Left = 200 + Height = 23 + Top = 85 + Width = 156 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + Caption = '&Replace all resolutions...' + OnClick = BtnReplaceClick + TabOrder = 10 + end + object BtnAddMoreResolutions: TButton + Tag = 1 + AnchorSideLeft.Control = BtnAdd + AnchorSideTop.Control = BtnAdd + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = BtnAdd + AnchorSideRight.Side = asrBottom + Left = 200 + Height = 23 + Top = 31 + Width = 156 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + Caption = 'Add more resolutions...' + OnClick = BtnAddClick + TabOrder = 11 + end + object btnDeleteResolution: TButton + AnchorSideLeft.Control = BtnAdd + AnchorSideTop.Control = btnAddNewResolution + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = BtnAdd + AnchorSideRight.Side = asrBottom + Left = 200 + Height = 23 + Top = 301 + Width = 156 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + Caption = 'Delete resolution ...' + OnClick = btnDeleteResolutionClick + TabOrder = 12 end end object BtnPanel: TButtonPanel Left = 6 - Height = 27 - Top = 346 - Width = 604 + Height = 26 + Top = 392 + Width = 659 OKButton.Name = 'OKButton' OKButton.DefaultCaption = True HelpButton.Name = 'HelpButton' @@ -296,19 +347,19 @@ object ImageListEditorDlg: TImageListEditorDlg ShowBevel = False end object ImageList: TImageList - left = 216 - top = 246 + Left = 216 + Top = 246 end object OpenDialog: TOpenPictureDialog FilterIndex = 0 Options = [ofAllowMultiSelect, ofFileMustExist, ofEnableSizing, ofViewDetail, ofAutoPreview] - left = 216 - top = 209 + Left = 216 + Top = 209 end object SaveDialog: TSavePictureDialog FilterIndex = 0 Options = [ofEnableSizing, ofViewDetail, ofAutoPreview] - left = 252 - top = 209 + Left = 252 + Top = 209 end end diff --git a/components/ideintf/imagelisteditor.pp b/components/ideintf/imagelisteditor.pp index d0a0e02175..95fb28b328 100644 --- a/components/ideintf/imagelisteditor.pp +++ b/components/ideintf/imagelisteditor.pp @@ -30,22 +30,27 @@ uses Classes, SysUtils, Math, // LCL LCLProc, Forms, Controls, Graphics, GraphType, Dialogs, ComCtrls, StdCtrls, - ExtCtrls, ExtDlgs, ColorBox, Buttons, ButtonPanel, + ExtCtrls, ExtDlgs, ColorBox, Buttons, ButtonPanel, ImgList, LCLTaskDialog, + LCLIntf, LCLType, // IdeIntf - IDEDialogs, PropEdits, ComponentEditors, ObjInspStrConsts, IDEWindowIntf; + IDEDialogs, PropEdits, ComponentEditors, ObjInspStrConsts, IDEWindowIntf, Types; type TGlyphAdjustment = (gaNone, gaStretch, gaCrop, gaCenter); - PGlyphInfo = ^TGlyphInfo; - TGlyphInfo = record + TGlyphInfo = class + public Bitmap: TBitmap; Adjustment: TGlyphAdjustment; TransparentColor: TColor; + public + destructor Destroy; override; end; { TImageListEditorDlg } + TAddType = (atAdd, atInsert, atReplace, atReplaceAllResolutions); + TImageListEditorDlg = class(TForm) BtnAdd: TButton; BtnClear: TButton; @@ -60,13 +65,16 @@ type GroupBoxL: TGroupBox; GroupBoxR: TGroupBox; ImageList: TImageList; - LabelSize: TLabel; LabelTransparent: TLabel; OpenDialog: TOpenPictureDialog; RadioGroup: TRadioGroup; Preview: TScrollBox; SaveDialog: TSavePictureDialog; - TreeView: TTreeView; + ImageListBox: TListBox; + btnAddNewResolution: TButton; + BtnReplaceAll: TButton; + BtnAddMoreResolutions: TButton; + btnDeleteResolution: TButton; procedure BtnAddClick(Sender: TObject); procedure BtnClearClick(Sender: TObject); procedure BtnDeleteClick(Sender: TObject); @@ -77,21 +85,36 @@ type procedure ColorBoxTransparentClick(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCreate(Sender: TObject); - procedure FormDestroy(Sender: TObject); - procedure PreviewPaint(Sender: TObject); procedure btnApplyClick(Sender: TObject); - procedure TreeViewDeletion(Sender: TObject; Node: TTreeNode); - procedure TreeViewSelectionChanged(Sender: TObject); + procedure ImageListBoxDrawItem(Control: TWinControl; Index: Integer; + ARect: TRect; State: TOwnerDrawState); + procedure btnAddNewResolutionClick(Sender: TObject); + procedure btnDeleteResolutionClick(Sender: TObject); + procedure ImageListBoxSelectionChange(Sender: TObject; User: boolean); + procedure FormResize(Sender: TObject); private FImageList: TImageList; FModified: Boolean; - FPreviewBmp: TBitmap; + FImagesGroupBoxMaxWidth: Integer; + FPreviewImages: array of TImage; + FPreviewLabels: array of TLabel; procedure SavePicture(Picture: TPicture); + function GetSelGlyphInfo: TGlyphInfo; + function GetGlyphInfo(const aItemIndex: Integer): TGlyphInfo; + procedure RefreshItemHeight; + procedure FreeGlyphInfos; + procedure RecreatePreviewImages(const aForce: Boolean = False); + procedure UpdatePreviewImage; + procedure UpdateImagesGroupBoxWidth; + procedure UpdateImagesGroupBoxWidthQueue(Data: PtrInt); + class function ResolutionToString(const ARes: TCustomImageListResolution): string; + protected + procedure DoDestroy; override; public procedure LoadFromImageList(AImageList: TImageList); procedure SaveToImageList; - procedure AddImageToList(const FileName: String; Insert : Boolean); + procedure AddImageToList(const FileName: String; AddType: TAddType); end; //Editor call by Lazarus with 1 verbe only @@ -184,6 +207,14 @@ begin Result.LoadFromRawImage(DstRawImage, True); end; +{ TGlyphInfo } + +destructor TGlyphInfo.Destroy; +begin + Bitmap.Free; + inherited Destroy; +end; + { TImageListEditorDlg } procedure TImageListEditorDlg.FormCreate(Sender: TObject); @@ -194,13 +225,16 @@ begin GroupBoxR.Caption := sccsILEdtGrpRCaption; BtnAdd.Caption := sccsILEdtAdd; + BtnAddMoreResolutions.Caption := sccsILEdtAddMoreResolutions; BtnDelete.Caption := sccsILEdtDelete; BtnReplace.Caption := sccsILEdtReplace; + BtnReplaceAll.Caption := sccsILEdtReplaceAllResolutions; BtnClear.Caption := sccsILEdtClear; BtnMoveUp.Caption := sccsILEdtMoveUp; BtnMoveDown.Caption := sccsILEdtMoveDown; BtnSave.Caption := sccsILEdtSave; BtnSaveAll.Caption := sccsILEdtSaveAll; + BtnAddNewResolution.Caption := sccsILEdtAddNewResolution; BtnPanel.HelpButton.Caption := oisHelp; BtnPanel.OKButton.Caption := oisOK; @@ -225,15 +259,73 @@ begin IDEDialogLayoutList.ApplyLayout(Self); end; +procedure TImageListEditorDlg.FormResize(Sender: TObject); +begin + UpdateImagesGroupBoxWidth; +end; + procedure TImageListEditorDlg.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin IDEDialogLayoutList.SaveLayout(Self); end; -procedure TImageListEditorDlg.FormDestroy(Sender: TObject); +procedure TImageListEditorDlg.FreeGlyphInfos; +var + I: Integer; begin - FreeAndNil(FPreviewBmp); + for I := 0 to ImageListBox.Items.Count-1 do + ImageListBox.Items.Objects[I].Free; +end; + +function TImageListEditorDlg.GetGlyphInfo( + const aItemIndex: Integer): TGlyphInfo; +begin + if (aItemIndex<0) or (aItemIndex>=ImageListBox.Count) then + Exit(nil); + Result := TGlyphInfo(ImageListBox.Items.Objects[aItemIndex]); +end; + +function TImageListEditorDlg.GetSelGlyphInfo: TGlyphInfo; +begin + Result := GetGlyphInfo(ImageListBox.ItemIndex); +end; + +procedure TImageListEditorDlg.ImageListBoxDrawItem(Control: TWinControl; + Index: Integer; ARect: TRect; State: TOwnerDrawState); +var + C: TCanvas; + X, Y, NewImagesGroupBoxMaxWidth: Integer; + R: TCustomImageListResolution; +begin + C := (Control as TListBox).Canvas; + C.FillRect(ARect); + + X := ARect.Left+Control.Scale96ToFont(2); + Y := ARect.Top+Control.Scale96ToFont(2); + C.TextOut(X, Y, IntToStr(Index)); + Inc(X, C.TextWidth('0')*4); + InflateRect(ARect, Control.Scale96ToFont(2), Control.Scale96ToFont(2)); + C.ClipRect := ARect; + C.Clipping := True; + + for R in ImageList.Resolutions do + begin + if XNewImagesGroupBoxMaxWidth then + Application.QueueAsyncCall(@UpdateImagesGroupBoxWidthQueue, 0); + FImagesGroupBoxMaxWidth := NewImagesGroupBoxMaxWidth; + C.Clipping := False; +end; + +procedure TImageListEditorDlg.ImageListBoxSelectionChange(Sender: TObject; + User: boolean); +begin + UpdatePreviewImage; end; procedure TImageListEditorDlg.BtnAddClick(Sender: TObject); @@ -245,114 +337,145 @@ begin if OpenDialog.Execute then begin ImageList.BeginUpdate; - TreeView.BeginUpdate; + ImageListBox.Items.BeginUpdate; try for I := 0 to OpenDialog.Files.Count - 1 do - AddImageToList(TrimRight(OpenDialog.Files[I]),False); + begin + if (I = 0) or (Sender<>BtnAddMoreResolutions) then + AddImageToList(TrimRight(OpenDialog.Files[I]), atAdd) + else + AddImageToList(TrimRight(OpenDialog.Files[I]), atReplace); + end; finally - TreeView.EndUpdate; + ImageListBox.Items.EndUpdate; ImageList.EndUpdate; end; - TreeView.SetFocus; + ImageListBox.SetFocus; + end; +end; + +procedure TImageListEditorDlg.btnDeleteResolutionClick(Sender: TObject); +var + TD: LCLTaskDialog.TTaskDialog; + R: TCustomImageListResolution; + TDRes: Integer; + RA: array of Integer; + ResItem: string; +begin + FillChar(TD, SizeOf(LCLTaskDialog.TTaskDialog), 0); + SetLength(RA, 0); + for R in ImageList.Resolutions do + begin + if R.Width=ImageList.Width then // cannot delete default resolution + continue; + + if TD.Selection<>'' then + TD.Selection += sLineBreak; + ResItem := ResolutionToString(R); + TD.Selection += ResItem; + if TD.Query='' then + TD.Query := ResItem; + SetLength(RA, Length(RA)+1); + RA[High(RA)] := R.Width; + end; + + if TD.Selection='' then + begin + MessageDlg(sccsILEdtCannotDeleteResolution, mtError, [mbOK], 0); + Exit; + end; + + TD.Inst := sccsILEdtDeleteResolutionConfirmation; + if TD.Execute([cbOK, cbCancel]) = mrOK then + begin + ImageList.DeleteResolution(RA[TD.SelectionRes]); + ImageListBox.Repaint; + UpdatePreviewImage; + UpdateImagesGroupBoxWidth; end; end; procedure TImageListEditorDlg.BtnClearClick(Sender: TObject); begin - if TreeView.Items.Count=0 then exit; + if ImageListBox.Items.Count=0 then exit; if (IDEQuestionDialog(Caption, s_Confirm_Clear, mtConfirmation, [mrYes, mrNo]) = mrYes) then begin + FreeGlyphInfos; ImageList.Clear; - TreeView.Items.Clear; + ImageListBox.Items.Clear; end; end; procedure TImageListEditorDlg.BtnDeleteClick(Sender: TObject); var - Node: TTreeNode; - I, S: Integer; + S: Integer; begin - if Assigned(TreeView.Selected) then + if ImageListBox.ItemIndex>=0 then begin - Node := TreeView.Selected.GetNext; - if Node = nil then Node := TreeView.Selected.GetPrev; + S := ImageListBox.ItemIndex; - S := TreeView.Selected.ImageIndex; ImageList.Delete(S); - TreeView.BeginUpdate; - try - TreeView.Selected.Delete; - - for I := S to TreeView.Items.Count -1 do - begin - TreeView.Items[I].Text := IntToStr(I); - TreeView.Items[I].ImageIndex := I; - TreeView.Items[I].SelectedIndex := I; - end; - finally - TreeView.EndUpdate; - end; - TreeView.Selected := Node; + ImageListBox.Items.Objects[S].Free; + ImageListBox.Items.Delete(S); + ImageListBox.ItemIndex := Min(S, ImageListBox.Count-1); end; - TreeView.SetFocus; + ImageListBox.SetFocus; end; procedure TImageListEditorDlg.BtnReplaceClick(Sender: TObject); var - S,N: Integer; Node: TTreeNode; + AT: TAddType; begin - if Assigned(TreeView.Selected) then + if ImageListBox.ItemIndex>=0 then begin - Node := TreeView.Selected; OpenDialog.Title := sccsILEdtOpenDialogN; OpenDialog.Options:=OpenDialog.Options-[ofAllowMultiSelect]; if OpenDialog.Execute then begin - ImageList.BeginUpdate; - TreeView.BeginUpdate; - try - AddImageToList(TrimRight(OpenDialog.FileName),True); - S:=TreeView.Selected.ImageIndex-1; - ImageList.Delete(S); - TreeView.Selected.ImageIndex:=S+1; - TreeView.Selected.Delete; - for N := S to TreeView.Items.Count-1 do - begin - TreeView.Items[N].Text := IntToStr(N); - TreeView.Items[N].ImageIndex := N; - TreeView.Items[N].SelectedIndex := N; - end; - TreeView.Selected:=Node; - finally - TreeView.EndUpdate; - ImageList.EndUpdate; - end; - TreeView.SetFocus; + if Sender=BtnReplaceAll then + AT := atReplaceAllResolutions + else + AT := atReplace; + AddImageToList(TrimRight(OpenDialog.FileName), AT); + ImageListBox.SetFocus; end; end; end; +procedure TImageListEditorDlg.btnAddNewResolutionClick(Sender: TObject); +var + R: Longint; +begin + if TryStrToInt(InputBox(sccsILEdtAddNewResolution, sccsILEdtImageWidthOfNewResolution, ''), R) then + begin + ImageList.RegisterResolutions([R]); + RefreshItemHeight; + ImageListBox.Repaint; + UpdateImagesGroupBoxWidth; + end; +end; + procedure TImageListEditorDlg.BtnMoveUpClick(Sender: TObject); var S, D: Integer; - P: PGlyphInfo; + P: TObject; begin - if Assigned(TreeView.Selected) and (TreeView.Items.Count > 1) then + if ImageListBox.ItemIndex > 0 then begin - S := TreeView.Selected.ImageIndex; + S := ImageListBox.ItemIndex; D := (Sender as TControl).Tag; - if (S + D >= 0) and (S + D < TreeView.Items.Count) then + if (S + D >= 0) and (S + D < ImageListBox.Items.Count) then begin ImageList.Move(S, S + D); - P := TreeView.Items[S + D].Data; - TreeView.Items[S + D].Data := TreeView.Items[S].Data; - TreeView.Items[S].Data := P; + P := ImageListBox.Items.Objects[S + D]; + ImageListBox.Items.Objects[S + D] := ImageListBox.Items.Objects[S]; + ImageListBox.Items.Objects[S] := P; - TreeView.Selected := TreeView.Items[S + D]; - TreeView.SetFocus; + ImageListBox.ItemIndex := S + D; + ImageListBox.SetFocus; end; end; end; @@ -396,11 +519,11 @@ procedure TImageListEditorDlg.BtnSaveClick(Sender: TObject); var Picture: TPicture; begin - if Assigned(TreeView.Selected) then + if ImageListBox.ItemIndex>=0 then begin Picture := TPicture.Create; try - ImageList.GetBitmap(TreeView.Selected.ImageIndex, Picture.Bitmap); + ImageList.GetBitmap(ImageListBox.ItemIndex, Picture.Bitmap); SavePicture(Picture); finally Picture.Free; @@ -410,40 +533,52 @@ end; procedure TImageListEditorDlg.ColorBoxTransparentClick(Sender: TObject); var - P: PGlyphInfo; + P: TGlyphInfo; T: TBitmap; begin - if Assigned(TreeView.Selected) then + P := GetSelGlyphInfo; + if Assigned(P) then begin - if Assigned(TreeView.Selected.Data) then - begin - P := PGlyphInfo(TreeView.Selected.Data); - P^.Adjustment := TGlyphAdjustment(RadioGroup.ItemIndex); - P^.TransparentColor := ColorBoxTransparent.Selected; - - T := CreateGlyph(P^.Bitmap, ImageList.Width, ImageList.Height, P^.Adjustment, - P^.TransparentColor); - ImageList.BeginUpdate; - try - ImageList.Delete(TreeView.Selected.ImageIndex); - ImageList.Insert(TreeView.Selected.ImageIndex, T, nil); - finally - ImageList.EndUpdate; - T.Free; - end; - - TreeView.Invalidate; - TreeViewSelectionChanged(nil); - end + P.Adjustment := TGlyphAdjustment(RadioGroup.ItemIndex); + P.TransparentColor := ColorBoxTransparent.Selected; + + T := CreateGlyph(P.Bitmap, ImageList.Width, ImageList.Height, P.Adjustment, + P.TransparentColor); + ImageList.BeginUpdate; + try + ImageList.Delete(ImageListBox.ItemIndex); + ImageList.Insert(ImageListBox.ItemIndex, T, nil); + finally + ImageList.EndUpdate; + T.Free; + end; + + ImageListBox.Invalidate; + + end +end; + +procedure TImageListEditorDlg.DoDestroy; +begin + FreeGlyphInfos; + inherited DoDestroy; +end; + +procedure TImageListEditorDlg.RefreshItemHeight; +var + R: TCustomImageListResolution; +begin + for R in ImageList.ResolutionsDesc do // get highest resolution + begin + ImageListBox.ItemHeight := Min(R.Height, Scale96ToFont(32)) + Scale96ToFont(4); + break; end; end; -procedure TImageListEditorDlg.PreviewPaint(Sender: TObject); +class function TImageListEditorDlg.ResolutionToString( + const ARes: TCustomImageListResolution): string; begin - if Assigned(FPreviewBmp) then - begin - Preview.Canvas.Draw(0, 0, FPreviewBmp); - end; + Result := Format('%d x %d', [ARes.Width, ARes.Height]); end; procedure TImageListEditorDlg.btnApplyClick(Sender: TObject); @@ -451,69 +586,9 @@ begin SaveToImageList; end; -procedure TImageListEditorDlg.TreeViewDeletion(Sender: TObject; Node: TTreeNode); -var - P: PGlyphInfo; -begin - if Assigned(Node) then +procedure TImageListEditorDlg.UpdatePreviewImage; + procedure DisablePreview; begin - if Node.Data <> nil then - begin - P := PGlyphInfo(Node.Data); - P^.Bitmap.Free; - Dispose(P); - end; - end; -end; - -procedure TImageListEditorDlg.TreeViewSelectionChanged(Sender: TObject); -var - P: PGlyphInfo; -begin - if Assigned(TreeView.Selected) then - begin - if Assigned(FPreviewBmp) then FPreviewBmp.Free; - FPreviewBmp := TBitmap.Create; - ImageList.GetBitmap(TreeView.Selected.ImageIndex, FPreviewBmp); - - if Assigned(TreeView.Selected.Data) then - begin - P := PGlyphInfo(TreeView.Selected.Data); - - RadioGroup.Enabled := True; - RadioGroup.OnClick := nil; - RadioGroup.ItemIndex := Integer(P^.Adjustment); - RadioGroup.OnClick := @ColorBoxTransparentClick; - - ColorBoxTransparent.Enabled := True; - ColorBoxTransparent.OnChange := nil; - ColorBoxTransparent.Selected := P^.TransparentColor; - ColorBoxTransparent.OnChange := @ColorBoxTransparentClick; - end - else - begin - RadioGroup.Enabled := False; - RadioGroup.OnClick := nil; - RadioGroup.ItemIndex := 0; - RadioGroup.OnClick := @ColorBoxTransparentClick; - - ColorBoxTransparent.Enabled := False; - ColorBoxTransparent.OnChange := nil; - ColorBoxTransparent.Selected := clFuchsia; - ColorBoxTransparent.OnChange := @ColorBoxTransparentClick; - end; - - LabelSize.Caption := Format('%d x %d', [FPreviewBmp.Width, FPreviewBmp.Height]); - - Preview.HorzScrollBar.Range := FPreviewBmp.Width; - Preview.VertScrollBar.Range := FPreviewBmp.Height; - Preview.Invalidate; - end - else - begin - if Assigned(FPreviewBmp) then FreeThenNil(FPreviewBmp); - LabelSize.Caption := ''; - RadioGroup.Enabled := False; RadioGroup.OnClick := nil; RadioGroup.ItemIndex := 0; @@ -523,58 +598,150 @@ begin ColorBoxTransparent.OnChange := nil; ColorBoxTransparent.Selected := clFuchsia; ColorBoxTransparent.OnChange := @ColorBoxTransparentClick; - - Preview.HorzScrollBar.Range := ImageList.Width; - Preview.VertScrollBar.Range := ImageList.Height; - Preview.Invalidate; end; +var + Img: TImage; + R, I: Integer; + Res: TCustomImageListResolution; + P: TGlyphInfo; +begin + RecreatePreviewImages; + I := ImageListBox.ItemIndex; + if I<0 then + begin + for R := 0 to High(FPreviewImages) do + FPreviewImages[R].Picture.Clear; + + DisablePreview; + Exit; + end; + + for R := 0 to ImageList.ResolutionCount-1 do + begin + Img := FPreviewImages[R]; + Res := ImageList.ResolutionByIndex[R]; + Res.GetBitmap(I, Img.Picture.Bitmap); + end; + + P := GetSelGlyphInfo; + if Assigned(P) then + begin + RadioGroup.Enabled := True; + RadioGroup.OnClick := nil; + RadioGroup.ItemIndex := Integer(P.Adjustment); + RadioGroup.OnClick := @ColorBoxTransparentClick; + + ColorBoxTransparent.Enabled := True; + ColorBoxTransparent.OnChange := nil; + ColorBoxTransparent.Selected := P.TransparentColor; + ColorBoxTransparent.OnChange := @ColorBoxTransparentClick; + end else + DisablePreview; end; procedure TImageListEditorDlg.LoadFromImageList(AImageList: TImageList); var - I, C: Integer; + I: Integer; + R: TCustomImageListResolution; begin ImageList.Clear; FImageList := AImageList; FModified := False; - + if Assigned(AImageList) then begin ImageList.Assign(AImageList); - C := ImageList.Count; - - TreeView.BeginUpdate; + ImageListBox.Items.BeginUpdate; try - TreeView.Items.Clear; - for I := 0 to Pred(C) do - begin - with TreeView.Items.Add(nil, IntToStr(I)) do - begin - ImageIndex := I; - SelectedIndex := I; - Data := nil; - end; - end; + FreeGlyphInfos; + ImageListBox.Items.Clear; + for I := 0 to ImageList.Count-1 do + ImageListBox.Items.AddObject('', nil); + + RefreshItemHeight; + if ImageListBox.Items.Count>0 then + ImageListBox.ItemIndex := 0; + RecreatePreviewImages(True); + UpdatePreviewImage; + UpdateImagesGroupBoxWidth; finally - TreeView.EndUpdate; + ImageListBox.Items.EndUpdate; end; end; end; +procedure TImageListEditorDlg.RecreatePreviewImages(const aForce: Boolean); +var + I, X, Y: Integer; + Img: TImage; + R: TCustomImageListResolution; + Lbl: TLabel; +begin + if not aForce and (Length(FPreviewImages)=ImageList.ResolutionCount) then + Exit; + + for Img in FPreviewImages do + Img.Free; + for Lbl in FPreviewLabels do + Lbl.Free; + + SetLength(FPreviewImages, ImageList.ResolutionCount); + SetLength(FPreviewLabels, ImageList.ResolutionCount); + + X := Scale96ToFont(4); + Y := Scale96ToFont(4); + + for I := 0 to ImageList.ResolutionCount-1 do + begin + R := ImageList.ResolutionByIndex[I]; + Img := TImage.Create(Self); + FPreviewImages[I] := Img; + Lbl := TLabel.Create(Self); + FPreviewLabels[I] := Lbl; + + Img.Parent := Preview; + Img.SetBounds(X, Y, R.Width, R.Height); + Img.Stretch := False; + + Lbl.Parent := Preview; + Lbl.AnchorParallel(akTop, 0, Img); + Lbl.AnchorToNeighbour(akLeft, Scale96ToFont(6), Img); + Lbl.Caption := ResolutionToString(R); + + Inc(Y, Img.Height + X); + end; +end; + procedure TImageListEditorDlg.SaveToImageList; begin FImageList.Assign(ImageList); FModified := True; end; -procedure TImageListEditorDlg.AddImageToList(const FileName: String;Insert:boolean); +procedure TImageListEditorDlg.UpdateImagesGroupBoxWidth; var - SrcBmp: TBitmap; + NewWidth: Integer; +begin + NewWidth := (ClientWidth + BtnAdd.Width) div 2; + if (FImagesGroupBoxMaxWidth>0) then + NewWidth := Min(NewWidth, FImagesGroupBoxMaxWidth + BtnAdd.Width + 5*BtnAdd.BorderSpacing.Right); + GroupBoxL.Width := NewWidth; + GroupBoxR.Left := GroupBoxL.BoundsRect.Right + Scale96ToFont(4); +end; + +procedure TImageListEditorDlg.UpdateImagesGroupBoxWidthQueue(Data: PtrInt); +begin + UpdateImagesGroupBoxWidth; +end; + +procedure TImageListEditorDlg.AddImageToList(const FileName: String; + AddType: TAddType); +var + SrcBmp, DestBmp: TBitmap; Picture: TPicture; Node: TTreeNode; - P: PGlyphInfo; - I: Integer; + P: TGlyphInfo; ImagesPerColumn: Integer; ImagesPerRow: Integer; iRow: Integer; @@ -583,69 +750,56 @@ begin SaveDialog.InitialDir := ExtractFileDir(FileName); SrcBmp := nil; + ImageList.BeginUpdate; Picture := TPicture.Create; try Picture.LoadFromFile(FileName); - SrcBmp := TBitmap.Create; - SrcBmp.Assign(Picture.Graphic); + if Picture.Graphic is TCustomIcon then + begin + ImageListBox.Items.Add(''); + case AddType of + atAdd: ImageList.AddIcon(TCustomIcon(Picture.Graphic)); + atInsert: ImageList.InsertIcon(ImageListBox.ItemIndex+1, TCustomIcon(Picture.Graphic)); + atReplace, atReplaceAllResolutions: ImageList.ReplaceIcon(ImageListBox.ItemIndex, TCustomIcon(Picture.Graphic)); + end; + end else + begin + SrcBmp := TBitmap.Create; + if (AddType in [atReplace, atReplaceAllResolutions]) and (GetSelGlyphInfo<>nil) then + begin + P := GetSelGlyphInfo; + P.Bitmap.Free; + P.Bitmap := SrcBmp; + end else + begin + P := TGlyphInfo.Create; + P.Bitmap := SrcBmp; + end; + P.TransparentColor := clDefault; + P.Adjustment := gaNone; + if not (AddType in [atReplace, atReplaceAllResolutions]) then + ImageListBox.Items.AddObject('', P); + + SrcBmp.Assign(Picture.Graphic); + DestBmp := CreateGlyph(SrcBmp, SrcBmp.Width, SrcBmp.Height, P.Adjustment, P.TransparentColor); + try + case AddType of + atAdd: ImageList.Add(DestBmp, nil); + atInsert: ImageList.Insert(ImageListBox.ItemIndex+1, DestBmp, nil); + atReplace, atReplaceAllResolutions: ImageList.Replace(ImageListBox.ItemIndex, DestBmp, nil, AddType=atReplaceAllResolutions); + end; + finally + DestBmp.Free; + end; + end; + + case AddType of + atAdd: ImageListBox.ItemIndex := ImageListBox.Count-1; + atInsert: ImageListBox.ItemIndex := ImageListBox.ItemIndex+1; + end; finally Picture.Free; - end; - - if Assigned(SrcBmp) then - begin - if not SrcBmp.Empty then - begin - //If the height and with of SrcBmp is an exact factor of ImageList height and width - //the image can be split into smaller images - if (SrcBmp.Height mod ImageList.Height = 0) - and (SrcBmp.Width mod ImageList.Width = 0) then - begin - ImagesPerColumn := SrcBmp.Height div ImageList.Height; - ImagesPerRow := SrcBmp.Width div ImageList.Width; - end - else - begin - ImagesPerColumn := 1; - ImagesPerRow := 1; - end; - //Ask the user if wants to split the source image - if ((ImagesPerRow > 1) or (ImagesPerColumn > 1)) - and (IDEQuestionDialog(Caption, - s_SuggestSplitImage, mtConfirmation, - [mrNo, s_AddAsSingle, mrYes, s_SplitImage]) <> mrYes) then - begin - //"Add as single" was choosen - ImagesPerColumn := 1; - ImagesPerRow := 1; - end; - //Split image or copy the first image list width/height image data if the file - //is bigger than image list width/height but the user choosen "add as single" - for iRow := 0 to ImagesPerColumn - 1 do - for iCol := 0 to ImagesPerRow - 1 do - begin - New(P); - P^.Bitmap := CreateGlyphSplit(SrcBmp, ImageList.Width, ImageList.Height, - iRow, iCol); - P^.Adjustment := gaNone; - P^.TransparentColor := clDefault; - - if Insert then - begin - I := TreeView.Selected.ImageIndex+1; - ImageList.Insert(I,P^.Bitmap, nil); - Node := TreeView.Items.InsertObjectBehind(TreeView.Selected, IntToStr(I), P); - end else - begin - I := ImageList.Add(P^.Bitmap, nil); - Node := TreeView.Items.AddObject(nil, IntToStr(I), P); - end; - Node.ImageIndex := I; - Node.SelectedIndex := I; - TreeView.Selected := Node; - end; - SrcBmp.Free; - end; + ImageList.EndUpdate; end; end; diff --git a/components/ideintf/objinspstrconsts.pas b/components/ideintf/objinspstrconsts.pas index 0977c00a79..2dd241febb 100644 --- a/components/ideintf/objinspstrconsts.pas +++ b/components/ideintf/objinspstrconsts.pas @@ -133,7 +133,9 @@ resourcestring sccsILEdtGrpLCaption = 'Images'; sccsILEdtGrpRCaption = 'Selected Image'; sccsILEdtAdd = '&Add ...'; + sccsILEdtAddMoreResolutions = 'Add more resolutions ...'; sccsILEdtReplace = '&Replace ...'; + sccsILEdtReplaceAllResolutions = 'Replace all resolutions ...'; sccsILEdtDelete = '&Delete'; sccsILEdtApply = '&Apply'; sccsILEdtClear = '&Clear'; @@ -141,6 +143,11 @@ resourcestring sccsILEdtMoveDown = 'Move D&own'; sccsILEdtSave = '&Save ...'; sccsILEdtSaveAll = 'Save All ...'; + sccsILEdtAddNewResolution = 'New resolution ...'; + sccsILEdtDeleteResolution = 'Delete resolution ...'; + sccsILEdtDeleteResolutionConfirmation = 'Select the resolution to delete.'; + sccsILEdtCannotDeleteResolution = 'Cannot delete default resolution.'; + sccsILEdtImageWidthOfNewResolution = 'Image width of the new resolution:'; sccsILEdtransparentColor = 'Transparent Color:'; sccsILEdtAdjustment = 'Adjustment'; sccsILEdtNone = 'None';