{ /*************************************************************************** componentpalette.pas -------------------- ***************************************************************************/ *************************************************************************** * * * This source is free software; you can redistribute it and/or modify * * it under the terms of the GNU General Public License as published by * * the Free Software Foundation; either version 2 of the License, or * * (at your option) any later version. * * * * This code is distributed in the hope that it will be useful, but * * WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * * General Public License for more details. * * * * A copy of the GNU General Public License is available on the World * * Wide Web at . You can also * * obtain it by writing to the Free Software Foundation, * * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. * * * *************************************************************************** Author: Mattias Gaertner, Juha Manninen Abstract: The implementation of the component palette. Supports reordering of pages and components by user settings in environment options. } unit ComponentPalette; {$mode objfpc}{$H+} interface uses Classes, SysUtils, AVL_Tree, // LCL Controls, Forms, Graphics, ComCtrls, Buttons, Menus, ExtCtrls, ImgList, // LazUtils LazFileUtils, LazFileCache, LazLoggerBase, AvgLvlTree, // IdeIntf FormEditingIntf, LazIDEIntf, IDEImagesIntf, PropEdits, ComponentReg, // IDE ComponentPalette_Options, MainBase, LazarusIDEStrConsts, DesignerProcs, PackageDefs, EnvGuiOptions; const CompPalSelectionToolBtnPrefix = 'PaletteSelectBtn'; CompPaletteCompBtnPrefix = 'PaletteBtn'; type { TComponentPage } TComponentPage = class(TBaseComponentPage) private fPageComponent: TCustomPage; fSelectButton: TComponent; fBtnIndex: integer; fRegComps: TRegisteredCompList; // Reference to components. fGuiCreated: Boolean; procedure ReAlignButtons; procedure RemoveSheet; procedure InsertVisiblePage(aCompNames: TRegisteredCompList); procedure CreateSelectionButton(aButtonUniqueName: string; aScrollBox: TScrollBox); procedure CreateOrDelButton(aComp: TPkgComponent; aButtonUniqueName: string; aScrollBox: TScrollBox); procedure CreateButtons; protected public constructor Create(const ThePageName: string); destructor Destroy; override; function GetScrollBox: TScrollBox; public property PageComponent: TCustomPage read fPageComponent write fPageComponent; property SelectButton: TComponent read fSelectButton write fSelectButton; end; { TComponentPalette } TComponentPalette = class(TBaseComponentPalette) PalettePopupMenu: TPopupMenu; PopupMenu: TPopupMenu; OpenPackageMenuItem: TMenuItem; OpenUnitMenuItem: TMenuItem; procedure ActivePageChanged(Sender: TObject); procedure OnScrollBoxResize(Sender: TObject); procedure OpenPackageClicked(Sender: TObject); procedure OpenUnitClicked(Sender: TObject); procedure ComponentListClicked(Sender: TObject); procedure OptionsClicked(Sender: TObject); procedure PalettePopupMenuPopup(Sender: TObject); procedure PopupMenuPopup(Sender: TObject); private // Generics TFPGMap<> is bocus, being actually a sorted list, slow adding items. // Instead use a tree container as Map. fComponentButtons: TPointerToPointerTree; // Visual container for tabs FPageControl: TPageControl; FOnOpenPackage: TNotifyEvent; FOnOpenUnit: TNotifyEvent; FOnChangeActivePage: TNotifyEvent; fSelectButtonIcon: TCustomBitmap; fUpdatingPageControl: boolean; fUpdateLock: integer; // Used by UpdateNoteBookButtons fOldActivePage: TTabSheet; fVisiblePageIndex: integer; procedure ClearButtons; function FindCompByButton(Button: TSpeedButton): TRegisteredComponent; function FindPkgCompByButton(Button: TComponent): TPkgComponent; function IndexOfPageComponent(AComponent: TComponent): integer; procedure ReAlignButtons(aSheet: TCustomPage); procedure UpdateNoteBookButtons(ForceUpdateAll: Boolean); procedure RemoveUnneededPage(aSheet: TCustomPage); procedure SetPageControl(const AValue: TPageControl); procedure SelectionToolClick(Sender: TObject); procedure ComponentBtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; {%H-}X, {%H-}Y: Integer); procedure ComponentBtnMouseUp(Sender: TObject; {%H-}Button: TMouseButton; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer); procedure ComponentBtnDblClick(Sender: TObject); procedure OnPageMouseWheel(Sender: TObject; {%H-}Shift: TShiftState; WheelDelta: Integer; {%H-}MousePos: TPoint; var Handled: Boolean); procedure CreatePopupMenu; procedure UnselectAllButtons; procedure GetUnregisteredIcon(var ImageList: TCustomImageList; var ImageIndex: TImageIndex); function GetSelectButtonIcon: TCustomBitmap; function SelectAButton(Button: TSpeedButton): boolean; procedure ComponentWasAdded({%H-}ALookupRoot, {%H-}AComponent: TComponent; {%H-}ARegisteredComponent: TRegisteredComponent); procedure SelectionWasChanged; protected procedure DoChange; override; public constructor Create; destructor Destroy; override; procedure GetNonVisualCompIcon(Sender: TObject; AComponent: TComponent; var ImageList: TCustomImageList; var ImageIndex: TImageIndex); procedure BeginUpdate; override; procedure EndUpdate; override; function IsUpdateLocked: boolean; procedure Update(ForceUpdateAll: Boolean); override; public property PageControl: TPageControl read FPageControl write SetPageControl; property OnOpenPackage: TNotifyEvent read FOnOpenPackage write FOnOpenPackage; property OnOpenUnit: TNotifyEvent read FOnOpenUnit write FOnOpenUnit; property OnChangeActivePage: TNotifyEvent read FOnChangeActivePage write FOnChangeActivePage; end; function CompareControlsWithTag(Control1, Control2: Pointer): integer; implementation {$R ../images/components_images.res} {$DEFINE USE_PageIndex} const OVERVIEW_PANEL_WIDTH = 20; function CompareControlsWithTag(Control1, Control2: Pointer): integer; var Ctrl1: TControl absolute Control1; Ctrl2: TControl absolute Control2; begin if Ctrl1.Tag>Ctrl2.Tag then Result:=1 else if Ctrl1.Tag 0) and (PageComponent.Components[0] is TScrollBox) then Result := TScrollBox(PageComponent.Components[0]) else Result := Nil; end; function IsSelectionToolBtn(aControl: TControl): boolean; begin Result:=(aControl is TSpeedButton) and (LeftStr(aControl.Name,length(CompPalSelectionToolBtnPrefix))=CompPalSelectionToolBtnPrefix); end; procedure TComponentPage.ReAlignButtons; var Pal: TComponentPalette; CurButton: TSpeedButton; ButtonTree: TAVLTree; Node: TAVLTreeNode; ScrollBox: TScrollBox; buttonx, MaxBtnPerRow, i, ComponentPaletteBtnWidthScaled, ComponentPaletteBtnHeightScaled: integer; begin if (PageComponent=Nil) or (PageComponent.ComponentCount=0) or not (PageComponent.Components[0] is TScrollBox) then exit; if not fGuiCreated then begin {$IFDEF VerboseComponentPalette} DebugLn(['TComponentPage.ReAlignButtons, ', PageName, ', calling CreateButtons']); {$ENDIF} CreateButtons; // Delayed creation of buttons at startup. end; Pal := TComponentPalette(Palette); if Pal.PageControl<>nil then Pal.PageControl.DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TComponentPage.ReAlignButtons'){$ENDIF}; ComponentPaletteBtnWidthScaled := Pal.PageControl.Scale96ToForm(ComponentPaletteBtnWidth); ComponentPaletteBtnHeightScaled := Pal.PageControl.Scale96ToForm(ComponentPaletteBtnHeight); ButtonTree:=nil; try ScrollBox:=TScrollBox(PageComponent.Components[0]); ButtonTree:=TAVLTree.Create(@CompareControlsWithTag); for i:=0 to ScrollBox.ControlCount-1 do begin CurButton:=TSpeedbutton(ScrollBox.Controls[i]); if IsSelectionToolBtn(CurButton) then continue; if (CurButton is TSpeedButton) and CurButton.Visible then ButtonTree.Add(CurButton); end; if ButtonTree.Count=0 then exit; ButtonX:= ((ComponentPaletteBtnWidthScaled*3) div 2) + 2; {$IFDEF VerboseComponentPalette} if PageComponent.Caption = CompPalVerbPgName then DebugLn(['TComponentPage.ReAlignButtons', ' ButtonTree.Count=',ButtonTree.Count, ' ScrollBox.ControlCount=',ScrollBox.ControlCount, ' ScrollBox.Bounds=',dbgs(ScrollBox.BoundsRect), ' VertScrollBar.Size=',ScrollBox.VertScrollBar.Size, ' ClientSizeWithoutBar=',ScrollBox.VertScrollBar.ClientSizeWithoutBar, ' IsScrollBarVisible=',ScrollBox.VertScrollBar.IsScrollBarVisible, ' HorzScrollBar.Size=',ScrollBox.HorzScrollBar.Size, ' Page=',ScrollBox.HorzScrollBar.Page, ' Range=',ScrollBox.HorzScrollBar.Range, ' IsScrollBarVisible=',ScrollBox.HorzScrollBar.IsScrollBarVisible ]); {$ENDIF} MaxBtnPerRow:=((ScrollBox.VertScrollBar.ClientSizeWithoutBar - ButtonX) div ComponentPaletteBtnWidthScaled); // If we need to wrap, make sure we have space for the scrollbar if MaxBtnPerRow < ButtonTree.Count then MaxBtnPerRow:=((ScrollBox.VertScrollBar.ClientSizeWithBar - ButtonX) div ComponentPaletteBtnWidthScaled); //debugln(['TComponentPage.ReAlignButtons MaxBtnPerRow=',MaxBtnPerRow,' ButtonTree.Count=',ButtonTree.Count,' ',ButtonX + MaxBtnPerRow * ComponentPaletteBtnWidthScaled]); if MaxBtnPerRow<1 then MaxBtnPerRow:=1; i:=0; Node:=ButtonTree.FindLowest; while Node<>nil do begin CurButton:=TSpeedbutton(Node.Data); CurButton.SetBounds(ButtonX + (i mod MaxBtnPerRow) * ComponentPaletteBtnWidthScaled, (i div MaxBtnPerRow) * ComponentPaletteBtnHeightScaled, CurButton.Width, CurButton.Height); {$IFDEF VerboseComponentPalette} if PageComponent.Caption = CompPalVerbPgName then DebugLn(['TComponentPage.ReAlignButtons ',CurButton.Name,' ',dbgs(CurButton.BoundsRect)]); {$ENDIF} inc(i); Node:=ButtonTree.FindSuccessor(Node); end; PageComponent.Invalidate; finally if Pal.PageControl<>nil then Pal.PageControl.EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TComponentPage.ReAlignButtons'){$ENDIF}; FreeAndNil(ButtonTree); end; end; procedure TComponentPage.RemoveSheet; var Btn: TSpeedButton; begin Btn:=TSpeedButton(SelectButton); if Btn<>nil then begin SelectButton:=nil; Application.ReleaseComponent(Btn); Btn.Visible:=false; end; PageComponent:=nil; end; procedure TComponentPage.InsertVisiblePage(aCompNames: TRegisteredCompList); var Pal: TComponentPalette; TabIndex: Integer; PanelRight: TPanel; BtnRight: TSpeedButton; TabControl: TCustomTabControl; begin if not Visible then begin {$IFDEF VerboseComponentPalette} DebugLn(['TComponentPalette.InsertVisiblePage: Not inserting Page=', PageName]); {$ENDIF} exit; end; fRegComps := aCompNames; Pal := TComponentPalette(Palette); TabControl := TCustomTabControl(Pal.FPageControl); if PageComponent=nil then begin // insert a new PageControl page {$IFDEF VerboseComponentPalette} DebugLn(['TComponentPalette.InsertVisiblePage: Inserting Page=', PageName, ', at index=', Pal.fVisiblePageIndex]); {$ENDIF} {$IFDEF USE_PageIndex} TabIndex:= TabControl.Pages.Add(PageName); PageComponent := Pal.FPageControl.Page[TabIndex]; PageComponent.PageIndex := Pal.fVisiblePageIndex; {$ELSE} TabControl.Pages.Insert(Pal.fVisiblePageIndex, PageName); PageComponent := Pal.FPageControl.Page[Pal.fVisiblePageIndex]; {$ENDIF} with TScrollBox.Create(PageComponent) do begin Align := alClient; BorderStyle := bsNone; BorderWidth := 0; HorzScrollBar.Visible := false; {$IFDEF LCLCarbon} // carbon has not implemented turning scrollbars on and off VertScrollBar.Visible := false; AutoScroll:=false; {$ENDIF} VertScrollBar.Increment := PageComponent.Scale96ToForm(ComponentPaletteBtnHeight); VertScrollBar.Tracking := True; Parent := PageComponent; end; PanelRight := TPanel.Create(PageComponent); with PanelRight do begin Align := alRight; Caption := ''; BevelOuter := bvNone; Visible := True; // EnvironmentOptions.IDESpeedButtonsVisible; Parent := PageComponent; Width := Scale96ToForm(OVERVIEW_PANEL_WIDTH); OnMouseWheel := @Pal.OnPageMouseWheel; end; BtnRight:=TSpeedButton.Create(PageComponent); with BtnRight do begin IDEImages.AssignImage(BtnRight, 'SelCompPage'); Flat := True; Hint := lisClickToSelectPalettePage; ShowHint := True; OnMouseDown := @MainIDE.SelComponentPageButtonMouseDown; OnClick := @MainIDE.SelComponentPageButtonClick; OnMouseWheel := @Pal.OnPageMouseWheel; Parent := PanelRight; SetBounds(Scale96ToForm(2), Scale96ToForm(1), Scale96ToForm(16), Scale96ToForm(16)); end; end else begin // move to the right position {$IFDEF USE_PageIndex} {$IFDEF VerboseComponentPalette} DebugLn(['TComponentPalette.InsertVisiblePage: Page=', PageName, ' setting PageIndex from ', PageComponent.PageIndex , ' to ', Pal.fVisiblePageIndex]); {$ENDIF} PageComponent.PageIndex := Pal.fVisiblePageIndex; {$ELSE} TabIndex := PageComponent.PageIndex; {$IFDEF VerboseComponentPalette} DebugLn(['TComponentPalette.InsertVisiblePage: Start moving Page=', PageName, ' from ', TabIndex, ' to ', Pal.fVisiblePageIndex]); {$ENDIF} if (TabIndex<>Pal.fVisiblePageIndex) and (Pal.fVisiblePageIndex < TabControl.Pages.Count) then begin {$IFDEF VerboseComponentPalette} if {PageName = CompPalVerbPgName} true then DebugLn(['TComponentPalette.InsertVisiblePage: Moving Page=', PageName, ' from ', TabIndex, ' to ', Pal.fVisiblePageIndex]); {$ENDIF} TabControl.Pages.Move(TabIndex, Pal.fVisiblePageIndex); end; {$ENDIF} end; inc(Pal.fVisiblePageIndex); end; procedure TComponentPage.CreateSelectionButton(aButtonUniqueName: string; aScrollBox: TScrollBox); var Pal: TComponentPalette; Btn: TSpeedButton; begin if Assigned(SelectButton) then Exit; Pal := TComponentPalette(Palette); if Pal=nil then debugln(['TComponentPage.CreateSelectionButton missing Palette']); Btn := TSpeedButton.Create(nil); SelectButton:=Btn; IDEImages.AssignImage(Btn, 'tmouse'); with Btn do begin Name := CompPalSelectionToolBtnPrefix + aButtonUniqueName; OnClick := @Pal.SelectionToolClick; OnMouseWheel := @Pal.OnPageMouseWheel; Flat := True; GroupIndex:= 1; Down := True; Hint := lisSelectionTool; ShowHint := EnvironmentGuiOpts.ShowHintsForComponentPalette; SetBounds(0,0,aScrollBox.Scale96ToForm(ComponentPaletteBtnWidth),aScrollBox.Scale96ToForm(ComponentPaletteBtnHeight)); Parent := aScrollBox; end; end; procedure TComponentPage.CreateOrDelButton(aComp: TPkgComponent; aButtonUniqueName: string; aScrollBox: TScrollBox); var Pal: TComponentPalette; CompCls: TComponentClass; Btn: TSpeedButton; begin Pal := TComponentPalette(Palette); CompCls := aComp.ComponentClass; Btn := TSpeedButton(Pal.fComponentButtons[CompCls]); if aComp.Visible then begin inc(fBtnIndex); if Btn=nil then begin Btn := TSpeedButton.Create(nil); Pal.fComponentButtons[CompCls] := Btn; Btn.Name := CompPaletteCompBtnPrefix + aButtonUniqueName + CompCls.ClassName; // Left and Top will be set in ReAlignButtons. Btn.SetBounds(Btn.Left, Btn.Top, aScrollBox.Scale96ToForm(ComponentPaletteBtnWidth), aScrollBox.Scale96ToForm(ComponentPaletteBtnHeight)); Btn.Images := aComp.Images; Btn.ImageIndex := aComp.ImageIndex; Btn.GroupIndex := 1; Btn.Flat := true; Btn.OnMouseDown := @Pal.ComponentBtnMouseDown; Btn.OnMouseUp := @Pal.ComponentBtnMouseUp; Btn.OnDblClick := @Pal.ComponentBtnDblClick; Btn.OnMouseWheel := @Pal.OnPageMouseWheel; Btn.ShowHint := EnvironmentGuiOpts.ShowHintsForComponentPalette; Btn.Hint := CompCls.ClassName + sLineBreak + '(' + aComp.ComponentClass.UnitName+', '+aComp.PkgFile.LazPackage.Name + ')'; Btn.PopupMenu:=Pal.PopupMenu; {$IFDEF VerboseComponentPalette} if aComp.RealPage.PageName = CompPalVerbPgName then DebugLn(['TComponentPalette.CreateOrDelButton Created Button: ',CompCls.ClassName,' ',Btn.Name]); {$ENDIF} end else begin {$IFDEF VerboseComponentPalette} if aComp.RealPage.PageName = CompPalVerbPgName then DebugLn(['TComponentPalette.CreateOrDelButton Keep Button: ',CompCls.ClassName,' ',Btn.Name,' ',DbgSName(Btn.Parent)]); {$ENDIF} end; Btn.Parent := aScrollBox; Btn.Tag:=fBtnIndex; end else if Btn<>nil then begin {$IFDEF VerboseComponentPalette} if aComp.RealPage.PageName = CompPalVerbPgName then DebugLn(['TComponentPalette.CreateOrDelButton Destroy Button: ',CompCls.ClassName,' ',Btn.Name]); {$ENDIF} Application.ReleaseComponent(Btn); Pal.fComponentButtons.Remove(CompCls); Btn.Visible:=false; end; end; procedure TComponentPage.CreateButtons; // Create speedbuttons for every visible component var ScrollBox: TScrollBox; Comp: TPkgComponent; i: Integer; begin if not Visible then Exit; ScrollBox := GetScrollBox; Assert(Assigned(ScrollBox), 'CreateButtons: ScrollBox not assigned.'); ScrollBox.OnResize := @TComponentPalette(Palette).OnScrollBoxResize; ScrollBox.OnMouseWheel := @TComponentPalette(Palette).OnPageMouseWheel; {$IFDEF VerboseComponentPalette} if PageName = CompPalVerbPgName then DebugLn(['TComponentPalette.CreateButtons PAGE="',PageName,'", PageIndex=',PageComponent.PageIndex]); {$ENDIF} // create selection button CreateSelectionButton(IntToStr(FIndex), ScrollBox); // create component buttons and delete unneeded ones fBtnIndex := 0; Assert(Assigned(fRegComps), 'TComponentPage.CreateButtons: fCompNames is not assigned.'); for i := 0 to fRegComps.Count-1 do begin Comp := TPkgComponent(fRegComps[i]); if Assigned(Comp) then CreateOrDelButton(Comp, Format('%d_%d_',[FIndex,i]), ScrollBox); end; fGuiCreated := True; end; { TComponentPalette } procedure TComponentPalette.ActivePageChanged(Sender: TObject); begin if (FPageControl=nil) or fUpdatingPageControl then exit; if (Selected<>nil) and (TComponentPage(Selected.RealPage).PageComponent=FPageControl.ActivePage) then exit; {$IFDEF VerboseComponentPalette} DebugLn('TComponentPalette.ActivePageChanged: Calling ReAlignButtons, setting Selected:=nil.'); {$ENDIF} ReAlignButtons(FPageControl.ActivePage); Selected:=nil; if MainIDE.IDEStarted and Assigned(FOnChangeActivePage) then FOnChangeActivePage(Sender); end; procedure TComponentPalette.OnScrollBoxResize(Sender: TObject); begin if MainIDE.IDEStarted and (TControl(Sender).Parent is TCustomPage) then begin {$IFDEF VerboseComponentPalette} DebugLn(['TComponentPalette.OnScrollBoxResize Calling ReAlignButtons, IDEStarted=', MainIDE.IDEStarted]); {$ENDIF} ReAlignButtons(TCustomPage(TControl(Sender).Parent)); end; end; procedure TComponentPalette.OpenPackageClicked(Sender: TObject); var PkgComponent: TPkgComponent; begin PkgComponent:=FindPkgCompByButton(PopupMenu.PopupComponent); if (PkgComponent=nil) or (PkgComponent.PkgFile=nil) or (PkgComponent.PkgFile.LazPackage=nil) then exit; if Assigned(OnOpenPackage) then OnOpenPackage(PkgComponent.PkgFile.LazPackage); end; procedure TComponentPalette.OpenUnitClicked(Sender: TObject); var PkgComponent: TPkgComponent; begin PkgComponent:=FindPkgCompByButton(PopupMenu.PopupComponent); if (PkgComponent=nil) or (PkgComponent.PkgFile=nil) or (PkgComponent.PkgFile.LazPackage=nil) then exit; if Assigned(OnOpenUnit) then OnOpenUnit(PkgComponent); end; procedure TComponentPalette.ComponentListClicked(Sender: TObject); begin MainIDE.DoShowComponentList; end; procedure TComponentPalette.OptionsClicked(Sender: TObject); begin MainIDE.DoOpenIDEOptions(TCompPaletteOptionsFrame, '', [], []); end; procedure TComponentPalette.PalettePopupMenuPopup(Sender: TObject); begin ; end; procedure TComponentPalette.PopupMenuPopup(Sender: TObject); var PkgComponent: TPkgComponent; APackage: TLazPackage; UnitFilename: String; ShownFilename: String; begin PkgComponent:=FindPkgCompByButton(PopupMenu.PopupComponent); APackage:=nil; if (PkgComponent<>nil) and (PkgComponent.PkgFile<>nil) then APackage:=PkgComponent.PkgFile.LazPackage; if APackage=nil then begin OpenPackageMenuItem.Visible:=false; OpenUnitMenuItem.Visible:=false; end else begin OpenPackageMenuItem.Caption:=Format(lisCPOpenPackage, [APackage.IDAsString]); OpenPackageMenuItem.Visible:=true; ShownFilename:=PkgComponent.PkgFile.Filename; UnitFilename:=PkgComponent.PkgFile.GetFullFilename; if not FileExistsCached(UnitFilename) then begin UnitFilename:=LazarusIDE.FindSourceFile(ExtractFilename(UnitFilename), APackage.Directory,[]); if FileExistsUTF8(UnitFilename) then UnitFilename:=ShownFilename; end; OpenUnitMenuItem.Caption:=Format(lisCPOpenUnit, [ShownFilename]); OpenUnitMenuItem.Visible:=true; OpenUnitMenuItem.Enabled:=FileExistsCached(UnitFilename); end; end; procedure TComponentPalette.SetPageControl(const AValue: TPageControl); var miCompList, miOptions: TMenuItem; begin if FPageControl=AValue then exit; ClearButtons; FPageControl:=AValue; if FPageControl<>nil then begin FPageControl.OnChange:=@ActivePageChanged; if PalettePopupMenu=nil then begin PalettePopupMenu:=TPopupMenu.Create(nil); PalettePopupMenu.OnPopup:=@PalettePopupMenuPopup; PalettePopupMenu.Name:='PalettePopupMenu'; // menuitem: Component List PalettePopupMenu.Images := IDEImages.Images_16; miCompList:=TMenuItem.Create(PalettePopupMenu); with miCompList do begin Name:='ComponentListMenuItem'; Caption:=lisCompPalComponentList; OnClick:=@ComponentListClicked; ImageIndex := IDEImages.LoadImage('menu_view_components'); end; PalettePopupMenu.Items.Add(miCompList); // menuitem Options miOptions:=TMenuItem.Create(PalettePopupMenu); with miOptions do begin Name:='OptionsMenuItem'; Caption:=lisMenuGeneralOptions; OnClick:=@OptionsClicked; ImageIndex := IDEImages.LoadImage('menu_environment_options'); end; PalettePopupMenu.Items.Add(miOptions); end; FPageControl.PopupMenu:=PalettePopupMenu; end; {$IFDEF VerboseComponentPalette} DebugLn(['TComponentPalette.SetPageControl, calling UpdateNoteBookButtons, ', AValue]); {$ENDIF} end; procedure TComponentPalette.SelectionToolClick(Sender: TObject); begin SelectAButton(TSpeedButton(Sender)); end; procedure TComponentPalette.ComponentBtnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button=mbLeft then begin if ssShift in Shift then SelectionMode := csmMulty else SelectionMode := csmSingle; SelectAButton(TSpeedButton(Sender)); if Assigned(OnClassSelected) then OnClassSelected(Self); end; end; procedure TComponentPalette.ComponentBtnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin { If the visual state is down, but internal "no selection" then just do visual unselection of all buttons This trick is for double-click handling (to unselect the button visually ). } if ((Sender as TCustomSpeedButton).Down) and (Selected = Nil) then UnselectAllButtons; end; procedure TComponentPalette.ComponentBtnDblClick(Sender: TObject); var TypeClass: TComponentClass; ParentComp: TComponent; X, Y: integer; AComponent: TComponent; DisableAutoSize: Boolean; begin //debugln('TComponentPalette.ComponentBtnDblClick ',TComponent(Sender).Name); if SelectAButton(TSpeedButton(Sender)) and (Selected<>nil) then begin if FormEditingHook<>nil then begin TypeClass:=Selected.ComponentClass; if assigned(Selected.OnGetCreationClass) then Selected.OnGetCreationClass(Self,TypeClass); if TypeClass=nil then exit; ParentComp:=FormEditingHook.GetDefaultComponentParent(TypeClass); if ParentComp=nil then exit; if not FormEditingHook.GetDefaultComponentPosition(TypeClass,ParentComp,X,Y) then exit; //debugln('TComponentPalette.ComponentBtnDblClick ',dbgsName(Sender),' ',dbgs(X),',',dbgs(Y)); DisableAutoSize:=true; AComponent:=FormEditingHook.CreateComponent(ParentComp,TypeClass,'',X,Y,0,0, DisableAutoSize); if AComponent<>nil then begin if DisableAutoSize and (AComponent is TControl) then TControl(AComponent).EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TComponentPalette.ComponentBtnDblClick'){$ENDIF}; GlobalDesignHook.PersistentAdded(AComponent,true); end; end; end; Selected:=nil; if Assigned(OnClassSelected) then OnClassSelected(Self); end; // unselect all other buttons on all other PageControl pages procedure TComponentPalette.UnselectAllButtons; var i: Integer; CurPage: TBaseComponentPage; SelectButtonOnPage: TSpeedButton; begin for i:=0 to Pages.Count-1 do begin CurPage:=Pages[i]; if (Selected=nil) or (Selected.RealPage<>CurPage) then begin SelectButtonOnPage:=TSpeedButton(TComponentPage(CurPage).SelectButton); if SelectButtonOnPage<>nil then SelectButtonOnPage.Down:=true; end; end; end; procedure TComponentPalette.SelectionWasChanged; var Sheet: TTabSheet; Btn: TSpeedButton; begin if FPageControl=nil then exit; UnselectAllButtons; if Selected=nil then exit; Assert(Assigned(Selected.RealPage), 'TComponentPalette.SelectionWasChanged: Selected.RealPage = Nil.'); Sheet:=TComponentPage(Selected.RealPage).PageComponent as TTabSheet; {$IFDEF VerboseComponentPalette} DebugLn(['TComponentPalette.SelectionWasChanged: Setting FPageControl.ActivePage index ',Sheet.PageIndex]); {$ENDIF} // Switch to the new page FPageControl.ActivePage:=Sheet; // Build the GUI layout for this page if not done yet. Btn:=TSpeedButton(fComponentButtons[Selected.ComponentClass]); if Btn=nil then ReAlignButtons(FPageControl.ActivePage); // Select button Btn:=TSpeedButton(fComponentButtons[Selected.ComponentClass]); //find again! if Btn<>nil then Btn.Down:=true; end; procedure TComponentPalette.CreatePopupMenu; var MenuItem: TMenuItem; begin if PopupMenu<>nil then exit; PopupMenu:=TPopupMenu.Create(nil); PopupMenu.OnPopup:=@PopupMenuPopup; PopupMenu.Name:='ComponentPopupMenu'; PopupMenu.Images:=IDEImages.Images_16; OpenPackageMenuItem:=TMenuItem.Create(PopupMenu); with OpenPackageMenuItem do begin Name:='OpenPackageMenuItem'; Caption:=lisCompPalOpenPackage; OnClick:=@OpenPackageClicked; end; PopupMenu.Items.Add(OpenPackageMenuItem); OpenUnitMenuItem:=TMenuItem.Create(PopupMenu); with OpenUnitMenuItem do begin Name:='OpenUnitMenuItem'; Caption:=lisCompPalOpenUnit; OnClick:=@OpenUnitClicked; end; PopupMenu.Items.Add(OpenUnitMenuItem); PopupMenu.Items.AddSeparator; MenuItem:=TMenuItem.Create(PopupMenu); with MenuItem do begin Name:='ComponentListMenuItem'; Caption:=lisCompPalComponentList; OnClick:=@ComponentListClicked; end; PopupMenu.Items.Add(MenuItem); MenuItem:=TMenuItem.Create(PopupMenu); with MenuItem do begin Name:='OptionsMenuItem'; Caption:=lisMenuGeneralOptions; OnClick:=@OptionsClicked; ImageIndex := IDEImages.LoadImage('menu_environment_options'); end; PopupMenu.Items.Add(MenuItem); end; procedure TComponentPalette.OnPageMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); begin if (WheelDelta > 0) then begin if (PageControl.ActivePageIndex > 0) then begin PageControl.ActivePageIndex := PageControl.ActivePageIndex - 1; PageControl.OnChange(PageControl); end; end else begin if (PageControl.ActivePageIndex < PageControl.PageCount-1) then begin PageControl.ActivePageIndex := PageControl.ActivePageIndex + 1; PageControl.OnChange(PageControl); end; end; Handled := True; end; constructor TComponentPalette.Create; begin inherited Create(EnvironmentGuiOpts.Desktop.ComponentPaletteOptions); fComponentButtons:=TPointerToPointerTree.Create; AddHandlerComponentAdded(@ComponentWasAdded); AddHandlerSelectionChanged(@SelectionWasChanged); ComponentPageClass := TComponentPage; // Used by CreatePagesFromUserOrder end; destructor TComponentPalette.Destroy; var AVLNode: TAVLTreeNode; P2PItem: PPointerToPointerItem; begin PageControl:=nil; // Free SpeedButtons stored in the tree map. AVLNode:=fComponentButtons.Tree.FindLowest; while AVLNode<>nil do begin P2PItem:=PPointerToPointerItem(AVLNode.Data); TSpeedButton(P2PItem^.Value).Free; AVLNode:=fComponentButtons.Tree.FindSuccessor(AVLNode); end; FreeAndNil(fComponentButtons); FreeAndNil(fSelectButtonIcon); FreeAndNil(PopupMenu); FreeAndNil(PalettePopupMenu); inherited Destroy; end; procedure TComponentPalette.BeginUpdate; begin inc(FUpdateLock); end; procedure TComponentPalette.EndUpdate; begin if FUpdateLock<=0 then raise Exception.Create('TBaseComponentPalette.EndUpdate: FUpdateLock<=0'); dec(FUpdateLock); if (FUpdateLock=0) and FChanged then Update(False); end; function TComponentPalette.IsUpdateLocked: boolean; begin Result:=FUpdateLock>0; end; procedure TComponentPalette.Update(ForceUpdateAll: Boolean); begin if not (ForceUpdateAll or FChanged) then Exit; inherited Update(ForceUpdateAll); {$IFDEF VerboseComponentPalette} DebugLn(['TComponentPalette.Update, fUpdatingPageControl=', fUpdatingPageControl, ', ForceUpdateAll=', ForceUpdateAll, ', FChanged=', FChanged]); {$ENDIF} UpdateNoteBookButtons(ForceUpdateAll); FChanged:=False; end; procedure TComponentPalette.ClearButtons; begin if FPageControl<>nil then FPageControl.DisableAlign; Selected:=nil; if PopupMenu<>nil then begin PopupMenu.Free; PopupMenu:=nil; OpenPackageMenuItem:=nil; end; if FPageControl<>nil then FPageControl.EnableAlign; end; procedure TComponentPalette.GetUnregisteredIcon( var ImageList: TCustomImageList; var ImageIndex: TImageIndex); var IL: TLCLGlyphs; begin IL := IDEImages.Images_24; ImageList := IL; ImageIndex := IL.GetImageIndex('unregisteredcomponent'); if ImageIndex<0 then ImageIndex := IL.GetImageIndex('default'); end; function TComponentPalette.GetSelectButtonIcon: TCustomBitmap; begin if fSelectButtonIcon=nil then fSelectButtonIcon := CreateBitmapFromResourceName(hInstance, 'tmouse'); Result:=fSelectButtonIcon; end; function TComponentPalette.SelectAButton(Button: TSpeedButton): boolean; var NewComponent: TRegisteredComponent; begin NewComponent := FindCompByButton(Button); Selected := NewComponent; Result := (Selected = NewComponent); end; procedure TComponentPalette.ComponentWasAdded(ALookupRoot, AComponent: TComponent; ARegisteredComponent: TRegisteredComponent); begin if not (ssShift in GetKeyShiftState) and (SelectionMode = csmSingle) then Selected := nil; end; procedure TComponentPalette.DoChange; begin if FUpdateLock>0 then FChanged:=true else Update(False); end; procedure TComponentPalette.ReAlignButtons(aSheet: TCustomPage); var PageInd: Integer; begin if (aSheet=Nil) or not aSheet.Visible then exit; {$IFDEF VerboseComponentPalette} DebugLn(['TComponentPalette.ReAlignButtons Visible="',aSheet.Caption,'", ClientWidth=',aSheet.ClientWidth]); {$ENDIF} PageInd:=IndexOfPageComponent(aSheet); if PageInd>=0 then TComponentPage(Pages[PageInd]).ReAlignButtons; end; procedure TComponentPalette.RemoveUnneededPage(aSheet: TCustomPage); var PageInd: Integer; begin PageInd:=IndexOfPageComponent(aSheet); if (PageInd>=0) and Pages[PageInd].Visible then Exit; // page is not needed anymore => delete if PageInd>=0 then TComponentPage(Pages[PageInd]).RemoveSheet; if aSheet=fOldActivePage then fOldActivePage:=nil; aSheet.Visible:=false; {$IFDEF VerboseComponentPalette} if aSheet.Caption = CompPalVerbPgName then DebugLn(['TComponentPalette.RemoveUnneededPage: Removing Page=', aSheet.Caption, ', index=', PageInd]); {$ENDIF} Application.ReleaseComponent(aSheet); end; procedure TComponentPalette.UpdateNoteBookButtons(ForceUpdateAll: Boolean); var i: Integer; Pg: TComponentPage; begin if fUpdatingPageControl then exit; Assert(not IsUpdateLocked, 'TComponentPalette.UpdateNoteBookButtons: IsUpdateLocked'); if FPageControl=Nil then exit; // lock fUpdatingPageControl:=true; FPageControl.DisableAlign; try fOldActivePage:=FPageControl.ActivePage; CreatePopupMenu; {$IFDEF VerboseComponentPalette} DebugLn(['TComponentPalette.UpdateNoteBookButtons: FPageCount before=', FPageControl.PageCount]); {$ENDIF} // remove every page in the PageControl without a visible page for i:=FPageControl.PageCount-1 downto 0 do RemoveUnneededPage(FPageControl.Pages[i]); {$IFDEF VerboseComponentPalette} DebugLn(['TComponentPalette.UpdateNoteBookButtons: FPageCount after=', FPageControl.PageCount, ' PageCount=', Pages.count]); {$ENDIF} // Mark GUIs as not created. They will be created later when page gets selected. for i := 0 to Pages.Count-1 do TComponentPage(Pages[i]).fGuiCreated := False; // insert a PageControl page for every visible palette page fVisiblePageIndex := 0; for i := 0 to Pages.Count-1 do begin // Pages and UserOrder.ComponentPages are now synchronized, same index applies. Assert(Pages[i].PageName=UserOrder.ComponentPages[i], 'UpdateNoteBookButtons: Page names do not match.'); Pg := TComponentPage(Pages[i]); {$IF DEFINED(LCLQt) OR DEFINED(LCLQt5) OR DEFINED(LCLQt6)} // Qt has some problems in moving existing tabs! if Assigned(Pg.PageComponent) then begin Pg.PageComponent.Free; Pg.RemoveSheet; end; {$ENDIF} Pg.InsertVisiblePage(TRegisteredCompList(UserOrder.ComponentPages.Objects[i])); {$IFDEF VerboseComponentPalette} DebugLn(['TComponentPalette.UpdateNoteBookButtons: PageIndex=', i, ' PageName=',Pages[i].PageName]); {$ENDIF} end; // OldActivePage can be invalid if a user defined page is just deleted. if Assigned(fOldActivePage) and (FPageControl.IndexOf(fOldActivePage) = -1) then fOldActivePage := Nil; for i := Pages.Count-1 downto 0 do begin Pg := TComponentPage(Pages[i]); // During IDE start create GUI only for the active page. if ((fOldActivePage=Nil) and (i=0)) // First page is activated by default. or (Pg.PageComponent=fOldActivePage) // Previous active page will be restored. or (ForceUpdateAll) then // Forced after changing configuration. Pg.ReAlignButtons; end; // restore active page if Assigned(fOldActivePage) then FPageControl.ActivePage:=fOldActivePage else if FPageControl.PageCount>0 then FPageControl.PageIndex:=0; finally // unlock fUpdatingPageControl:=false; FPageControl.EnableAlign; end; end; procedure TComponentPalette.GetNonVisualCompIcon(Sender: TObject; AComponent: TComponent; var ImageList: TCustomImageList; var ImageIndex: TImageIndex); var ARegComp: TRegisteredComponent; begin if AComponent<>nil then ARegComp:=FindRegComponent(AComponent.ClassType) else ARegComp:=nil; if ARegComp<>nil then begin ImageList := TPkgComponent(ARegComp).Images; ImageIndex := TPkgComponent(ARegComp).ImageIndex; end else begin GetUnregisteredIcon(ImageList, ImageIndex); end; end; function TComponentPalette.IndexOfPageComponent(AComponent: TComponent): integer; begin if AComponent<>nil then begin Result:=Pages.Count-1; while (Result>=0) and (TComponentPage(Pages[Result]).PageComponent<>AComponent) do dec(Result); end else Result:=-1; end; function TComponentPalette.FindCompByButton(Button: TSpeedButton): TRegisteredComponent; var CompClass: TComponentClass; begin CompClass := TComponentClass(fComponentButtons.FindByValue(Button)); if Assigned(CompClass) then Result := FindRegComponent(CompClass) else Result := nil; end; function TComponentPalette.FindPkgCompByButton(Button: TComponent): TPkgComponent; begin Result := TPkgComponent(FindCompByButton(TSpeedButton(Button))); end; end.