implemented dynamic component palette

git-svn-id: trunk@4091 -

ide/componentpalette.pas

@@ -38,7 +38,12 @@ unit ComponentPalette;
 interface
 
 uses
-  Classes, SysUtils, Dialogs, Graphics, ExtCtrls, ComponentReg, PackageDefs;
+  Classes, SysUtils, Dialogs, Graphics, ExtCtrls, Buttons,
+  ComponentReg, PackageDefs, LazarusIDEStrConsts;
+
+const
+  ComponentPaletteBtnWidth  = 25;
+  ComponentPaletteBtnHeight = 25;
 
 type
   TComponentPalette = class(TBaseComponentPalette)
@@ -46,6 +51,8 @@ type
     FNoteBook: TNotebook;
     fNoteBookNeedsUpdate: boolean;
     procedure SetNoteBook(const AValue: TNotebook);
+    procedure SelectionToolClick(Sender: TObject);
+    procedure ComponentBtnClick(Sender: TObject);
   protected
     procedure DoEndUpdate(Changed: boolean); override;
   public
@@ -64,6 +71,16 @@ begin
   UpdateNoteBookButtons;
 end;
 
+procedure TComponentPalette.SelectionToolClick(Sender: TObject);
+begin
+
+end;
+
+procedure TComponentPalette.ComponentBtnClick(Sender: TObject);
+begin
+
+end;
+
 procedure TComponentPalette.DoEndUpdate(Changed: boolean);
 begin
   if Changed then UpdateNoteBookButtons;
@@ -71,12 +88,101 @@ begin
 end;
 
 procedure TComponentPalette.UpdateNoteBookButtons;
+var
+  i: Integer;
+  PageIndex: Integer;
+  CurPage: TBaseComponentPage;
+  CurNoteBookPage: TPage;
+  CurComponent: TPkgComponent;
+  CurBtn: TSpeedButton;
+  ButtonX: Integer;
+  CurPageIndex: Integer;
+  j: Integer;
 begin
   if IsUpdating then begin
     fNoteBookNeedsUpdate:=true;
     exit;
   end;
   fNoteBookNeedsUpdate:=false;
+  if FNoteBook=nil then begin
+    ClearButtons;
+    exit;
+  end;
+  // remove every page in the notebook without a visible page
+  for i:=FNoteBook.PageCount-1 downto 0 do begin
+    PageIndex:=IndexOfPageComponent(FNoteBook.Page[i]);
+    if (PageIndex<0) or (not Pages[PageIndex].Visible) then begin
+      if PageIndex>=0 then
+        Pages[i].PageComponent:=nil;
+      FNoteBook.Pages.Delete(i);
+    end;
+  end;
+  // insert a notebook page for every visible palette page
+  PageIndex:=0;
+  for i:=0 to Count-1 do begin
+    if not Pages[i].Visible then continue;
+    if Pages[i].PageComponent=nil then begin
+      // insert a new notebook page
+      FNoteBook.Pages.Insert(PageIndex,Pages[i].PageName);
+    end else begin
+      // move to the right position
+      CurPageIndex:=TPage(Pages[i].PageComponent).PageIndex;
+      if CurPageIndex<>PageIndex then
+        FNoteBook.Pages.Move(CurPageIndex,PageIndex);
+    end;
+    inc(PageIndex);
+  end;
+  // create a speedbutton for every visible component
+  for i:=0 to Count-1 do begin
+    CurPage:=Pages[i];
+    if not CurPage.Visible then continue;
+    CurNoteBookPage:=TPage(CurPage.PageComponent);
+    ButtonX:=0;
+    // create selection button
+    if CurPage.SelectButton=nil then begin
+      CurBtn:=TSpeedButton.Create(nil);
+      CurPage.SelectButton:=CurBtn;
+      with CurBtn do begin
+        Name:='PaletteSelectBtn'+IntToStr(i);
+        Parent:=CurNoteBookPage;
+        OnClick := @SelectionToolClick;
+        Glyph.LoadFromLazarusResource('tmouse');
+        Flat := True;
+        GroupIndex:= 1;
+        Down := True;
+        Hint := lisSelectionTool;
+        SetBounds(ButtonX,0,ComponentPaletteBtnWidth,ComponentPaletteBtnHeight);
+      end;
+    end;
+    inc(ButtonX,ComponentPaletteBtnWidth+10);
+    // create component buttons
+    for j:=0 to CurPage.Count-1 do begin
+      CurComponent:=TPkgComponent(CurPage[j]);
+      if CurComponent.Visible then begin
+        if CurComponent.Button=nil then begin
+          CurBtn:=TSpeedButton.Create(nil);
+          CurComponent.Button:=CurBtn;
+          with CurBtn do begin
+            Name:='PaletteBtnPage'+IntToStr(i)+'_'+IntToStr(j)
+                  +'_'+CurComponent.ComponentClass.ClassName;
+            Parent := CurNoteBookPage;
+            Glyph:=CurComponent.GetIconCopy;
+            Width := ComponentPaletteBtnWidth;
+            Height := ComponentPaletteBtnHeight;
+            GroupIndex := 1;
+            Flat := true;
+            OnClick := @ComponentBtnClick;
+            Hint := CurComponent.ComponentClass.ClassName;
+            SetBounds(ButtonX,0,ComponentPaletteBtnWidth,ComponentPaletteBtnHeight);
+            inc(ButtonX,ComponentPaletteBtnWidth+2);
+          end;
+        end;
+      end else if CurComponent.Button<>nil then begin
+        CurComponent.Button.Free;
+        CurComponent.Button:=nil;
+      end;
+    end;
+  end;
 end;
 
 end.

