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

LCL: reduced number of TWSWinControlClass.SetBounds calls

Browse Source 
git-svn-id: trunk@12668 -
This commit is contained in:
mattias 2007-11-01 02:05:47 +00:00
parent 574f810690
commit 178543e288
4 changed files with 90 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
ide/compileroptionsdlg.pp
View File

@ -286,17 +286,17 @@ constructor TfrmCompilerOptions.Create(TheOwner: TComponent);
var
Page: integer;
begin
inherited Create(TheOwner);
Caption := dlgCompilerOptions;
IDEDialogLayoutList.ApplyLayout(Self,550,450);
ImageIndexPackage := IDEImages.LoadImage(16, 'pkg_package');
ImageIndexRequired := IDEImages.LoadImage(16, 'pkg_required');
ImageIndexInherited := IDEImages.LoadImage(16, 'pkg_inherited');
DisableAlign;
try
inherited Create(TheOwner);
Caption := dlgCompilerOptions;
IDEDialogLayoutList.ApplyLayout(Self,550,450);
ImageIndexPackage := IDEImages.LoadImage(16, 'pkg_package');
ImageIndexRequired := IDEImages.LoadImage(16, 'pkg_required');
ImageIndexInherited := IDEImages.LoadImage(16, 'pkg_inherited');
MainNotebook.PageIndex:=0;
Page:=0;

4
lcl/controls.pp
View File

@ -756,7 +756,6 @@ type
cfHeightLoaded,
cfClientWidthLoaded,
cfClientHeightLoaded,
cfLastAlignedBoundsValid,
cfBoundsRectForNewParentValid,
cfBaseBoundsValid,
cfPreferredSizeValid,
@ -826,6 +825,7 @@ type
FHostDockSite: TWinControl;
FIsControl: Boolean;
fLastAlignedBounds: TRect;
fLastAlignedBoundsTried: integer;
FLastChangebounds: TRect;
FLastDoChangeBounds: TRect;
FLastDoChangeClientSize: TPoint;
@ -972,6 +972,7 @@ type
procedure ChangeScale(Multiplier, Divider: Integer); dynamic;
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; virtual;
procedure SetAlignedBounds(aLeft, aTop, aWidth, aHeight: integer); virtual;
function IsAParentAligning: boolean;
function GetClientOrigin: TPoint; virtual;
function GetClientRect: TRect; virtual;
function GetScrolledClientRect: TRect; virtual;
@ -1597,6 +1598,7 @@ type
procedure ControlsAligned; virtual;// called by AlignControls after aligning controls
procedure DoSendBoundsToInterface; virtual;
procedure RealizeBounds; virtual;// checks for changes and calls DoSendBoundsToInterface
procedure RealizeBoundsRecursive;
procedure CreateSubClass(var Params: TCreateParams;ControlClassName: PChar);
procedure DoConstraintsChange(Sender: TObject); override;
procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;

31
lcl/include/control.inc
View File

