paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-12 00:38:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Call GetPageClass when adding a TTabSheet in PageControl. Eliminate PageClass variable. Issue #34886.

Browse Source 
git-svn-id: trunk@62136 -
This commit is contained in:
juha 2019-10-27 19:19:28 +00:00
parent 6bb1d0f3da
commit b13519cc85
4 changed files with 10 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/comctrls.pp
View File

@ -427,7 +427,6 @@ type
AWidth: Integer; AReferenceHandle: TLCLHandle);
procedure SetImageListAsync(Data: PtrInt);
protected
PageClass: TCustomPageClass;
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
function GetPageClass: TCustomPageClass; virtual;

9
lcl/include/customnotebook.inc
View File

@ -150,7 +150,7 @@ begin
NewOwner := FNotebook.Owner;
if NewOwner = nil then
NewOwner := FNotebook;
NewPage := FNotebook.PageClass.Create(NewOwner);
NewPage := FNotebook.GetPageClass.Create(NewOwner);
with NewPage do
Caption := S;
@ -240,20 +240,13 @@ end;
------------------------------------------------------------------------------}
constructor TCustomTabControl.Create(TheOwner: TComponent);
begin
if PageClass=nil then PageClass := GetPageClass;
inherited Create(TheOwner);
fCompStyle := csNoteBook;
FAccess := GetListClass.Create(Self);
FImageListChangeLink := TChangeLink.Create;
FImageListChangeLink.OnChange := @DoImageListChange;
FImageListChangeLink.OnDestroyResolutionHandle := @DoImageListDestroyResolutionHandle;
FPageIndex := -1;
ControlStyle := []; // do not add csAcceptsControls
TabPosition := tpTop;
TabStop := true;

4
lcl/include/pagecontrol.inc
View File

@ -112,7 +112,7 @@ end;
function TPageControl.ChildClassAllowed(ChildClass: TClass): boolean;
begin
Result:=(ChildClass<>nil) and (ChildClass.InheritsFrom(PageClass));
Result:=(ChildClass<>nil) and (ChildClass.InheritsFrom(GetPageClass));
if Widgetset.GetLCLCapability(lcAllowChildControlsInNativeControls) = LCL_CAPABILITY_YES then Result := True;
end;
@ -189,7 +189,7 @@ end;
// A Lazarus addition
function TPageControl.AddTabSheet: TTabSheet;
begin
Result := TTabSheet.Create(Self);
Result := GetPageClass.Create(Self) as TTabSheet;
Result.PageControl := Self;
end;

16
lcl/ldocktree.pas
View File

@ -170,9 +170,9 @@ type
procedure SetActiveNotebookPageComponent(const AValue: TLazDockPage);
protected
function GetFloatingDockSiteClass: TWinControlClass; override;
function GetPageClass: TCustomPageClass; override;
procedure Change; override;
public
constructor Create(TheOwner: TComponent); override;
property Page[Index: Integer]: TLazDockPage read GetNoteBookPage;
property ActivePageComponent: TLazDockPage read GetActiveNotebookPageComponent
write SetActiveNotebookPageComponent;
@ -766,8 +766,7 @@ begin
Result:=TLazDockPage(inherited Page[Index]);
end;
procedure TLazDockPages.SetActiveNotebookPageComponent(
const AValue: TLazDockPage);
procedure TLazDockPages.SetActiveNotebookPageComponent(const AValue: TLazDockPage);
begin
ActivePageComponent:=AValue;
end;
@ -777,18 +776,17 @@ begin
Result:=TLazDockForm;
end;
function TLazDockPages.GetPageClass: TCustomPageClass;
begin
Result:=TLazDockPage;
end;
procedure TLazDockPages.Change;
begin
inherited Change;
TLazDockForm.UpdateMainControlInParents(Self);
end;
constructor TLazDockPages.Create(TheOwner: TComponent);
begin
PageClass := TLazDockPage;
inherited Create(TheOwner);
end;
{ TLazDockTree }
procedure TLazDockTree.UndockControlForDocking(AControl: TControl);