ide/transfermacros.pp

@@ -96,10 +96,10 @@ type
     procedure Clear;
     procedure Delete(Index: integer);
     procedure Add(NewMacro: TTransferMacro);
+    function FindByName(const MacroName: string): TTransferMacro; virtual;
     function SubstituteStr(var s:string): boolean; virtual;
     property OnSubstitution: TOnSubstitution
        read fOnSubstitution write fOnSubstitution;
-    function FindByName(const MacroName: string): TTransferMacro; virtual;
     property MarkUnhandledMacros: boolean read FMarkUnhandledMacros write SetMarkUnhandledMacros;
   end;
 
@@ -373,10 +373,11 @@ begin
   l:=0;
   r:=fItems.Count-1;
   m:=0;
+  Result:=nil;
   while l<=r do begin
     m:=(l+r) shr 1;
     Result:=Items[m];
-    cmp:=AnsiCompareText(Result.Name,Items[m].Name);
+    cmp:=AnsiCompareText(MacroName,Result.Name);
     if cmp<0 then
       r:=m-1
     else if cmp>0 then

packager/componentreg.pas

@@ -75,6 +75,9 @@ type
     FComponentClass: TComponentClass;
     FPage: TBaseComponentPage;
     FPageName: string;
+  protected
+    FVisible: boolean;
+    procedure SetVisible(const AValue: boolean); virtual;
   public
     constructor Create(TheComponentClass: TComponentClass;
       const ThePageName: string);
@@ -89,6 +92,7 @@ type
     property PageName: string read FPageName;
     property Page: TBaseComponentPage read FPage write FPage;
     property Button: TComponent read FButton write FButton;
+    property Visible: boolean read FVisible write SetVisible;
   end;
 
 
@@ -101,7 +105,11 @@ type
     FPageName: string;
     FPalette: TBaseComponentPalette;
     FPriority: TComponentPriority;
+    FSelectButton: TComponent;
     function GetItems(Index: integer): TRegisteredComponent;
+  protected
+    FVisible: boolean;
+    procedure SetVisible(const AValue: boolean); virtual;
   public
     constructor Create(const ThePageName: string);
     destructor Destroy; override;
@@ -118,6 +126,8 @@ type
     property Palette: TBaseComponentPalette read FPalette;
     property Priority: TComponentPriority read FPriority write FPriority;
     property PageComponent: TComponent read FPageComponent write FPageComponent;
+    property SelectButton: TComponent read FSelectButton write FSelectButton;
+    property Visible: boolean read FVisible write SetVisible;
   end;
 
 
@@ -154,6 +164,7 @@ type
       const Priority: TComponentPriority): TBaseComponentPage;
     function FindComponent(const CompClassName: string): TRegisteredComponent;
     function CreateNewClassName(const Prefix: string): string;
+    function IndexOfPageComponent(AComponent: TComponent): integer;
   public
     property Pages[Index: integer]: TBaseComponentPage read GetItems; default;
     property UpdateLock: integer read FUpdateLock;
