mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-02 00:20:24 +02:00
Advances a lot the new TTabControl, should be finished now
git-svn-id: trunk@33218 -
This commit is contained in:
sekelsenmat
parent
edb96895c4
commit
f0297d8f4f
126
lcl/comctrls.pp
126
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;
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user