paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-16 06:20:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: TabControl refactor

Browse Source 
git-svn-id: trunk@42594 -
This commit is contained in:
martin 2013-09-04 10:17:31 +00:00
parent 378550a77a
commit 32a6a28ad6
3 changed files with 13 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/comctrls.pp
View File

@ -363,6 +363,7 @@ type
procedure UpdateDesignerFlags(APageIndex: integer); procedure UpdateDesignerFlags(APageIndex: integer);
protected protected
PageClass: TCustomPageClass; PageClass: TCustomPageClass;
function GetPageClass: TCustomPageClass; virtual;
procedure CNNotify(var Message: TLMNotify); message CN_NOTIFY; procedure CNNotify(var Message: TLMNotify); message CN_NOTIFY;
class procedure WSRegisterClass; override; class procedure WSRegisterClass; override;
procedure CreateWnd; override; procedure CreateWnd; override;
@ -505,6 +506,7 @@ type
function FindPageWithDockClient(Client: TControl): TTabSheet; function FindPageWithDockClient(Client: TControl): TTabSheet;
protected protected
class procedure WSRegisterClass; override; class procedure WSRegisterClass; override;
function GetPageClass: TCustomPageClass; override;
procedure DoAddDockClient(Client: TControl; const ARect: TRect); override; procedure DoAddDockClient(Client: TControl; const ARect: TRect); override;
procedure DockOver(Source: TDragDockObject; X, Y: Integer; procedure DockOver(Source: TDragDockObject; X, Y: Integer;
State: TDragState; var Accept: Boolean); override; State: TDragState; var Accept: Boolean); override;
@ -512,7 +514,6 @@ type
function DoUndockClientMsg(NewTarget, Client: TControl):boolean; override; function DoUndockClientMsg(NewTarget, Client: TControl):boolean; override;
function ChildClassAllowed(ChildClass: TClass): boolean; override; function ChildClassAllowed(ChildClass: TClass): boolean; override;
public public
constructor Create(TheOwner: TComponent); override;
function FindNextPage(CurPage: TTabSheet; function FindNextPage(CurPage: TTabSheet;
GoForward, CheckTabVisible: Boolean): TTabSheet; GoForward, CheckTabVisible: Boolean): TTabSheet;
procedure SelectNextPage(GoForward: Boolean); procedure SelectNextPage(GoForward: Boolean);

7
lcl/include/customnotebook.inc
View File

@ -203,7 +203,7 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
constructor TCustomTabControl.Create(TheOwner: TComponent); constructor TCustomTabControl.Create(TheOwner: TComponent);
begin begin
if PageClass=nil then PageClass := TCustomPage; if PageClass=nil then PageClass := GetPageClass;
inherited Create(TheOwner); inherited Create(TheOwner);
@ -849,6 +849,11 @@ begin
Page[APageIndex].ControlStyle-[csNoDesignVisible]; Page[APageIndex].ControlStyle-[csNoDesignVisible];
end; end;
function TCustomTabControl.GetPageClass: TCustomPageClass;
begin
Result := TCustomPage;
end;
class procedure TCustomTabControl.WSRegisterClass; class procedure TCustomTabControl.WSRegisterClass;
begin begin
inherited WSRegisterClass; inherited WSRegisterClass;

11
lcl/include/pagecontrol.inc
View File

@ -64,6 +64,11 @@ begin
RegisterPropertyToSkip(TPageControl, 'TabFont', 'Needed when converting from VCL TabbedNotebook to TPageControl', ''); RegisterPropertyToSkip(TPageControl, 'TabFont', 'Needed when converting from VCL TabbedNotebook to TPageControl', '');
end; end;
function TPageControl.GetPageClass: TCustomPageClass;
begin
Result := TTabSheet;
end;
procedure TPageControl.DoAddDockClient(Client: TControl; const ARect: TRect); procedure TPageControl.DoAddDockClient(Client: TControl; const ARect: TRect);
var var
TabSheet: TTabSheet; TabSheet: TTabSheet;
@ -111,12 +116,6 @@ begin
if Widgetset.GetLCLCapability(lcAllowChildControlsInNativeControls) = LCL_CAPABILITY_YES then Result := True; if Widgetset.GetLCLCapability(lcAllowChildControlsInNativeControls) = LCL_CAPABILITY_YES then Result := True;
end; end;
constructor TPageControl.Create(TheOwner: TComponent);
begin
PageClass:=TTabSheet;
inherited Create(TheOwner);
end;
function TPageControl.FindNextPage(CurPage: TTabSheet; GoForward, function TPageControl.FindNextPage(CurPage: TTabSheet; GoForward,
CheckTabVisible: Boolean): TTabSheet; CheckTabVisible: Boolean): TTabSheet;
var var