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

fix bug #605: resizing upward or leftward should not move control

Browse Source 
git-svn-id: trunk@6893 -
This commit is contained in:
micha 2005-03-04 17:55:34 +00:00
parent 5ff7db8121
commit 471229e5b7
2 changed files with 41 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lcl/controls.pp
View File

@ -894,7 +894,7 @@ type
function IsVisibleStored: Boolean;
procedure CheckMenuPopup(const P: TSmallPoint);
procedure DoBeforeMouseMessage;
procedure DoConstrainedResize(var NewWidth, NewHeight: integer);
procedure DoConstrainedResize(var NewLeft, NewTop, NewWidth, NewHeight: integer);
procedure DoMouseDown(var Message: TLMMouse; Button: TMouseButton;
Shift: TShiftState);
procedure DoMouseUp(var Message: TLMMouse; Button: TMouseButton);
@ -2982,6 +2982,9 @@ end.
{ =============================================================================
$Log$
Revision 1.286 2005/03/04 17:55:34 micha
fix bug 605: resizing upward or leftward should not move control
Revision 1.285 2005/02/26 17:08:41 marc
* Reworked listviews to match new interface

41
lcl/include/control.inc
View File

@ -311,7 +311,7 @@ begin
' New='+dbgs(ALeft)+','+dbgs(ATop)+','+dbgs(AWidth),',',dbgs(AHeight));
{$ENDIF}
// constraint the size
DoConstrainedResize(AWidth, AHeight);
DoConstrainedResize(ALeft, ATop, AWidth, AHeight);
// check, if we are already processing this bound change
NewBounds:=Bounds(ALeft,ATop,AWidth,AHeight);
@ -847,7 +847,7 @@ end;
{------------------------------------------------------------------------------
TControl.DoConstrainedResize
------------------------------------------------------------------------------}
procedure TControl.DoConstrainedResize(var NewWidth, NewHeight : integer);
procedure TControl.DoConstrainedResize(var NewLeft, NewTop, NewWidth, NewHeight: integer);
var MinWidth, MinHeight, MaxWidth, MaxHeight : TConstraintSize;
begin
MinWidth:= Constraints.EffectiveMinWidth;
@ -858,14 +858,44 @@ begin
ConstrainedResize(MinWidth, MinHeight, MaxWidth, MaxHeight);
if (MinWidth > 0) and (NewWidth < MinWidth) then
begin
if NewLeft <> Left then
begin
Dec(NewLeft, MinWidth - NewWidth);
if NewLeft < Left then
NewLeft := Left;
end;
NewWidth:= MinWidth
else if (MaxWidth > 0) and (NewWidth > MaxWidth) then
end else if (MaxWidth > 0) and (NewWidth > MaxWidth) then
begin
if NewLeft <> Left then
begin
Inc(NewLeft, NewWidth - MaxWidth);
if NewLeft > Left then
NewLeft := Left;
end;
NewWidth:= MaxWidth;
end;
if (MinHeight > 0) and (NewHeight < MinHeight) then
begin
if NewTop <> Top then
begin
Dec(NewTop, MinHeight - NewHeight);
if NewTop < Top then
NewTop := Top;
end;
NewHeight:= MinHeight
else if (MaxHeight > 0) and (NewHeight > MaxHeight) then
end else if (MaxHeight > 0) and (NewHeight > MaxHeight) then
begin
if NewTop <> Top then
begin
Inc(NewTop, NewHeight - MaxHeight);
if NewTop > Top then
NewTop := Top;
end;
NewHeight:= MaxHeight;
end;
//debugln('TControl.DoConstrainedResize ',DbgSName(Self),' ',dbgs(NewWidth),',',dbgs(NewHeight));
end;
@ -3467,6 +3497,9 @@ end;
{ =============================================================================
$Log$
Revision 1.247 2005/03/04 17:55:34 micha
fix bug 605: resizing upward or leftward should not move control
Revision 1.246 2005/02/26 17:08:41 marc
* Reworked listviews to match new interface