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

lcl: prevent setbounds infinite loop (bug #0014474)

Browse Source 
git-svn-id: trunk@21521 -
This commit is contained in:
paul 2009-09-01 14:37:48 +00:00
parent 5c235ca5a6
commit b66b9e6cb4
2 changed files with 9 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
lcl/include/customlabel.inc
View File

@ -107,7 +107,12 @@ begin
NewHeight := Height;
//debugln('TCustomLabel.DoAutoSize ',dbgsName(Self),' Anchored ',dbgs(Left),',',dbgs(Top),',w=',dbgs(NewWidth),',h=',dbgs(NewHeight));
SetBoundsKeepBase(Left, Top, NewWidth, NewHeight);
FInternalSetBounds := True;
try
SetBoundsKeepBase(Left, Top, NewWidth, NewHeight);
finally
FInternalSetBounds := False;
end;
end;
procedure TCustomLabel.SetAlignment(Value : TAlignment);
@ -211,6 +216,7 @@ begin
ControlStyle := [csSetCaption, csClickEvents, csDoubleClicks, csReplicatable];
SetInitialBounds(0, 0, GetControlClassDefaultSize.X, GetControlClassDefaultSize.Y);
FShowAccelChar := True;
FInternalSetBounds := False;
Color := clNone;
AutoSize := True;
end;
@ -478,7 +484,7 @@ end;
procedure TCustomLabel.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
begin
if AutoSize and WordWrap then
if not FInternalSetBounds and AutoSize and WordWrap then
InvalidatePreferredSize;
inherited SetBounds(aLeft, aTop, aWidth, aHeight);
end;

1
lcl/stdctrls.pp
View File

@ -1363,6 +1363,7 @@ type
FShowAccelChar: Boolean;
FWordWrap: Boolean;
FLayout: TTextLayout;
FInternalSetBounds: Boolean;
procedure SetAlignment(Value: TAlignment);
procedure SetOptimalFill(const AValue: Boolean);
protected