@ -1282,11 +1282,16 @@ var
NewBounds: TRect;
begin
NewBounds:=Bounds(aLeft, aTop, aWidth, aHeight);
if (cfLastAlignedBoundsValid in FControlFlags)
and CompareRect(@NewBounds,@fLastAlignedBounds) then
exit;
if (fLastAlignedBoundsTried>0)
and CompareRect(@NewBounds,@fLastAlignedBounds) then begin
inc(fLastAlignedBoundsTried);
if fLastAlignedBoundsTried>4 then begin
DebugLn(['TControl.SetAlignedBounds ',DbgSName(Self),' last try ',dbgs(NewBounds),' try=',fLastAlignedBoundsTried]);
exit;
end;
end;
fLastAlignedBounds:=NewBounds;
Include(FControlFlags,cfLastAlignedBoundsValid);
fLastAlignedBoundsTried:=1;
//if AnsiCompareText(ClassName,'TSCROLLBAR')=0 then
// DebugLn('TControl.SetAlignedBounds A ',Name,':',ClassName,' ',aLeft,',',aTop,',',aWidth,',',aHeight);
@ -1294,6 +1299,20 @@ begin
SetBoundsKeepBase(aLeft, aTop, aWidth, aHeight, true);
end;
function TControl.IsAParentAligning: boolean;
var
p: TWinControl;
begin
p:=Parent;
while (p<>nil) do begin
if (wcfAligningControls in p.FWinControlFlags)
or (p.FAlignLevel>0) then
exit(true);
p:=p.Parent;
end;
Result:=false;
end;
{------------------------------------------------------------------------------
procedure TControl.VisibleChanging;
------------------------------------------------------------------------------}
@ -2738,7 +2757,7 @@ begin
//DebugLn(['TControl.SetAlign ',DbgSName(Self),' Old=',AlignNames[FAlign],' New=',AlignNames[Value],' ',Anchors<>AnchorAlign[FAlign]]);
OldAlign:=FAlign;
FAlign := Value;
Exclude(FControlFlags,cfLastAlignedBoundsValid);
fLastAlignedBoundsTried:=0;
// if anchors were on default then change them to new default
// This is done for Delphi compatibility.
if (Anchors=AnchorAlign[OldAlign]) and (Anchors<>AnchorAlign[FAlign]) then
@ -2754,7 +2773,7 @@ procedure TControl.SetAnchors(const AValue: TAnchors);
begin
if Anchors=AValue then exit;
FAnchors:=AValue;
Exclude(FControlFlags,cfLastAlignedBoundsValid);
fLastAlignedBoundsTried:=0;
RequestAlign;
end;

76
lcl/include/wincontrol.inc
View File

