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

implemented TControl.AnchorSide

Browse Source 
git-svn-id: trunk@6474 -
This commit is contained in:
mattias 2005-01-03 22:44:31 +00:00
parent 3ddfc40ef5
commit 131da415de
4 changed files with 332 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

215
lcl/controls.pp
View File

@ -608,6 +608,8 @@ type
TSpacingSize = 0..MaxInt;
{ TControlBorderSpacing }
TControlBorderSpacing = class(TPersistent)
private
FAround: TSpacingSize;
@ -630,6 +632,7 @@ type
procedure AssignTo(Dest: TPersistent); override;
function IsEqual(Spacing: TControlBorderSpacing): boolean;
procedure GetSpaceAround(var SpaceAround: TRect);
function GetSpace(Kind: TAnchorKind): Integer;
public
property Control: TControl read FControl;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
@ -692,15 +695,19 @@ type
FKind: TAnchorKind;
FOwner: TControl;
FSide: TAnchorSideReference;
function IsSideStored: boolean;
procedure SetControl(const AValue: TControl);
procedure SetSide(const AValue: TAnchorSideReference);
public
constructor Create(TheOwner: TControl; TheKind: TAnchorKind);
procedure GetSidePosition(var ReferenceControl: TControl;
var ReferenceSide: TAnchorSideReference; var Position: Integer);
public
property Owner: TControl read FOwner;
property Kind: TAnchorKind read FKind;
published
property Control: TControl read FControl write SetControl;
property Side: TAnchorSideReference read FSide write SetSide;
property Side: TAnchorSideReference read FSide write SetSide stored IsSideStored;
end;
@ -1887,6 +1894,26 @@ const
{ alCustom }
[akLeft, akTop]
);
DefaultSideForAnchorKind: array[TAnchorKind] of TAnchorSideReference = (
// akTop
asrBottom,
// akLeft
asrBottom,
// akRight
asrTop,
// akBottom
asrTop
);
AnchorReferenceSide: array[TAnchorKind,TAnchorSideReference] of TAnchorKind =(
// akTop -> asrTop, asrBottom, asrCenter
(akTop,akBottom,akTop),
// akLeft -> asrTop, asrBottom, asrCenter
(akLeft,akRight,akLeft),
// akRight -> asrTop, asrBottom, asrCenter
(akTop,akBottom,akTop),
// akBottom -> asrTop, asrBottom, asrCenter
(akLeft,akRight,akLeft)
);
AlignNames: array[TAlign] of string = (
'alNone', 'alTop', 'alBottom', 'alLeft', 'alRight', 'alClient', 'alCustom');
@ -2393,6 +2420,17 @@ begin
SpaceAround.Bottom:=Bottom+Around;
end;
function TControlBorderSpacing.GetSpace(Kind: TAnchorKind): Integer;
begin
Result:=Around;
case Kind of
akLeft: inc(Result,Left);
akTop: inc(Result,Top);
akRight: inc(Result,Right);
akBottom: inc(Result,Bottom);
end;
end;
procedure TControlBorderSpacing.Change;
begin
if Assigned(FOnChange) then FOnChange(Self);
@ -2517,15 +2555,45 @@ end;
{ TAnchorSide }
procedure TAnchorSide.SetControl(const AValue: TControl);
procedure RaiseOwnerCircle;
begin
raise Exception.Create('TAnchorSide.SetControl AValue=FOwner');
end;
begin
if (AValue=FOwner) then RaiseOwnerCircle;
if FControl=AValue then exit;
FControl:=AValue;
//debugln('TAnchorSide.SetControl A ',DbgSName(FOwner));
FOwner.AnchorSideChanged(Self);
end;
function TAnchorSide.IsSideStored: boolean;
begin
Result:=(Control<>nil) and (FSide<>DefaultSideForAnchorKind[FKind]);
end;
procedure TAnchorSide.SetSide(const AValue: TAnchorSideReference);
var
OldSide: TAnchorSideReference;
begin
if FSide=AValue then exit;
if AValue=asrCenter then begin
// in case asrCenter, both sides are controlled by one anchor
// -> disable opposite anchor and aligning
OldSide:=FSide;
if FOwner.Align in [alLeft,alTop,alRight,alBottom,alClient] then begin
FOwner.Align:=alNone;
end;
case Kind of
akLeft: FOwner.Anchors:=FOwner.Anchors-[akRight];
akTop: FOwner.Anchors:=FOwner.Anchors-[akBottom];
akRight: FOwner.Anchors:=FOwner.Anchors-[akLeft];
akBottom: FOwner.Anchors:=FOwner.Anchors-[akTop];
end;
if OldSide<>FSide then exit;
end;
FSide:=AValue;
FOwner.AnchorSideChanged(Self);
end;
@ -2535,6 +2603,148 @@ begin
inherited Create;
FOwner:=TheOwner;
FKind:=TheKind;
FSide:=DefaultSideForAnchorKind[FKind];
end;
procedure TAnchorSide.GetSidePosition(var ReferenceControl: TControl;
var ReferenceSide: TAnchorSideReference; var Position: Integer);
procedure RaiseInvalidSide;
begin
raise Exception.Create('TAnchorSide.GetSidePosition invalid Side');
end;
var
NextReferenceSide: TAnchorSide;
ChainLength: Integer;
MaxChainLength: LongInt;
OwnerBorderSpacing: LongInt;
OwnerParent: TWinControl;
begin
ReferenceControl:=Control;
ReferenceSide:=Side;
Position:=0;
OwnerParent:=FOwner.Parent;
if OwnerParent=nil then begin
// AnchorSide is only between siblings allowed
ReferenceControl:=nil;
exit;
end;
ChainLength:=0;
MaxChainLength:=OwnerParent.ControlCount;
while ReferenceControl<>nil do begin
// check for circles
inc(ChainLength);
if ChainLength>MaxChainLength then begin
// the chain has more elements than there are siblings -> circle
ReferenceControl:=nil;
exit;
end;
// check sibling
if (ReferenceControl.Parent<>OwnerParent) then begin
// not a sibling -> invalid AnchorSide
ReferenceControl:=nil;
exit;
end;
if ReferenceControl.Visible
or ([csDesigning,csNoDesignVisible]*ReferenceControl.ComponentState
=[csDesigning])
then begin
// ReferenceControl is visible
// -> calculate Position
OwnerBorderSpacing:=FOwner.BorderSpacing.GetSpace(Kind);
case ReferenceSide of
asrTop:
if Kind in [akLeft,akRight] then begin
// anchor to left side of ReferenceControl
Position:=ReferenceControl.Left;
if Kind=akLeft then begin
// anchor left of ReferenceControl and left of Owner
inc(Position,OwnerBorderSpacing);
end else begin
// anchor left of ReferenceControl and right of Owner
OwnerBorderSpacing:=Max(OwnerBorderSpacing,
ReferenceControl.BorderSpacing.GetSpace(akLeft));
dec(Position,OwnerBorderSpacing);
end;
end else begin
// anchor to top side of ReferenceControl
Position:=ReferenceControl.Top;
if Kind=akTop then begin
// anchor top of ReferenceControl and top of Owner
inc(Position,OwnerBorderSpacing);
end else begin
// anchor top of ReferenceControl and bottom of Owner
OwnerBorderSpacing:=Max(OwnerBorderSpacing,
ReferenceControl.BorderSpacing.GetSpace(akTop));
dec(Position,OwnerBorderSpacing);
end;
end;
asrBottom:
if Kind in [akLeft,akRight] then begin
// anchor to right side of ReferenceControl
Position:=ReferenceControl.Left+ReferenceControl.Width;
if Kind=akLeft then begin
// anchor right of ReferenceControl and left of Owner
OwnerBorderSpacing:=Max(OwnerBorderSpacing,
ReferenceControl.BorderSpacing.GetSpace(akRight));
inc(Position,OwnerBorderSpacing);
end else begin
// anchor right of ReferenceControl and right of Owner
dec(Position,OwnerBorderSpacing);
end;
end else begin
// anchor to bottom side of ReferenceControl
Position:=ReferenceControl.Top+ReferenceControl.Height;
if Kind=akTop then begin
// anchor bottom of ReferenceControl and top of Owner
OwnerBorderSpacing:=Max(OwnerBorderSpacing,
ReferenceControl.BorderSpacing.GetSpace(akBottom));
inc(Position,OwnerBorderSpacing);
end else begin
// anchor bottom of ReferenceControl and bottom of Owner
dec(Position,OwnerBorderSpacing);
end;
end;
asrCenter:
if Kind in [akLeft,akRight] then begin
// center horizontally
Position:=ReferenceControl.Left+(ReferenceControl.Width div 2);
if Kind=akLeft then
dec(Position,FOwner.Width div 2)
else
inc(Position,FOwner.Width div 2);
end else begin
// center vertically
Position:=ReferenceControl.Top+(ReferenceControl.Height div 2);
if Kind=akTop then
dec(Position,FOwner.Height div 2)
else
inc(Position,FOwner.Height div 2);
end;
else
RaiseInvalidSide;
end;
// side found
exit;
end;
// ReferenceControl is not visible -> try next
NextReferenceSide:=ReferenceControl.AnchorSide[
AnchorReferenceSide[Kind,ReferenceSide]];
if (NextReferenceSide=nil) then begin
ReferenceControl:=nil;
exit;
end;
ReferenceControl:=NextReferenceSide.Control;
ReferenceSide:=NextReferenceSide.Side;
end;
end;
{$IFNDEF VER1_0}
@ -2599,6 +2809,9 @@ end.
{ =============================================================================
$Log$
Revision 1.263 2005/01/03 22:44:31 mattias
implemented TControl.AnchorSide
Revision 1.262 2004/12/27 19:40:59 mattias
published BorderSpacing for many controls

45
lcl/include/clipbrd.inc
View File

@ -52,7 +52,9 @@ end;
function TClipboard.IndexOfCachedFormatID(FormatID: TClipboardFormat;
CreateIfNotExists: boolean): integer;
var NewSize: integer;
var
NewSize: integer;
FormatAdded: Boolean;
begin
//DebugLn('[TClipboard.IndexOfCachedFormatID] A ',ClipboardTypeName[ClipboardType]
//,' Format=',FormatID,' CreateIfNotExists=',CreateIfNotExists);
@ -65,23 +67,33 @@ begin
end;
Result:=FCount-1;
while (Result>=0) and (FData[Result].FormatID<>FormatID) do dec(Result);
FormatAdded:=false;
if (Result<0) and CreateIfNotExists then begin
if not GetOwnerShip then begin
Result:=-1;
raise Exception.Create('Unable to get clipboard ownership for '+
ClipboardTypeName[ClipboardType]);
end else begin
inc(FCount);
// add format
inc(FCount);
NewSize:=SizeOf(TClipboardData)*FCount;
ReallocMem(FData,NewSize);
Result:=FCount-1;
FData[Result].FormatID:=FormatID;
FData[Result].Stream:=TMemoryStream.Create;
FSupportedFormatsChanged:=true;
FormatAdded:=true;
end;
// CreateIfNotExists = true means changing the clipboard
// => we need OwnerShip for that
if CreateIfNotExists and (not GetOwnerShip) then begin
// getting ownership failed
if FormatAdded then begin
// undo: remove added format
// Note: This creates a little overhead in case of an error, but reduces
// overhead in case of everything works
FData[Result].Stream.Free;
NewSize:=SizeOf(TClipboardData)*FCount;
if FData<>nil then
ReallocMem(FData,NewSize)
else
GetMem(FData,NewSize);
Result:=FCount-1;
FData[Result].FormatID:=FormatID;
FData[Result].Stream:=TMemoryStream.Create;
FSupportedFormatsChanged:=true;
ReallocMem(FData,NewSize);
end;
Result:=-1;
raise Exception.Create('Unable to get clipboard ownership for '+
ClipboardTypeName[ClipboardType]);
end;
//DebugLn('[TClipboard.IndexOfCachedFormatID] END ',ClipboardTypeName[ClipboardType]
//,' Format=',FormatID,' CreateIfNotExists=',CreateIfNotExists,' Result=',Result);
@ -692,6 +704,9 @@ end;
{
$Log$
Revision 1.20 2005/01/03 22:44:31 mattias
implemented TControl.AnchorSide
Revision 1.19 2005/01/03 16:32:13 micha
always request ownership when about to modify buffer

5
lcl/include/control.inc
View File

@ -1943,7 +1943,7 @@ end;
procedure TControl.AnchorSideChanged(TheAnchorSide: TAnchorSide);
begin
RequestAlign;
end;
{------------------------------------------------------------------------------
@ -3459,6 +3459,9 @@ end;
{ =============================================================================
$Log$
Revision 1.230 2005/01/03 22:44:31 mattias
implemented TControl.AnchorSide
Revision 1.229 2005/01/03 01:07:08 mattias
fixed registering TProgressBar, disabled docking in TToolBar, return key for codeexplorer, updated finnish translation

117
lcl/include/wincontrol.inc
View File

@ -83,13 +83,17 @@ var
function AlignWork: Boolean;
var
I: Integer;
CurControl: TControl;
begin
Result := True;
for I := ControlCount - 1 downto 0 do
begin
if (Controls[I].Align <> alNone)
or (Controls[I].Anchors <> [akLeft, akTop])
CurControl:=Controls[I];
if (CurControl.Align <> alNone)
or (CurControl.Anchors <> [akLeft, akTop])
or (CurControl.AnchorSide[akLeft].Control<>nil)
or (CurControl.AnchorSide[akTop].Control<>nil)
then Exit;
end;
Result := False;
@ -123,6 +127,8 @@ var
CurRemainingClientRect: TRect;
CurRemainingBorderSpace: TRect;
ChildAroundSpace: TRect;
AnchorSideCacheValid: array[TAnchorKind] of boolean;
AnchorSideCache: array[TAnchorKind] of integer;
function ConstraintWidth(NewWidth: integer): integer;
begin
@ -139,12 +145,42 @@ var
Result:=MaxHeight;
if Result<MinHeight then Result:=MinHeight;
end;
procedure InitAnchorSideCache;
var
a: TAnchorKind;
begin
for a:=Low(TAnchorKind) to High(TAnchorKind) do
AnchorSideCacheValid[a]:=false;
end;
function GetAnchorSidePosition(Kind: TAnchorKind;
DefaultPosition: Integer): integer;
var
CurAnchorSide: TAnchorSide;
ReferenceControl: TControl;
ReferenceSide: TAnchorSideReference;
Position: Integer;
begin
if AnchorSideCacheValid[Kind] then begin
Result:=AnchorSideCache[Kind];
exit;
end;
Result:=DefaultPosition;
CurAnchorSide:=Control.AnchorSide[Kind];
//debugln('GetAnchorSidePosition Self=',DbgSName(Self),' Control=',DbgSName(Control),' ',dbgs(CurAnchorSide.Control<>nil));
CurAnchorSide.GetSidePosition(ReferenceControl,ReferenceSide,Position);
if ReferenceControl<>nil then
Result:=Position;
AnchorSideCacheValid[Kind]:=true;
AnchorSideCache[Kind]:=Result;
end;
begin
{$IFDEF CHECK_POSITION}
if AnsiCompareText(Control.ClassName,'TScrollBar')=0 then
with Control do
DebugLn('[TWinControl.AlignControls.DoPosition] A Control=',Name,':',ClassName,' ',Left,',',Top,',',Width,',',Height,' recalculate the anchors=',(Control.Anchors <> AnchorAlign[AAlign]),' Align=',AlignNames[AAlign]);
DebugLn('[TWinControl.AlignControls.DoPosition] A Control=',Name,':',ClassName,' ',dbgs(Left),',',dbgs(Top),',',dbgs(Width),',',dbgs(Height),' recalculate the anchors=',dbgs(Control.Anchors <> AnchorAlign[AAlign]),' Align=',AlignNames[AAlign]);
{$ENDIF}
@ -164,11 +200,17 @@ var
NewHeight:=ConstraintHeight(Height);
end;
InitAnchorSideCache;
{ Recalculate the anchors
Use Anchors to ensure that a control maintains its current position
relative to an edge of its parent, even if the parent is resized. When
its parent is resized, the control holds its position relative to the
relative to an edge of its parent or another sibling.
This is controlled with the AnchorSide properties.
1. If AnchorSide[].Control is not set, the distance is kept relative to
the edges of the client are of its parent.
When its parent is resized, the control holds its position relative to the
edges to which it is anchored.
If a control is anchored to opposite edges of its parent, the control
stretches when its parent is resized. For example, if a control has its
@ -178,6 +220,9 @@ var
if a control is anchored to opposite edges of a form at design time and
the form is created in a maximized state, the control is not stretched
because the form is not resized after the control is created.
2. If AnchorSide[].Control is set, the BorderSpace properties defines the
distance to another sibling (i.e. AnchorSide[].Control).
}
if (AAlign = alNone) or (Control.Anchors <> AnchorAlign[AAlign]) then
begin
@ -202,23 +247,23 @@ var
if AnsiCompareText(Control.ClassName,'TScrollBar')=0 then
DebugLn('[TWinControl.AlignControls.DoPosition] Before Anchoring ',
' ',Name,':',ClassName,
' CurBaseBounds=',CurBaseBounds.Left,',',CurBaseBounds.Top,',',CurBaseBounds.Right-CurBaseBounds.Left,',',CurBaseBounds.Bottom-CurBaseBounds.Top,
' ParBaseClient=',ParentBaseClientSize.X,',',ParentBaseClientSize.Y,
' ParClient=',Control.Parent.ClientWidth,',',Control.Parent.ClientHeight,
' NewBounds=',NewLeft,',',NewTop,',',NewWidth,',',NewHeight,
' CurBaseBounds='+dbgs(CurBaseBounds.Left)+','+dbgs(CurBaseBounds.Top)+','+dbgs(CurBaseBounds.Right-CurBaseBounds.Left)+','+dbgs(CurBaseBounds.Bottom-CurBaseBounds.Top),
' ParBaseClient='+dbgs(ParentBaseClientSize.X)+','+dbgs(ParentBaseClientSize.Y),
' ParClient='+dbgs(Control.Parent.ClientWidth)+','+dbgs(Control.Parent.ClientHeight),
' NewBounds='+dbgs(NewLeft)+','+dbgs(NewTop)+','+dbgs(NewWidth)+','+dbgs(NewHeight),
'');
{$ENDIF}
if akLeft in Control.Anchors then begin
// keep distance to left side of parent
NewLeft:=CurBaseBounds.Left;
// keep distance to left side of parent or another sibling
NewLeft:=GetAnchorSidePosition(akLeft,CurBaseBounds.Left);
if akRight in Control.Anchors then begin
// keep distance to right side of parent
// keep distance to right side of parent or another sibling
// -> change the width
NewWidth:=Control.Parent.ClientWidth
-(ParentBaseClientSize.X-CurBaseBounds.Right)
-NewLeft;
NewWidth:=ConstraintWidth(NewWidth);
NewRight:=Control.Parent.ClientWidth
-(ParentBaseClientSize.X-CurBaseBounds.Right);
NewRight:=GetAnchorSidePosition(akRight,NewRight);
NewWidth:=ConstraintWidth(NewRight-NewLeft);
end else begin
// do not anchor to the right
// -> keep new width
@ -228,9 +273,10 @@ var
if akRight in Control.Anchors then begin
// keep distance to right side of parent
// and keep new width
NewLeft:=Control.Parent.ClientWidth
-(ParentBaseClientSize.X-CurBaseBounds.Right)
-NewWidth;
NewRight:=Control.Parent.ClientWidth
-(ParentBaseClientSize.X-CurBaseBounds.Right);
NewRight:=GetAnchorSidePosition(akRight,NewRight);
NewLeft:=NewRight-NewWidth;
end else begin
// do not anchor to the right
// -> keep new width and center horizontally
@ -240,14 +286,14 @@ var
if akTop in Control.Anchors then begin
// keep distance to top side of parent
NewTop:=CurBaseBounds.Top;
NewTop:=GetAnchorSidePosition(akTop,CurBaseBounds.Top);
if akBottom in Control.Anchors then begin
// keep distance to bottom side of parent
// -> change the height
NewHeight:=Control.Parent.ClientHeight
-(ParentBaseClientSize.Y-CurBaseBounds.Bottom)
-NewTop;
NewHeight:=ConstraintHeight(NewHeight);
NewBottom:=Control.Parent.ClientHeight
-(ParentBaseClientSize.Y-CurBaseBounds.Bottom);
NewBottom:=GetAnchorSidePosition(akBottom,NewBottom);
NewHeight:=ConstraintHeight(NewBottom-NewTop);
end else begin
// do not anchor to the bottom
// -> keep new height
@ -257,9 +303,10 @@ var
if akBottom in Control.Anchors then begin
// keep distance to bottom side of parent
// and keep new height
NewTop:=Control.Parent.ClientHeight
-(ParentBaseClientSize.Y-CurBaseBounds.Bottom)
-NewHeight;
NewBottom:=Control.Parent.ClientHeight
-(ParentBaseClientSize.Y-CurBaseBounds.Bottom);
NewBottom:=GetAnchorSidePosition(akBottom,NewBottom);
NewTop:=NewBottom-NewHeight;
end else begin
// do not anchor to the bottom
// -> keep new height and center vertically
@ -294,7 +341,8 @@ var
form or panel and have it remain there even if the size of the form,
panel, or component that contains the control changes. When the parent
is resized, an aligned control also resizes so that it continues to span
the top, bottom, left, or right edge of the parent.
the top, bottom, left, or right edge of the parent (more exact:
span the remaining client area of its parent).
}
NewRight:=NewLeft+NewWidth;
NewBottom:=NewTop+NewHeight;
@ -452,11 +500,11 @@ var
begin
// VCL is tricking here.
// For alClients with Constraints do the same as for alLeft
//debugln('TWinControl.AlignControls.DoPosition A Self=',Name,' Control=',DbgSName(Control),' ',dbgs(NewLeft),' ',dbgs(NewWidth));
// RemainingClientRect.Left:=NewLeft+NewWidth;
// RemainingBorderSpace.Left:=0;
// AdjustBorderSpace(RemainingClientRect,RemainingBorderSpace,
// Max(ChildSizing.HorizontalSpacing,ChildAroundSpace.Right),0,0,0);
{debugln('TWinControl.AlignControls.DoPosition A Self=',Name,' Control=',DbgSName(Control),' ',dbgs(NewLeft),' ',dbgs(NewWidth));
RemainingClientRect.Left:=NewLeft+NewWidth;
RemainingBorderSpace.Left:=0;
AdjustBorderSpace(RemainingClientRect,RemainingBorderSpace,
Max(ChildSizing.HorizontalSpacing,ChildAroundSpace.Right),0,0,0);}
end;
end;
@ -4184,6 +4232,9 @@ end;
{ =============================================================================
$Log$
Revision 1.294 2005/01/03 22:44:31 mattias
implemented TControl.AnchorSide
Revision 1.293 2005/01/01 18:56:47 mattias
implemented TTIProgressBar