From 4a68ab4027a158499eca3281bc61654fcd3dbb31 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 4 May 2018 12:04:31 +0000 Subject: [PATCH] tvplanit: use a Listbox in VpNavBar component editor for image selection. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6380 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/tvplanit/source/design/vpnabed.lfm | 177 +++++++-------- components/tvplanit/source/design/vpnabed.pas | 204 ++++++------------ 2 files changed, 148 insertions(+), 233 deletions(-) diff --git a/components/tvplanit/source/design/vpnabed.lfm b/components/tvplanit/source/design/vpnabed.lfm index 2671b2a0f..eefeb5c6c 100644 --- a/components/tvplanit/source/design/vpnabed.lfm +++ b/components/tvplanit/source/design/vpnabed.lfm @@ -15,81 +15,16 @@ object frmNavBarEd: TfrmNavBarEd OnShow = FormShow Position = poScreenCenter LCLVersion = '1.9.0.0' - object pnlImages: TPanel - Left = 0 - Height = 85 - Top = 279 - Width = 543 - Align = alBottom - AutoSize = True - BevelOuter = bvNone - ClientHeight = 85 - ClientWidth = 543 - TabOrder = 0 - object Panel8: TPanel - Left = 0 - Height = 27 - Top = 0 - Width = 543 - Align = alTop - BevelOuter = bvNone - ClientHeight = 27 - ClientWidth = 543 - TabOrder = 0 - object Label3: TLabel - AnchorSideLeft.Control = Panel8 - AnchorSideTop.Control = Panel8 - Left = 4 - Height = 15 - Top = 8 - Width = 89 - BorderSpacing.Left = 4 - BorderSpacing.Top = 8 - Caption = 'Available Images' - ParentColor = False - end - end - object sbImages: TScrollBox - Left = 4 - Height = 54 - Top = 27 - Width = 535 - HorzScrollBar.Page = 56 - HorzScrollBar.Tracking = True - VertScrollBar.Page = 50 - Align = alClient - AutoSize = True - BorderSpacing.Left = 4 - BorderSpacing.Right = 4 - BorderSpacing.Bottom = 4 - ClientHeight = 50 - ClientWidth = 531 - Color = clWindow - ParentColor = False - TabOrder = 1 - OnResize = sbImagesResize - object pnlImageView: TPanel - Left = 0 - Height = 50 - Top = 0 - Width = 56 - Constraints.MinHeight = 40 - TabOrder = 0 - OnClick = pnlImageViewClick - OnPaint = pnlImageViewPaint - end - end - end object pnlFoldersAndItems: TPanel Left = 0 - Height = 279 + Height = 364 Top = 0 Width = 543 Align = alClient BevelOuter = bvNone - ClientHeight = 279 + ClientHeight = 364 ClientWidth = 543 - TabOrder = 1 + TabOrder = 0 object pnlFolders: TPanel AnchorSideLeft.Control = pnlFoldersAndItems AnchorSideTop.Control = pnlFoldersAndItems @@ -97,20 +32,27 @@ object frmNavBarEd: TfrmNavBarEd AnchorSideBottom.Control = pnlFoldersAndItems AnchorSideBottom.Side = asrBottom Left = 0 - Height = 279 + Height = 364 Top = 0 - Width = 269 + Width = 235 Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Right = 4 BevelOuter = bvNone - ClientHeight = 279 - ClientWidth = 269 + ClientHeight = 364 + ClientWidth = 235 TabOrder = 0 object lbFolders: TListBox + AnchorSideLeft.Control = pnlFolders + AnchorSideTop.Control = Panel6 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = pnlFolders + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Panel5 Left = 4 - Height = 227 + Height = 308 Top = 23 - Width = 265 - Align = alClient + Width = 231 + Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Left = 4 ItemHeight = 0 OnClick = lbFoldersClick @@ -120,11 +62,11 @@ object frmNavBarEd: TfrmNavBarEd Left = 0 Height = 23 Top = 0 - Width = 269 + Width = 235 Align = alTop BevelOuter = bvNone ClientHeight = 23 - ClientWidth = 269 + ClientWidth = 235 TabOrder = 0 object Label1: TLabel Left = 4 @@ -139,15 +81,16 @@ object frmNavBarEd: TfrmNavBarEd object Panel5: TPanel Left = 4 Height = 25 - Top = 254 - Width = 265 + Top = 335 + Width = 231 Align = alBottom AutoSize = True BorderSpacing.Left = 4 BorderSpacing.Top = 4 + BorderSpacing.Bottom = 4 BevelOuter = bvNone ClientHeight = 25 - ClientWidth = 265 + ClientWidth = 231 TabOrder = 2 object btnFolderAdd: TSpeedButton AnchorSideLeft.Control = Panel5 @@ -253,28 +196,34 @@ object frmNavBarEd: TfrmNavBarEd end end object pnlItems: TPanel - AnchorSideLeft.Control = Bevel1 + AnchorSideLeft.Control = pnlFolders AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = pnlFoldersAndItems AnchorSideRight.Control = pnlFoldersAndItems AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = pnlFoldersAndItems AnchorSideBottom.Side = asrBottom - Left = 273 - Height = 279 + Left = 239 + Height = 364 Top = 0 - Width = 270 + Width = 300 Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Right = 4 BevelOuter = bvNone - ClientHeight = 279 - ClientWidth = 270 + ClientHeight = 364 + ClientWidth = 300 TabOrder = 1 object lbItems: TListBox + AnchorSideLeft.Control = pnlItems + AnchorSideTop.Control = Panel4 + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = lbImages + AnchorSideBottom.Control = Panel1 Left = 0 - Height = 227 - Top = 23 - Width = 266 - Align = alClient + Height = 307 + Top = 24 + Width = 248 + Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Right = 4 ItemHeight = 13 OnClick = lbItemsClick @@ -286,15 +235,16 @@ object frmNavBarEd: TfrmNavBarEd object Panel1: TPanel Left = 0 Height = 25 - Top = 254 - Width = 266 + Top = 335 + Width = 296 Align = alBottom AutoSize = True BorderSpacing.Top = 4 BorderSpacing.Right = 4 + BorderSpacing.Bottom = 4 BevelOuter = bvNone ClientHeight = 25 - ClientWidth = 266 + ClientWidth = 296 TabOrder = 2 object btnItemAdd: TSpeedButton AnchorSideLeft.Control = Panel1 @@ -401,13 +351,13 @@ object frmNavBarEd: TfrmNavBarEd end object Panel4: TPanel Left = 0 - Height = 23 + Height = 24 Top = 0 - Width = 270 + Width = 300 Align = alTop BevelOuter = bvNone - ClientHeight = 23 - ClientWidth = 270 + ClientHeight = 24 + ClientWidth = 300 TabOrder = 0 object Label2: TLabel Left = 0 @@ -418,15 +368,44 @@ object frmNavBarEd: TfrmNavBarEd FocusControl = lbItems ParentColor = False end + object Label4: TLabel + AnchorSideTop.Control = Label2 + AnchorSideRight.Control = Panel4 + AnchorSideRight.Side = asrBottom + Left = 211 + Height = 15 + Top = 4 + Width = 89 + Anchors = [akTop, akRight] + Caption = 'Available i&mages' + ParentColor = False + end + end + object lbImages: TListBox + AnchorSideTop.Control = lbItems + AnchorSideRight.Control = pnlItems + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = lbItems + AnchorSideBottom.Side = asrBottom + Left = 252 + Height = 307 + Top = 24 + Width = 48 + Anchors = [akTop, akRight, akBottom] + ItemHeight = 0 + OnClick = lbImagesClick + OnDrawItem = lbImagesDrawItem + Style = lbOwnerDrawFixed + TabOrder = 3 end end object Bevel1: TBevel AnchorSideLeft.Control = pnlFoldersAndItems AnchorSideLeft.Side = asrCenter - Left = 269 + Left = 239 Height = 50 Top = 0 - Width = 4 + Width = 64 Shape = bsSpacer end end diff --git a/components/tvplanit/source/design/vpnabed.pas b/components/tvplanit/source/design/vpnabed.pas index 0813dbb05..e787aa0f7 100644 --- a/components/tvplanit/source/design/vpnabed.pas +++ b/components/tvplanit/source/design/vpnabed.pas @@ -40,7 +40,7 @@ uses PropEdits, LazarusPackageIntf, FieldsEditor, ComponentEditors, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, - VpBase, VpNavBar; + VpBase, VpNavBar, Types; type @@ -56,7 +56,8 @@ type TfrmNavBarEd = class(TForm) Bevel1: TBevel; - pnlImageView: TPanel; + Label4: TLabel; + lbImages: TListBox; pnlFoldersAndItems: TPanel; pnlItems: TPanel; pnlFolders: TPanel; @@ -76,10 +77,6 @@ type btnFolderDown: TSpeedButton; Panel6: TPanel; Label1: TLabel; - pnlImages: TPanel; - Panel8: TPanel; - Label3: TLabel; - sbImages: TScrollBox; procedure btnFolderAddClick(Sender: TObject); procedure btnFolderDeleteClick(Sender: TObject); @@ -98,18 +95,15 @@ type procedure FormShow(Sender: TObject); procedure lbFoldersClick(Sender: TObject); + procedure lbImagesClick(Sender: TObject); + procedure lbImagesDrawItem(Control: TWinControl; Index: Integer; + ARect: TRect; State: TOwnerDrawState); procedure lbItemsClick(Sender: TObject); procedure lbItemsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure lbItemsMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer); - procedure pnlImageViewClick(Sender: TObject); - procedure pnlImageViewPaint(Sender: TObject); - - procedure sbImagesResize(Sender: TObject); - private FBar: TVpNavBar; - FSelImgIndex: Integer; function FindBtnIndex(APersistent: TPersistent): Integer; function FindFolderIndex(APersistent: TPersistent): Integer; function GetFolderDisplayName(AFolder: TVpNavFolder): String; @@ -134,6 +128,7 @@ type ADesigner: TComponentEditorDesigner); reintroduce; destructor Destroy; override; procedure PopulateFolderList; + procedure PopulateImagesList; procedure PopulateItemList; procedure SetData(ADesigner: TComponentEditorDesigner; ABar: TVpNavBar); property Bar: TVpNavBar read FBar; @@ -146,12 +141,14 @@ implementation {$R *.lfm} uses - PropEditUtils, StrUtils, + PropEditUtils, StrUtils, ImgList, VpMisc; const ITEMS_MARGIN = 2; IMG_MARGIN = 4; + IMG_MARGIN_HOR = 8; + IMG_MARGIN_VERT = 4; {------------------------------------------------------------------------------- @@ -195,8 +192,6 @@ end; constructor TfrmNavBarEd.Create(AOwner: TComponent; ABar: TVpNavBar; ADesigner: TComponentEditorDesigner); -var - w: Integer; begin inherited Create(AOwner); @@ -204,19 +199,6 @@ begin FDesigner := ADesigner; PopulateFolderList; - - if FBar.Images <> nil then begin - w := (FBar.Images.Width + 2*IMG_MARGIN) * FBar.Images.Count; - pnlImageView.ClientWidth := w; - pnlImageView.Constraints.MinHeight := FBar.Images.Height + 2 * IMG_MARGIN + GetScrollbarHeight; - if w > sbImages.ClientWidth then begin - sbImages.HorzScrollbar.Range := w - sbImages.ClientWidth; - sbImages.HorzScrollbar.Visible := true; - end else - sbImages.HorzScrollbar.Visible := false; - end; - FSelImgIndex := -1; - AddDesignHookHandlers; SelectionChanged; UpdateBtnStates; @@ -269,10 +251,7 @@ end; procedure TfrmNavBarEd.FormShow(Sender: TObject); begin - if (Bar <> nil) and (Bar.Images <> nil) then begin - pnlImages.Height := Bar.Images.Height + GetScrollbarHeight + 2*IMG_MARGIN + - Panel8.Height + pnlImages.BorderSpacing.Top + pnlImages.BorderSpacing.Bottom; - end; + PopulateImagesList; lbFolders.SetFocus; end; @@ -417,7 +396,9 @@ begin if selections[i] is TVpNavFolder then lbFolders.Items[i] := GetFolderDisplayName(TVpNavFolder(selections[i])) else if selections[i] is TVpNavBtnItem then - lbItems.Items[i] := GetItemDisplayName(TVpNavBtnItem(selections[i])); + lbItems.Items[i] := GetItemDisplayName(TVpNavBtnItem(selections[i])) + else if (selections[i] is TCustomImageList) and (TCustomImageList(selections[i]) = FBar.Images) then + PopulateImagesList; end; finally selections.Free; @@ -471,6 +452,21 @@ begin end; end; +procedure TfrmNavbarEd.PopulateImagesList; +var + i: Integer; +begin + lbImages.Clear; + if (FBar = nil) or (FBar.Images = nil) then + exit; + + for i:=0 to Bar.Images.Count-1 do + lbImages.Items.Add(''); + + lbImages.ItemHeight := FBar.Images.Width + 2*IMG_MARGIN_HOR; + lbImages.ClientWidth := FBar.Images.Width + 2*IMG_MARGIN_VERT + GetScrollbarWidth; +end; + procedure TfrmNavBarEd.PopulateItemList; var I : Integer; @@ -488,7 +484,6 @@ end; procedure TfrmNavBarEd.SetData(ADesigner: TComponentEditorDesigner; ABar: TVpNavBar); var i: Integer; - w: Integer; begin if FBar <> nil then FBar.RemoveFreeNotification(self); @@ -500,18 +495,7 @@ begin FBar.FreeNotification(self); PopulateFolderList; - - if FBar.Images <> nil then begin - w := (Bar.Images.Width + 2*IMG_MARGIN) * Bar.Images.Count; - pnlImageView.ClientWidth := w; - pnlImageView.Constraints.MinHeight := Bar.Images.Height + 2 * IMG_MARGIN + GetScrollbarHeight; - if w > sbImages.ClientWidth then begin - sbImages.HorzScrollbar.Range := w - sbImages.ClientWidth; - sbImages.HorzScrollbar.Visible := true; - end else - sbImages.HorzScrollbar.Visible := false; - end; - FSelImgIndex := -1; + PopulateImagesList; AddDesignHookHandlers; UpdateBtnStates; @@ -524,8 +508,7 @@ var begin PopulateItemList; Bar.ActiveFolder := lbFolders.ItemIndex; - FSelImgIndex := -1; - pnlImageView.Invalidate; + lbImages.ItemIndex := -1; SelList := TPersistentSelectionList.Create; SelList.ForceUpdate := true; @@ -542,6 +525,41 @@ begin UpdateBtnStates; end; +procedure TfrmNavBarEd.lbImagesClick(Sender: TObject); +var + btn: TVpNavBtnItem; + res: Integer; +begin + if (lbImages.ItemIndex <> -1) and (lbItems.ItemIndex <> -1) then begin + btn := TVpNavBtnItem(lbItems.Items.Objects[lbItems.ItemIndex]); + if btn.IconIndex <> -1 then begin + res := MessageDlg('Do you want to replace the button icon by this one?', + mtConfirmation, [mbYes, mbNo, mbCancel], 0); + if res <> mrYes then + exit; + end; + btn.IconIndex := lbImages.ItemIndex; + lbItems.Invalidate; + if Assigned(Designer) then + Designer.Modified; + end; +end; + +procedure TfrmNavBarEd.lbImagesDrawItem(Control: TWinControl; Index: Integer; + ARect: TRect; State: TOwnerDrawState); +var + x, y: Integer; +begin + if [odSelected, odFocused] * State <> [] then + lbImages.Canvas.Brush.Color := clHighlight + else + lbImages.Canvas.Brush.Color := clWindow; + lbImages.Canvas.FillRect(ARect); + x := (ARect.Left + ARect.Right - Bar.Images.Width) div 2; + y := (ARect.Top + ARect.Bottom - Bar.Images.Height) div 2; + FBar.Images.Draw(lbImages.Canvas, x, y, Index); +end; + procedure TfrmNavBarEd.lbItemsMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer); begin @@ -601,8 +619,8 @@ begin if (FBar <> nil) and (FBar.ActiveFolder <> -1) and (lbItems.ItemIndex <> -1) then begin btn := TVpNavBtnItem(lbItems.Items.Objects[lbItems.ItemIndex]); - FSelImgIndex := btn.IconIndex; - pnlImageView.Invalidate; + lbImages.ItemIndex := btn.IconIndex; + SelList := TPersistentSelectionList.Create; SelList.ForceUpdate := true; for i:=0 to lbItems.Items.Count-1 do @@ -712,7 +730,7 @@ begin if (lbItems.ItemIndex <> -1) then begin TVpNavBtnItem(lbItems.Items.Objects[lbItems.ItemIndex]).Free; lbItems.ItemIndex := -1; - FSelImgIndex := -1; + lbImages.ItemIndex := -1; PopulateItemList; if Assigned(Designer) then Designer.Modified; @@ -726,7 +744,7 @@ begin TVpNavFolder(lbFolders.Items.Objects[lbFolders.ItemIndex]).Free; lbFolders.ItemIndex := -1; FBar.Activefolder := -1; - FSelImgIndex := -1; + lbImages.ItemIndex := -1; PopulateFolderList; PopulateItemList; if Assigned(Designer) then @@ -762,93 +780,11 @@ begin if (lbFolders.ItemIndex <> -1) then begin folder := TVpNavFolder(lbFolders.Items.Objects[lbFolders.ItemIndex]); item := TVpNavBtnItem(folder.ItemCollection.Add); -// item.Name := Designer.CreateUniqueComponentName('TVpNavBtnItem'); GlobalDesignHook.PersistentAdded(item, true); - (* - - TVpNavFolder( - lbFolders.Items.Objects[lbFolders.ItemIndex]).ItemCollection.Add; - lbItems.ItemIndex := -1; - FSelImgIndex := -1; - PopulateItemList; - SelectionChanged(true); - if assigned(Designer) then - Designer.Modified; - *) end; UpdateBtnStates; end; -procedure TfrmNavBarEd.pnlImageViewPaint(Sender: TObject); -var - R: TRect; - Rimg: TRect; - i: Integer; - x, y: Integer; - wimg, himg: Integer; -begin - R := Rect(0, 0, sbImages.Width, sbImages.Height); - pnlImageView.Canvas.Brush.Color := clWindow; - pnlImageView.Canvas.FillRect(R); - - if (Bar.Images = nil) or (Bar.Images.Count = 0) then - exit; - - wimg := Bar.Images.Width; - himg := Bar.Images.Height; - - x := 0; - y := R.Top + IMG_MARGIN; - if pnlImageView.Width <= sbImages.Width then // no scrollbar - inc(y, GetScrollbarHeight div 2); - - i := 0; - while i < Bar.Images.Count do begin - if i = FSelImgIndex then begin - R := Rect(x, R.Top, x+wimg+2*IMG_MARGIN, R.Bottom); - pnlImageView.Canvas.Brush.Color := clHighlight; - pnlImageView.Canvas.FillRect(R); - end; - FBar.Images.Draw(pnlImageView.Canvas, x + IMG_MARGIN, y, i, true); - inc(i); - inc(x, wimg + 2*IMG_MARGIN); - end; -end; - -procedure TfrmNavBarEd.pnlImageViewClick(Sender: TObject); -var - P: TPoint; - btn: TVpNavBtnItem; - res: Integer; -begin - if (Bar.Images = nil) or (Bar.Images.Count = 0) then - exit; - - P := pnlImageView.ScreenToClient(Mouse.CursorPos); - FSelImgIndex := P.X div (Bar.Images.Width + 2*IMG_MARGIN); - if FSelImgIndex >= Bar.Images.Count then FSelImgIndex := Bar.Images.Count - 1; - pnlImageView.Invalidate; - - if (FSelImgIndex <> -1) and (lbItems.ItemIndex <> -1) then begin - btn := TVpNavBtnItem(lbItems.Items.Objects[lbItems.ItemIndex]); - if btn.IconIndex <> -1 then begin - res := MessageDlg('Do you want to replace the button icon by this one?', - mtConfirmation, [mbYes, mbNo, mbCancel], 0); - if res <> mrYes then - exit; - end; - btn.IconIndex := FSelImgIndex; - lbItems.Invalidate; - if Assigned(Designer) then - Designer.Modified; - end; -end; - -procedure TfrmNavBarEd.sbImagesResize(Sender: TObject); -begin - sbImages.HorzScrollbar.Visible := sbImages.ClientWidth < pnlImageView.ClientWidth; -end; - procedure TfrmNavBarEd.SelectionChanged(AOrderChanged: Boolean = false); var SelList: TPersistentSelectionList;