paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2026-01-06 05:40:30 +01:00
Code Issues Packages Projects Releases Wiki Activity

implemented borderspacing TWinControl.ChildSizing.Left/Top

Browse Source 
git-svn-id: trunk@6170 -
This commit is contained in:
mattias 2004-10-28 09:30:49 +00:00
parent d5427c9574
commit 9479dd1716
3 changed files with 112 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
lcl/controls.pp
View File

@ -858,7 +858,7 @@ type
procedure UpdateAnchorRules;
procedure ChangeBounds(ALeft, ATop, AWidth, AHeight: integer); virtual;
procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); virtual;
procedure ChangeScale(M,D: Integer); dynamic;
procedure ChangeScale(Multiplier, Divider: Integer); dynamic;
Function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; virtual;
procedure SetAlignedBounds(aLeft, aTop, aWidth, aHeight: integer); virtual;
Function GetClientOrigin: TPoint; virtual;
@ -1357,7 +1357,8 @@ type
function GetActionLinkClass: TControlActionLinkClass; override;
procedure AdjustSize; override;
procedure AdjustClientRect(var ARect: TRect); virtual;
procedure AlignControls(AControl: TControl; var ARect: TRect); virtual;
procedure AlignControls(AControl: TControl;
var RemainingClientRect: TRect); virtual;
function DoAlignChildControls(TheAlign: TAlign; AControl: TControl;
AControlList: TList; var ARect: TRect): Boolean; virtual;
procedure DoChildSizingChange(Sender: TObject); virtual;
@ -1813,14 +1814,21 @@ var
NewStyleControls: Boolean;
Mouse: TMouse;
// cursor
function CursorToString(Cursor: TCursor): string;
function StringToCursor(const S: string): TCursor;
procedure GetCursorValues(Proc: TGetStrProc);
function CursorToIdent(Cursor: Longint; var Ident: string): Boolean;
function IdentToCursor(const Ident: string; var Cursor: Longint): Boolean;
// shiftstate
function GetKeyShiftState: TShiftState;
procedure AdjustBorderSpace(var RemainingClientRect, CurBorderSpace: TRect;
Left, Top, Right, Bottom: integer);
// register (called by the package initialization in design mode)
procedure Register;
@ -1837,6 +1845,65 @@ var
CaptureControl: TControl;
DockSiteHash: TDynHashArray;
procedure AdjustBorderSpace(var RemainingClientRect, CurBorderSpace: TRect;
Left, Top, Right, Bottom: integer);
// RemainingClientRect: remaining clientrect without CurBorderSpace
// CurBorderSpace: current borderspace around RemainingClientRect
// Left, Top, Right, Bottom: apply these borderspaces to CurBorderSpace
//
// CurBorderSpace will be set to the maximum of CurBorderSpace and Left, Top,
// Right, Bottom. RemainingClientRect will shrink.
// RemainingClientRect will not shrink to negative size.
var
NewWidth: Integer;
NewHeight: Integer;
NewLeft: Integer;
NewTop: Integer;
begin
// set CurBorderSpace to maximum border spacing and adjust RemainingClientRect
if CurBorderSpace.Left<Left then begin
inc(RemainingClientRect.Left,Left-CurBorderSpace.Left);
CurBorderSpace.Left:=Left;
end;
if CurBorderSpace.Right<Right then begin
dec(RemainingClientRect.Right,Right-CurBorderSpace.Right);
CurBorderSpace.Right:=Right;
end;
if CurBorderSpace.Top<Top then begin
inc(RemainingClientRect.Top,Top-CurBorderSpace.Top);
CurBorderSpace.Top:=Top;
end;
if CurBorderSpace.Bottom<Bottom then begin
dec(RemainingClientRect.Bottom,Bottom-CurBorderSpace.Bottom);
CurBorderSpace.Bottom:=Bottom;
end;
// make sure RemainingClientRect has no negative Size
NewWidth:=RemainingClientRect.Right-RemainingClientRect.Left;
if NewWidth<0 then begin
// Width is negative
// set Width to 0 and adjust borderspace. Set Left/Right to center.
// Example: RemainingClientRect.Left=20, RemainingClientRect.Right=10,
// CurBorderSpace.Left:=17, CurBorderSpace.Right:=18
// Result: RemainingClientRect.Left=RemainingClientRect.Right=15;
// CurBorderSpace.Left:=17, CurBorderSpace.Right:=18
NewLeft:=(RemainingClientRect.Left+RemainingClientRect.Right) div 2;
dec(CurBorderSpace.Left,RemainingClientRect.Left-NewLeft);
dec(CurBorderSpace.Right,NewLeft-RemainingClientRect.Right);
RemainingClientRect.Left:=NewLeft;
RemainingClientRect.Right:=RemainingClientRect.Left;
end;
NewHeight:=RemainingClientRect.Bottom-RemainingClientRect.Top;
if NewHeight<0 then begin
// Height is negative
NewTop:=(RemainingClientRect.Top+RemainingClientRect.Bottom) div 2;
dec(CurBorderSpace.Top,RemainingClientRect.Top-NewTop);
dec(CurBorderSpace.Bottom,NewTop-RemainingClientRect.Bottom);
RemainingClientRect.Top:=NewTop;
RemainingClientRect.Bottom:=RemainingClientRect.Top;
end;
end;
procedure Register;
begin
RegisterComponents('Common Controls',[TImageList]);
@ -2391,6 +2458,9 @@ end.
{ =============================================================================
$Log$
Revision 1.251 2004/10/28 09:30:49 mattias
implemented borderspacing TWinControl.ChildSizing.Left/Top
Revision 1.250 2004/10/12 08:23:20 mattias
fixed compiler options interface double variables

15
lcl/include/control.inc
View File

@ -357,6 +357,7 @@ begin
if UpdatePosSizeChanged then exit;
//if csDesigning in ComponentState then
// DebugLn('TControl.ChangeBounds ',Name,':',ClassName,' ',Left,',',Top,',',Width,',',Height);
// autosize this control and its brothers
RequestAlign;
if UpdatePosSizeChanged then exit;
@ -429,11 +430,12 @@ begin
FHeight:= AHeight;
end;
{------------------------------------------------------------------------------}
{ TControl.ChangeScale
}
{------------------------------------------------------------------------------}
Procedure TControl.ChangeScale(M,D : Integer);
{------------------------------------------------------------------------------
TControl.ChangeScale
Scale contorl by factor Multiplier/Divider
------------------------------------------------------------------------------}
Procedure TControl.ChangeScale(Multiplier, Divider: Integer);
Begin
// TODO: TCONTROL.CHANGESCALE
//Assert(False, 'Trace:TODO: [TControl.ChangeScale]');
@ -3286,6 +3288,9 @@ end;
{ =============================================================================
$Log$
Revision 1.219 2004/10/28 09:30:49 mattias
implemented borderspacing TWinControl.ChildSizing.Left/Top
Revision 1.218 2004/10/13 09:59:24 vincents
change parameter type in implementation to TTranslateString too

50
lcl/include/wincontrol.inc
View File

@ -50,9 +50,11 @@ end;
Align child controls
------------------------------------------------------------------------------}
procedure TWinControl.AlignControls(AControl : TControl; var ARect : TRect);
procedure TWinControl.AlignControls(AControl: TControl;
var RemainingClientRect: TRect);
var
AlignList: TList;
RemainingBorderSpace: TRect; // borderspace around RemainingClientRect
function AlignWork: Boolean;
var
@ -254,7 +256,7 @@ var
// set min size to stop circling (this should not be needed. But if someone
// plays/fixes the above code, new bugs can enter and there are far too many
// combinations to test, and so the LCL can loop for some applications.
// Prevent this, so the users can at least report a bug.)
// Prevent this, so users can at least report a bug.)
if NewWidth<0 then NewWidth:=0;
if NewHeight<0 then NewHeight:=0;
@ -279,32 +281,32 @@ var
if akLeft in AnchorAlign[AAlign] then begin
if (akRight in (Control.Anchors+AnchorAlign[AAlign])) then begin
// left align and keep right border
NewLeft:=ARect.Left;
NewLeft:=RemainingClientRect.Left;
NewRight:=NewLeft+ConstraintWidth(NewRight-NewLeft);
end else begin
// left align and right border free to move (-> keep width)
dec(NewRight,NewLeft-ARect.Left);
NewLeft:=ARect.Left;
dec(NewRight,NewLeft-RemainingClientRect.Left);
NewLeft:=RemainingClientRect.Left;
end;
end;
if akTop in AnchorAlign[AAlign] then begin
if (akBottom in (Control.Anchors+AnchorAlign[AAlign])) then begin
// top align and keep bottom border
NewTop:=ARect.Top;
NewTop:=RemainingClientRect.Top;
NewBottom:=NewTop+ConstraintHeight(NewBottom-NewTop);
end else begin
// top align and bottom border is free to move (-> keep height)
dec(NewBottom,NewTop-ARect.Top);
NewTop:=ARect.Top;
dec(NewBottom,NewTop-RemainingClientRect.Top);
NewTop:=RemainingClientRect.Top;
end;
end;
if akRight in AnchorAlign[AAlign] then begin
if (akLeft in (Control.Anchors+AnchorAlign[AAlign])) then begin
// right align and keep left border
NewWidth:=ConstraintWidth(ARect.Right-NewLeft);
NewWidth:=ConstraintWidth(RemainingClientRect.Right-NewLeft);
if AAlign=alRight then begin
// align to right (this overrides the keeping of left border)
NewRight:=ARect.Right;
NewRight:=RemainingClientRect.Right;
NewLeft:=NewRight-NewWidth;
end else begin
// keep left border overrides keeping right border
@ -312,17 +314,17 @@ var
end;
end else begin
// right align and left border free to move (-> keep width)
inc(NewLeft,ARect.Right-NewRight);
NewRight:=ARect.Right;
inc(NewLeft,RemainingClientRect.Right-NewRight);
NewRight:=RemainingClientRect.Right;
end;
end;
if akBottom in AnchorAlign[AAlign] then begin
if (akTop in (Control.Anchors+AnchorAlign[AAlign])) then begin
// bottom align and keep top border
NewHeight:=ConstraintHeight(ARect.Bottom-NewTop);
NewHeight:=ConstraintHeight(RemainingClientRect.Bottom-NewTop);
if AAlign=alBottom then begin
// align to bottom (this overrides the keeping of top border)
NewBottom:=ARect.Bottom;
NewBottom:=RemainingClientRect.Bottom;
NewTop:=NewBottom-NewHeight;
end else begin
// keeping top border overrides keeping bottom border
@ -330,8 +332,8 @@ var
end;
end else begin
// bottom align and top border free to move (-> keep height)
inc(NewTop,ARect.Bottom-NewBottom);
NewBottom:=ARect.Bottom;
inc(NewTop,RemainingClientRect.Bottom-NewBottom);
NewBottom:=RemainingClientRect.Bottom;
end;
end;
NewWidth:=Max(0,NewRight-NewLeft);
@ -382,7 +384,7 @@ var
end;
// adjust the remaining client area
with ARect do begin
with RemainingClientRect do begin
case AAlign of
alTop:
Inc(Top, NewHeight);
@ -469,7 +471,7 @@ var
end;
end;
if not DoAlignChildControls(AAlign,AControl,AlignList,ARect) then
if not DoAlignChildControls(AAlign,AControl,AlignList,RemainingClientRect) then
for I := 0 to AlignList.Count - 1 do
DoPosition(TControl(AlignList[I]), AAlign);
end;
@ -495,8 +497,13 @@ begin
//end;
if AlignWork then
begin
AdjustClientRect(ARect);
//DebugLn('[TWinControl.AlignControls] ',Name,':',Classname,' ',Left,',',Top,',',Width,',',Height,' ClientRect=',ARect.Left,',',ARect.Top,',',ARect.Right,',',ARect.Bottom);
AdjustClientRect(RemainingClientRect);
RemainingBorderSpace:=Rect(0,0,0,0);
// adjust RemainingClientRect by ChildSizing properties
AdjustBorderSpace(RemainingClientRect,RemainingBorderSpace,
ChildSizing.LeftRightSpacing,ChildSizing.TopBottomSpacing,
ChildSizing.LeftRightSpacing,ChildSizing.TopBottomSpacing);
//DebugLn('[TWinControl.AlignControls] ',Name,':',Classname,' ',Left,',',Top,',',Width,',',Height,' ClientRect=',RemainingClientRect.Left,',',RemainingClientRect.Top,',',RemainingClientRect.Right,',',RemainingClientRect.Bottom);
AlignList := TList.Create;
try
DoAlign(alTop);
@ -3914,6 +3921,9 @@ end;
{ =============================================================================
$Log$
Revision 1.283 2004/10/28 09:30:49 mattias
implemented borderspacing TWinControl.ChildSizing.Left/Top
Revision 1.282 2004/09/24 21:34:14 micha
convert LM_CREATE message to interface methods
remove SendMsgToInterface, CNSendMessage and related methods