started TTabControl

git-svn-id: trunk@5947 -

.gitattributes

@@ -1232,6 +1232,7 @@ lcl/include/spinedit.inc svneol=native#text/pascal
 lcl/include/statusbar.inc svneol=native#text/pascal
 lcl/include/statuspanel.inc svneol=native#text/pascal
 lcl/include/statuspanels.inc svneol=native#text/pascal
+lcl/include/tabcontrol.inc svneol=native#text/pascal
 lcl/include/tabsheet.inc svneol=native#text/pascal
 lcl/include/timer.inc svneol=native#text/pascal
 lcl/include/togglebox.inc svneol=native#text/pascal

lcl/comctrls.pp

@@ -42,6 +42,10 @@ uses
   Controls, Forms, StdCtrls, ExtCtrls, ToolWin, CommCtrl, Buttons;
 
 type
+  THitTest = (htAbove, htBelow, htNowhere, htOnItem, htOnButton, htOnIcon,
+    htOnIndent, htOnLabel, htOnRight, htOnStateIcon, htToLeft, htToRight);
+  THitTests = set of THitTest;
+
   TStatusPanelStyle = (psText, psOwnerDraw);
   TStatusPanelBevel = (pbNone, pbLowered, pbRaised);
 
@@ -267,6 +271,156 @@ type
   end;
 
 
+  {$IFDEF EnableTabControl}
+
+  { TCustomTabControl }
+  
+  TCustomTabControl = class;
+
+  TDrawTabEvent = procedure(Control: TCustomTabControl; TabIndex: Integer;
+    const Rect: TRect; Active: Boolean) of object;
+
+  TCustomTabControl = class(TWinControl)
+  private
+    FCanvas: TCanvas;
+    FHotTrack: Boolean;
+    FImageChangeLink: TChangeLink;
+    FImages: TCustomImageList;
+    FMultiLine: Boolean;
+    FMultiSelect: Boolean;
+    FOnChange: TNotifyEvent;
+    FOnChanging: TTabChangingEvent;
+    FOnDrawTab: TDrawTabEvent;
+    FOnGetImageIndex: TTabGetImageEvent;
+    FOwnerDraw: Boolean;
+    FRaggedRight: Boolean;
+    FScrollOpposite: Boolean;
+    FStyle: TTabStyle;
+    FTabHeight: Smallint;
+    FTabIndex: integer;
+    FTabPosition: TTabPosition;
+    FTabWidth: Smallint;
+    FTabs: TStrings;
+    function GetDisplayRect: TRect;
+    function GetTabIndex: Integer;
+    procedure SetHotTrack(const AValue: Boolean);
+    procedure SetImages(const AValue: TCustomImageList);
+    procedure SetMultiLine(const AValue: Boolean);
+    procedure SetMultiSelect(const AValue: Boolean);
+    procedure SetOwnerDraw(const AValue: Boolean);
+    procedure SetRaggedRight(const AValue: Boolean);
+    procedure SetScrollOpposite(const AValue: Boolean);
+    procedure SetStyle(const AValue: TTabStyle);
+    procedure SetTabHeight(const AValue: Smallint);
+    procedure SetTabPosition(const AValue: TTabPosition);
+    procedure SetTabs(const AValue: TStrings);
+    procedure SetTabWidth(const AValue: Smallint);
+  protected
+    function CanChange: Boolean; dynamic;
+    function CanShowTab(TabIndex: Integer): Boolean; virtual;
+    procedure Change; dynamic;
+    procedure DrawTab(TabIndex: Integer; const Rect: TRect; Active: Boolean); virtual;
+    function GetImageIndex(TabIndex: Integer): Integer; virtual;
+    procedure Loaded; override;
+    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+    procedure SetTabIndex(Value: Integer); virtual;
+    procedure UpdateTabImages;
+    procedure ImageListChange(Sender: TObject); virtual;
+  protected
+    property DisplayRect: TRect read GetDisplayRect;
+    property HotTrack: Boolean read FHotTrack write SetHotTrack default False;
+    property Images: TCustomImageList read FImages write SetImages;
+    property MultiLine: Boolean read FMultiLine write SetMultiLine default False;
+    property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default False;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property OnChanging: TTabChangingEvent read FOnChanging write FOnChanging;
+    property OnDrawTab: TDrawTabEvent read FOnDrawTab write FOnDrawTab;
+    property OnGetImageIndex: TTabGetImageEvent read FOnGetImageIndex write FOnGetImageIndex;
+    property OwnerDraw: Boolean read FOwnerDraw write SetOwnerDraw default False;
+    property RaggedRight: Boolean read FRaggedRight write SetRaggedRight default False;
+    property ScrollOpposite: Boolean read FScrollOpposite
+                                     write SetScrollOpposite default False;
+    property Style: TTabStyle read FStyle write SetStyle default tsTabs;
+    property TabHeight: Smallint read FTabHeight 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 FTabWidth 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 TabRect(Index: Integer): TRect;
+    function RowCount: Integer;
+    procedure ScrollTabs(Delta: Integer);
+    property Canvas: TCanvas read FCanvas;
+    property TabStop default True;
+  end;
+
+
+  { TTabControl }
+
+  TTabControl = class(TCustomTabControl)
+  public
+    property DisplayRect;
+  published
+    property Align;
+    property Anchors;
+    property Constraints;
+    property DockSite;
+    property DragCursor;
+    property DragKind;
+    property DragMode;
+    property Enabled;
+    property Font;
+    property HotTrack;
+    property Images;
+    property MultiLine;
+    property MultiSelect;
+    property OnChange;
+    property OnChangeBounds;
+    property OnChanging;
+    property OnContextPopup;
+    property OnDockDrop;
+    property OnDockOver;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnDrawTab;
+    property OnEndDock;
+    property OnEndDrag;
+    property OnEnter;
+    property OnExit;
+    property OnGetImageIndex;
+    property OnGetSiteInfo;
+    property OnMouseDown;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnResize;
+    property OnStartDock;
+    property OnStartDrag;
+    property OnUnDock;
+    property OwnerDraw;
+    property ParentFont;
+    property ParentShowHint;
+    property PopupMenu;
+    property RaggedRight;
+    property ScrollOpposite;
+    property ShowHint;
+    property Style;
+    property TabHeight;
+    property TabIndex;
+    property TabOrder;
+    property TabPosition;
+    property Tabs;
+    property TabStop;
+    property TabWidth;
+    property Visible;
+  end;
+  {$ENDIF EnableTabControl}
+
+
   { Custom draw }
 
   TCustomDrawTarget = (dtControl, dtItem, dtSubItem);
