implemented TTabControl component editor

git-svn-id: trunk@9201 -

ideintf/componenteditors.pas

@@ -155,7 +155,7 @@ type
     function IsInInlined: Boolean; virtual; abstract;
     function GetComponent: TComponent; virtual; abstract;
     function GetDesigner: TComponentEditorDesigner; virtual; abstract;
-    function GetHook(var Hook: TPropertyEditorHook): boolean; virtual; abstract;
+    function GetHook(out Hook: TPropertyEditorHook): boolean; virtual; abstract;
     procedure Modified; virtual; abstract;
   end;
 
@@ -186,7 +186,7 @@ type
     procedure PrepareItem(Index: Integer; const AnItem: TMenuItem); override;
     property Component: TComponent read FComponent;
     property Designer: TComponentEditorDesigner read GetDesigner;
-    function GetHook(var Hook: TPropertyEditorHook): boolean; override;
+    function GetHook(out Hook: TPropertyEditorHook): boolean; override;
     procedure Modified; override;
   end;
 
@@ -229,7 +229,7 @@ type
     procedure DoDeletePage; virtual;
     procedure DoMoveActivePageLeft; virtual;
     procedure DoMoveActivePageRight; virtual;
-    procedure DoMoveActivePage(CurIndex, NewIndex: Integer); virtual;
+    procedure DoMovePage(CurIndex, NewIndex: Integer); virtual;
     procedure AddMenuItemsForPages(ParentMenuItem: TMenuItem); virtual;
     procedure ShowPageMenuItemClick(Sender: TObject);
   public
@@ -251,6 +251,28 @@ type
   end;
 
 
+{ TTabControlComponentEditor
+  The default component editor for TCustomTabControl. }
+  TTabControlComponentEditor = class(TDefaultComponentEditor)
+  protected
+    procedure DoAddTab; virtual;
+    procedure DoInsertTab; virtual;
+    procedure DoDeleteTab; virtual;
+    procedure DoMoveActiveTabLeft; virtual;
+    procedure DoMoveActiveTabRight; virtual;
+    procedure DoMoveTab(CurIndex, NewIndex: Integer); virtual;
+    procedure AddMenuItemsForTabs(ParentMenuItem: TMenuItem); virtual;
+    procedure ShowTabMenuItemClick(Sender: TObject);
+    function CreateNewTabCaption: string;
+  public
+    procedure ExecuteVerb(Index: Integer); override;
+    function GetVerb(Index: Integer): string; override;
+    function GetVerbCount: Integer; override;
+    procedure PrepareItem(Index: Integer; const AnItem: TMenuItem); override;
+    function TabControl: TCustomTabControl; virtual;
+  end;
+
+
 { TStringGridComponentEditor
   The default componenteditor for TStringGrid }
 
@@ -385,6 +407,7 @@ begin
     for I := 0 to ComponentClassList.Count-1 do
     begin
       P := PComponentClassRec(ComponentClassList[I]);
+      //DebugLn('GetComponentEditor Component=',dbgsName(Component),' ',dbgsName(P^.ComponentClass),' ',dbgsName(P^.EditorClass));
       if (Component is P^.ComponentClass) and
         (P^.ComponentClass <> ComponentClass) and
         (P^.ComponentClass.InheritsFrom(ComponentClass)) then
@@ -466,9 +489,10 @@ begin
   // Intended for descendents to implement
 end;
 
-function TComponentEditor.GetHook(var Hook: TPropertyEditorHook): boolean;
+function TComponentEditor.GetHook(out Hook: TPropertyEditorHook): boolean;
 begin
   Result:=false;
+  Hook:=nil;
   if GetDesigner=nil then exit;
   Hook:=GetDesigner.PropertyEditorHook;
   Result:=Hook<>nil;
@@ -669,7 +693,7 @@ var
 begin
   Index:=NoteBook.PageIndex;
   if (Index<0) then exit;
-  DoMoveActivePage(Index,Index-1);
+  DoMovePage(Index,Index-1);
 end;
 
 procedure TNotebookComponentEditor.DoMoveActivePageRight;
@@ -679,10 +703,10 @@ begin
   Index:=NoteBook.PageIndex;
   if (Index>=0)
   and (Index>=NoteBook.PageCount-1) then exit;
-  DoMoveActivePage(Index,Index+1);
+  DoMovePage(Index,Index+1);
 end;
 