@@ -205,11 +216,18 @@ end;
 
 { TRegisteredComponent }
 
+procedure TRegisteredComponent.SetVisible(const AValue: boolean);
+begin
+  if FVisible=AValue then exit;
+  FVisible:=AValue;
+end;
+
 constructor TRegisteredComponent.Create(TheComponentClass: TComponentClass;
   const ThePageName: string);
 begin
   FComponentClass:=TheComponentClass;
   FPageName:=ThePageName;
+  FVisible:=true;
 end;
 
 destructor TRegisteredComponent.Destroy;
@@ -249,16 +267,24 @@ begin
   Result:=TRegisteredComponent(FItems[Index]);
 end;
 
+procedure TBaseComponentPage.SetVisible(const AValue: boolean);
+begin
+  if FVisible=AValue then exit;
+  FVisible:=AValue;
+end;
+
 constructor TBaseComponentPage.Create(const ThePageName: string);
 begin
   FPageName:=ThePageName;
   FItems:=TList.Create;
+  FVisible:=FPageName<>'';
 end;
 
 destructor TBaseComponentPage.Destroy;
 begin
   Clear;
   FreeThenNil(FPageComponent);
+  FreeThenNil(FSelectButton);
   FItems.Free;
   inherited Destroy;
 end;
@@ -266,13 +292,9 @@ end;
 procedure TBaseComponentPage.Clear;
 var
   i: Integer;
-  AComponent: TRegisteredComponent;
 begin
-  for i:=0 to FItems.Count-1 do begin
-    AComponent:=Items[i];
-    FreeThenNil(AComponent.FButton);
-    AComponent.Page:=nil;
-  end;
+  ClearButtons;
+  for i:=0 to FItems.Count-1 do Items[i].Page:=nil;
   FItems.Clear;
 end;
 
@@ -283,6 +305,7 @@ var
 begin
   Cnt:=Count;
   for i:=0 to Cnt-1 do FreeThenNil(Items[i].FButton);
+  FreeThenNil(FSelectButton);
 end;
 
 procedure TBaseComponentPage.ConsistencyCheck;
@@ -476,6 +499,17 @@ begin
   end;
 end;
 
+function TBaseComponentPalette.IndexOfPageComponent(AComponent: TComponent
+  ): integer;
+begin
+  if AComponent<>nil then begin
+    Result:=Count-1;
+    while (Result>=0) and (Pages[Result].PageComponent<>AComponent) do
+      dec(Result);
+  end else
+    Result:=-1;
+end;
+
 
 initialization
   IDEComponentPalette:=nil;

packager/packagedefs.pas

@@ -78,6 +78,7 @@ type
     function GetPriority: TComponentPriority; override;
     procedure ConsistencyCheck; override;
     function Icon: TBitmap;
+    function GetIconCopy: TBitMap;
     function HasIcon: boolean;
     function Createable: boolean; override;
   public
@@ -2341,25 +2342,28 @@ begin
 end;
 
 function TPkgComponent.Icon: TBitmap;
+begin
+  if not fIconLoaded then begin
+    fIcon:=GetIconCopy;
+    fIconLoaded:=true;
+  end;
+  Result:=FIcon;
+end;
+
+function TPkgComponent.GetIconCopy: TBitMap;
 var
   ResName: string;
   res: TLResource;
 begin
-  if not fIconLoaded then begin
-    if Page.PageName<>'' then begin
-      FIcon:=TPixmap.Create;
-      FIcon.TransparentColor:=clWhite;
-      ResName:=ComponentClass.ClassName;
-      res:=LazarusResources.Find(ResName);
-      if (res<>nil) and (res.Value<>'') and (res.ValueType='XPM') then begin
-        FIcon.LoadFromLazarusResource(ResName);
-      end else begin
-        FIcon.LoadFromLazarusResource('default');
-      end;
-    end;
-    fIconLoaded:=true;
+  Result:=TPixmap.Create;
+  Result.TransparentColor:=clWhite;
+  ResName:=ComponentClass.ClassName;
+  res:=LazarusResources.Find(ResName);
+  if (res<>nil) and (res.Value<>'') and (res.ValueType='XPM') then begin
+    Result.LoadFromLazarusResource(ResName);
+  end else begin
+    Result.LoadFromLazarusResource('default');
   end;
-  Result:=FIcon;
 end;
 
 function TPkgComponent.HasIcon: boolean;