@@ -1519,10 +1673,6 @@ type
     Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
     var PaintImages, DefaultDraw: Boolean) of object;
 
-  THitTest = (htAbove, htBelow, htNowhere, htOnItem, htOnButton, htOnIcon,
-    htOnIndent, htOnLabel, htOnRight, htOnStateIcon, htToLeft, htToRight);
-  THitTests = set of THitTest;
-
   TTreeNodeCompare = function(Node1, Node2: TTreeNode): integer of object;
 
   PTreeNodeInfo = ^TTreeNodeInfo;
@@ -2287,6 +2437,7 @@ end;
 {$I statuspanels.inc}
 {$I tabsheet.inc}
 {$I pagecontrol.inc}
+{$I tabcontrol.inc}
 { $I alignment.inc}
 {$I listcolumns.inc}
 {$I listcolumn.inc}
@@ -2300,12 +2451,14 @@ end;
 {$I trackbar.inc}
 {$I treeview.inc}
 
-
 end.
 
 { =============================================================================
 
   $Log$
+  Revision 1.145  2004/09/08 22:59:54  mattias
+  started TTabControl
+
   Revision 1.144  2004/09/04 22:24:16  mattias
   added default values for compiler skip options and improved many parts of synedit for UTF8
 

lcl/controls.pp

@@ -1096,7 +1096,7 @@ type
     property ShowHint: Boolean read FShowHint write SetShowHint stored IsShowHintStored default False;
     property Visible: Boolean read FVisible write SetVisible stored IsVisibleStored default True;
     property WindowProc: TWndMethod read FWindowProc write FWindowProc;
-    property TabStop: Boolean read FTabStop write SetTabStop;
+    property TabStop: Boolean read FTabStop write SetTabStop default false;
     property TabOrder: TTabOrder read GetTabOrder write SetTaborder default -1;
   public
     // docking properties
@@ -2410,6 +2410,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.245  2004/09/08 22:59:54  mattias
+  started TTabControl
+
   Revision 1.244  2004/09/08 08:20:50  mattias
   fixed find in files searching at end of line
 

lcl/extctrls.pp

@@ -52,10 +52,6 @@ type
   { workaround problem with fcl }
   TAbstractReader = TReader;
 
-  { TTabPosition - Move to TTabbedNotebook when it is created }
-  TTabPosition = (tpTop, tpBottom, tpLeft, tpRight);
-
-
   { TCustomPage }
 
   TPageFlag = (
@@ -124,6 +120,16 @@ type
 
   { TCustomNotebook }
 
+  TTabChangingEvent = procedure(Sender: TObject;
+    var AllowChange: Boolean) of object;
+
+  TTabPosition = (tpTop, tpBottom, tpLeft, tpRight);
+
+  TTabStyle = (tsTabs, tsButtons, tsFlatButtons);
+
+  TTabGetImageEvent = procedure(Sender: TObject; TabIndex: Integer;
+    var ImageIndex: Integer) of object;
+
   TNoteBookOption = (nboShowCloseButtons, nboMultiLine);
   TNoteBookOptions = set of TNoteBookOption;
 
@@ -966,6 +972,9 @@ end.
 
  {
   $Log$
+  Revision 1.117  2004/09/08 22:59:54  mattias
+  started TTabControl
+
   Revision 1.116  2004/09/04 22:24:16  mattias
   added default values for compiler skip options and improved many parts of synedit for UTF8
 

lcl/include/control.inc

@@ -3130,7 +3130,7 @@ begin
   FEnabled := True;
   FHelpType := htContext;
   FTabOrder := -1;
-  TabStop := False;
+  FTabStop := False;
   FDragCursor := crDrag;
   FFloatingDockSiteClass := TCustomDockForm;
   //DebugLn('TControl.Create END ',Name,':',ClassName);
@@ -3275,6 +3275,9 @@ end;
 
 { =============================================================================
   $Log$
+  Revision 1.214  2004/09/08 22:59:54  mattias
+  started TTabControl
+
   Revision 1.213  2004/09/04 22:24:16  mattias
   added default values for compiler skip options and improved many parts of synedit for UTF8
 

lcl/include/tabcontrol.inc

@@ -0,0 +1,246 @@
+{%MainUnit ../comctrls.pp}
+
+{******************************************************************************
+                                  TTabControl
+ ******************************************************************************
+
+  Author: Mattias Gaertner
+
+ *****************************************************************************
+ *                                                                           *
+ *  This file is part of the Lazarus Component Library (LCL)                 *
+ *                                                                           *
+ *  See the file COPYING.LCL, included in this distribution,                 *
+ *  for details about the copyright.                                         *
+ *                                                                           *
+ *  This program 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.                     *
+ *                                                                           *
+ *****************************************************************************
+
+}
+
+{$IFDEF EnableTabControl}
+{ TCustomTabControl }
+
+function TCustomTabControl.GetDisplayRect: TRect;
+begin
+  Result:=ClientRect;
+end;
+
+function TCustomTabControl.GetTabIndex: Integer;
+begin
+  Result:=FTabIndex;
+  // ToDo
+end;
+
+procedure TCustomTabControl.SetHotTrack(const AValue: Boolean);
+begin
+  if FHotTrack=AValue then exit;
+  FHotTrack:=AValue;
+  // ToDo
+end;
+
+procedure TCustomTabControl.SetImages(const AValue: TCustomImageList);
+begin
+  if FImages=AValue then exit;
+  FImages:=AValue;
+  // ToDo
+end;
+
+procedure TCustomTabControl.SetMultiLine(const AValue: Boolean);
+begin
+  if FMultiLine=AValue then exit;
+  FMultiLine:=AValue;
+  // ToDo
+end;
+
+procedure TCustomTabControl.SetMultiSelect(const AValue: Boolean);
+begin
+  if FMultiSelect=AValue then exit;
+  FMultiSelect:=AValue;
+  // ToDo
+end;
+
+procedure TCustomTabControl.SetOwnerDraw(const AValue: Boolean);
+begin
+  if FOwnerDraw=AValue then exit;
+  FOwnerDraw:=AValue;
+  // ToDo
+end;
+
+procedure TCustomTabControl.SetRaggedRight(const AValue: Boolean);
+begin
+  if FRaggedRight=AValue then exit;
+  FRaggedRight:=AValue;
+  // ToDo
+end;
+
+procedure TCustomTabControl.SetScrollOpposite(const AValue: Boolean);
+begin
+  if FScrollOpposite=AValue then exit;
+  FScrollOpposite:=AValue;
+  // ToDo
+end;
+
+procedure TCustomTabControl.SetStyle(const AValue: TTabStyle);
+begin
+  if FStyle=AValue then exit;
+  FStyle:=AValue;
+  // ToDo
+end;
+
+procedure TCustomTabControl.SetTabHeight(const AValue: Smallint);
+begin
+  if FTabHeight=AValue then exit;
+  FTabHeight:=AValue;
+  // ToDo
+end;
+
+procedure TCustomTabControl.SetTabPosition(const AValue: TTabPosition);
+begin
+  if FTabPosition=AValue then exit;
+  FTabPosition:=AValue;
+  // ToDo
+end;
+
+procedure TCustomTabControl.SetTabs(const AValue: TStrings);
+begin
+  if FTabs=AValue then exit;
+  FTabs:=AValue;
+  // ToDo
+end;
+
+procedure TCustomTabControl.SetTabWidth(const AValue: Smallint);
+begin
+  if FTabWidth=AValue then exit;
+  FTabWidth:=AValue;
+  // ToDo
+end;
+
+function TCustomTabControl.CanChange: Boolean;
+begin
+  Result:=true;
+  if Assigned(FOnChanging) then FOnChanging(Self,Result);
+end;
+
+function TCustomTabControl.CanShowTab(TabIndex: Integer): Boolean;
+begin
+  Result:=true;
+end;
+
+procedure TCustomTabControl.Change;
+begin
+  if Assigned(FOnChange) then FOnChange(Self);
+end;
+
+procedure TCustomTabControl.DrawTab(TabIndex: Integer; const Rect: TRect;
+  Active: Boolean);
+begin
+  // ToDo
+end;
+
+function TCustomTabControl.GetImageIndex(TabIndex: Integer): Integer;
+begin
+  Result:=TabIndex;
+  if Assigned(FOnGetImageIndex) then
+    FOnGetImageIndex(Self,TabIndex,Result);
+end;
+
+procedure TCustomTabControl.Loaded;
+begin
+  inherited Loaded;
+end;
+
+procedure TCustomTabControl.Notification(AComponent: TComponent;
+  Operation: TOperation);
+begin
+  inherited Notification(AComponent, Operation);
+  if (Operation = opRemove) and (AComponent = Images) then
+    Images := nil;
+end;
+
+procedure TCustomTabControl.SetTabIndex(Value: Integer);
+begin
+  if TabIndex=Value then exit;
+  FTabIndex:=Value;
+end;
+
+procedure TCustomTabControl.UpdateTabImages;
+begin
+  // ToDo
+end;
+
+procedure TCustomTabControl.ImageListChange(Sender: TObject);
+begin
+  // ToDo
+end;
+
+constructor TCustomTabControl.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  FHotTrack:=false;
+  FMultiLine:=false;
+  FMultiSelect:=false;
+  FOwnerDraw:=false;
+  FRaggedRight:=false;
+  FScrollOpposite:=false;
+  FStyle:=tsTabs;
+  FTabHeight:=0;
+  FTabIndex:=-1;
+  FTabPosition:=tpTop;
+  FTabWidth:=0;
+  FImageChangeLink := TChangeLink.Create;
+  FImageChangeLink.OnChange := @ImageListChange;
+  SetInitialBounds(0,0,200,150);
+end;
+
+destructor TCustomTabControl.Destroy;
+begin
+  FreeThenNil(FImageChangeLink);
+  inherited Destroy;
+end;
+
+function TCustomTabControl.IndexOfTabAt(X, Y: Integer): Integer;
+begin
+  Result:=0;
+  // ToDo
+end;
+
+function TCustomTabControl.GetHitTestInfoAt(X, Y: Integer): THitTests;
+begin
+  Result:=[];
+  // ToDo
+end;
+
+function TCustomTabControl.TabRect(Index: Integer): TRect;
+begin
+  FillChar(Result,SizeOf(Result),0);
+  // ToDo
+end;
+
+function TCustomTabControl.RowCount: Integer;
+begin
+  Result:=1;
+  // ToDo
+end;
+
+procedure TCustomTabControl.ScrollTabs(Delta: Integer);
+begin
+  // ToDo
+end;
+
+{$ENDIF}
+
+
+// included by comctrls.pp
+
+{ =============================================================================
+
+  $Log$
+  Revision 1.1  2004/09/08 22:59:54  mattias
+  started TTabControl
+
+}
+