-procedure TNotebookComponentEditor.DoMoveActivePage(
+procedure TNotebookComponentEditor.DoMovePage(
   CurIndex, NewIndex: Integer);
 begin
   NoteBook.Pages.Move(CurIndex,NewIndex);
@@ -1370,6 +1394,141 @@ begin
   end;
 end;
 
+{ TTabControlComponentEditor }
+
+const
+  tcvAddTab       = 0;
+  tcvInsertTab    = 1;
+  tcvDeleteTab    = 2;
+  tcvMoveTabLeft  = 3;
+  tcvMoveTabRight = 4;
+
+procedure TTabControlComponentEditor.DoAddTab;
+begin
+  TabControl.Tabs.Add(CreateNewTabCaption);
+  Modified;
+end;
+
+procedure TTabControlComponentEditor.DoInsertTab;
+begin
+  TabControl.Tabs.Insert(TabControl.TabIndex,CreateNewTabCaption);
+  Modified;
+end;
+
+procedure TTabControlComponentEditor.DoDeleteTab;
+begin
+  if (TabControl.Tabs.Count=0) then exit;
+  TabControl.Tabs.Delete(TabControl.TabIndex);
+  Modified;
+end;
+
+procedure TTabControlComponentEditor.DoMoveActiveTabLeft;
+var
+  Index: integer;
+begin
+  Index:=TabControl.TabIndex;
+  if (Index<0) then exit;
+  DoMoveTab(Index,Index-1);
+end;
+
+procedure TTabControlComponentEditor.DoMoveActiveTabRight;
+var
+  Index: integer;
+begin
+  Index:=TabControl.TabIndex;
+  if (Index>=TabControl.Tabs.Count-1) then exit;
+  DoMoveTab(Index,Index+1);
+end;
+
+procedure TTabControlComponentEditor.DoMoveTab(CurIndex, NewIndex: Integer);
+begin
+  TabControl.Tabs.Move(CurIndex,NewIndex);
+  Modified;
+end;
+
+procedure TTabControlComponentEditor.AddMenuItemsForTabs(
+  ParentMenuItem: TMenuItem);
+var
+  i: integer;
+  NewMenuItem: TMenuItem;
+begin
+  ParentMenuItem.Enabled:=TabControl.Tabs.Count>0;
+  for i:=0 to TabControl.Tabs.Count-1 do begin
+    NewMenuItem:=TMenuItem.Create(ParentMenuItem);
+    NewMenuItem.Name:='ShowTab'+IntToStr(i);
+    NewMenuItem.Caption:='"'+TabControl.Tabs[i]+'"';
+    NewMenuItem.OnClick:=@ShowTabMenuItemClick;
+    ParentMenuItem.Add(NewMenuItem);
+  end;
+end;
+
+procedure TTabControlComponentEditor.ShowTabMenuItemClick(Sender: TObject);
+var
+  AMenuItem: TMenuItem;
+  NewTabIndex: LongInt;
+begin
+  AMenuItem:=TMenuItem(Sender);
+  if (AMenuItem=nil) or (not (AMenuItem is TMenuItem)) then exit;
+  NewTabIndex:=AMenuItem.MenuIndex;
+  if (NewTabIndex<0) or (NewTabIndex>=TabControl.Tabs.Count) then exit;
+  TabControl.TabIndex:=NewTabIndex;
+  Modified;
+end;
+
+function TTabControlComponentEditor.CreateNewTabCaption: string;
+begin
+  Result:='New Tab';
+  while TabControl.IndexOfTabWithCaption(Result)>=0 do
+    Result:=CreateNextIdentifier(Result);
+end;
+
+procedure TTabControlComponentEditor.ExecuteVerb(Index: Integer);
+begin
+  case Index of
+    tcvAddTab:       DoAddTab;
+    tcvInsertTab:    DoInsertTab;
+    tcvDeleteTab:    DoDeleteTab; // beware: this can free the editor itself
+    tcvMoveTabLeft:  DoMoveActiveTabLeft;
+    tcvMoveTabRight: DoMoveActiveTabRight;
+  end;
+end;
+
+function TTabControlComponentEditor.GetVerb(Index: Integer): string;
+begin
+  case Index of
+    tcvAddTab:       Result:=tccesAddTab;
+    tcvInsertTab:    Result:=tccesInsertTab;
+    tcvDeleteTab:    Result:=tccesDeleteTab;
+    tcvMoveTabLeft:  Result:=tccesMoveTabLeft;
+    tcvMoveTabRight: Result:=tccesMoveTabRight;
+  else
+    Result:='';
+  end;
+end;
+
+function TTabControlComponentEditor.GetVerbCount: Integer;
+begin
+  Result:=5;
+end;
+
+procedure TTabControlComponentEditor.PrepareItem(Index: Integer;
+  const AnItem: TMenuItem);
+begin
+  inherited PrepareItem(Index, AnItem);
+  case Index of
+    tcvAddTab:       ;
+    tcvInsertTab:    AnItem.Enabled:=TabControl.TabIndex>=0;
+    tcvDeleteTab:    AnItem.Enabled:=TabControl.TabIndex>=0;
+    tcvMoveTabLeft:  AnItem.Enabled:=TabControl.TabIndex>0;
+    tcvMoveTabRight: AnItem.Enabled:=TabControl.TabIndex<TabControl.Tabs.Count-1;
+  end;
+end;
+
+function TTabControlComponentEditor.TabControl: TCustomTabControl;
+begin
+  Result:=TCustomTabControl(GetComponent);
+end;
+
 initialization
   {$I checklistboxeditordlg.lrs}
   {$I checkgroupeditordlg.lrs}
@@ -1378,6 +1537,7 @@ initialization
   RegisterComponentEditorProc:=@DefaultRegisterComponentEditorProc;
   RegisterComponentEditor(TCustomNotebook,TNotebookComponentEditor);
   RegisterComponentEditor(TCustomPage,TPageComponentEditor);
+  RegisterComponentEditor(TCustomTabControl,TTabControlComponentEditor);
   RegisterComponentEditor(TStringGrid,TStringGridComponentEditor);
   RegisterComponentEditor(TCheckListBox,TCheckListBoxComponentEditor);
   RegisterComponentEditor(TCheckGroup,TCheckGroupComponentEditor);

ideintf/objinspstrconsts.pas

@@ -141,6 +141,11 @@ resourcestring
   nbcesMovePageRight = 'Move page right';
   nbcesShowPage = 'Show page ...';
   oisCreateDefaultEvent = 'Create default event';
+  tccesAddTab  = 'Add tab';
+  tccesInsertTab = 'Insert tab';
+  tccesDeleteTab = 'Delete tab';
+  tccesMoveTabLeft = 'Move tab left';
+  tccesMoveTabRight = 'Move tab right';
 
   //checklistbox editor
   clbCheckListBoxEditor = 'CheckListBox Editor';

lcl/comctrls.pp

@@ -232,7 +232,7 @@ type
   public
     constructor Create(TheOwner: TComponent); override;
     function FindNextPage(CurPage: TTabSheet;
-                                GoForward, CheckTabVisible: Boolean): TTabSheet;
+                          GoForward, CheckTabVisible: Boolean): TTabSheet;
     procedure SelectNextPage(GoForward: Boolean);
     procedure SelectNextPage(GoForward: Boolean; CheckTabVisible: Boolean);
     property ActivePageIndex: Integer read GetActivePageIndex
