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

optimize: only create tabpage contents when accessed, not immediately upon creation

Browse Source 
git-svn-id: trunk@6157 -
This commit is contained in:
micha 2004-10-23 14:49:38 +00:00
parent a8b23d5e3c
commit bda4272d04
5 changed files with 107 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/extctrls.pp
View File

@ -156,6 +156,7 @@ type
procedure SetPages(AValue: TStrings);
procedure SetShowTabs(AValue: Boolean);
procedure SetTabPosition(tabPos: TTabPosition);
procedure ShowCurrentPage;
procedure UpdateAllDesignerFlags;
procedure UpdateDesignerFlags(APageIndex: integer);
protected
@ -970,6 +971,9 @@ end.
{
$Log$
Revision 1.124 2004/10/23 14:49:38 micha
optimize: only create tabpage contents when accessed, not immediately upon creation
Revision 1.123 2004/09/24 20:23:33 vincents
fixed fpc 1.0.x compilation

40
lcl/include/customnotebook.inc
View File

@ -122,10 +122,7 @@ begin
NewOwner:=FNotebook;
NewPage := FNotebook.PageClass.Create(NewOwner);
with NewPage do
begin
Caption := S;
Visible := true;
end;
{$IFDEF NOTEBOOK_DEBUG}
DebugLn('TNBPages.Insert B ',FNotebook;.Name,' Index=',Index,' S="',S,'"');
@ -231,6 +228,7 @@ end;
procedure TCustomNotebook.DoCreateWnd;
var
i: Integer;
lPage: TCustomPage;
begin
{$IFDEF NOTEBOOK_DEBUG}
DebugLn('TCustomNotebook.DoCreateWnd ',Name,':',ClassName,' HandleAllocated=',HandleAllocated);
@ -240,9 +238,10 @@ begin
{$IFDEF NOTEBOOK_DEBUG}
DebugLn('TCustomNotebook.DoCreateWnd ',Name,':',ClassName,' ',Page[i].Caption,' ',not (pfAdded in Page[i].Flags));
{$ENDIF}
if not (pfAdded in Page[i].Flags) then begin
TWSCustomNotebookClass(WidgetSetClass).AddPage(Self, TCustomPage(FPageList[i]), i);
Include(Page[i].FFlags,pfAdded);
lPage := Page[i];
if not (pfAdded in lPage.Flags) then begin
TWSCustomNotebookClass(WidgetSetClass).AddPage(Self, lPage, i);
Include(lPage.FFlags,pfAdded);
end;
end;
fAddingPages:=false;
@ -444,7 +443,14 @@ begin
APage.Parent := Self;
if NewZPosition>=0 then
SetControlIndex(APage,NewZPosition);
APage.Visible:=true;
if PageIndex = -1 then
FPageIndex := Index;
{$ifndef WIN32}
// TODO: remove when gtk widgetset fixed to show tabpage tab upon
// AddPage, instead of needing TabPage.Visible := true
APage.Visible := true;
{$endif}
UpdateDesignerFlags(Index);
@ -452,9 +458,7 @@ begin
TWSCustomNotebookClass(WidgetSetClass).AddPage(Self, APage, Index);
Include(APage.FFlags, pfAdded);
if PageIndex = Index then
DoSendPageIndex
else
PageIndex := Index;
DoSendPageIndex;
end;
{$IFDEF NOTEBOOK_DEBUG}
DebugLn('TCustomNotebook.InsertPage END ',Name,' Index=',
@ -660,6 +664,7 @@ end;
procedure TCustomNotebook.Change;
Begin
fPageIndexOnLastChange:=fPageIndex;
ShowCurrentPage;
if ([csLoading,csDestroying]*ComponentState=[])
and (not fAddingPages) then begin
if Assigned(fOnPageChanged) then fOnPageChanged(Self);
@ -716,6 +721,17 @@ Begin
end;
end;
{------------------------------------------------------------------------------
procedure TCustomNotebook.DoSendPageIndex
Makes sure Visible = true for page which has index FPageIndex
------------------------------------------------------------------------------}
procedure TCustomNotebook.ShowCurrentPage;
begin
if (FPageIndex >= 0) and (FPageIndex < PageCount) then
Page[FPageIndex].Visible := true;
end;
{------------------------------------------------------------------------------
procedure TCustomNotebook.DoSendPageIndex;
------------------------------------------------------------------------------}
@ -726,6 +742,7 @@ begin
{$IFDEF NOTEBOOK_DEBUG}
DebugLn('[TCustomNotebook.DoSendPageIndex] A ',Name,' PageIndex=',dbgs(fPageIndex));
{$ENDIF}
ShowCurrentPage;
TWSCustomNotebookClass(WidgetSetClass).SetPageIndex(Self, FPageIndex);
{$IFDEF NOTEBOOK_DEBUG}
DebugLn('[TCustomNotebook.DoSendPageIndex] B');
@ -760,6 +777,9 @@ end;
{ =============================================================================
$Log$
Revision 1.66 2004/10/23 14:49:38 micha
optimize: only create tabpage contents when accessed, not immediately upon creation
Revision 1.65 2004/10/15 12:04:09 mattias
calling updating notebook tab after realize, needed for close btns

2
lcl/include/custompage.inc
View File

@ -32,8 +32,8 @@ begin
end else begin
SetInitialBounds(0,0,120,100);
end;
Visible := False;
Caption := '';
Visible := false;
end;
{------------------------------------------------------------------------------

12
lcl/interfaces/win32/win32proc.pp
View File

@ -599,6 +599,7 @@ function LCLControlSizeNeedsUpdate(Sender: TWinControl;
SendSizeMsgOnDiff: boolean): boolean;
var
Window:HWND;
LMessage: TLMSize;
IntfWidth, IntfHeight: integer;
begin
Result:=false;
@ -612,7 +613,16 @@ begin
if SendSizeMsgOnDiff then begin
//writeln('LCLBoundsNeedsUpdate B ',TheWinControl.Name,':',TheWinControl.ClassName,' Sending WM_SIZE');
Sender.InvalidateClientRectCache(true);
Windows.PostMessage(Window, WM_SIZE, 0, MakeLParam(IntfWidth, IntfHeight));
// send message directly to LCL, some controls not subclassed -> message
// never reaches LCL
with LMessage do
begin
Msg := LM_SIZE;
SizeType := SIZE_RESTORED or Size_SourceIsInterface;
Width := IntfWidth;
Height := IntfHeight;
end;
DeliverMessage(Sender, LMessage);
end;
end;

85
lcl/interfaces/win32/win32wsextctrls.pp
View File

@ -1,4 +1,3 @@
{ $Id$}
{
*****************************************************************************
* Win32WSExtCtrls.pp *
@ -35,7 +34,8 @@ uses
////////////////////////////////////////////////////
Windows, ExtCtrls, Classes, Controls, LCLType,
////////////////////////////////////////////////////
WSExtCtrls, WSLCLClasses, WinExt, Win32Int, InterfaceBase, Win32WSControls;
WSExtCtrls, WSLCLClasses, WinExt, Win32Int, Win32Proc, InterfaceBase,
Win32WSControls;
type
@ -48,6 +48,7 @@ type
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
class procedure UpdateProperties(const ACustomPage: TCustomPage); override;
class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override;
end;
{ TWin32WSCustomNotebook }
@ -238,11 +239,11 @@ begin
// check if already shown
TCI.Mask := TCIF_PARAM;
Res := Windows.SendMessage(Notebook.Handle, TCM_GETITEM, I, LPARAM(@TCI));
if (Res = 0) or (dword(TCI.lParam) <> lPage.Handle) then
if (Res = 0) or (dword(TCI.lParam) <> dword(lPage)) then
begin
TCI.Mask := TCIF_TEXT or TCIF_PARAM;
TCI.pszText := PChar(lPage.Caption);
TCI.lParam := lPage.Handle;
TCI.lParam := dword(lPage);
Windows.SendMessage(Notebook.Handle, TCM_INSERTITEM, I, LPARAM(@TCI));
end;
end;
@ -272,6 +273,20 @@ end;
{ TWin32WSCustomPage }
procedure CustomPageCalcBounds(const AWinControl: TWinControl;
var Left, Top, Width, Height: integer);
var
Rect, OffsetRect: TRect;
begin
// Adjust page size to fit in tabcontrol, need bounds of notebook in client of parent
Windows.GetClientRect(TCustomPage(AWinControl).Parent.Handle, @Rect);
GetLCLClientBoundsOffset(AWinControl.Parent, OffsetRect);
Left := OffsetRect.Left;
Top := OffsetRect.Top;
Width := Rect.Right + OffsetRect.Right - OffsetRect.Left - Rect.Left;
Height := Rect.Bottom + OffsetRect.Bottom - OffsetRect.Top - Rect.Top;
end;
function TWin32WSCustomPage.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
var
@ -285,15 +300,49 @@ begin
pClassName := @ClsName;
Flags := Flags and DWORD(not WS_VISIBLE);
SubClassWndProc := nil;
CustomPageCalcBounds(AWinControl, Left, Top, Width, Height);
end;
// create window
FinishCreateWindow(AWinControl, Params, false);
// TODO: created (not WS_VISIBLE), following still needed?
// ShowWindow(Window, SW_HIDE);
// return window handle
Result := Params.Window;
end;
procedure TWin32WSCustomPage.SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: Integer);
var
lLeft, lTop, lWidth, lHeight: integer;
wLeft, wTop, wWidth, wHeight: integer;
PageRect, ParentRect: Windows.RECT;
WinHandle: HWND;
begin
// calculate bounds as we think it should be
CustomPageCalcBounds(AWinControl, wLeft, wTop, wWidth, wHeight);
// calculate current bounds of page
WinHandle := AWinControl.Handle;
GetWindowRect(WinHandle, @PageRect);
GetWindowRect(GetParent(WinHandle), @ParentRect);
OffsetRect(PageRect, -ParentRect.Left, -ParentRect.Top);
// if differ, then update page to new bounds
if (wLeft <> PageRect.Left) or (wTop <> PageRect.Top)
or (wWidth <> (PageRect.Right - PageRect.Left))
or (wHeight <> (PageRect.Bottom - PageRect.Top)) then
begin
SetWindowPos(WinHandle, 0, wLeft, wTop, wWidth, wHeight, SWP_NOACTIVATE or SWP_NOZORDER);
end else begin
// calculate bounds as LCL thinks it should be
lLeft := ALeft; lTop := ATop;
lWidth := AWidth; lHeight := AHeight;
LCLBoundsToWin32Bounds(AWinControl, lLeft, lTop, lWidth, lHeight);
// if differ, then update LCL
if (lLeft <> wLeft) or (lTop <> wTop)
or (lWidth <> wWidth) or (lHeight <> wHeight) then
begin
LCLControlSizeNeedsUpdate(AWinControl, true);
end;
end;
end;
procedure TWin32WSCustomPage.UpdateProperties(const ACustomPage: TCustomPage);
begin
// TODO: implement me!
@ -322,27 +371,15 @@ procedure TWin32WSCustomNotebook.AddPage(const ANotebook: TCustomNotebook;
const AChild: TCustomPage; const AIndex: integer);
var
TCI: TC_ITEM;
OldPageIndex: integer;
R: TRect;
begin
With ANotebook do
Begin
with ANotebook do
begin
TCI.Mask := TCIF_TEXT or TCIF_PARAM;
TCI.pszText := PChar(AChild.Caption);
// store handle as extra data, so we can verify we got the right page later
TCI.lParam := AChild.Handle;
// store object as extra, so we can verify we got the right page later
TCI.lParam := dword(AChild);
Windows.SendMessage(Handle, TCM_INSERTITEM, AIndex, LPARAM(@TCI));
// Adjust page size to fit in tabcontrol, need bounds of notebook in client of parent
TWin32WidgetSet(InterfaceObject).GetClientRect(Handle, R);
TWin32WSWinControl.SetBounds(AChild, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top);
// Do the page switch. The are no tabcontrol notifications so we have to
// do the hiding and showing ourselves.
OldPageIndex := SendMessage(Handle,TCM_GETCURSEL,0,0);
SendMessage(Handle,TCM_SETCURSEL, AChild.PageIndex,0);
ShowWindow(AChild.Handle, SW_SHOW);
if (OldPageIndex >= 0) and (OldPageIndex <> AChild.PageIndex) then
ShowWindow(Page[OldPageIndex].Handle, SW_HIDE);
End;
end;
end;
procedure TWin32WSCustomNotebook.MovePage(const ANotebook: TCustomNotebook;