{ /*************************************************************************** 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 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, fgl, Controls, Forms, Graphics, ComCtrls, Buttons, Menus, ExtCtrls, LazFileUtils, LazFileCache, PropEdits, LCLProc, MainBase, LazarusIDEStrConsts, FormEditingIntf, LazIDEIntf, IDEImagesIntf, ComponentReg, DesignerProcs, PackageDefs, EnvironmentOpts; const CompPalSelectionToolBtnPrefix = 'PaletteSelectBtn'; CompPaletteCompBtnPrefix = 'PaletteBtn'; type { TComponentPage } TComponentPage = class(TBaseComponentPage) private fPageComponent: TCustomPage; fSelectButton: TComponent; fBtnIndex: integer; fCompNames: TStringList; // Reference to component names. fGuiCreated: Boolean; procedure ReAlignButtons; procedure RemoveSheet; procedure InsertVisiblePage(aCompNames: TStringList); 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; TComponentButtonMap = specialize TFPGMap; { 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 fComponentButtons: TComponentButtonMap; // Visual container for tabs FPageControl: TPageControl; FOnOpenPackage: TNotifyEvent; FOnOpenUnit: TNotifyEvent; FOnChangeActivePage: TNotifyEvent; fUnregisteredIcon: TCustomBitmap; fSelectButtonIcon: TCustomBitmap; fUpdatingPageControl: boolean; // 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 SelectionWasChanged; function GetUnregisteredIcon: TCustomBitmap; function GetSelectButtonIcon: TCustomBitmap; function SelectAButton(Button: TSpeedButton): boolean; procedure ComponentWasAdded({%H-}ALookupRoot, {%H-}AComponent: TComponent; {%H-}ARegisteredComponent: TRegisteredComponent); procedure CheckComponentDesignerVisible(AComponent: TComponent; var Invisible: boolean); public constructor Create; destructor Destroy; override; procedure OnGetNonVisualCompIcon(Sender: TObject; AComponent: TComponent; var Icon: TCustomBitmap); 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 uses componentpalette_options; {$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: 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}; 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:= ((ComponentPaletteBtnWidth*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 ComponentPaletteBtnWidth); // If we need to wrap, make sure we have space for the scrollbar if MaxBtnPerRow < ButtonTree.Count then MaxBtnPerRow:=((ScrollBox.VertScrollBar.ClientSizeWithBar - ButtonX) div ComponentPaletteBtnWidth); //debugln(['TComponentPage.ReAlignButtons MaxBtnPerRow=',MaxBtnPerRow,' ButtonTree.Count=',ButtonTree.Count,' ',ButtonX + MaxBtnPerRow * ComponentPaletteBtnWidth]); 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) * ComponentPaletteBtnWidth, (i div MaxBtnPerRow) * ComponentPaletteBtnHeight, 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: TStringList); 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; fCompNames := 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 := ComponentPaletteBtnHeight; VertScrollBar.Tracking := True; Parent := PageComponent; end; PanelRight := TPanel.Create(PageComponent); with PanelRight do begin Align := alRight; Caption := ''; BevelOuter := bvNone; Width := OVERVIEW_PANEL_WIDTH; Visible := True; // EnvironmentOptions.IDESpeedButtonsVisible; Parent := PageComponent; OnMouseWheel := @Pal.OnPageMouseWheel; end; BtnRight:=TSpeedButton.Create(PageComponent); with BtnRight do begin LoadGlyphFromResourceName(HInstance, 'SelCompPage'); Flat := True; SetBounds(2,1,16,16); Hint := lisClickToSelectPalettePage; ShowHint := True; OnMouseDown := @MainIDE.SelComponentPageButtonMouseDown; OnClick := @MainIDE.SelComponentPageButtonClick; OnMouseWheel := @Pal.OnPageMouseWheel; Parent := PanelRight; 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 {%H-}Pal: TComponentPalette; Btn: TSpeedButton; begin if Assigned(SelectButton) then Exit; Pal := TComponentPalette(Palette); Btn := TSpeedButton.Create(nil); SelectButton:=Btn; with Btn do begin Name := CompPalSelectionToolBtnPrefix + aButtonUniqueName; OnClick := @Pal.SelectionToolClick; OnMouseWheel := @Pal.OnPageMouseWheel; LoadGlyphFromResourceName(hInstance, 'tmouse'); Flat := True; GroupIndex:= 1; Down := True; Hint := lisSelectionTool; ShowHint := EnvironmentOptions.ShowHintsForComponentPalette; SetBounds(0,0,ComponentPaletteBtnWidth,ComponentPaletteBtnHeight); Parent := aScrollBox; end; end; procedure TComponentPage.CreateOrDelButton(aComp: TPkgComponent; aButtonUniqueName: string; aScrollBox: TScrollBox); var Pal: TComponentPalette; Btn: TSpeedButton; CompCN: String; // Component ClassName i: Integer; begin Pal := TComponentPalette(Palette); CompCN := aComp.ComponentClass.ClassName; if Pal.fComponentButtons.Find(CompCN, i) then Btn := Pal.fComponentButtons.Data[i] else Btn := nil; if aComp.Visible then begin inc(fBtnIndex); if Btn=nil then begin Btn := TSpeedButton.Create(nil); Pal.fComponentButtons[CompCN] := Btn; Btn.Name := CompPaletteCompBtnPrefix + aButtonUniqueName + CompCN; // Left and Top will be set in ReAlignButtons. Btn.SetBounds(Btn.Left,Btn.Top,ComponentPaletteBtnWidth,ComponentPaletteBtnHeight); Btn.Glyph.Assign(aComp.Icon); Btn.GroupIndex := 1; Btn.Flat := true; Btn.OnMouseDown := @Pal.ComponentBtnMouseDown; Btn.OnMouseUp := @Pal.ComponentBtnMouseUp; Btn.OnDblClick := @Pal.ComponentBtnDblClick; Btn.OnMouseWheel := @Pal.OnPageMouseWheel; Btn.ShowHint := EnvironmentOptions.ShowHintsForComponentPalette; Btn.Hint := CompCN + sLineBreak + '(' + aComp.ComponentClass.UnitName + ')'; Btn.PopupMenu:=Pal.PopupMenu; {$IFDEF VerboseComponentPalette} if aComp.RealPage.PageName = CompPalVerbPgName then DebugLn(['TComponentPalette.CreateOrDelButton Created Button: ',CompCN,' ',Btn.Name]); {$ENDIF} end else begin {$IFDEF VerboseComponentPalette} if aComp.RealPage.PageName = CompPalVerbPgName then DebugLn(['TComponentPalette.CreateOrDelButton Keep Button: ',CompCN,' ',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: ',CompCN,' ',Btn.Name]); {$ENDIF} Application.ReleaseComponent(Btn); Pal.fComponentButtons.Remove(CompCN); Btn.Visible:=false; end; end; procedure TComponentPage.CreateButtons; // Create speedbuttons for every visible component var Pal: TComponentPalette; ScrollBox: TScrollBox; Comp: TPkgComponent; i: Integer; begin if not Visible then Exit; Pal := TComponentPalette(Palette); ScrollBox := GetScrollBox; Assert(Assigned(ScrollBox), 'CreateButtons: ScrollBox not assigned.'); ScrollBox.OnResize := @Pal.OnScrollBoxResize; ScrollBox.OnMouseWheel := @Pal.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(fCompNames), 'TComponentPage.CreateButtons: fCompNames is not assigned.'); for i := 0 to fCompNames.Count-1 do begin Comp := Pal.FindComponent(fCompNames[i]) as TPkgComponent; 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 ((Selected.RealPage as TComponentPage).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'; // Component List PalettePopupMenu.Images := IDEImages.Images_16; miCompList:=TMenuItem.Create(PalettePopupMenu); with miCompList do begin Name:='ComponentListMenuItem'; Caption:=lisCompPalComponentList; OnClick:=@ComponentListClicked; end; PalettePopupMenu.Items.Add(miCompList); miOptions:=TMenuItem.Create(PalettePopupMenu); with miOptions do begin Name:='OptionsMenuItem'; Caption:=lisOptions; OnClick:=@OptionsClicked; ImageIndex := IDEImages.LoadImage(16, '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; i: Integer; begin if FPageControl=nil then exit; UnselectAllButtons; if Selected=nil then exit; Assert(Assigned(Selected.RealPage), 'TComponentPalette.SelectionWasChanged: Selected.RealPage = Nil.'); Sheet:=(Selected.RealPage as TComponentPage).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. if not fComponentButtons.Find(Selected.ComponentClass.ClassName, i) then ReAlignButtons(FPageControl.ActivePage); // Select button if fComponentButtons.Find(Selected.ComponentClass.ClassName, i) then //find again! fComponentButtons.Data[i].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:=lisOptions; OnClick:=@OptionsClicked; ImageIndex := IDEImages.LoadImage(16, '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 PageControl.ActivePageIndex := PageControl.ActivePageIndex - 1; end else begin if (PageControl.ActivePageIndex < PageControl.PageCount-1) then PageControl.ActivePageIndex := PageControl.ActivePageIndex + 1; end; Handled := True; end; procedure TComponentPalette.Update(ForceUpdateAll: Boolean); begin inherited Update(ForceUpdateAll); {$IFDEF VerboseComponentPalette} DebugLn(['TComponentPalette.Update, calling UpdateNoteBookButtons, fUpdatingPageControl=', fUpdatingPageControl]); {$ENDIF} UpdateNoteBookButtons(ForceUpdateAll); end; procedure TComponentPalette.CheckComponentDesignerVisible( AComponent: TComponent; var Invisible: boolean); var RegComp: TRegisteredComponent; AControl: TControl; begin if (AComponent is TControl) then begin AControl:=TControl(AComponent); Invisible:=(csNoDesignVisible in AControl.ControlStyle) end else begin RegComp:=FindComponent(AComponent.ClassName); Invisible:=(RegComp=nil) or (RegComp.OrigPageName=''); end; end; constructor TComponentPalette.Create; begin inherited Create(EnvironmentOptions.Desktop.ComponentPaletteOptions); fComponentButtons:=TComponentButtonMap.Create; fComponentButtons.Sorted:=True; OnComponentIsInvisible:=@CheckComponentDesignerVisible; {IDEComponentPalette.} AddHandlerComponentAdded(@ComponentWasAdded); {IDEComponentPalette.} AddHandlerSelectionChanged(@SelectionWasChanged); ComponentPageClass := TComponentPage; // Used by CreatePagesFromUserOrder end; destructor TComponentPalette.Destroy; var i: Integer; begin if OnComponentIsInvisible=@CheckComponentDesignerVisible then OnComponentIsInvisible:=nil; PageControl:=nil; for i := 0 to fComponentButtons.Count-1 do fComponentButtons.Data[i].Free; FreeAndNil(fComponentButtons); FreeAndNil(fUnregisteredIcon); FreeAndNil(fSelectButtonIcon); FreeAndNil(PopupMenu); FreeAndNil(PalettePopupMenu); inherited Destroy; 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; function TComponentPalette.GetUnregisteredIcon: TCustomBitmap; begin if fUnregisteredIcon = nil then begin fUnregisteredIcon := CreateBitmapFromResourceName(hInstance, 'unregisteredcomponent'); if fUnregisteredIcon = nil then fUnregisteredIcon := CreateBitmapFromResourceName(hInstance, 'default'); end; Result := fUnregisteredIcon; 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.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]); Application.ProcessMessages; // PageIndex of tabs are not updated without this. {$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]); {$IFDEF LCLQt} // Qt has some problems in moving existing tabs! if Assigned(Pg.PageComponent) then begin Pg.PageComponent.Free; Pg.RemoveSheet; end; {$ENDIF} Pg.InsertVisiblePage(TStringList(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.OnGetNonVisualCompIcon(Sender: TObject; AComponent: TComponent; var Icon: TCustomBitmap); var ARegComp: TRegisteredComponent; begin if AComponent<>nil then ARegComp:=FindComponent(AComponent.ClassName) else ARegComp:=nil; if ARegComp<>nil then Icon:=TPkgComponent(ARegComp).Icon else Icon:=GetUnregisteredIcon; end; function TComponentPalette.IndexOfPageComponent(AComponent: TComponent): integer; begin if AComponent<>nil then begin Result:=Pages.Count-1; while (Result>=0) and ((Pages[Result] as TComponentPage).PageComponent<>AComponent) do dec(Result); end else Result:=-1; end; function TComponentPalette.FindCompByButton(Button: TSpeedButton): TRegisteredComponent; var i: Integer; begin i := fComponentButtons.IndexOfData(Button); if i >= 0 then Result := FindComponent(fComponentButtons.Keys[i]) else Result := nil; end; function TComponentPalette.FindPkgCompByButton(Button: TComponent): TPkgComponent; begin Result := FindCompByButton(Button as TSpeedButton) as TPkgComponent; end; end.