@@ -462,22 +462,23 @@ type
                                      write SetScrollOpposite default False;
     property Style: TTabStyle read FStyle write SetStyle default tsTabs;
     property TabHeight: Smallint read GetTabHeight write SetTabHeight default 0;
-    property TabIndex: Integer read GetTabIndex write SetTabIndex default -1;
     property TabPosition: TTabPosition read FTabPosition write SetTabPosition
                                        default tpTop;
-    property Tabs: TStrings read FTabs write SetTabs;
     property TabWidth: Smallint read GetTabWidth write SetTabWidth default 0;
   public
     constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
     function IndexOfTabAt(X, Y: Integer): Integer;
     function GetHitTestInfoAt(X, Y: Integer): THitTests;
+    function IndexOfTabWithCaption(const TabCaption: string): Integer;
     function TabRect(Index: Integer): TRect;
     function RowCount: Integer;
     procedure ScrollTabs(Delta: Integer);
     procedure BeginUpdate;
     procedure EndUpdate;
     function IsUpdating: boolean;
+    property TabIndex: Integer read GetTabIndex write SetTabIndex default -1;
+    property Tabs: TStrings read FTabs write SetTabs;
   public
     property TabStop default True;
   end;

lcl/include/tabcontrol.inc

@@ -601,6 +601,17 @@ begin
   Result:=TTabControlStrings(FTabs).GetHitTestInfoAt(X,Y);
 end;
 
+function TCustomTabControl.IndexOfTabWithCaption(const TabCaption: string
+  ): Integer;
+begin
+  Result:=0;
+  while Result<Tabs.Count do begin
+    if CompareText(Tabs[Result],TabCaption)=0 then exit;
+    inc(Result);
+  end;
+  Result:=-1;
+end;
+
 function TCustomTabControl.TabRect(Index: Integer): TRect;
 begin
   Result:=TTabControlStrings(FTabs).TabRect(Index);

lcl/interfaces/gtk/gtkcallback.inc

@@ -1352,8 +1352,10 @@ begin
     end;
   end else begin
     // stop the signal, so that the widget does not auto react
-    if (not (TControl(Data) is TCustomNoteBook))
+    if (event^.Button<>1)
-    or (event^.Button<>1) then begin
+    or ((not (TControl(Data) is TCustomNoteBook))
+    and (not (TControl(Data) is TCustomTabControl)))
+    then begin
       g_signal_stop_emission_by_name(PGTKObject(Widget),'button-press-event');
       Result := not CallBackDefaultReturn;
     end;
@@ -1518,7 +1520,9 @@ begin
     end;
   end else begin
     // stop the signal, so that the widget does not auto react
-    if not (TControl(Data) is TCustomNoteBook) then
+    if (not (TControl(Data) is TCustomNoteBook))
+    and (not (TControl(Data) is TCustomTabControl))
+    then
       g_signal_stop_emission_by_name(PGTKObject(Widget),'button-release-event');
     Result := not CallBackDefaultReturn;
   end;