@ -31,8 +31,8 @@
{off $DEFINE CHECK_POSITION}
{$IFDEF CHECK_POSITION}
const CheckPostionClassName = 'xxxTButtonPanel';
const CheckPostionName = 'xxxedtUnitOutputDir';
const CheckPostionParentName = 'PathPage';
const CheckPostionName = 'xxInhTreeView';
const CheckPostionParentName = 'xxxInheritedPage';
function CheckPosition(AControl: TControl): boolean;
begin
@ -1958,12 +1958,11 @@ begin
NewBounds:=ControlBox.NewControlBounds;
OldBounds:=CurControl.BoundsRect;
if not CompareRect(@NewBounds,@OldBounds) then begin
//DebugLn('TAutoSizeBox.SetTableControlBounds Control=',DbgSName(CurControl),' CellBounds=',dbgs(CellBounds),' NewBounds=',dbgs(NewBounds));
Result:=true;
CurControl.SetBoundsKeepBase(NewBounds.Left,
NewBounds.Top,
NewBounds.Right-NewBounds.Left,
NewBounds.Bottom-NewBounds.Top);
CurControl.SetAlignedBounds(NewBounds.Left,
NewBounds.Top,
NewBounds.Right-NewBounds.Left,
NewBounds.Bottom-NewBounds.Top);
end;
end;
end;
@ -2188,6 +2187,14 @@ var
end;
end;
function IsNotAligned(AControl: TControl): boolean;
begin
Result:=(AControl.Align=alNone)
and (AControl.Anchors=[akLeft,akTop])
and (AControl.AnchorSide[akLeft].Control=nil)
and (AControl.AnchorSide[akTop].Control=nil);
end;
procedure DoPosition(Control: TControl; AAlign: TAlign);
var
NewLeft, NewTop, NewWidth, NewHeight: Integer;
@ -2666,6 +2673,7 @@ var
procedure DoAlign(AAlign: TAlign);
var
I: Integer;
Control: TControl;
begin
//DebugLn(['DoAlign ',DbgSName(Self),' ',dbgs(ClientRect)]);
CreateControlAlignList(AAlign,AlignList,AControl);
@ -2681,10 +2689,19 @@ var
DebugLn(']');
end;
{$ENDIF}
if not DoAlignChildControls(AAlign,AControl,AlignList,RemainingClientRect) then
for I := 0 to AlignList.Count - 1 do
DoPosition(TControl(AlignList[I]), AAlign);
// let override handle them
if DoAlignChildControls(AAlign,AControl,AlignList,RemainingClientRect) then
exit;
// remove controls that are positioned by other means
if (AAlign=alNone) and (AutoSize or (ChildSizing.Layout<>cclNone)) then
for I := AlignList.Count - 1 downto 0 do begin
Control:=TControl(AlignList[I]);
if IsNotAligned(Control) then AlignList.Delete(I);
end;
// anchor/align control
for I := 0 to AlignList.Count - 1 do
DoPosition(TControl(AlignList[I]), AAlign);
end;
procedure DoAlignNotAligned;
@ -2701,14 +2718,8 @@ var
AlignList.Clear;
for i:=0 to ControlCount-1 do begin
Control := Controls[i];
if (Control.Align=alNone)
and Control.IsControlVisible
and (Control.Anchors=[akLeft,akTop])
and (Control.AnchorSide[akLeft].Control=nil)
and (Control.AnchorSide[akTop].Control=nil)
then begin
if IsNotAligned(Control) and Control.IsControlVisible then
AlignList.Add(Control);
end;
end;
//debugln('DoAlignNotAligned ',DbgSName(Self),' AlignList.Count=',dbgs(AlignList.Count));
if AlignList.Count=0 then exit;
@ -3065,7 +3076,7 @@ begin
inc(NewTop,Height-PreferredHeight);
//if CompareText(Name,'NewUnitOkButton')=0 then
//debugln(['DoAutoSize Resize ',DbgSName(Self),' Old=',dbgs(BoundsRect),' New=',dbgs(Bounds(NewLeft,NewTop,PreferredWidth,PreferredHeight)),' WidthIsFixed=',WidthIsFixed,' HeightIsFixed=',HeightIsFixed,' Align=',dbgs(Align),' Anchors=',dbgs(Anchors)]);
SetBoundsKeepBase(NewLeft,NewTop,PreferredWidth,PreferredHeight,true);
SetAlignedBounds(NewLeft,NewTop,PreferredWidth,PreferredHeight);
end;
finally
Exclude(FControlFlags,cfAutoSizeNeeded);
@ -3405,7 +3416,7 @@ function TWinControl.GetClientRect: TRect;
{$ENDIF}
if ClientSizeChanged then begin
for i:=0 to ControlCount-1 do
Exclude(Controls[i].FControlFlags,cfLastAlignedBoundsValid);
Controls[i].fLastAlignedBoundsTried:=0;
end;
Exclude(FWinControlFlags,wcfClientRectNeedsUpdate);
end;
@ -5547,6 +5558,9 @@ begin
finally
Exclude(FControlState, csAlignmentNeeded);
EnableAlign;
if (FAlignLevel=0) and (not IsAParentAligning) and (FWinControls<>nil) then
for i:=0 to FWinControls.Count-1 do
TWinControl(FWinControls[i]).RealizeBoundsRecursive;
end;
End;
@ -6912,7 +6926,10 @@ begin
if CheckPosition(Self) and (AWidth=1) then
DumpStack;
{$ENDIF}
if BoundsLockCount<>0 then exit;
if BoundsLockCount<>0 then begin
//DebugLn(['TWinControl.SetBounds ',DbgSName(Self),' ignoring loop Cur=',dbgs(BoundsRect),' ',dbgs(Bounds(ALeft,ATop,AWidth,AHeight))]);
exit;
end;
OldBounds:=BoundsRect;
NewBounds:=Bounds(ALeft, ATop, AWidth, AHeight);
@ -7161,8 +7178,10 @@ var
begin
NewBounds:=Bounds(Left, Top, Width, Height);
if HandleAllocated
and (not (csLoading in ComponentState))
and (not CompareRect(@NewBounds,@FBoundsRealized)) then
and ([csLoading,csDestroying]*ComponentState=[])
and (not (csDestroyingHandle in ControlState))
and (not CompareRect(@NewBounds,@FBoundsRealized))
and (not IsAParentAligning) then
begin
// the new bounds were not yet sent to the InterfaceObject -> send them
{$IFDEF CHECK_POSITION}
@ -7181,6 +7200,17 @@ begin
end;
end;
procedure TWinControl.RealizeBoundsRecursive;
var
i: Integer;
begin
RealizeBounds;
if FWinControls<>nil then begin
for i:=0 to FWinControls.Count-1 do
TWinControl(FWinControls[i]).RealizeBoundsRecursive;
end;
end;
{------------------------------------------------------------------------------
Method: TWinControl.CMShowingChanged
Params: Message : not used