From f0297d8f4f41bc16b5b9d35a83cfc7a85dd2b466 Mon Sep 17 00:00:00 2001 From: sekelsenmat Date: Wed, 2 Nov 2011 13:08:43 +0000 Subject: [PATCH] Advances a lot the new TTabControl, should be finished now git-svn-id: trunk@33218 - --- lcl/comctrls.pp | 126 ++++++++++++++++------- lcl/include/tabcontrol.inc | 206 +++++++++---------------------------- 2 files changed, 139 insertions(+), 193 deletions(-) diff --git a/lcl/comctrls.pp b/lcl/comctrls.pp index 9370ead137..67d44e805a 100644 --- a/lcl/comctrls.pp +++ b/lcl/comctrls.pp @@ -39,7 +39,7 @@ uses SysUtils, Types, Classes, Math, LCLStrConsts, LResources, LCLIntf, LCLType, FileUtil, LCLProc, AvgLvlTree, LMessages, ImgList, ActnList, GraphType, Graphics, Menus, Controls, Forms, StdCtrls, ExtCtrls, ToolWin, Buttons, - Themes; + Themes, WSLCLClasses, LCLClasses; type THitTest = (htAbove, htBelow, htNowhere, htOnItem, htOnButton, htOnIcon, @@ -673,6 +673,8 @@ type property NoteBook: TCustomTabControl read FNoteBook; end; + {$ifndef LCL_NEW_TABCONTROL} + { TTabControl } TTabControl = class(TCustomControl) @@ -805,26 +807,100 @@ type property Visible; end; -{$ifdef LCL_NEW_TABCONTROL} +{$else} - { TNewTabControl } - -(* TNewTabControl is a replacement for TTabControl, derived from TCustomTabControl. - TTabPage is a dummy page, for communication with the widgetsets. - TTabPages holds the tabs (Strings[] and Objects[]). +(* This is the new TTabControl which replaces the one one. + This new one is derived from TCustomTabControl. *) - TNewTabControl = class(TCustomTabControl) + TTabControl = class(TCustomTabControl) + private + FImageChangeLink: TChangeLink; + FOnChange: TNotifyEvent; + FOnChangeNeeded: Boolean; + FTabControlCreating: Boolean; + FTabs: TStrings;// this is a TTabControlNoteBookStrings + FCanvas: TCanvas; + FOnPaint: TNotifyEvent; + procedure AdjustDisplayRect(var ARect: TRect); + function GetDisplayRect: TRect; + function GetHotTrack: Boolean; + function GetMultiLine: Boolean; + function GetMultiSelect: Boolean; + function GetOwnerDraw: Boolean; + function GetRaggedRight: Boolean; + function GetScrollOpposite: Boolean; + function GetTabHeight: Smallint; + function GetTabIndex: Integer; + function GetTabRectWithBorder: TRect; + function GetTabWidth: Smallint; + 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 - procedure DoChange; override; - function GetPage(AIndex: Integer): TCustomPage; override; - procedure InsertPage(APage: TCustomPage; Index: Integer); override; - procedure RemovePage(Index: Integer); override; + function CanChange: Boolean; virtual; + function CanShowTab(ATabIndex: Integer): Boolean; virtual; + procedure Change; virtual; + function GetImageIndex(ATabIndex: Integer): Integer; virtual; + procedure Loaded; override; + procedure CreateWnd; override; + procedure DestroyHandle; override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure SetTabIndex(Value: Integer); virtual; + procedure UpdateTabImages; + procedure ImageListChange(Sender: TObject); + procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override; + class function GetControlClassDefaultSize: TSize; override; + procedure PaintWindow(DC: HDC); override; + procedure Paint; virtual; + procedure AdjustDisplayRectWithBorder(var ARect: TRect); virtual; + procedure AdjustClientRect(var ARect: TRect); override; + class function GetWSComponentClass(ASelf: TLCLComponent): TWSLCLComponentClass; override; + procedure DoCreateWnd; override; public constructor Create(TheOwner: TComponent); override; - function IndexOf(APage: TPersistent): integer; override; + destructor Destroy; override; + function IndexOfTabAt(X, Y: Integer): Integer; + function GetHitTestInfoAt(X, Y: Integer): THitTests; function IndexOfTabWithCaption(const TabCaption: string): Integer; - published //copied from TTabControl + function TabRect(Index: Integer): TRect; + function RowCount: Integer; + procedure ScrollTabs(Delta: Integer); + procedure BeginUpdate; + procedure EndUpdate; + function IsUpdating: boolean; + public + property DisplayRect: TRect read GetDisplayRect; + published + property HotTrack: Boolean read GetHotTrack write SetHotTrack default False; + property Images; + property MultiLine: Boolean read GetMultiLine write SetMultiLine default False; + property MultiSelect: Boolean read GetMultiSelect write SetMultiSelect default False; + property OnChange: TNotifyEvent read FOnChange write FOnChange; + property OnChanging; + property OnDrawTab; + property OnGetImageIndex; + property OwnerDraw: Boolean read GetOwnerDraw write SetOwnerDraw default False; + property RaggedRight: Boolean read GetRaggedRight write SetRaggedRight default False; + property ScrollOpposite: Boolean read GetScrollOpposite + write SetScrollOpposite default False; + property Style default tsTabs; + property TabHeight: Smallint read GetTabHeight write SetTabHeight default 0; + property TabPosition default tpTop; + property TabWidth: Smallint read GetTabWidth write SetTabWidth default 0; + property TabIndex: Integer read GetTabIndex write SetTabIndex default -1; + property Tabs: TStrings read FTabs write SetTabs; + property TabStop default True; + // property Align; property Anchors; property BorderSpacing; @@ -835,24 +911,16 @@ type 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 OnMouseEnter; @@ -863,22 +931,11 @@ type 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 TabCount: integer read GetPageCount; - property TabIndex: Integer read FPageIndex write SetPageIndex default -1; property TabOrder; - property TabPosition; - property Tabs: TStrings read FAccess write SetPages; - property TabStop; - property TabWidth; property Visible; end; @@ -3372,7 +3429,7 @@ implementation // !!! Avoid unit circles. Only add units if really needed. uses - WSComCtrls, WSFactory, WSLCLClasses; + WSComCtrls, WSFactory; const ScrollBarWidth = 0; @@ -3463,7 +3520,6 @@ procedure Register; begin RegisterComponents('Common Controls',[TTrackbar,TProgressBar,TTreeView, TListView,TStatusBar,TToolBar,TUpDown,TPageControl,TTabControl, -{$ifdef LCL_NEW_TABCONTROL}TNewTabControl,{$endif} THeaderControl]); RegisterNoIcon([TToolButton,TTabSheet]); end; diff --git a/lcl/include/tabcontrol.inc b/lcl/include/tabcontrol.inc index a615b57650..89bef20aa9 100644 --- a/lcl/include/tabcontrol.inc +++ b/lcl/include/tabcontrol.inc @@ -389,7 +389,7 @@ begin if FImages = AValue then Exit; if FImages <> nil then FImages.RemoveFreeNotification(Self); - FImages := AValue; + FImages := TImageList(AValue); if FImages <> nil then FImages.FreeNotification(Self); TTabControlStrings(FTabs).Images := FImages; @@ -475,6 +475,7 @@ begin FOnChange(Self); end; +{$ifndef LCL_NEW_TABCONTROL} procedure TTabControl.DrawTab(ATabIndex: Integer; const Rect: TRect; Active: Boolean); begin @@ -483,6 +484,7 @@ begin else Canvas.FillRect(Rect); end; +{$endif} function TTabControl.GetImageIndex(ATabIndex: Integer): Integer; begin @@ -545,12 +547,35 @@ begin Result.CY := 150; end; +{$ifdef LCL_NEW_TABCONTROL} +procedure TTabControl.PaintWindow(DC: HDC); +var + DCChanged: boolean; +begin + DCChanged := (not FCanvas.HandleAllocated) or (FCanvas.Handle <> DC); + if DCChanged then + FCanvas.Handle := DC; + try + Paint; + finally + if DCChanged then FCanvas.Handle := 0; + end; +end; +{$endif} + procedure TTabControl.Paint; var ARect: TRect; TS: TTextStyle; Details: TThemedElementDetails; + lCanvas: TCanvas; begin + {$ifdef LCL_NEW_TABCONTROL} + lCanvas := FCanvas; + {$else} + lCanvas := Canvas; + {$endif} + //DebugLn(['TTabControl.Paint Bounds=',dbgs(BoundsRect),' ClientRect=',dbgs(ClientRect),' CientOrigin=',dbgs(ClientOrigin)]); // clear only display area since button area is painted by another control // draw a frame @@ -558,20 +583,20 @@ begin AdjustDisplayRectWithBorder(ARect); Details := ThemeServices.GetElementDetails(ttPane); - ThemeServices.DrawElement(Canvas.Handle, Details, ARect); + ThemeServices.DrawElement(lCanvas.Handle, Details, ARect); InflateRect(ARect,BorderWidth,BorderWidth); - Canvas.Frame3d(ARect, BorderWidth, bvRaised); + lCanvas.Frame3d(ARect, BorderWidth, bvRaised); if (csDesigning in ComponentState) and (Caption <> '') then begin ARect:=GetDisplayRect; - TS := Canvas.TextStyle; + TS := lCanvas.TextStyle; TS.Alignment:=taCenter; TS.Layout:= tlCenter; TS.Opaque:= false; TS.Clipping:= false; - Canvas.TextRect(ARect, ARect.Left, ARect.Top, Caption, TS); + lCanvas.TextRect(ARect, ARect.Left, ARect.Top, Caption, TS); end; end; @@ -607,6 +632,20 @@ begin AdjustDisplayRect(ARect); end; +{$ifdef LCL_NEW_TABCONTROL} +class function TTabControl.GetWSComponentClass(ASelf: TLCLComponent + ): TWSLCLComponentClass; +begin + Result:= FindWSComponentClass(TCustomControl); +end; + +procedure TTabControl.DoCreateWnd; +begin + +end; + +{$endif} + constructor TTabControl.Create(TheOwner: TComponent); begin FTabControlCreating:=true; @@ -621,6 +660,10 @@ begin SetInitialBounds(0, 0, CX, CY); BorderWidth:=2; FTabControlCreating:=false; + {$ifdef LCL_NEW_TABCONTROL} + FCanvas := TControlCanvas.Create; + TControlCanvas(FCanvas).Control := Self; + {$endif} end; destructor TTabControl.Destroy; @@ -689,158 +732,5 @@ begin Result:=(FTabs<>nil) and TTabControlStrings(fTabs).IsUpdating; end; -{$ifdef LCL_NEW_TABCONTROL} - -{ TTabPage } - -type - TTabPage = class(TCustomPage) - protected - FIndex: integer; - FTabs: TTabControl; - function GetTabVisible: Boolean; override; //assure always visible - function GetPageIndex: integer; override; - procedure SetPageIndex(AValue: Integer); override; - public - function IsControlVisible: Boolean; override; - function VisibleIndex: integer; override; - end; - -function TTabPage.GetTabVisible: Boolean; -begin - Result := True; -end; - -function TTabPage.GetPageIndex: integer; -begin - Result := FIndex; -end; - -procedure TTabPage.SetPageIndex(AValue: Integer); -begin - FIndex := AValue; -end; - -function TTabPage.IsControlVisible: Boolean; -begin - Result := True; -end; - -function TTabPage.VisibleIndex: integer; -begin - Result := FIndex; //assume always visible -end; - -{ TTabPages } - -type - TTabPages = class(TStringList) - protected - FPage: TTabPage; - FTabs: TNewTabControl; - public - constructor Create(ATabCtl: TNewTabControl); - function Add(const S: string): Integer; override; - procedure Delete(Index: Integer); override; - end; - -constructor TTabPages.Create(ATabCtl: TNewTabControl); -begin - inherited Create; - FTabs := ATabCtl; - FPage := TTabPage.Create(ATabCtl); - FPage.Visible := False; -end; - -function TTabPages.Add(const S: string): Integer; -begin - Result:=inherited Add(S); - FTabs.InsertPage(nil, Result); -end; - -procedure TTabPages.Delete(Index: Integer); -begin - inherited Delete(Index); - FTabs.PageRemoved(Index); -end; - -{ TNewTabControl } - -constructor TNewTabControl.Create(TheOwner: TComponent); -begin - FUnPaged:=True; - FAccess := TTabPages.Create(Self); //specialization required for notifications - TTabPages(FAccess).FTabs := Self; - inherited Create(TheOwner); -end; - -procedure TNewTabControl.DoChange; -var - i: integer; - p: TObject; -begin - //inherited DoChange; - if Assigned(OnChange) then - OnChange(Self) - else begin - //emulate page switch - for i := 0 to TabCount - 1 do begin - p := Tabs.Objects[i]; - if p is TControl then - TControl(p).Visible := i = TabIndex; - end; - end; -end; - -function TNewTabControl.GetPage(AIndex: Integer): TCustomPage; -begin - Result := TTabPages(Tabs).FPage; - Result.PageIndex := AIndex; - Result.Caption := FAccess.Strings[AIndex]; -end; - -function TNewTabControl.IndexOf(APage: TPersistent): integer; -begin - if APage is TTabPage then begin - Result := TTabPage(APage).FIndex; - end else - Result := Tabs.IndexOfObject(APage); -end; - -function TNewTabControl.IndexOfTabWithCaption(const TabCaption: string): Integer; -begin - Result := Tabs.IndexOf(TabCaption); -end; - -procedure TNewTabControl.InsertPage(APage: TCustomPage; Index: Integer); -begin -//A page has been added to Pages - notify widgetset -//TWSCustomNotebookClass(WidgetSetClass).AddPage(Self, APage, APage.VisibleIndex); - if HandleAllocated and (not (csLoading in ComponentState)) then begin - //if first page, make it current - if APage = nil then - APage := Page[Index]; - TWSCustomTabControlClass(WidgetSetClass).AddPage(Self, APage, Index); - if PageIndex <> Index then begin //??? - //DoSendPageIndex; - PageIndex:=Index; - end; - end; -end; - -procedure TNewTabControl.RemovePage(Index: Integer); -begin -//A page has been removed from Pages - notify widgetset -//TWSCustomNotebookClass(WidgetSetClass).RemovePage(Self, APage.VisibleIndex); - //if False then inherited RemovePage(Index); - if HandleAllocated and not (csDestroying in ComponentState) then begin - //select next visible page - TWSCustomTabControlClass(WidgetSetClass).RemovePage(Self, Index); - if FPageIndex >= Index then - Dec(FPageIndex); - end; -end; -{$endif} - // included by comctrls.pp