mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-22 20:19:27 +02:00
Starts implementing TUntabbedNotebook
git-svn-id: trunk@27092 -
This commit is contained in:
sekelsenmat
parent
995a8157de
commit
58756ec370
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -4602,6 +4602,7 @@ lcl/include/toolbutton.inc svneol=native#text/pascal
|
||||
lcl/include/toolwindow.inc svneol=native#text/pascal
|
||||
lcl/include/trackbar.inc svneol=native#text/pascal
|
||||
lcl/include/treeview.inc svneol=native#text/pascal
|
||||
lcl/include/untabbednotebook.inc svneol=native#text/plain
|
||||
lcl/include/winapi.inc svneol=native#text/pascal
|
||||
lcl/include/winapih.inc svneol=native#text/pascal
|
||||
lcl/include/wincontrol.inc svneol=native#text/pascal
|
||||
|
||||
@ -262,7 +262,23 @@ type
|
||||
function Notebook: TCustomNotebook; virtual;
|
||||
end;
|
||||
|
||||
|
||||
{ TUntabbedNotebookComponentEditor
|
||||
The default component editor for TUntabbedNotebook. }
|
||||
TUntabbedNotebookComponentEditor = class(TDefaultComponentEditor)
|
||||
protected
|
||||
procedure AddNewPageToDesigner(Index: integer); virtual;
|
||||
procedure DoAddPage; virtual;
|
||||
procedure DoDeletePage; virtual;
|
||||
procedure AddMenuItemsForPages(ParentMenuItem: TMenuItem); virtual;
|
||||
procedure ShowPageMenuItemClick(Sender: TObject);
|
||||
public
|
||||
procedure ExecuteVerb(Index: Integer); override;
|
||||
function GetVerb(Index: Integer): string; override;
|
||||
function GetVerbCount: Integer; override;
|
||||
procedure PrepareItem(Index: Integer; const AnItem: TMenuItem); override;
|
||||
function UNotebook: TUntabbedNotebook; virtual;
|
||||
end;
|
||||
|
||||
{ TPageComponentEditor
|
||||
The default component editor for TCustomPage. }
|
||||
TPageComponentEditor = class(TNotebookComponentEditor)
|
||||
@ -815,6 +831,117 @@ begin
|
||||
Result:=TCustomNotebook(GetComponent);
|
||||
end;
|
||||
|
||||
{ TUntabbedNotebookComponentEditor }
|
||||
|
||||
const
|
||||
unbvAddPage = 0;
|
||||
unbvDeletePage = 1;
|
||||
unbvShowPage = 2;
|
||||
|
||||
procedure TUntabbedNotebookComponentEditor.AddNewPageToDesigner(Index: integer
|
||||
);
|
||||
var
|
||||
Hook: TPropertyEditorHook;
|
||||
NewPage: TUNBPage;
|
||||
NewName: string;
|
||||
begin
|
||||
Hook:=nil;
|
||||
if not GetHook(Hook) then exit;
|
||||
NewPage:=UNoteBook.Page[Index];
|
||||
NewName:=GetDesigner.CreateUniqueComponentName(NewPage.ClassName);
|
||||
NewPage.Caption:=NewName;
|
||||
NewPage.Name:=NewName;
|
||||
UNoteBook.PageIndex:=Index;
|
||||
Hook.PersistentAdded(NewPage,true);
|
||||
Modified;
|
||||
end;
|
||||
|
||||
procedure TUntabbedNotebookComponentEditor.DoAddPage;
|
||||
begin
|
||||
if not HasHook then exit;
|
||||
UNoteBook.Pages.Add('');
|
||||
AddNewPageToDesigner(UNoteBook.Pages.Count-1);
|
||||
end;
|
||||
|
||||
procedure TUntabbedNotebookComponentEditor.DoDeletePage;
|
||||
var
|
||||
Hook: TPropertyEditorHook;
|
||||
OldIndex: integer;
|
||||
PageComponent: TPersistent;
|
||||
begin
|
||||
OldIndex := UNotebook.PageIndex;
|
||||
if (OldIndex>=0) and (OldIndex<UNotebook.Pages.Count) then
|
||||
begin
|
||||
if not GetHook(Hook) then exit;
|
||||
PageComponent := TPersistent(UNoteBook.Pages.Objects[OldIndex]);
|
||||
Hook.DeletePersistent(PageComponent);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TUntabbedNotebookComponentEditor.AddMenuItemsForPages(
|
||||
ParentMenuItem: TMenuItem);
|
||||
var
|
||||
i: integer;
|
||||
NewMenuItem: TMenuItem;
|
||||
begin
|
||||
ParentMenuItem.Enabled:=UNoteBook.Pages.Count>0;
|
||||
for i:=0 to UNoteBook.Pages.Count-1 do
|
||||
begin
|
||||
NewMenuItem:=TMenuItem.Create(ParentMenuItem);
|
||||
NewMenuItem.Name:='ShowPage'+IntToStr(i);
|
||||
NewMenuItem.Caption:=UNotebook.Page[i].Name+' "'+UNotebook.Pages[i]+'"';
|
||||
NewMenuItem.OnClick:=@ShowPageMenuItemClick;
|
||||
ParentMenuItem.Add(NewMenuItem);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TUntabbedNotebookComponentEditor.ShowPageMenuItemClick(Sender: TObject
|
||||
);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure TUntabbedNotebookComponentEditor.ExecuteVerb(Index: Integer);
|
||||
begin
|
||||
case Index of
|
||||
unbvAddPage: DoAddPage;
|
||||
unbvDeletePage: DoDeletePage; // beware: this can free the editor itself
|
||||
end;
|
||||
end;
|
||||
|
||||
function TUntabbedNotebookComponentEditor.GetVerb(Index: Integer): string;
|
||||
begin
|
||||
// Here we reuse the strings from TNotebook, since they are indeed the same ones
|
||||
case Index of
|
||||
unbvAddPage: Result:=nbcesAddPage;
|
||||
unbvDeletePage: Result:=nbcesDeletePage;
|
||||
unbvShowPage: Result:=nbcesShowPage;
|
||||
else
|
||||
Result:='';
|
||||
end;
|
||||
end;
|
||||
|
||||
function TUntabbedNotebookComponentEditor.GetVerbCount: Integer;
|
||||
begin
|
||||
Result := 3;
|
||||
end;
|
||||
|
||||
procedure TUntabbedNotebookComponentEditor.PrepareItem(Index: Integer;
|
||||
const AnItem: TMenuItem);
|
||||
begin
|
||||
inherited PrepareItem(Index, AnItem);
|
||||
case Index of
|
||||
unbvAddPage: ;
|
||||
unbvDeletePage: AnItem.Enabled:=UNotebook.PageIndex>=0;
|
||||
unbvShowPage: AddMenuItemsForPages(AnItem);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TUntabbedNotebookComponentEditor.UNotebook: TUntabbedNotebook;
|
||||
begin
|
||||
Result:=TUntabbedNotebook(GetComponent);
|
||||
end;
|
||||
|
||||
{ TPageComponentEditor }
|
||||
|
||||
function TPageComponentEditor.Notebook: TCustomNotebook;
|
||||
@ -1282,6 +1409,7 @@ end;
|
||||
initialization
|
||||
RegisterComponentEditorProc := @DefaultRegisterComponentEditorProc;
|
||||
RegisterComponentEditor(TCustomNotebook, TNotebookComponentEditor);
|
||||
RegisterComponentEditor(TUntabbedNotebook, TUntabbedNotebookComponentEditor);
|
||||
RegisterComponentEditor(TCustomPage, TPageComponentEditor);
|
||||
RegisterComponentEditor(TCustomTabControl, TTabControlComponentEditor);
|
||||
RegisterComponentEditor(TStringGrid, TStringGridComponentEditor);
|
||||
|
||||
@ -319,6 +319,68 @@ type
|
||||
property TabStop;
|
||||
end;
|
||||
|
||||
{ TUNBPages }
|
||||
|
||||
TUntabbedNotebook = class;
|
||||
|
||||
TUNBPages = class(TStrings)
|
||||
private
|
||||
FPageList: TListWithEvent;
|
||||
FUNotebook: TUntabbedNotebook;
|
||||
procedure PageListChange(Ptr: Pointer; AnAction: TListNotification);
|
||||
protected
|
||||
function GetObject(Index: Integer): TObject; override;
|
||||
public
|
||||
constructor Create(thePageList: TListWithEvent;
|
||||
theUNotebook: TUntabbedNotebook);
|
||||
procedure Clear; override;
|
||||
procedure Delete(Index: Integer); override;
|
||||
procedure Insert(Index: Integer; const S: String); override;
|
||||
end;
|
||||
|
||||
{ TUNBPage }
|
||||
|
||||
TUNBPage = class(TCustomControl)
|
||||
public
|
||||
end;
|
||||
|
||||
{ TUntabbedNotebook }
|
||||
|
||||
TUntabbedNotebook = class(TCustomControl)
|
||||
private
|
||||
FPages: TStrings; // TUNBPages
|
||||
FPageIndex: Integer;
|
||||
FPageList: TListWithEvent;
|
||||
{ function GetActivePage: String;
|
||||
function GetActivePageComponent: TCustomPage;}
|
||||
function GetPage(AIndex: Integer): TUNBPage;
|
||||
// function GetPageCount : integer;
|
||||
function GetPageIndex: Integer;
|
||||
{ function FindVisiblePage(Index: Integer): Integer;}
|
||||
procedure InsertPage(APage: TUNBPage; Index: Integer);
|
||||
{ procedure MovePage(APage: TCustomPage; NewIndex: Integer);
|
||||
procedure RemovePage(Index: Integer);
|
||||
procedure SetActivePage(const Value: String);}
|
||||
procedure SetPageIndex(AValue: Integer);
|
||||
{ procedure ShowCurrentPage;}
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
{ function TabIndexAtClientPos(ClientPos: TPoint): integer;
|
||||
function TabRect(AIndex: Integer): TRect;
|
||||
function GetImageIndex(ThePageIndex: Integer): Integer; virtual;
|
||||
function IndexOf(APage: TCustomPage): integer;
|
||||
function CustomPage(Index: integer): TCustomPage;}
|
||||
public
|
||||
property Page[Index: Integer]: TUNBPage read GetPage;
|
||||
// property PageCount: integer read GetPageCount;
|
||||
// property PageList: TList read FPageList;
|
||||
published
|
||||
// property TabStop default true;
|
||||
property PageIndex: Integer read GetPageIndex write SetPageIndex default -1;
|
||||
property Pages: TStrings read FPages;
|
||||
// property ActivePage: String read GetActivePage write SetActivePage;
|
||||
end;
|
||||
|
||||
{ Timer }
|
||||
|
||||
@ -1250,15 +1312,16 @@ procedure Register;
|
||||
begin
|
||||
RegisterComponents('Standard',[TRadioGroup,TCheckGroup,TPanel]);
|
||||
RegisterComponents('Additional',[TImage,TShape,TBevel,TPaintBox,TNotebook,
|
||||
TLabeledEdit,TSplitter,TTrayIcon]);
|
||||
TUntabbedNotebook, TLabeledEdit, TSplitter, TTrayIcon]);
|
||||
RegisterComponents('System',[TTimer,TIdleTimer]);
|
||||
RegisterNoIcon([TPage]);
|
||||
RegisterNoIcon([TPage, TUNBPage]);
|
||||
end;
|
||||
|
||||
{$I custompage.inc}
|
||||
{$I page.inc}
|
||||
{$I customnotebook.inc}
|
||||
{$I notebook.inc}
|
||||
{$I untabbednotebook.inc}
|
||||
{$I timer.inc}
|
||||
{$I idletimer.inc}
|
||||
{$I shape.inc}
|
||||
|
||||
168
lcl/include/untabbednotebook.inc
Normal file
168
lcl/include/untabbednotebook.inc
Normal file
@ -0,0 +1,168 @@
|
||||
{%MainUnit ../extctrls.pp}
|
||||
{******************************************************************************
|
||||
TUntabbedNotebook
|
||||
******************************************************************************
|
||||
|
||||
*****************************************************************************
|
||||
* *
|
||||
* This file is part of the Lazarus Component Library (LCL) *
|
||||
* *
|
||||
* See the file COPYING.modifiedLGPL.txt, 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. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
}
|
||||
|
||||
{******************************************************************************
|
||||
TUNBPages
|
||||
******************************************************************************}
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
TUNBPages Constructor
|
||||
------------------------------------------------------------------------------}
|
||||
constructor TUNBPages.Create(thePageList: TListWithEvent;
|
||||
theUNotebook: TUntabbedNotebook);
|
||||
begin
|
||||
inherited Create;
|
||||
fPageList := thePageList;
|
||||
fPageList.OnChange:=@PageListChange;
|
||||
fUNotebook := theUNotebook;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
procedure TUNBPages.PageListChange(Ptr: Pointer; AnAction: TListNotification);
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TUNBPages.PageListChange(Ptr: Pointer; AnAction: TListNotification);
|
||||
{var
|
||||
APage: TCustomPage;}
|
||||
begin
|
||||
{ if (AnAction=lnAdded) then begin
|
||||
APage:=TObject(Ptr) as TCustomPage;
|
||||
if not (pfInserting in APage.FFlags) then
|
||||
APage.Parent:=fNotebook;
|
||||
end;}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
TUNBPages GetObject
|
||||
------------------------------------------------------------------------------}
|
||||
function TUNBPages.GetObject(Index: Integer): TObject;
|
||||
begin
|
||||
{ if (Index<0) or (Index>=fPageList.Count) then
|
||||
RaiseGDBException('TNBPages.GetObject Index out of bounds');
|
||||
Result := TCustomPage(fPageList[Index]);}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
TUNBPages Clear
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TUNBPages.Clear;
|
||||
begin
|
||||
{ while fPageList.Count>0 do
|
||||
Delete(fPageList.Count-1);}
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
TUNBPages Delete
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TUNBPages.Delete(Index: Integer);
|
||||
var
|
||||
APage: TCustomPage;
|
||||
begin
|
||||
// Make sure Index is in the range of valid pages to delete
|
||||
if (Index < 0) or (Index >= fPageList.Count) then Exit;
|
||||
|
||||
APage := TCustomPage(fPageList[Index]);
|
||||
// delete handle
|
||||
APage.Parent := nil;
|
||||
// free the page
|
||||
Application.ReleaseComponent(APage);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
TUNBPages Insert
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TUNBPages.Insert(Index: Integer; const S: String);
|
||||
var
|
||||
NewPage: TUNBPage;
|
||||
NewOwner: TComponent;
|
||||
begin
|
||||
NewOwner := FUNotebook.Owner;
|
||||
if NewOwner = nil then
|
||||
NewOwner := FUNotebook;
|
||||
NewPage := TUNBPage.Create(NewOwner);
|
||||
NewPage.Caption := S;
|
||||
|
||||
FUNoteBook.InsertPage(NewPage,Index);
|
||||
end;
|
||||
|
||||
{******************************************************************************
|
||||
TUntabbedNotebook
|
||||
******************************************************************************}
|
||||
|
||||
function TUntabbedNotebook.GetPage(AIndex: Integer): TUNBPage;
|
||||
begin
|
||||
if (AIndex < 0) or (AIndex >= FPageList.Count) then
|
||||
RaiseGDBException('TUntabbedNotebook.GetCustomPage Index out of bounds');
|
||||
Result := TUNBPage(FPageList.Items[AIndex]);
|
||||
end;
|
||||
|
||||
function TUntabbedNotebook.GetPageIndex: Integer;
|
||||
begin
|
||||
Result := FPageIndex;
|
||||
end;
|
||||
|
||||
procedure TUntabbedNotebook.InsertPage(APage: TUNBPage; Index: Integer);
|
||||
begin
|
||||
if FPageList.IndexOf(APage) >= 0 then Exit;
|
||||
|
||||
FPageList.Insert(Index, APage);
|
||||
|
||||
APage.Parent := Self;
|
||||
APage.Align := alClient;
|
||||
|
||||
if PageIndex = -1 then SetPageIndex(Index);
|
||||
end;
|
||||
|
||||
procedure TUntabbedNotebook.SetPageIndex(AValue: Integer);
|
||||
begin
|
||||
if (AValue < -1) or (AValue >= Pages.Count) then Exit;
|
||||
if FPageIndex = AValue then exit;
|
||||
|
||||
// Hide the previously shown page
|
||||
if (FPageIndex >= 0) and (FPageIndex < Pages.Count) then
|
||||
Page[FPageIndex].Visible := False;
|
||||
|
||||
// Update the property
|
||||
FPageIndex := AValue;
|
||||
|
||||
// And show the new one
|
||||
Page[FPageIndex].Visible := False;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
TUntabbedNotebook Constructor
|
||||
------------------------------------------------------------------------------}
|
||||
constructor TUntabbedNotebook.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
|
||||
FPageList := TListWithEvent.Create;
|
||||
FPageIndex := -1;
|
||||
FPages := TUNBPages.Create(FPageList, Self);
|
||||
|
||||
ControlStyle := []; // do not add csAcceptsControls
|
||||
TabStop := true;
|
||||
end;
|
||||
|
||||
destructor TUntabbedNotebook.Destroy;
|
||||
begin
|
||||
FPageList.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user