1{%MainUnit ../controls.pp} 2 3{****************************************************************************** 4 TWinControl 5 ****************************************************************************** 6 7 ***************************************************************************** 8 This file is part of the Lazarus Component Library (LCL) 9 10 See the file COPYING.modifiedLGPL.txt, included in this distribution, 11 for details about the license. 12 ***************************************************************************** 13} 14 15{$IFOPT C-} 16// Uncomment for local trace 17// {$C+} 18// {$DEFINE ASSERT_IS_ON} 19{$ENDIF} 20 21{off $DEFINE VerboseAutoSizeCtrlData} 22{off $DEFINE VerboseMouseBugfix} 23{off $DEFINE VerboseCanAutoSize} 24{off $DEFINE VerboseIntfSizing} 25{off $DEFINE VerboseClientRectBugFix} 26{$IFDEF VerboseClientRectBugFix} 27const CheckClientRectName = 'LCLInterfaceRadioGroup'; 28{$ENDIF} 29 30{off $DEFINE VerboseSizeMsg} 31{off $DEFINE CHECK_POSITION} 32{$IFDEF CHECK_POSITION} 33const CheckPostionClassName = 'xxxTBreakPropertyDlg'; 34const CheckPostionName = 'FakeStatusBar'; 35const CheckPostionParentName = 'xxxEnvVarsPage'; 36 37function CheckPosition(AControl: TControl): boolean; 38begin 39 Result:=(CompareText(AControl.ClassName,CheckPostionClassName)=0) 40 or (CompareText(AControl.Name,CheckPostionName)=0) 41 or ((AControl.Parent<>nil) 42 and (CompareText(AControl.Parent.Name,CheckPostionParentName)=0)); 43end; 44{$ENDIF} 45 46function IsNotAligned(AControl: TControl): boolean; 47begin 48 Result:=(AControl.Align=alNone) 49 and (AControl.Anchors=[akLeft,akTop]) 50 and (AControl.AnchorSide[akLeft].Control=nil) 51 and (AControl.AnchorSide[akTop].Control=nil); 52end; 53 54function IsNotAligned(AControl: TControl; ASide: TAnchorKind): boolean; 55begin 56 Result:=(AControl.Align=alNone); 57 if not Result then Exit; 58 if ASide in [akLeft, akRight] then 59 Result:=(AControl.Anchors*[akLeft, akRight]=[akLeft]) 60 and (AControl.AnchorSide[akLeft].Control=nil) 61 else 62 Result:=(AControl.Anchors*[akTop, akBottom]=[akTop]) 63 and (AControl.AnchorSide[akBottom].Control=nil); 64end; 65 66{------------------------------------------------------------------------------ 67 Autosizing Helper classes 68-------------------------------------------------------------------------------} 69type 70 TAutoSizeBoxOrientation = (asboHorizontal, asboVertical); 71 72 PAutoSizeBox = ^TAutoSizeBox; 73 74 { TAutoSizeBox 75 A TAutoSizeBox is a node in a tree. 76 A TAutoSizeBox can be a cell. Then it is a leaf in the tree and can have a 77 Control. 78 A TAutoSizeBox can be a row or column. Then it has only one Children array. 79 A TAutoSizeBox can be a table. Then it has both Children arrays. 80 } 81 82 TAutoSizeBox = class 83 public 84 Control: TControl; // the Control of a leaf node 85 MinimumSize: array[TAutoSizeBoxOrientation] of integer; 86 MaximumSize: array[TAutoSizeBoxOrientation] of integer; // 0 means inifinte 87 PreferredSize: array[TAutoSizeBoxOrientation] of integer;// without theme space 88 LeftTop: array[TAutoSizeBoxOrientation] of integer; 89 BorderLeftTop: array[TAutoSizeBoxOrientation] of integer; 90 BorderRightBottom: array[TAutoSizeBoxOrientation] of integer; 91 Parent: array[TAutoSizeBoxOrientation] of TAutoSizeBox; 92 Index: array[TAutoSizeBoxOrientation] of Integer; // index in parent or grandparent 93 ChildCount: array[TAutoSizeBoxOrientation] of Integer; 94 Children: array[TAutoSizeBoxOrientation] of PAutoSizeBox; 95 NewControlBounds: TRect; 96 97 // for nodes 98 destructor Destroy; override; 99 procedure Clear; 100 procedure SetControl(AControl: TControl); 101 procedure ApplyChildSizingBorders(ChildSizing: TControlChildSizing); 102 103 // for rows and columns 104 procedure AllocateChildsArray(Orientation: TAutoSizeBoxOrientation; 105 NewChildCount: Integer); 106 procedure InitSums; 107 procedure SumLine(Orientation: TAutoSizeBoxOrientation; 108 DoInit: boolean); 109 procedure ResizeChildren(ChildSizing: TControlChildSizing; 110 Orientation: TAutoSizeBoxOrientation; 111 TargetSize: integer); 112 procedure ComputeLeftTops(Orientation: TAutoSizeBoxOrientation); 113 114 // for tables 115 procedure AllocateTable(ColCount, RowCount: Integer); 116 procedure SetTableControls(ListOfControls: TFPList; 117 ChildSizing: TControlChildSizing; 118 BiDiMode: TBiDiMode); 119 procedure SumTable; 120 procedure ResizeTable(ChildSizing: TControlChildSizing; 121 TargetWidth, TargetHeight: integer); 122// Michl: Commented procedure AlignToRight because of issue #28483, afaics 123// it isn't needed, I'll remove code, if there are no regressions. 124// Commented in revision 55209 125// procedure AlignToRight(TargetWidth: integer); 126 procedure ComputeTableControlBounds(ChildSizing: TControlChildSizing; 127 BiDiMode: TBiDiMode); 128 function SetTableControlBounds(ChildSizing: TControlChildSizing 129 ): boolean;// true if changed 130 function AlignControlsInTable(ListOfControls: TFPList; 131 ChildSizing: TControlChildSizing; 132 BiDiMode: TBiDiMode; 133 TargetWidth, TargetHeight: integer; 134 Apply: boolean): boolean;// true if changed 135 136 // debugging 137 procedure WriteDebugReport(const Title: string); 138 end; 139 140 { TAutoSizeCtrlData 141 This class is used by the auto size algorithm, to compute the preferred 142 size of a control given the preferred sizes of its children. 143 Hints about the algorithm: 144 First it builds a graph of dependencies. That means, for every side 145 (Left,Top,Right,Bottom) of each child control the anchor control and 146 space is calculated. Anchor means here direct and indirect anchors. 147 Indirect anchors are defined by the Align property. 148 For example a control with Align=alTop is anchored left to the parent, 149 right to the parent and top to either the parent or another alTop control. 150 Then it searches for circles and other invalid combinations and repairs 151 them. 152 } 153 154 TAutoSizeCtrlData = class; 155 156 TAutoSizeSideDataState = ( 157 assdfInvalid, 158 assdfComputing, 159 assdfUncomputable,// e.g. if [akLeft,akRight]*Anchors = [] 160 assdfValid 161 ); 162 TAutoSizeSideDistDirection = ( 163 assddLeftTop, 164 assddRightBottom 165 ); 166 167 TAutoSizeSideData = record 168 CtrlData: TAutoSizeCtrlData; 169 Side: TAnchorSideReference; 170 Space: integer; 171 Distance: array[TAutoSizeSideDistDirection] of integer; 172 DistanceState: array[TAutoSizeSideDistDirection] of TAutoSizeSideDataState; 173 end; 174 175 TAutoSizeCtrlData = class 176 private 177 FChilds: TAvlTree;// tree of TAutoSizeCtrlData 178 function GetChildren(AControl: TControl): TAutoSizeCtrlData; 179 procedure DoMoveNonAlignedChildren(Side: TAnchorKind; 180 var MoveDiff: integer; FindMinimum: boolean); 181 procedure SetupNonAlignedChildren(MoveNonAlignedChildrenLeft, 182 MoveNonAlignedChildrenTop: boolean); 183 procedure AlignChildren; 184 procedure SetupSpace; 185 function ComputePositions: boolean;// false if recomputation is needed (a property changed) 186 public 187 Control: TControl; // the Control of a leaf node 188 WinControl: TWinControl;// the Control as TWinControl (else nil) 189 ChildCount: integer; 190 Visible: boolean;//= Control.IsControlVisible 191 PreferredSize: array[TAutoSizeBoxOrientation] of integer;// without theme space 192 Borders: array[TAnchorKind] of integer; 193 AdjustedClientBorders: array[TAnchorKind] of integer;// the borderspace created by WinControl.AdjustClientRect 194 Sides: array[TAnchorKind] of TAutoSizeSideData; 195 BaseBounds: TRect; 196 BaseParentClientSize: TSize; 197 constructor Create(AControl: TControl; IsParent: boolean = true); 198 destructor Destroy; override; 199 procedure Clear; 200 procedure ComputePreferredClientArea(MoveNonAlignedChildrenLeft, 201 MoveNonAlignedChildrenTop: boolean; 202 out MoveNonAlignedToLeft, MoveNonAlignedToTop, 203 PreferredClientWidth, PreferredClientHeight: integer); 204 procedure FixControlProperties(Child: TControl); 205 procedure ClearSides; 206 procedure SetFixedLeftTop(ChildData: TAutoSizeCtrlData; Side: TAnchorKind; 207 NewLeftTop: integer); 208 property Children[AControl: TControl]: TAutoSizeCtrlData read GetChildren; default; 209 procedure WriteDebugReport(const Title, Prefix: string; OnlyVisible: boolean = true); 210 end; 211 212const 213 SizeBoxOrthogonal: array[TAutoSizeBoxOrientation] of TAutoSizeBoxOrientation 214 = (asboVertical,asboHorizontal); 215 {AutoSizeSideDataStateNames: array[TAutoSizeSideDataState] of shortstring = ( 216 'assdfInvalid', 217 'assdfComputing', 218 'assdfUncomputable', 219 'assdfValid' 220 );} 221 {$IFNDEF DisableChecks} 222 AutoSizeSideDistDirectionNames: array[TAutoSizeSideDistDirection] of shortstring = ( 223 'assddLeftTop', 224 'assddRightBottom' 225 ); 226 {$ENDIF} 227 228function CompareAutoSizeCtrlDatas(Data1, Data2: Pointer): integer; 229var 230 Control1: TControl; 231 Control2: TControl; 232begin 233 Control1:=TAutoSizeCtrlData(Data1).Control; 234 Control2:=TAutoSizeCtrlData(Data2).Control; 235 if Pointer(Control1)>Pointer(Control2) then 236 Result:=1 237 else if Pointer(Control1)<Pointer(Control2) then 238 Result:=-1 239 else 240 Result:=0; 241end; 242 243function CompareControlWithAutoSizeCtrlData(AControl, AData: Pointer): integer; 244var 245 Control1: TControl; 246 Control2: TControl; 247begin 248 Control1:=TControl(AControl); 249 Control2:=TAutoSizeCtrlData(AData).Control; 250 if Pointer(Control1)>Pointer(Control2) then 251 Result:=1 252 else if Pointer(Control1)<Pointer(Control2) then 253 Result:=-1 254 else 255 Result:=0; 256end; 257 258 259{ TAutoSizeCtrlData } 260 261function TAutoSizeCtrlData.GetChildren(AControl: TControl): TAutoSizeCtrlData; 262var 263 AVLNode: TAvlTreeNode; 264begin 265 if AControl=nil then exit(nil); 266 if AControl=Control then RaiseGDBException('TAutoSizeCtrlData.GetChilds'); 267 if FChilds=nil then 268 FChilds:=TAvlTree.Create(@CompareAutoSizeCtrlDatas); 269 AVLNode:=FChilds.FindKey(AControl,@CompareControlWithAutoSizeCtrlData); 270 if AVLNode<>nil then 271 Result:=TAutoSizeCtrlData(AVLNode.Data) 272 else begin 273 Result:=TAutoSizeCtrlData.Create(AControl,false); 274 FChilds.Add(Result); 275 end; 276end; 277 278procedure TAutoSizeCtrlData.AlignChildren; 279var 280 AlignList: TFPList; 281 AlignBoundaryControls: array[TAnchorKind] of TAutoSizeCtrlData; 282 283 procedure DoAlign(TheAlign: TAlign); 284 var 285 Child: TControl; 286 i: Integer; 287 ChildData: TAutoSizeCtrlData; 288 a: TAnchorKind; 289 begin 290 WinControl.CreateControlAlignList(TheAlign, AlignList, nil); 291 for i := 0 to AlignList.Count - 1 do 292 begin 293 Child := TControl(AlignList[i]); 294 ChildData := Children[Child]; 295 //DebugLn('DoAlign ',DbgSName(Child),' ',dbgs(Child.Align)); 296 297 for a := Low(TAnchorKind) to High(TAnchorKind) do 298 if a in AnchorAlign[TheAlign] then 299 begin 300 ChildData.Sides[a].CtrlData := AlignBoundaryControls[a]; 301 if (a in [akLeft, akTop]) = (ChildData.Sides[a].CtrlData = Self) then 302 ChildData.Sides[a].Side := asrLeft 303 else 304 ChildData.Sides[a].Side := asrRight; 305 //DebugLn('DoAlign ',DbgSName(Child),' ',dbgs(a),' ',dbgs(a,ChildData.Sides[a].Side)); 306 end; 307 308 case TheAlign of 309 alTop: AlignBoundaryControls[akTop] := ChildData; 310 alBottom: AlignBoundaryControls[akBottom] := ChildData; 311 alLeft: AlignBoundaryControls[akLeft] := ChildData; 312 alRight: AlignBoundaryControls[akRight] := ChildData; 313 alClient: ; // Delphi compatibility: multiple alClient controls overlap 314 end; 315 {DebugLn(['DoAlign AlignBoundaryControls:', 316 ' Left=',DbgSName(AlignBoundaryControls[akLeft].Control), 317 ' Top=',DbgSName(AlignBoundaryControls[akTop].Control), 318 ' Right=',DbgSName(AlignBoundaryControls[akRight].Control), 319 ' Bottom=',DbgSName(AlignBoundaryControls[akBottom].Control) ]);} 320 end; 321 end; 322 323var 324 a: TAnchorKind; 325begin 326 if ChildCount = 0 then exit; 327 AlignList := TFPList.Create; 328 try 329 // align and anchor child controls 330 for a := Low(TAnchorKind) to High(TAnchorKind) do 331 AlignBoundaryControls[a] := Self; 332 DoAlign(alTop); 333 DoAlign(alBottom); 334 DoAlign(alLeft); 335 DoAlign(alRight); 336 DoAlign(alClient); 337 finally 338 AlignList.Free; 339 end; 340end; 341 342procedure TAutoSizeCtrlData.SetupSpace; 343var 344 i: Integer; 345 Child: TControl; 346 ChildData: TAutoSizeCtrlData; 347 a: TAnchorKind; 348 SiblingData: TAutoSizeCtrlData; 349 NewSpace: LongInt; 350begin 351 for i:=0 to ChildCount-1 do begin 352 Child:=WinControl.Controls[i]; 353 ChildData:=Children[Child]; 354 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 355 if ChildData.Sides[a].CtrlData=Self then begin 356 // aligned or anchored to parent 357 if a in [akLeft,akRight] then begin 358 ChildData.Sides[a].Space:=Max(WinControl.ChildSizing.LeftRightSpacing, 359 ChildData.Borders[a]); 360 end else begin 361 ChildData.Sides[a].Space:=Max(WinControl.ChildSizing.TopBottomSpacing, 362 ChildData.Borders[a]); 363 end; 364 inc(ChildData.Sides[a].Space,AdjustedClientBorders[a]); 365 end else if ChildData.Sides[a].CtrlData<>nil then begin 366 SiblingData:=ChildData.Sides[a].CtrlData; 367 // aligned or anchored to a sibling 368 if a in [akLeft,akTop] then begin 369 NewSpace:=ChildData.Borders[a]; 370 if ChildData.Sides[a].Side=asrRight then begin 371 NewSpace:=Max(NewSpace,WinControl.ChildSizing.HorizontalSpacing); 372 if a=akLeft then 373 NewSpace:=Max(NewSpace,SiblingData.Borders[akRight]) 374 else 375 NewSpace:=Max(NewSpace,SiblingData.Borders[akBottom]); 376 end else if ChildData.Sides[a].Side=asrLeft then 377 378 else if ChildData.Sides[a].Side=asrCenter then 379 NewSpace:=0; 380 ChildData.Sides[a].Space:=NewSpace; 381 end else begin 382 NewSpace:=ChildData.Borders[a]; 383 if ChildData.Sides[a].Side=asrTop then begin 384 NewSpace:=Max(NewSpace,WinControl.ChildSizing.VerticalSpacing); 385 if a=akRight then 386 NewSpace:=Max(NewSpace,SiblingData.Borders[akLeft]) 387 else 388 NewSpace:=Max(NewSpace,SiblingData.Borders[akTop]); 389 end else if ChildData.Sides[a].Side=asrBottom then 390 391 else if ChildData.Sides[a].Side=asrCenter then 392 NewSpace:=0; 393 ChildData.Sides[a].Space:=NewSpace; 394 end; 395 end else if a in Child.Anchors then begin 396 // anchored to parent via BaseBounds 397 if a in [akLeft,akTop] then begin 398 ChildData.Sides[a].Side:=asrRight; 399 end else begin 400 ChildData.Sides[a].Side:=asrLeft; 401 end; 402 case a of 403 akTop: ChildData.Sides[a].Space:=ChildData.BaseBounds.Top; 404 akLeft: ChildData.Sides[a].Space:=ChildData.BaseBounds.Left; 405 akRight: ChildData.Sides[a].Space:= 406 ChildData.BaseParentClientSize.cx-ChildData.BaseBounds.Right; 407 akBottom: ChildData.Sides[a].Space:= 408 ChildData.BaseParentClientSize.cy-ChildData.BaseBounds.Bottom; 409 end; 410 end else begin 411 // not anchored => use borderspacing 412 if a in [akLeft,akTop] then 413 ChildData.Sides[a].Side:=asrRight 414 else 415 ChildData.Sides[a].Side:=asrLeft; 416 if a in [akLeft,akRight] then begin 417 ChildData.Sides[a].Space:= 418 Max(WinControl.ChildSizing.LeftRightSpacing, 419 ChildData.Borders[a]); 420 end else begin 421 ChildData.Sides[a].Space:= 422 Max(WinControl.ChildSizing.TopBottomSpacing, 423 ChildData.Borders[a]); 424 end; 425 inc(ChildData.Sides[a].Space,AdjustedClientBorders[a]); 426 end; 427 end; 428 end; 429end; 430 431function TAutoSizeCtrlData.ComputePositions: boolean; 432type 433 TComputeResult = ( 434 crSuccess, 435 crCircle, 436 crFixedCircled 437 ); 438 439 function ComputePosition(ChildData: TAutoSizeCtrlData; Side: TAnchorKind; 440 Direction: TAutoSizeSideDistDirection): TComputeResult; 441 var 442 OppositeSide: TAnchorKind; 443 NewDist: LongInt; 444 SiblingData: TAutoSizeCtrlData; 445 NeededSiblingSides: TAnchors; 446 a: TAnchorKind; 447 Child: TControl; 448 IsSideLeftTop, IsOutwards, IsParentInwards: boolean; 449 CurAnchors: TAnchors; 450 CurSize: LongInt; 451 FoundSides: TAnchors; 452 AddPreferredSize: Boolean; 453 begin 454 if ChildData.Sides[Side].DistanceState[Direction] 455 in [assdfValid,assdfUncomputable] 456 then 457 exit(crSuccess); // already computed 458 if ChildData.Sides[Side].DistanceState[Direction]=assdfComputing then begin 459 {$IFNDEF DisableChecks} 460 DebugLn(['TAutoSizeCtrlData.ComputePositions.ComputePosition CIRCLE detected ',DbgSName(ChildData.Control),' ',dbgs(Side),' ',AutoSizeSideDistDirectionNames[Direction]]); 461 {$ENDIF} 462 exit(crCircle); // there is a circle 463 end; 464 if ChildData.Sides[Side].DistanceState[Direction]<>assdfInvalid then 465 raise Exception.Create('TAutoSizeCtrlData.ComputePositions.ComputePosition <>assdfInvalid'); 466 467 // mark as computing 468 ChildData.Sides[Side].DistanceState[Direction]:=assdfComputing; 469 OppositeSide:=OppositeAnchor[Side]; 470 471 // try to find good distances to the client area for this side 472 Child:=ChildData.Control; 473 CurAnchors:=Child.Anchors; 474 if Child.Align in [alLeft,alTop,alRight,alBottom,alClient] then 475 CurAnchors:=CurAnchors+AnchorAlign[Child.Align]; 476 if (Side in CurAnchors) then begin 477 // this side is anchored 478 SiblingData:=ChildData.Sides[Side].CtrlData; 479 NewDist:=0; 480 if (SiblingData=nil) or (SiblingData=Self) then begin 481 // this side is anchored to parent 482 // Note: SiblingData=nil can happen, if the reference control 483 // is not visible => use parent as default anchor 484 case ChildData.Sides[Side].Side of 485 asrLeft,asrRight: // asrTop=asrLeft,asrBottom=asrRight 486 begin 487 IsSideLeftTop:=(Side in [akLeft,akTop]); 488 IsOutwards:=(Direction=assddLeftTop)=IsSideLeftTop; 489 IsParentInwards:=(SiblingData=nil) 490 or ((ChildData.Sides[Side].Side=asrLeft)=IsSideLeftTop); 491 if not IsParentInwards then begin 492 // for example: left side is anchored to right side of parent 493 //DebugLn(['ComputePosition ',DbgSName(Child),' Side=',dbgs(Side),' parent outside anchored, Direction=',AutoSizeSideDistDirectionNames[Direction],' => assdfUncomputable']); 494 ChildData.Sides[Side].DistanceState[Direction]:=assdfUncomputable; 495 end else if IsOutwards then begin 496 // for example: left side is anchored to left side of parent 497 // and left distance is needed 498 ChildData.Sides[Side].Distance[Direction]:=ChildData.Sides[Side].Space; 499 ChildData.Sides[Side].DistanceState[Direction]:=assdfValid; 500 end else begin 501 // for example: left side is anchored to left side of parent, 502 // right distance is needed 503 AddPreferredSize:=true; 504 if OppositeSide in CurAnchors then begin 505 // compute opposite side first 506 Result:=ComputePosition(ChildData,OppositeSide,Direction); 507 if Result<>crSuccess then begin 508 {$IFNDEF DisableChecks} 509 DebugLn(['ComputePosition FAILED opposite side: ',DbgSName(Child),' ',dbgs(Side),' ',AutoSizeSideDistDirectionNames[Direction]]); 510 {$ENDIF} 511 exit; 512 end; 513 if ChildData.Sides[OppositeSide].DistanceState[Direction]<>assdfValid 514 then begin 515 ChildData.Sides[Side].DistanceState[Direction]:=assdfUncomputable; 516 exit; 517 end; 518 NewDist:=ChildData.Sides[OppositeSide].Distance[Direction]; 519 if (ChildData.Sides[OppositeSide].CtrlData<>nil) 520 and (ChildData.Sides[OppositeSide].CtrlData<>Self) 521 then begin 522 // opposite side is anchored to a sibling 523 if ((OppositeSide in [akLeft,akTop]) 524 and (ChildData.Sides[OppositeSide].Side<>asrRight)) 525 or ((OppositeSide in [akRight,akBottom]) 526 and (ChildData.Sides[OppositeSide].Side<>asrLeft)) 527 then 528 AddPreferredSize:=false; 529 end; 530 end else begin 531 NewDist:=ChildData.Sides[OppositeSide].Space; 532 end; 533 if AddPreferredSize then begin 534 if Side in [akLeft,akRight] then 535 inc(NewDist,ChildData.PreferredSize[asboHorizontal]) 536 else 537 inc(NewDist,ChildData.PreferredSize[asboVertical]); 538 end; 539 ChildData.Sides[Side].Distance[Direction]:=NewDist; 540 ChildData.Sides[Side].DistanceState[Direction]:=assdfValid; 541 end; 542 end; 543 asrCenter: 544 begin 545 //DebugLn(['ComputePosition ',DbgSName(Child),' Side=',dbgs(Side),' parent anchored, Direction=',AutoSizeSideDistDirectionNames[Direction],' => assdfUncomputable']); 546 ChildData.Sides[Side].DistanceState[Direction]:=assdfUncomputable; 547 end; 548 else 549 RaiseGDBException(''); 550 end; 551 end else begin 552 // this side is anchored to a sibling 553 // first compute needed sides of sibling 554 NeededSiblingSides:=[]; 555 case ChildData.Sides[Side].Side of 556 asrLeft: // Note: asrLeft=asrTop 557 if Side in [akLeft,akRight] then begin 558 Include(NeededSiblingSides,akLeft); 559 end else begin 560 Include(NeededSiblingSides,akTop); 561 end; 562 asrRight: // Note: asrRight=asrBottom 563 if Side in [akLeft,akRight] then begin 564 Include(NeededSiblingSides,akRight); 565 end else begin 566 Include(NeededSiblingSides,akBottom); 567 end; 568 asrCenter: 569 if Side in [akLeft,akRight] then begin 570 NeededSiblingSides:=NeededSiblingSides+[akLeft,akRight]; 571 end else begin 572 NeededSiblingSides:=NeededSiblingSides+[akTop,akBottom]; 573 end; 574 end; 575 FoundSides:=[]; 576 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 577 if a in NeededSiblingSides then begin 578 Result:=ComputePosition(SiblingData,a,Direction); 579 if (Result=crCircle) 580 and ((Child.Align in [alNone,alCustom]) 581 or (not (Side in AnchorAlign[Child.Align]))) then 582 begin 583 // there is a circle and it can be broken => break it 584 {$IFNDEF DisableChecks} 585 DebugLn(['ComputePosition breaking CIRCLE ',DbgSName(Child),' - ',DbgSName(SiblingData.Control),' ',dbgs(a),' ',AutoSizeSideDistDirectionNames[Direction]]); 586 {$ENDIF} 587 Child.Anchors:=Child.Anchors-[Side]; 588 Result:=crFixedCircled; 589 end; 590 if Result<>crSuccess then begin 591 {$IFNDEF DisableChecks} 592 DebugLn(['ComputePosition FAILED sibling dependency: ',DbgSName(Child),' - ',DbgSName(SiblingData.Control),' Side=',dbgs(Side),' a=',dbgs(a),' ',AutoSizeSideDistDirectionNames[Direction]]); 593 {$ENDIF} 594 exit; 595 end; 596 if SiblingData.Sides[a].DistanceState[Direction]=assdfValid then 597 Include(FoundSides,a); 598 end; 599 end; 600 if FoundSides=[] then begin 601 ChildData.Sides[Side].DistanceState[Direction]:=assdfUncomputable; 602 exit(crSuccess); 603 end; 604 605 // this side is anchored to a sibling and some needed sibling sides are valid 606 case ChildData.Sides[Side].Side of 607 asrLeft,asrRight: // asrLeft=asrTop,asrRight=asrBottom 608 begin 609 if ChildData.Sides[Side].Side=asrLeft then begin 610 if Side in [akLeft,akRight] then 611 NewDist:=SiblingData.Sides[akLeft].Distance[Direction] 612 else 613 NewDist:=SiblingData.Sides[akTop].Distance[Direction]; 614 end else begin 615 if Side in [akLeft,akRight] then 616 NewDist:=SiblingData.Sides[akRight].Distance[Direction] 617 else 618 NewDist:=SiblingData.Sides[akBottom].Distance[Direction]; 619 end; 620 if (Direction=assddLeftTop)=(Side in [akLeft,akTop]) then 621 inc(NewDist,ChildData.Sides[Side].Space) 622 else 623 dec(NewDist,ChildData.Sides[Side].Space); 624 //DebugLn(['ComputePosition ',DbgSName(Child),' - ',DbgSName(SiblingData.Control),' Side=',dbgs(Side),' ',AutoSizeSideDistDirectionNames[Direction],' NewDist=',NewDist]); 625 end; 626 asrCenter: 627 if Side in [akLeft,akRight] then begin 628 if FoundSides=[akLeft,akRight] then begin 629 NewDist:=((SiblingData.Sides[akLeft].Distance[Direction] 630 +SiblingData.Sides[akRight].Distance[Direction]) div 2); 631 end else if (FoundSides=[akLeft]) then begin 632 NewDist:=SiblingData.Sides[akLeft].Distance[Direction] 633 +(SiblingData.PreferredSize[asboHorizontal] div 2); 634 end else begin 635 NewDist:=SiblingData.Sides[akRight].Distance[Direction] 636 -(SiblingData.PreferredSize[asboHorizontal] div 2); 637 end; 638 //DebugLn(['ComputePosition BEFORE ',DbgSName(Child),' center to ',DbgSName(SiblingData.Control),' Side=',dbgs(Side),' FoundSides=',dbgs(FoundSides),' NewDist=',NewDist,' Direction=',AutoSizeSideDistDirectionNames[Direction],' PreferredSize=',ChildData.PreferredSize[asboHorizontal]]); 639 dec(NewDist,ChildData.PreferredSize[asboHorizontal] div 2); 640 // use at least the size of the child 641 if (Side=akLeft)=(Direction=assddRightBottom) then 642 NewDist:=Max(NewDist,ChildData.PreferredSize[asboHorizontal]); 643 //DebugLn(['ComputePosition AFTER ',DbgSName(Child),' center to ',DbgSName(SiblingData.Control),' Side=',dbgs(Side),' FoundSides=',dbgs(FoundSides),' NewDist=',NewDist,' Direction=',AutoSizeSideDistDirectionNames[Direction],' PreferredSize=',ChildData.PreferredSize[asboHorizontal]]); 644 end else begin 645 if FoundSides=[akTop,akBottom] then begin 646 NewDist:=((SiblingData.Sides[akTop].Distance[Direction] 647 +SiblingData.Sides[akBottom].Distance[Direction]) div 2); 648 end else if (FoundSides=[akTop]) then begin 649 NewDist:=SiblingData.Sides[akTop].Distance[Direction] 650 +(SiblingData.PreferredSize[asboVertical] div 2); 651 end else begin 652 NewDist:=SiblingData.Sides[akBottom].Distance[Direction] 653 -(SiblingData.PreferredSize[asboVertical] div 2); 654 end; 655 dec(NewDist,ChildData.PreferredSize[asboVertical] div 2); 656 // use at least the size of the child 657 if (Side=akTop)=(Direction=assddRightBottom) then 658 NewDist:=Max(NewDist,ChildData.PreferredSize[asboVertical]); 659 end; 660 end; 661 ChildData.Sides[Side].Distance[Direction]:=NewDist; 662 ChildData.Sides[Side].DistanceState[Direction]:=assdfValid; 663 664 if (OppositeSide in CurAnchors) 665 and ((Direction=assddLeftTop) <> (Side in [akLeft,akTop])) then begin 666 // the opposite side is anchored too 667 // use the maximum of both anchors 668 Result:=ComputePosition(ChildData,OppositeSide,Direction); 669 if Result<>crSuccess then begin 670 //DebugLn(['ComputePosition (side anchored) FAILED computing opposite side: ',DbgSName(Child),' - ',DbgSName(SiblingData.Control),' Side=',dbgs(Side),' ',AutoSizeSideDistDirectionNames[Direction]]); 671 exit; 672 end; 673 case ChildData.Sides[OppositeSide].DistanceState[Direction] of 674 assdfValid: 675 begin 676 // opposite side +- preferred size 677 NewDist:=ChildData.Sides[OppositeSide].Distance[Direction]; 678 CurSize:=0; 679 if ((OppositeSide in [akLeft,akTop]) 680 and (ChildData.Sides[OppositeSide].Side=asrRight)) 681 or ((OppositeSide in [akRight,akBottom]) 682 and (ChildData.Sides[OppositeSide].Side=asrLeft)) 683 then begin 684 if Side in [akLeft,akRight] then 685 CurSize:=ChildData.PreferredSize[asboHorizontal] 686 else 687 CurSize:=ChildData.PreferredSize[asboVertical]; 688 end; 689 inc(NewDist,CurSize); 690 // check if opposite side needs a bigger distance 691 if ChildData.Sides[Side].Distance[Direction]<NewDist then 692 ChildData.Sides[Side].Distance[Direction]:=NewDist; 693 end; 694 assdfUncomputable: ; // no problem, there is already a value 695 else 696 raise Exception.Create('TAutoSizeCtrlData.ComputePositions.ComputePosition assdfValid,assdfUncomputable'); 697 end; 698 end; 699 end; 700 end else if (OppositeSide in CurAnchors) 701 and ((Direction=assddLeftTop) <> (Side in [akLeft,akTop])) then begin 702 // this side is not anchored, but the opposite is 703 // e.g. control is anchored to the right 704 // => compute the opposite side first 705 Result:=ComputePosition(ChildData,OppositeSide,Direction); 706 if Result<>crSuccess then begin 707 //DebugLn(['ComputePosition (side not anchored) FAILED computing opposite side: ',DbgSName(Child),' - ',DbgSName(SiblingData.Control),' Side=',dbgs(Side),' ',AutoSizeSideDistDirectionNames[Direction]]); 708 exit; 709 end; 710 case ChildData.Sides[OppositeSide].DistanceState[Direction] of 711 assdfValid: 712 begin 713 // opposite side +- preferred size 714 NewDist:=ChildData.Sides[OppositeSide].Distance[Direction]; 715 if Side in [akLeft,akRight] then 716 CurSize:=ChildData.PreferredSize[asboHorizontal] 717 else 718 CurSize:=ChildData.PreferredSize[asboVertical]; 719 inc(NewDist,CurSize); 720 ChildData.Sides[Side].Distance[Direction]:=NewDist; 721 ChildData.Sides[Side].DistanceState[Direction]:=assdfValid; 722 end; 723 assdfUncomputable: 724 ChildData.Sides[Side].DistanceState[Direction]:=assdfUncomputable; 725 else 726 raise Exception.Create('TAutoSizeCtrlData.ComputePositions.ComputePosition assdfValid,assdfUncomputable'); 727 end; 728 end else begin 729 // not anchored 730 if (Direction=assddLeftTop) = (Side in [akLeft,akTop]) then begin 731 NewDist:=ChildData.Sides[Side].Space; 732 ChildData.Sides[Side].Distance[Direction]:=NewDist; 733 ChildData.Sides[Side].DistanceState[Direction]:=assdfValid; 734 end else begin 735 //DebugLn(['ComputePosition ',DbgSName(Child),' Side=',dbgs(Side),' not anchored, Direction=',AutoSizeSideDistDirectionNames[Direction],' => assdfUncomputable']); 736 ChildData.Sides[Side].DistanceState[Direction]:=assdfUncomputable; 737 end; 738 end; 739 if not (ChildData.Sides[Side].DistanceState[Direction] 740 in [assdfUncomputable,assdfValid]) 741 then begin 742 {$IFNDEF DisableChecks} 743 DebugLn(['TAutoSizeCtrlData.ComputePositions.ComputePosition ',DbgSName(Child),' Side=',dbgs(Side),' Direction=',AutoSizeSideDistDirectionNames[Direction]]); 744 {$ENDIF} 745 raise Exception.Create('TAutoSizeCtrlData.ComputePositions.ComputePosition assdfValid,assdfUncomputable'); 746 end; 747 Result:=crSuccess; 748 end; 749 750var 751 i: Integer; 752 Child: TControl; 753 ChildData: TAutoSizeCtrlData; 754 a: TAnchorKind; 755begin 756 Result:=false; 757 // for every side try to find a good distance to the client area 758 for i:=0 to ChildCount-1 do begin 759 Child:=WinControl.Controls[i]; 760 ChildData:=Children[Child]; 761 if not ChildData.Visible then continue; 762 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 763 if ComputePosition(ChildData,a,assddLeftTop)<>crSuccess then begin 764 {$IFNDEF DisableChecks} 765 DebugLn(['TAutoSizeCtrlData.ComputePositions Failed to compute LeftTop ',DbgSName(Child),' ',dbgs(a)]); 766 {$ENDIF} 767 exit; 768 end; 769 if ComputePosition(ChildData,a,assddRightBottom)<>crSuccess then begin 770 {$IFNDEF DisableChecks} 771 DebugLn(['TAutoSizeCtrlData.ComputePositions Failed to compute RightBottom ',DbgSName(Child),' ',dbgs(a)]); 772 {$ENDIF} 773 exit; 774 end; 775 end; 776 end; 777 //WriteDebugReport('ComputePositons',' '); 778 Result:=true; 779end; 780 781constructor TAutoSizeCtrlData.Create(AControl: TControl; IsParent: boolean); 782const 783 BigInteger = High(Integer) div 4; 784var 785 CurBorders: TRect; 786 a: TAnchorKind; 787 AdjustedClientRect: TRect; 788 r: TRect; 789begin 790 //DebugLn(['TAutoSizeCtrlData.Create ',DbgSName(AControl)]); 791 Control:=AControl; 792 if Control is TWinControl then begin 793 WinControl:=TWinControl(Control); 794 ChildCount:=WinControl.ControlCount; 795 end else 796 ChildCount:=0; 797 Visible:=Control.IsControlVisible; 798 Control.BorderSpacing.GetSpaceAround(CurBorders); 799 Borders[akLeft]:=CurBorders.Left; 800 Borders[akTop]:=CurBorders.Top; 801 Borders[akRight]:=CurBorders.Right; 802 Borders[akBottom]:=CurBorders.Bottom; 803 BaseBounds:=Control.BaseBounds; 804 if (BaseBounds.Left=BaseBounds.Right) 805 and (BaseBounds.Top=BaseBounds.Bottom) then 806 BaseBounds:=Control.BoundsRect; 807 BaseParentClientSize:=Control.BaseParentClientSize; 808 809 if (WinControl<>nil) and IsParent then begin 810 AdjustedClientRect:=Rect(0,0,BigInteger,BigInteger); 811 WinControl.AdjustClientRect(AdjustedClientRect); 812 AdjustedClientBorders[akLeft]:=AdjustedClientRect.Left; 813 AdjustedClientBorders[akTop]:=AdjustedClientRect.Top; 814 AdjustedClientBorders[akRight]:=BigInteger-AdjustedClientRect.Right; 815 AdjustedClientBorders[akBottom]:=BigInteger-AdjustedClientRect.Bottom; 816 end else begin 817 for a:=low(TAnchorKind) to high(TAnchorKind) do 818 AdjustedClientBorders[a]:=0; 819 if (BaseParentClientSize.cx=0) and (BaseParentClientSize.cy=0) then begin 820 r:=Control.Parent.GetLogicalClientRect; 821 BaseParentClientSize.cx:=r.Right; 822 BaseParentClientSize.cy:=r.Bottom; 823 end; 824 end; 825end; 826 827destructor TAutoSizeCtrlData.Destroy; 828begin 829 Clear; 830 FreeAndNil(FChilds); 831 inherited Destroy; 832end; 833 834procedure TAutoSizeCtrlData.Clear; 835begin 836 ClearSides; 837 if FChilds<>nil then 838 FChilds.FreeAndClear; 839end; 840 841procedure TAutoSizeCtrlData.DoMoveNonAlignedChildren(Side: TAnchorKind; 842 var MoveDiff: integer; FindMinimum: boolean); 843var 844 i: Integer; 845 Child: TControl; 846 MoveDiffValid: Boolean; 847 ChildData: TAutoSizeCtrlData; 848 AddSpace: LongInt; 849 Position: Integer; 850begin 851 MoveDiffValid:=false; 852 for i:=0 to ChildCount-1 do begin 853 Child:=WinControl.Controls[i]; 854 ChildData:=Children[Child]; 855 if not ChildData.Visible then continue; 856 if IsNotAligned(Child, Side) then begin 857 // this is a non aligned control 858 //DebugLn(['TAutoSizeCtrlData.DoMoveNonAlignedChilds Child=',DbgSName(Child),' Side=',dbgs(Side)]); 859 if FindMinimum then begin 860 AddSpace:=Child.BorderSpacing.GetSideSpace(Side); 861 if Side=akLeft then 862 AddSpace:=Max(AddSpace,WinControl.ChildSizing.LeftRightSpacing) 863 else 864 AddSpace:=Max(AddSpace,WinControl.ChildSizing.TopBottomSpacing); 865 Position:=Child.GetSidePosition(Side) 866 -AddSpace 867 -AdjustedClientBorders[Side]; 868 if (not MoveDiffValid) or (MoveDiff>Position) then 869 begin 870 MoveDiff:=Position; 871 MoveDiffValid:=true; 872 end; 873 end else begin 874 SetFixedLeftTop(ChildData,Side,Child.GetSidePosition(Side)-MoveDiff); 875 end; 876 end else if (Child.Align=alCustom) 877 and (Side in AnchorAlign[alCustom]) then begin 878 if FindMinimum then begin 879 // no auto move 880 end else begin 881 // don't move alCustom, but use them for bounds computation 882 SetFixedLeftTop(ChildData,Side,Child.GetSidePosition(Side)); 883 end; 884 end; 885 end; 886end; 887 888procedure TAutoSizeCtrlData.SetupNonAlignedChildren(MoveNonAlignedChildrenLeft, 889 MoveNonAlignedChildrenTop: boolean); 890var 891 ChildSizing: TControlChildSizing; 892 Box: TAutoSizeBox; 893 y: Integer; 894 RowBox: TAutoSizeBox; 895 x: Integer; 896 ControlBox: TAutoSizeBox; 897 Child: TControl; 898 NewBounds: TRect; 899 ChildData: TAutoSizeCtrlData; 900 MoveDiff: Integer; 901 AlignList: TFPList; 902 r: TRect; 903 i: Integer; 904begin 905 if ChildCount=0 then exit; 906 if WinControl.ChildSizing.Layout=cclNone then begin 907 // move the non-aligned controls (i.e. not aligned or fixed anchored) 908 // Find the leftmost and topmost of those controls 909 MoveDiff:=0; 910 DoMoveNonAlignedChildren(akLeft,MoveDiff,true); 911 //DebugLn(['TAutoSizeCtrlData.ComputePreferredClientArea akLeft MoveDiff=',MoveDiff]); 912 if not MoveNonAlignedChildrenLeft then MoveDiff:=0; 913 DoMoveNonAlignedChildren(akLeft,MoveDiff,false); 914 MoveDiff:=0; 915 DoMoveNonAlignedChildren(akTop,MoveDiff,true); 916 //DebugLn(['TAutoSizeCtrlData.ComputePreferredClientArea akTop MoveDiff=',MoveDiff]); 917 if not MoveNonAlignedChildrenTop then MoveDiff:=0; 918 DoMoveNonAlignedChildren(akTop,MoveDiff,false); 919 end else begin 920 // there is an automatic layout for non aligned children 921 // use the layout engine, but with static values 922 ChildSizing:=nil; 923 Box:=nil; 924 AlignList:=TFPList.Create; 925 try 926 for i:=0 to WinControl.ControlCount-1 do begin 927 Child:=WinControl.Controls[i]; 928 if Child.IsControlVisible and IsNotAligned(Child) then 929 AlignList.Add(Child); 930 end; 931 if AlignList.Count=0 then exit; 932 ChildSizing:=TControlChildSizing.Create(nil); 933 Box:=TAutoSizeBox.Create; 934 // copy current ChildSizing ... 935 ChildSizing.Assign(WinControl.ChildSizing); 936 // ... and change it to static layout (i.e. independent of parent size) 937 ChildSizing.ShrinkHorizontal:=crsAnchorAligning; 938 ChildSizing.EnlargeHorizontal:=crsAnchorAligning; 939 ChildSizing.ShrinkVertical:=crsAnchorAligning; 940 ChildSizing.EnlargeVertical:=crsAnchorAligning; 941 // compute static layout 942 r:=WinControl.GetLogicalClientRect; 943 Box.AlignControlsInTable(AlignList,ChildSizing,WinControl.BiDiMode, 944 r.Right,r.Bottom,false); 945 //Box.WriteDebugReport('TAutoSizeCtrlData.SetupNonAlignedChilds'); 946 // transfer the coords of the layout 947 for y:=0 to Box.ChildCount[asboVertical]-1 do begin 948 RowBox:=Box.Children[asboVertical][y]; 949 for x:=0 to RowBox.ChildCount[asboHorizontal]-1 do begin 950 ControlBox:=RowBox.Children[asboHorizontal][x]; 951 Child:=ControlBox.Control; 952 if Child=nil then continue; 953 NewBounds:=ControlBox.NewControlBounds; 954 //DebugLn(['TAutoSizeCtrlData.SetupNonAlignedChilds ',DbgSName(Child),' ',dbgs(NewBounds)]); 955 ChildData:=Children[Child]; 956 // set left 957 SetFixedLeftTop(ChildData,akLeft,NewBounds.Left); 958 // set width 959 ChildData.PreferredSize[asboHorizontal]:=NewBounds.Right-NewBounds.Left; 960 // set top 961 SetFixedLeftTop(ChildData,akTop,NewBounds.Top); 962 // set height 963 ChildData.PreferredSize[asboVertical]:=NewBounds.Bottom-NewBounds.Top; 964 end; 965 end; 966 finally 967 ChildSizing.Free; 968 Box.Free; 969 AlignList.Free; 970 end; 971 end; 972end; 973 974procedure TAutoSizeCtrlData.ComputePreferredClientArea( 975 MoveNonAlignedChildrenLeft, MoveNonAlignedChildrenTop: boolean; out 976 MoveNonAlignedToLeft, MoveNonAlignedToTop, PreferredClientWidth, 977 PreferredClientHeight: integer); 978{ if MoveNonAlignedChilds=true then all non-aligned children will be moved in 979 parallel, so that at least one child is positioned left most and one child 980 is positioned top most. 981 982 Type of controls: 983 1. layout: the left and top side of the control has only designed position 984 and Parent.ChildSizing.Layout <> cclNone. 985 That means: Align=alNone, Anchors=[akLeft,akTop], 986 AnchorSide[akLeft/akTop].Control=nil, Parent.ChildSizing.Layout <> cclNone 987 2. non-aligned: the left+top side of the control has only a designed position. 988 That means: Align=alNone, akLeft is set, AnchorSide[akLeft].Control=nil 989 and Parent.ChildSizing.Layout=cclNone 990 Same for akTop. 991 3. Aligned: Align<>alNone 992 These are put consecutively into the remaining space. 993 BorderSpacing and AdjustClientRect defines the space. 994 The aligned sides automatically set the Anchors and the AnchorSide.Control 995 to nil. 996 alLeft,alRight,alTop,alBottom have one free side, which can be anchored. 997 4. centered: akLeft and akRight are not set 998 5. one side anchored: akLeft is set and akRight is not 999 OR akRight is set and akLeft is not 1000 5.1 anchored to a side (asrLeft,asrRight) 1001 5.2 anchored to a center (asrCenter) 1002 6. both sides anchored: akLeft and akRight not 1003 Note: asrCenter is not allowed here 1004 1005 Circles and invalid combinations will be automatically fixed. 1006} 1007 1008 procedure InitPreferredSizes; 1009 var 1010 i: Integer; 1011 Child: TControl; 1012 ChildData: TAutoSizeCtrlData; 1013 CurAnchors: TAnchors; 1014 CurPreferredWidth: integer; 1015 CurPreferredHeight: integer; 1016 UseCurrentWidth: Boolean; 1017 UseCurrentHeight: Boolean; 1018 NewWidth: LongInt; 1019 NewHeight: LongInt; 1020 begin 1021 for i:=0 to ChildCount-1 do begin 1022 Child:=WinControl.Controls[i]; 1023 ChildData:=Children[Child]; 1024 if ChildData.Visible then begin 1025 CurAnchors:=Child.Anchors; 1026 if Child.Align in [alLeft,alRight,alTop,alBottom,alClient] then 1027 CurAnchors:=CurAnchors+AnchorAlign[Child.Align]; 1028 // check if the current Width and/or Height of the Child control can be 1029 // used. For example: The current Width can be used, if it is independent 1030 // of the parent's width. 1031 UseCurrentWidth:=true; 1032 if Child.AutoSize 1033 or ([akLeft,akRight]*CurAnchors=[akLeft,akRight]) then 1034 UseCurrentWidth:=false; 1035 UseCurrentHeight:=true; 1036 if Child.AutoSize 1037 or ([akTop,akBottom]*CurAnchors=[akTop,akBottom]) then 1038 UseCurrentHeight:=false; 1039 1040 if (not UseCurrentWidth) or (not UseCurrentHeight) then 1041 Child.GetPreferredSize(CurPreferredWidth,CurPreferredHeight,true,true); 1042 1043 //if Child.Name='OtherInfoGroupBox' then debugln(['InitPreferredSizes ',DbgSName(Child),' Bounds=',dbgs(Child.BoundsRect),' Anchors=',dbgs(Child.Anchors),' CurAnchors=',dbgs(CurAnchors),' UseW=',UseCurrentWidth,' UseH=',UseCurrentHeight,' Pref=',CurPreferredWidth,'x',CurPreferredHeight]); 1044 if UseCurrentWidth then 1045 NewWidth:=Child.Width 1046 else if (CurPreferredWidth>0) 1047 or ((CurPreferredWidth=0) and (csAutoSize0x0 in Child.ControlStyle)) then 1048 NewWidth:=CurPreferredWidth 1049 else 1050 NewWidth:=Max(1,Child.GetDefaultWidth); 1051 NewWidth:=Child.Constraints.MinMaxWidth(NewWidth); 1052 1053 if UseCurrentHeight then 1054 NewHeight:=Child.Height 1055 else if (CurPreferredHeight>0) 1056 or ((CurPreferredHeight=0) and (csAutoSize0x0 in Child.ControlStyle)) then 1057 NewHeight:=CurPreferredHeight 1058 else 1059 NewHeight:=Max(1,Child.GetDefaultHeight); 1060 NewHeight:=Child.Constraints.MinMaxHeight(NewHeight); 1061 end else begin 1062 NewWidth:=0; 1063 NewHeight:=0; 1064 end; 1065 1066 ChildData.PreferredSize[asboHorizontal]:=NewWidth; 1067 ChildData.PreferredSize[asboVertical]:=NewHeight; 1068 //DebugLn(['InitPreferredSizes Child=',DbgSName(Child),' PrefSize=',NewWidth,',',NewHeight]); 1069 end; 1070 end; 1071 1072 procedure GetSideAnchor(ChildData: TAutoSizeCtrlData; a: TAnchorKind); 1073 var 1074 Child: TControl; 1075 ReferenceControl: TControl; 1076 ReferenceSide: TAnchorSideReference; 1077 Position: Integer; 1078 begin 1079 Child:=ChildData.Control; 1080 Child.AnchorSide[a].GetSidePosition(ReferenceControl,ReferenceSide,Position); 1081 //DebugLn(['GetSideAnchor Child=',DbgSName(Child),', a=',dbgs(a),' ReferenceControl=',DbgSName(ReferenceControl),' ReferenceSide=',dbgs(a,ReferenceSide)]); 1082 if ReferenceControl=nil then begin 1083 // invalid anchor 1084 // => anchor to parent 1085 ChildData.Sides[a].CtrlData:=Self; 1086 if a in [akLeft,akTop] then 1087 ChildData.Sides[a].Side:=asrLeft 1088 else 1089 ChildData.Sides[a].Side:=asrRight; 1090 exit; 1091 end; 1092 if ReferenceControl=Control then 1093 ChildData.Sides[a].CtrlData:=Self 1094 else if (ReferenceControl<>nil) and (ReferenceControl.Parent=Control) then 1095 ChildData.Sides[a].CtrlData:=Children[ReferenceControl]; 1096 ChildData.Sides[a].Side:=ReferenceSide; 1097 //if ChildData.Sides[a].CtrlData<>nil then DebugLn(['GetSideAnchor Child=',DbgSName(Child),', a=',dbgs(a),' ReferenceControl=',DbgSName(ChildData.Sides[a].CtrlData.Control),' ReferenceSide=',dbgs(a,ChildData.Sides[a].Side)]); 1098 end; 1099 1100var 1101 i: Integer; 1102 VisibleCount: Integer; 1103 Child: TControl; 1104 ChildData: TAutoSizeCtrlData; 1105 a: TAnchorKind; 1106 CurNeededClientWH: Integer; 1107begin 1108 PreferredClientWidth:=0; 1109 PreferredClientHeight:=0; 1110 MoveNonAlignedToLeft:=0; 1111 MoveNonAlignedToTop:=0; 1112 1113 if ChildCount=0 then exit; 1114 1115 // fix control properties 1116 // check if there are visible children 1117 VisibleCount:=0; 1118 for i:=0 to ChildCount-1 do begin 1119 Child:=WinControl.Controls[i]; 1120 FixControlProperties(Child); 1121 ChildData:=Children[Child]; 1122 if ChildData.Visible then 1123 inc(VisibleCount); 1124 end; 1125 //DebugLn(['TAutoSizeCtrlData.ComputePreferredClientArea ',DbgSName(Control),' VisibleCount=',VisibleCount]); 1126 if VisibleCount=0 then begin 1127 // nothing to do 1128 exit; 1129 end; 1130 1131 InitPreferredSizes; 1132 1133 repeat 1134 // init dependencies 1135 for i:=0 to ChildCount-1 do begin 1136 Child:=WinControl.Controls[i]; 1137 ChildData:=Children[Child]; 1138 ChildData.ClearSides; 1139 if not ChildData.Visible then continue; 1140 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 1141 ChildData.Sides[a].Side:=asrLeft; 1142 if (Child.Align in [alLeft,alRight,alTop,alBottom,alClient]) 1143 and (a in AnchorAlign[Child.Align]) then begin 1144 // this is an aligned side 1145 // => the dependencies will be setup later in AlignChilds 1146 end else if a in Child.Anchors then begin 1147 // this is an anchored side 1148 GetSideAnchor(ChildData,a); 1149 end else begin 1150 // this is a dangling side 1151 end; 1152 end; 1153 end; 1154 //WriteDebugReport('anchored',''); 1155 1156 SetupNonAlignedChildren(MoveNonAlignedChildrenLeft,MoveNonAlignedChildrenTop); 1157 //WriteDebugReport('nonaligned',''); 1158 // setup the dependencies for Aligned controls 1159 AlignChildren; 1160 //WriteDebugReport('aligned',''); 1161 1162 // setup space for dependencies 1163 SetupSpace; 1164 {$IFDEF VerboseAutoSizeCtrlData} 1165 WriteDebugReport('Space completed',''); 1166 {$ENDIF} 1167 1168 // calculate the needed positions for all children 1169 until ComputePositions; 1170 1171 {$IFDEF VerboseAutoSizeCtrlData} 1172 if WinControl.ClassName='TScrollBox' then 1173 WriteDebugReport('Positions completed',''); 1174 {$ENDIF} 1175 1176 // compute needed clientwidth/clientheight 1177 for i:=0 to ChildCount-1 do begin 1178 Child:=WinControl.Controls[i]; 1179 ChildData:=Children[Child]; 1180 if not ChildData.Visible then continue; 1181 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 1182 if (ChildData.Sides[a].DistanceState[assddLeftTop]=assdfValid) 1183 and (ChildData.Sides[a].DistanceState[assddRightBottom]=assdfValid) 1184 then begin 1185 CurNeededClientWH:=ChildData.Sides[a].Distance[assddLeftTop] 1186 +ChildData.Sides[a].Distance[assddRightBottom]; 1187 if a in [akLeft,akRight] then begin 1188 if PreferredClientWidth<CurNeededClientWH then 1189 PreferredClientWidth:=CurNeededClientWH; 1190 end else begin 1191 if PreferredClientHeight<CurNeededClientWH then 1192 PreferredClientHeight:=CurNeededClientWH; 1193 end; 1194 end; 1195 end; 1196 end; 1197 1198 // compute needed MoveNonAlignedToLeft,MoveNonAlignedToTop 1199 if MoveNonAlignedChildrenLeft or MoveNonAlignedChildrenTop then 1200 begin 1201 MoveNonAlignedToLeft:=Low(integer); 1202 MoveNonAlignedToTop:=Low(integer); 1203 for i:=0 to ChildCount-1 do 1204 begin 1205 Child:=WinControl.Controls[i]; 1206 ChildData:=Children[Child]; 1207 if not Child.IsControlVisible then continue; 1208 if IsNotAligned(Child, akLeft) then 1209 begin 1210 if MoveNonAlignedChildrenLeft 1211 and (ChildData.Sides[akLeft].DistanceState[assddLeftTop]=assdfValid) then 1212 MoveNonAlignedToLeft:=Max(MoveNonAlignedToLeft, 1213 Child.Left-ChildData.Sides[akLeft].Distance[assddLeftTop]); 1214 { the below is only correct, if PreferredClientWidth is realized. 1215 if (ChildData.Sides[akLeft].DistanceState[assddRightBottom]=assdfValid) then 1216 MoveNonAlignedToLeft:=Min(MoveNonAlignedToLeft, 1217 Child.Left 1218 -(PreferredClientWidth 1219 -ChildData.Sides[akLeft].Distance[assddRightBottom]));} 1220 end; 1221 if IsNotAligned(Child, akTop) then 1222 begin 1223 if MoveNonAlignedChildrenTop 1224 and (ChildData.Sides[akTop].DistanceState[assddLeftTop]=assdfValid) then 1225 MoveNonAlignedToTop:=Max(MoveNonAlignedToTop, 1226 Child.Top-ChildData.Sides[akTop].Distance[assddLeftTop]); 1227 { the below is only correct, if PreferredClientWidth is realized. 1228 if (ChildData.Sides[akTop].DistanceState[assddRightBottom]=assdfValid) then 1229 MoveNonAlignedToTop:=Min(MoveNonAlignedToTop, 1230 Child.Top 1231 -(PreferredClientHeight 1232 -ChildData.Sides[akTop].Distance[assddRightBottom]));} 1233 end; 1234 end; 1235 if MoveNonAlignedToLeft=Low(integer) then MoveNonAlignedToLeft:=0; 1236 if MoveNonAlignedToTop=Low(integer) then MoveNonAlignedToTop:=0; 1237 end; 1238 1239 {$IFDEF VerboseAutoSizeCtrlData} 1240 //if WinControl.ClassName='TProjectVersionInfoOptionsFrame' then 1241 DebugLn(['TAutoSizeCtrlData.ComputePreferredClientArea END ',DbgSName(Control),' PreferredClientWidth/height=',PreferredClientWidth,',',PreferredClientHeight]); 1242 {$ENDIF} 1243end; 1244 1245procedure TAutoSizeCtrlData.FixControlProperties(Child: TControl); 1246var 1247 a: TAnchorKind; 1248begin 1249 // check that all anchor-controls are siblings or the parent 1250 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 1251 if Child.AnchorSide[a].Control=nil then continue; 1252 if Child.AnchorSide[a].Control=Control then continue; 1253 if (Child.AnchorSide[a].Control=Child) 1254 or (Child.AnchorSide[a].Control.Parent<>Control) then begin 1255 {$IFNDEF DisableChecks} 1256 DebugLn(['TAutoSizeCtrlData.FixControlProperties ',DbgSName(Child),' a=',dbgs(a),' old=',DbgSName(Child.AnchorSide[a].Control),' new=nil']); 1257 {$ENDIF} 1258 Child.AnchorSide[a].Control:=nil; 1259 end; 1260 end; 1261 1262 if Child.Align in [alLeft,alRight,alTop,alBottom,alClient] then begin 1263 // the aligned sides must be anchored 1264 Child.Anchors:=Child.Anchors+AnchorAlign[Child.Align]; 1265 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 1266 if a in AnchorAlign[Child.Align] then begin 1267 // the aligned sides can not be anchored to a control 1268 {$IFNDEF DisableChecks} 1269 if Child.AnchorSide[a].Control<>nil then 1270 DebugLn(['TAutoSizeCtrlData.FixControlProperties aligned sides can not be anchored ',DbgSName(Child),' a=',dbgs(a),' old=',DbgSName(Child.AnchorSide[a].Control),' new=nil']); 1271 {$ENDIF} 1272 Child.AnchorSide[a].Control:=nil; 1273 end; 1274 if Child.AnchorSide[a].Side=asrCenter then begin 1275 // an aligned control can not be centered 1276 {$IFNDEF DisableChecks} 1277 DebugLn(['TAutoSizeCtrlData.FixControlProperties aligned control can not be centered ',DbgSName(Child),' a=',dbgs(a)]); 1278 {$ENDIF} 1279 Child.AnchorSide[a].Side:=asrLeft; 1280 if not (a in AnchorAlign[Child.Align]) then begin 1281 Child.Anchors:=Child.Anchors-[a]; 1282 Child.AnchorSide[a].Control:=nil; 1283 end; 1284 end; 1285 end; 1286 end else begin 1287 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 1288 if (a in Child.Anchors) 1289 and (Child.AnchorSide[a].Side=asrCenter) then begin 1290 if Child.AnchorSide[a].Control<>nil then begin 1291 // the control should be centered relative to another control 1292 if a in [akLeft,akTop] then begin 1293 // un-anchor the other side 1294 {$IFNDEF DisableChecks} 1295 if OppositeAnchor[a] in Child.Anchors then 1296 DebugLn(['TAutoSizeCtrlData.FixControlProperties control is center-anchored -> unanchor opposite side: ',DbgSName(Child),' a=',dbgs(a)]); 1297 {$ENDIF} 1298 Child.Anchors:=Child.Anchors-[OppositeAnchor[a]]; 1299 Child.AnchorSide[OppositeAnchor[a]].Control:=nil; 1300 end else begin 1301 // the centering was setup via the right,bottom 1302 // => normalize it to center via the Left,Top 1303 DebugLn(['TAutoSizeCtrlData.FixControlProperties control is center-anchored -> normalize it to use Left,Top instead of Bottom,Right: ',DbgSName(Child),' a=',dbgs(a)]); 1304 Child.AnchorSide[OppositeAnchor[a]].Control:=Child.AnchorSide[a].Control; 1305 Child.AnchorSide[OppositeAnchor[a]].Side:=asrCenter; 1306 Child.AnchorSide[a].Control:=nil; 1307 Child.AnchorSide[a].Side:=asrLeft; 1308 Child.Anchors:=Child.Anchors+[OppositeAnchor[a]]-[a]; 1309 end; 1310 end else begin 1311 // the asrCenter is not active => ok 1312 end; 1313 end; 1314 end; 1315 end; 1316end; 1317 1318procedure TAutoSizeCtrlData.ClearSides; 1319var 1320 a: TAnchorKind; 1321 d: TAutoSizeSideDistDirection; 1322begin 1323 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 1324 FillChar(Sides[a],SizeOf(TAutoSizeSideData),0); 1325 for d:=Low(TAutoSizeSideDistDirection) to High(TAutoSizeSideDistDirection) do 1326 Sides[a].DistanceState[d]:=assdfInvalid; 1327 end; 1328end; 1329 1330procedure TAutoSizeCtrlData.SetFixedLeftTop(ChildData: TAutoSizeCtrlData; 1331 Side: TAnchorKind; NewLeftTop: integer); 1332begin 1333 ChildData.Sides[Side].CtrlData:=Self; 1334 ChildData.Sides[Side].Side:=asrLeft; 1335 ChildData.Sides[Side].Space:=NewLeftTop; 1336 ChildData.Sides[Side].Distance[assddLeftTop]:=NewLeftTop; 1337 ChildData.Sides[Side].DistanceState[assddLeftTop]:=assdfValid; 1338end; 1339 1340procedure TAutoSizeCtrlData.WriteDebugReport(const Title, Prefix: string; 1341 OnlyVisible: boolean); 1342 1343 function GetDistance(a: TAnchorKind; d: TAutoSizeSideDistDirection): string; 1344 begin 1345 case Sides[a].DistanceState[d] of 1346 assdfInvalid: Result:='invalid'; 1347 assdfComputing: Result:='computing'; 1348 assdfUncomputable: Result:='uncomputable'; 1349 assdfValid: Result:=dbgs(Sides[a].Distance[d]); 1350 else Result:='???'; 1351 end; 1352 end; 1353 1354 function GetSideControl(a: TAnchorKind): string; 1355 begin 1356 if Sides[a].CtrlData<>nil then 1357 Result:=DbgSName(Sides[a].CtrlData.Control) 1358 else 1359 Result:='nil'; 1360 end; 1361 1362var 1363 a: TAnchorKind; 1364 i: Integer; 1365begin 1366 if Title<>'' then 1367 DebugLn([Prefix,'TAutoSizeCtrlData.WriteDebugReport ',Title]); 1368 DebugLn([Prefix,' Control=',DbgSName(Control),' ChildCount=',ChildCount,' Visible=',Visible,' Anchors=',dbgs(Control.Anchors),' Align=',dbgs(Control.Align)]); 1369 Debugln([Prefix,' PreferredSize=',PreferredSize[asboHorizontal],',',PreferredSize[asboVertical]]); 1370 DebugLn([Prefix,' Borders=l=',Borders[akLeft],',t=',Borders[akTop],',r=',Borders[akRight],',b=',Borders[akBottom]]); 1371 DebugLn([Prefix,' AdjustedClientBorders=l=',AdjustedClientBorders[akLeft],',t=',AdjustedClientBorders[akTop],',r=',AdjustedClientBorders[akRight],',b=',AdjustedClientBorders[akBottom]]); 1372 for a:=Low(TAnchorKind) to High(TAnchorKind) do begin 1373 DebugLn([Prefix,' Side ',dbgs(a),' Control=',GetSideControl(a), 1374 ' RefSide=',dbgs(a,Sides[a].Side), 1375 ' Space=',Sides[a].Space, 1376 ' DistLT=',GetDistance(a,assddLeftTop), 1377 ' DistBR=',GetDistance(a,assddRightBottom)]); 1378 end; 1379 for i:=0 to ChildCount-1 do 1380 if WinControl.Controls[i].Visible or (not OnlyVisible) then 1381 Children[WinControl.Controls[i]].WriteDebugReport('',Prefix+dbgs(i)+': '); 1382end; 1383 1384{ TAutoSizeBox } 1385 1386procedure TAutoSizeBox.SetControl(AControl: TControl); 1387var 1388 Border: TRect; 1389 AutoSize0x0: Boolean; 1390 IsPrefWidthValid: Boolean; 1391 IsPrefHeightValid: Boolean; 1392begin 1393 Control:=AControl; 1394 MinimumSize[asboHorizontal]:=Control.Constraints.EffectiveMinWidth; 1395 MinimumSize[asboVertical]:=Control.Constraints.EffectiveMinHeight; 1396 MaximumSize[asboHorizontal]:=Control.Constraints.EffectiveMaxWidth; 1397 MaximumSize[asboVertical]:=Control.Constraints.EffectiveMaxHeight; 1398 Control.GetPreferredSize(PreferredSize[asboHorizontal], 1399 PreferredSize[asboVertical], 1400 true, // without constraints 1401 true // with theme space 1402 ); 1403 //DebugLn(['TAutoSizeBox.SetControl ',DbgSName(Control),' ',PreferredSize[asboHorizontal]]); 1404 AutoSize0x0:=csAutoSize0x0 in Control.ControlStyle; 1405 IsPrefWidthValid:=(PreferredSize[asboHorizontal]>0) 1406 or (AutoSize0x0 and (PreferredSize[asboHorizontal]=0)); 1407 IsPrefHeightValid:=(PreferredSize[asboVertical]>0) 1408 or (AutoSize0x0 and (PreferredSize[asboVertical]=0)); 1409 1410 // apply constraints 1411 if IsPrefWidthValid then 1412 PreferredSize[asboHorizontal]:= 1413 Control.Constraints.MinMaxWidth(PreferredSize[asboHorizontal]); 1414 if IsPrefHeightValid then 1415 PreferredSize[asboVertical]:= 1416 Control.Constraints.MinMaxHeight(PreferredSize[asboVertical]); 1417 1418 if IsPrefWidthValid 1419 and (Control.AutoSize or (Control.BorderSpacing.CellAlignHorizontal<>ccaFill)) 1420 then begin 1421 // the control.width is fixed to its preferred width 1422 MaximumSize[asboHorizontal]:=PreferredSize[asboHorizontal]; 1423 end; 1424 if IsPrefHeightValid 1425 and (Control.AutoSize or (Control.BorderSpacing.CellAlignVertical<>ccaFill)) 1426 then begin 1427 // the control.height is fixed to its preferred height 1428 MaximumSize[asboVertical]:=PreferredSize[asboVertical]; 1429 end; 1430 1431 // if no preferred size is valid use the class defaults 1432 if not IsPrefWidthValid then 1433 PreferredSize[asboHorizontal]:= 1434 Control.Constraints.MinMaxWidth(Control.Scale96ToFont(Control.GetControlClassDefaultSize.CX)); 1435 if not IsPrefHeightValid then 1436 PreferredSize[asboVertical]:= 1437 Control.Constraints.MinMaxHeight(Control.Scale96ToFont(Control.GetControlClassDefaultSize.CY)); 1438 1439 //DebugLn(['TAutoSizeBox.SetControl ',DbgSName(Control),' ',PreferredSize[asboHorizontal]]); 1440 Control.BorderSpacing.GetSpaceAround(Border); 1441 BorderLeftTop[asboHorizontal]:=Border.Left; 1442 BorderLeftTop[asboVertical]:=Border.Top; 1443 BorderRightBottom[asboHorizontal]:=Border.Right; 1444 BorderRightBottom[asboVertical]:=Border.Bottom; 1445end; 1446 1447procedure TAutoSizeBox.AllocateChildsArray(Orientation: TAutoSizeBoxOrientation; 1448 NewChildCount: Integer); 1449var 1450 Size: Integer; 1451begin 1452 Size:=NewChildCount*SizeOf(Pointer); 1453 ReallocMem(Children[Orientation],Size); 1454 if Size>0 then 1455 FillChar(Children[Orientation][0],Size,0); 1456 ChildCount[Orientation]:=NewChildCount; 1457end; 1458 1459procedure TAutoSizeBox.AllocateTable(ColCount, RowCount: Integer); 1460{ This creates a ColCount x RowCount number of cells, 1461 and a Row of Columns and a Column of Rows. 1462 1463 +-++-++-++-+ +----------+ 1464 | || || || | | | 1465 | || || || | +----------+ 1466 | || || || | +----------+ 1467 | || || || | | | 1468 | || || || | +----------+ 1469 | || || || | +----------+ 1470 | || || || | | | 1471 +-++-++-++-+ +----------+ 1472 1473} 1474var 1475 x, y: Integer; 1476 RowBox: TAutoSizeBox; 1477 ColBox: TAutoSizeBox; 1478 CellBox: TAutoSizeBox; 1479begin 1480 AllocateChildsArray(asboHorizontal,ColCount); 1481 AllocateChildsArray(asboVertical,RowCount); 1482 // create columns 1483 for x:=0 to ColCount-1 do begin 1484 ColBox:=TAutoSizeBox.Create; 1485 Children[asboHorizontal][x]:=ColBox; 1486 ColBox.AllocateChildsArray(asboVertical,RowCount); 1487 ColBox.Parent[asboHorizontal]:=Self; 1488 ColBox.Index[asboHorizontal]:=x; 1489 ColBox.Index[asboVertical]:=-1; 1490 end; 1491 // create rows 1492 for y:=0 to RowCount-1 do begin 1493 RowBox:=TAutoSizeBox.Create; 1494 Children[asboVertical][y]:=RowBox; 1495 RowBox.AllocateChildsArray(asboHorizontal,ColCount); 1496 RowBox.Parent[asboVertical]:=Self; 1497 RowBox.Index[asboHorizontal]:=-1; 1498 RowBox.Index[asboVertical]:=y; 1499 end; 1500 // create cells 1501 for y:=0 to RowCount-1 do begin 1502 RowBox:=Children[asboVertical][y]; 1503 for x:=0 to ColCount-1 do begin 1504 ColBox:=Children[asboHorizontal][x]; 1505 CellBox:=TAutoSizeBox.Create; 1506 RowBox.Children[asboHorizontal][x]:=CellBox; 1507 ColBox.Children[asboVertical][y]:=CellBox; 1508 CellBox.Parent[asboHorizontal]:=RowBox; 1509 CellBox.Parent[asboVertical]:=ColBox; 1510 CellBox.Index[asboHorizontal]:=x; 1511 CellBox.Index[asboVertical]:=y; 1512 end; 1513 end; 1514end; 1515 1516procedure TAutoSizeBox.SetTableControls(ListOfControls: TFPList; 1517 ChildSizing: TControlChildSizing; BiDiMode: TBiDiMode); 1518var 1519 i: Integer; 1520 Row: LongInt; 1521 Col: LongInt; 1522 ChildControl: TControl; 1523 ChildBox: TAutoSizeBox; 1524 RowCount: LongInt; 1525 ColCount: Integer; 1526 LineMax: LongInt; 1527begin 1528 // allocate table 1529 case ChildSizing.Layout of 1530 cclLeftToRightThenTopToBottom: 1531 begin 1532 ColCount:=Max(1,Min(ChildSizing.ControlsPerLine,ListOfControls.Count)); 1533 RowCount:=((ListOfControls.Count-1) div ColCount)+1; 1534 end; 1535 cclTopToBottomThenLeftToRight: 1536 begin 1537 RowCount:=Max(1,min(ChildSizing.ControlsPerLine,ListOfControls.Count)); 1538 ColCount:=((ListOfControls.Count-1) div RowCount)+1; 1539 end; 1540 else 1541 raise Exception.Create('TAutoSizeBox.SetTableControls TODO'); 1542 end; 1543 AllocateTable(ColCount,RowCount); 1544 1545 // set controls 1546 for i:=0 to ListOfControls.Count-1 do begin 1547 ChildControl:=TControl(ListOfControls[i]); 1548 case ChildSizing.Layout of 1549 cclLeftToRightThenTopToBottom: 1550 begin 1551 LineMax:=ChildCount[asboHorizontal]; 1552 Row:=i div LineMax; 1553 Col:=i mod LineMax; 1554 if (BiDiMode=bdRightToLeft) then 1555 Col:=LineMax-Col-1; 1556 ChildBox:=Children[asboHorizontal][Col].Children[asboVertical][Row]; 1557 ChildBox.SetControl(ChildControl); 1558 ChildBox.ApplyChildsizingBorders(ChildSizing); 1559 end; 1560 cclTopToBottomThenLeftToRight: 1561 begin 1562 LineMax:=ChildCount[asboVertical]; 1563 Col:=i div LineMax; 1564 Row:=i mod LineMax; 1565 if (BiDiMode=bdRightToLeft) then 1566 Col:=ChildCount[asboHorizontal]-Col-1; 1567 ChildBox:=Children[asboVertical][Row].Children[asboHorizontal][Col]; 1568 ChildBox.SetControl(ChildControl); 1569 ChildBox.ApplyChildsizingBorders(ChildSizing); 1570 end; 1571 end; 1572 end; 1573end; 1574 1575procedure TAutoSizeBox.ApplyChildSizingBorders(ChildSizing: TControlChildSizing); 1576var 1577 MinBorder: LongInt; 1578begin 1579 // left border 1580 if (Parent[asboHorizontal]=nil) or (Index[asboHorizontal]=0) then 1581 MinBorder:=ChildSizing.LeftRightSpacing 1582 else 1583 MinBorder:=ChildSizing.HorizontalSpacing; 1584 BorderLeftTop[asboHorizontal]:=Max(BorderLeftTop[asboHorizontal],MinBorder); 1585 1586 // right border 1587 if (Parent[asboHorizontal]=nil) 1588 or (Index[asboHorizontal]=Parent[asboHorizontal].ChildCount[asboHorizontal]-1) 1589 then 1590 MinBorder:=ChildSizing.LeftRightSpacing 1591 else 1592 MinBorder:=ChildSizing.HorizontalSpacing; 1593 BorderRightBottom[asboHorizontal]:=Max(BorderRightBottom[asboHorizontal], 1594 MinBorder); 1595 1596 // top border 1597 if (Parent[asboVertical]=nil) or (Index[asboVertical]=0) then 1598 MinBorder:=ChildSizing.TopBottomSpacing 1599 else 1600 MinBorder:=ChildSizing.VerticalSpacing; 1601 BorderLeftTop[asboVertical]:=Max(BorderLeftTop[asboVertical],MinBorder); 1602 1603 // bottom border 1604 if (Parent[asboVertical]=nil) 1605 or (Index[asboVertical]=Parent[asboVertical].ChildCount[asboVertical]-1) 1606 then 1607 MinBorder:=ChildSizing.TopBottomSpacing 1608 else 1609 MinBorder:=ChildSizing.VerticalSpacing; 1610 BorderRightBottom[asboVertical]:=Max(BorderRightBottom[asboVertical], 1611 MinBorder); 1612end; 1613 1614procedure TAutoSizeBox.InitSums; 1615 1616 procedure Init(o: TAutoSizeBoxOrientation); 1617 var 1618 FirstChild: TAutoSizeBox; 1619 begin 1620 if ChildCount[o]>0 then begin 1621 FirstChild:=Children[o][0]; 1622 MaximumSize[o]:=FirstChild.MaximumSize[o]; 1623 MinimumSize[o]:=FirstChild.MinimumSize[o]; 1624 PreferredSize[o]:=FirstChild.PreferredSize[o]; 1625 BorderLeftTop[o]:=FirstChild.BorderLeftTop[o]; 1626 BorderRightBottom[o]:=FirstChild.BorderRightBottom[o]; 1627 end else begin 1628 MaximumSize[o]:=0; 1629 MinimumSize[o]:=0; 1630 PreferredSize[o]:=0; 1631 BorderLeftTop[o]:=0; 1632 BorderRightBottom[o]:=0; 1633 end; 1634 end; 1635 1636begin 1637 Init(asboHorizontal); 1638 Init(asboVertical); 1639end; 1640 1641procedure TAutoSizeBox.SumLine(Orientation: TAutoSizeBoxOrientation; 1642 DoInit: boolean); 1643// total orientated minimum is the sum of all minimums plus borders 1644// total orientated maximum is the sum of all maximums plus borders 1645// total orientated preferred is the sum of all preferred plus borders 1646// total orthogonal minimum is the maximum of all minimums 1647// total orthogonal maximum is the minimum of all maximums 1648// total orthogonal preferred is the maximum of all preferred 1649var 1650 i: Integer; 1651 Orthogonal: TAutoSizeBoxOrientation; 1652 CurChild: TAutoSizeBox; 1653 CurBorder: integer; 1654 LastChild: TAutoSizeBox; 1655begin 1656 if DoInit then InitSums; 1657 Orthogonal:=SizeBoxOrthogonal[Orientation]; 1658 if ChildCount[Orientation]>0 then begin 1659 for i:=0 to ChildCount[Orientation]-1 do begin 1660 CurChild:=Children[Orientation][i]; 1661 1662 // add border in Orientation 1663 CurBorder:=CurChild.BorderLeftTop[Orientation]; 1664 if i>0 then 1665 CurBorder:=Max(Children[Orientation][i-1].BorderRightBottom[Orientation], 1666 CurBorder); 1667 if MaximumSize[Orientation]>0 then begin 1668 inc(MaximumSize[Orientation],CurBorder); 1669 end; 1670 inc(MinimumSize[Orientation],CurBorder); 1671 inc(PreferredSize[Orientation],CurBorder); 1672 // add item size in Orientation 1673 if MaximumSize[Orientation]>0 then begin 1674 if CurChild.MaximumSize[Orientation]>0 then 1675 inc(MaximumSize[Orientation],CurChild.MaximumSize[Orientation]) 1676 else 1677 MaximumSize[Orientation]:=0; 1678 end; 1679 inc(MinimumSize[Orientation],CurChild.MinimumSize[Orientation]); 1680 inc(PreferredSize[Orientation],CurChild.PreferredSize[Orientation]); 1681 1682 // maximize in Orthogonal 1683 if MaximumSize[Orthogonal]>0 then begin 1684 if CurChild.MaximumSize[Orthogonal]>0 then 1685 MaximumSize[Orthogonal]:=Max(MaximumSize[Orthogonal], 1686 CurChild.MaximumSize[Orthogonal]) 1687 else 1688 MaximumSize[Orthogonal]:=0; 1689 end; 1690 MinimumSize[Orthogonal]:=Max(MinimumSize[Orthogonal], 1691 CurChild.MinimumSize[Orthogonal]); 1692 PreferredSize[Orthogonal]:=Max(PreferredSize[Orthogonal], 1693 CurChild.PreferredSize[Orthogonal]); 1694 BorderLeftTop[Orthogonal]:=Max(BorderLeftTop[Orthogonal], 1695 CurChild.BorderLeftTop[Orthogonal]); 1696 BorderRightBottom[Orthogonal]:=Max(BorderRightBottom[Orthogonal], 1697 CurChild.BorderRightBottom[Orthogonal]); 1698 end; 1699 1700 // last border 1701 LastChild:=Children[Orientation][ChildCount[Orientation]-1]; 1702 BorderRightBottom[Orientation]:=LastChild.BorderRightBottom[Orientation]; 1703 end; 1704end; 1705 1706procedure TAutoSizeBox.SumTable; 1707var 1708 x: Integer; 1709 ColBox: TAutoSizeBox; 1710 y: Integer; 1711 RowBox: TAutoSizeBox; 1712begin 1713 // sum items in rows 1714 for y:=0 to ChildCount[asboVertical]-1 do begin 1715 RowBox:=Children[asboVertical][y]; 1716 RowBox.SumLine(asboHorizontal,true); 1717 end; 1718 // sum items in columns 1719 for x:=0 to ChildCount[asboHorizontal]-1 do begin 1720 ColBox:=Children[asboHorizontal][x]; 1721 ColBox.SumLine(asboVertical,true); 1722 end; 1723 // sum rows 1724 SumLine(asboVertical,true); 1725 // sum columns 1726 SumLine(asboHorizontal,false); 1727end; 1728 1729procedure TAutoSizeBox.ComputeLeftTops(Orientation: TAutoSizeBoxOrientation); 1730var 1731 i: Integer; 1732 Child: TAutoSizeBox; 1733 CurLeftTop: Integer; 1734 s: LongInt; 1735begin 1736 CurLeftTop:=0; 1737 for i:=0 to ChildCount[Orientation]-1 do begin 1738 Child:=Children[Orientation][i]; 1739 if i=0 then 1740 inc(CurLeftTop,Child.BorderLeftTop[Orientation]); 1741 Child.LeftTop[Orientation]:=CurLeftTop; 1742 inc(CurLeftTop,Child.PreferredSize[Orientation]); 1743 s:=Child.BorderRightBottom[Orientation]; 1744 if i<ChildCount[Orientation]-1 then 1745 s:=Max(s,Children[Orientation][i+1].BorderLeftTop[Orientation]); 1746 inc(CurLeftTop,s); 1747 end; 1748end; 1749 1750procedure TAutoSizeBox.ResizeChildren(ChildSizing: TControlChildSizing; 1751 Orientation: TAutoSizeBoxOrientation; TargetSize: integer); 1752type 1753 TResizeFactor = record 1754 Scale: double; 1755 Offset: integer; 1756 end; 1757var 1758 EnlargeStyle: TChildControlResizeStyle; 1759 ShrinkStyle: TChildControlResizeStyle; 1760 CurSize: LongInt; 1761 1762 function GetChildTotalSize: integer; 1763 // computes the total preferred size of all children of this Orientation 1764 var 1765 i: Integer; 1766 Child: TAutoSizeBox; 1767 s: LongInt; 1768 begin 1769 Result:=0; 1770 for i:=0 to ChildCount[Orientation]-1 do begin 1771 Child:=Children[Orientation][i]; 1772 if i=0 then 1773 inc(Result,Child.BorderLeftTop[Orientation]); 1774 if Child.PreferredSize[Orientation]<1 then 1775 Child.PreferredSize[Orientation]:=1; 1776 inc(Result,Child.PreferredSize[Orientation]); 1777 s:=Child.BorderRightBottom[Orientation]; 1778 if i<ChildCount[Orientation]-1 then 1779 s:=Max(s,Children[Orientation][i+1].BorderLeftTop[Orientation]); 1780 inc(Result,s); 1781 end; 1782 end; 1783 1784 procedure GetChildMaxResize(out Factor: TResizeFactor; 1785 out ResizeableCount: integer); 1786 // returns the number of children/gaps, that can grow (ResizeableCount) 1787 // and the maximum factor, by which the children/gaps can grow (TResizeFactor) 1788 var 1789 i: Integer; 1790 CurScale: Double; 1791 CurOffset: LongInt; 1792 Child: TAutoSizeBox; 1793 begin 1794 Factor.Scale:=0; 1795 Factor.Offset:=0; 1796 ResizeableCount:=0; 1797 case EnlargeStyle of 1798 1799 crsAnchorAligning: 1800 exit; // no resizing 1801 1802 crsScaleChilds,crsHomogenousChildResize: 1803 1804 for i:=0 to ChildCount[Orientation]-1 do begin 1805 Child:=Children[Orientation][i]; 1806 if (Child.MaximumSize[Orientation]>0) 1807 and (Child.PreferredSize[Orientation]>=Child.MaximumSize[Orientation]) 1808 then begin 1809 // this child can not be further enlarged 1810 continue; 1811 end; 1812 inc(ResizeableCount); 1813 1814 case EnlargeStyle of 1815 1816 crsScaleChilds, crsHomogenousChildResize: 1817 begin 1818 if Child.MaximumSize[Orientation]=0 then begin 1819 CurScale:=double(TargetSize); 1820 CurOffset:=TargetSize; 1821 end else begin 1822 CurScale:=double(Child.MaximumSize[Orientation]) 1823 /Child.PreferredSize[Orientation]; 1824 CurOffset:=Child.MaximumSize[Orientation] 1825 -Child.PreferredSize[Orientation]; 1826 end; 1827 if (Factor.Offset=0) or (Factor.Offset>CurOffset) then begin 1828 Factor.Scale:=CurScale; 1829 Factor.Offset:=CurOffset; 1830 end; 1831 end; 1832 1833 end; 1834 end; 1835 1836 crsHomogenousSpaceResize: 1837 if ChildCount[Orientation]>0 then begin 1838 Factor.Scale:=double(TargetSize); 1839 Factor.Offset:=TargetSize; 1840 ResizeableCount:=ChildCount[Orientation]+1; 1841 end; 1842 1843 else 1844 raise Exception.Create('TAutoSizeBox.ResizeChilds'); 1845 1846 end; 1847 end; 1848 1849 procedure EnlargeChilds(const Factor: TResizeFactor); 1850 var 1851 i: Integer; 1852 Child: TAutoSizeBox; 1853 DiffSize: Integer; 1854 NewSize: LongInt; 1855 OldSize: LongInt; 1856 begin 1857 for i:=0 to ChildCount[Orientation]-1 do begin 1858 if TargetSize=CurSize then break; 1859 1860 Child:=Children[Orientation][i]; 1861 if (Child.MaximumSize[Orientation]<0) 1862 and (Child.PreferredSize[Orientation]>=Child.MaximumSize[Orientation]) 1863 then begin 1864 // this child can not be further enlarged 1865 continue; 1866 end; 1867 1868 case EnlargeStyle of 1869 1870 crsScaleChilds: 1871 begin 1872 // scale PreferredSize 1873 DiffSize:=TargetSize-CurSize; 1874 OldSize:=Child.PreferredSize[Orientation]; 1875 NewSize:=round(double(OldSize)*Factor.Scale); 1876 NewSize:=Min(OldSize+DiffSize,Max(OldSize+1,NewSize)); 1877 inc(CurSize,NewSize-OldSize); 1878 Child.PreferredSize[Orientation]:=NewSize; 1879 end; 1880 1881 crsHomogenousChildResize: 1882 begin 1883 // add to PreferredSize 1884 DiffSize:=TargetSize-CurSize; 1885 OldSize:=Child.PreferredSize[Orientation]; 1886 NewSize:=Min(OldSize+Factor.Offset,OldSize+DiffSize); 1887 inc(CurSize,NewSize-OldSize); 1888 Child.PreferredSize[Orientation]:=NewSize; 1889 end; 1890 1891 crsHomogenousSpaceResize: 1892 begin 1893 if i=0 then begin 1894 // add to left/top border 1895 DiffSize:=TargetSize-CurSize; 1896 OldSize:=Child.BorderLeftTop[Orientation]; 1897 NewSize:=Min(OldSize+Factor.Offset,OldSize+DiffSize); 1898 inc(CurSize,NewSize-OldSize); 1899 Child.BorderLeftTop[Orientation]:=NewSize; 1900 end; 1901 // add to right/bottom border 1902 DiffSize:=TargetSize-CurSize; 1903 OldSize:=Child.BorderRightBottom[Orientation]; 1904 NewSize:=Min(OldSize+Factor.Offset,OldSize+DiffSize); 1905 inc(CurSize,NewSize-OldSize); 1906 Child.BorderRightBottom[Orientation]:=NewSize; 1907 if i<ChildCount[Orientation]-1 then 1908 Child.BorderLeftTop[Orientation]:=NewSize; 1909 end; 1910 1911 end; 1912 end; 1913 end; 1914 1915 procedure GetChildMinResize(out Factor: TResizeFactor; 1916 out ResizeableCount: integer); 1917 // returns the number of children/gaps, that can shrink (ResizeableCount) 1918 // and the maximum factor, by which the children/gaps can shrink (TResizeFactor) 1919 var 1920 i: Integer; 1921 CurScale: Double; 1922 CurOffset: LongInt; 1923 Child: TAutoSizeBox; 1924 begin 1925 Factor.Scale:=0; 1926 Factor.Offset:=0; 1927 ResizeableCount:=0; 1928 case ShrinkStyle of 1929 1930 crsAnchorAligning: 1931 exit; // no resizing 1932 1933 crsScaleChilds,crsHomogenousChildResize: 1934 for i:=0 to ChildCount[Orientation]-1 do begin 1935 Child:=Children[Orientation][i]; 1936 if (Child.PreferredSize[Orientation]<=Child.MinimumSize[Orientation]) 1937 or (Child.PreferredSize[Orientation]<=1) 1938 then begin 1939 // this child can not be further shrinked 1940 continue; 1941 end; 1942 inc(ResizeableCount); 1943 1944 case ShrinkStyle of 1945 1946 crsScaleChilds: 1947 begin 1948 CurScale:=double(Child.MinimumSize[Orientation]) 1949 /Child.PreferredSize[Orientation]; 1950 CurOffset:=Child.PreferredSize[Orientation] 1951 -Child.MinimumSize[Orientation]; 1952 if (Factor.Offset=0) or (Factor.Scale<CurScale) then begin 1953 Factor.Scale:=CurScale; 1954 Factor.Offset:=CurOffset; 1955 end; 1956 end; 1957 1958 crsHomogenousChildResize: 1959 begin 1960 CurScale:=double(Child.MinimumSize[Orientation]) 1961 /Child.PreferredSize[Orientation]; 1962 CurOffset:=Child.PreferredSize[Orientation] 1963 -Child.MinimumSize[Orientation]; 1964 if (Factor.Offset=0) or (Factor.Offset>CurOffset) then begin 1965 Factor.Scale:=CurScale; 1966 Factor.Offset:=CurOffset; 1967 end; 1968 end; 1969 1970 end; 1971 end; 1972 1973 crsHomogenousSpaceResize: 1974 for i:=0 to ChildCount[Orientation]-1 do begin 1975 Child:=Children[Orientation][i]; 1976 if i=0 then begin 1977 CurScale:=double(TargetSize); 1978 CurOffset:=Child.BorderLeftTop[Orientation]; 1979 if CurOffset>0 then begin 1980 inc(ResizeableCount); 1981 if (Factor.Offset=0) or (Factor.Offset>CurOffset) then begin 1982 Factor.Scale:=CurScale; 1983 Factor.Offset:=CurOffset; 1984 end; 1985 end; 1986 end; 1987 CurScale:=double(TargetSize); 1988 CurOffset:=Child.BorderRightBottom[Orientation]; 1989 if CurOffset>0 then begin 1990 inc(ResizeableCount); 1991 if (Factor.Offset=0) or (Factor.Offset>CurOffset) then begin 1992 Factor.Scale:=CurScale; 1993 Factor.Offset:=CurOffset; 1994 end; 1995 end; 1996 end; 1997 1998 else 1999 raise Exception.Create('TAutoSizeBox.ResizeChilds'); 2000 2001 end; 2002 end; 2003 2004 procedure ShrinkChilds(const Factor: TResizeFactor); 2005 var 2006 i: Integer; 2007 Child: TAutoSizeBox; 2008 DiffSize: Integer; 2009 NewSize: LongInt; 2010 OldSize: LongInt; 2011 begin 2012 for i:=0 to ChildCount[Orientation]-1 do begin 2013 Child:=Children[Orientation][i]; 2014 if (Child.PreferredSize[Orientation]<=1) 2015 or (Child.PreferredSize[Orientation]<=Child.MinimumSize[Orientation]) 2016 then begin 2017 // this child can not be further shrinked 2018 continue; 2019 end; 2020 2021 case ShrinkStyle of 2022 2023 crsScaleChilds: 2024 begin 2025 // scale PreferredSize 2026 DiffSize:=CurSize-TargetSize; 2027 OldSize:=Child.PreferredSize[Orientation]; 2028 NewSize:=Min(round(OldSize*Factor.Scale),OldSize-1); 2029 NewSize:=Max(Max(1,NewSize),OldSize-DiffSize); 2030 dec(CurSize,OldSize-NewSize); 2031 Child.PreferredSize[Orientation]:=NewSize; 2032 end; 2033 2034 crsHomogenousChildResize: 2035 begin 2036 // add to PreferredSize 2037 DiffSize:=CurSize-TargetSize; 2038 OldSize:=Child.PreferredSize[Orientation]; 2039 NewSize:=OldSize-Factor.Offset; 2040 NewSize:=Max(Max(NewSize,1),OldSize-DiffSize); 2041 dec(CurSize,OldSize-NewSize); 2042 Child.PreferredSize[Orientation]:=NewSize; 2043 end; 2044 2045 crsHomogenousSpaceResize: 2046 begin 2047 if i=0 then begin 2048 // add to left/top border 2049 DiffSize:=CurSize-TargetSize; 2050 OldSize:=Child.BorderLeftTop[Orientation]; 2051 NewSize:=Max(Max(0,OldSize-Factor.Offset),OldSize-DiffSize); 2052 dec(CurSize,OldSize-NewSize); 2053 Child.BorderLeftTop[Orientation]:=NewSize; 2054 end; 2055 // add to right/bottom border 2056 DiffSize:=CurSize-TargetSize; 2057 OldSize:=Child.BorderRightBottom[Orientation]; 2058 NewSize:=Max(Max(0,OldSize-Factor.Offset),OldSize-DiffSize); 2059 dec(CurSize,OldSize-NewSize); 2060 Child.BorderRightBottom[Orientation]:=NewSize; 2061 if i<ChildCount[Orientation]-1 then 2062 Child.BorderLeftTop[Orientation]:=NewSize; 2063 end; 2064 2065 end; 2066 end; 2067 end; 2068 2069var 2070 MaxResizeFactorPerItem, MinResizeFactorPerItem, CurScale: TResizeFactor; 2071 ResizeableCount: integer; 2072 i: Integer; 2073begin 2074 CurSize:=GetChildTotalSize; 2075 //DebugLn('TAutoSizeBox.ResizeChilds CurSize=',dbgs(CurSize),' TargetSize=',dbgs(TargetSize)); 2076 EnlargeStyle:=crsAnchorAligning; 2077 ShrinkStyle:=crsAnchorAligning; 2078 i:=0; 2079 if TargetSize>CurSize then begin 2080 // enlarge 2081 if Orientation=asboHorizontal then 2082 EnlargeStyle:=ChildSizing.EnlargeHorizontal 2083 else 2084 EnlargeStyle:=ChildSizing.EnlargeVertical; 2085 while TargetSize>CurSize do begin 2086 // shrink children 2087 GetChildMaxResize(MaxResizeFactorPerItem,ResizeableCount); 2088 if (ResizeableCount=0) or (MaxResizeFactorPerItem.Offset=0) then break; 2089 2090 CurScale.Scale:=(double(TargetSize)/CurSize); 2091 if (MaxResizeFactorPerItem.Scale>0) 2092 and (MaxResizeFactorPerItem.Scale<CurScale.Scale) then 2093 CurScale.Scale:=MaxResizeFactorPerItem.Scale; 2094 2095 CurScale.Offset:=((TargetSize-CurSize-1) div ResizeableCount)+1; 2096 // note: the above formula makes sure, that Offset>0 2097 if (MaxResizeFactorPerItem.Offset>0) 2098 and (MaxResizeFactorPerItem.Offset<CurScale.Offset) then 2099 CurScale.Offset:=MaxResizeFactorPerItem.Offset; 2100 2101 EnlargeChilds(CurScale); 2102 inc(i); 2103 if i>1000 then RaiseGDBException('TAutoSizeBox.ResizeChilds consistency error'); 2104 end; 2105 end else if TargetSize<CurSize then begin 2106 // shrink 2107 if Orientation=asboHorizontal then 2108 ShrinkStyle:=ChildSizing.ShrinkHorizontal 2109 else 2110 ShrinkStyle:=ChildSizing.ShrinkVertical; 2111 while TargetSize<CurSize do begin 2112 GetChildMinResize(MinResizeFactorPerItem,ResizeableCount); 2113 if (ResizeableCount=0) or (MinResizeFactorPerItem.Offset=0) then break; 2114 2115 CurScale.Scale:=(double(TargetSize)/CurSize); 2116 if (MinResizeFactorPerItem.Scale>0) 2117 and (MinResizeFactorPerItem.Scale>CurScale.Scale) then 2118 CurScale.Scale:=MinResizeFactorPerItem.Scale; 2119 2120 CurScale.Offset:=((CurSize-TargetSize-1) div ResizeableCount)+1; 2121 // note: the above formula makes sure, that Offset>0 2122 if (MinResizeFactorPerItem.Offset>0) 2123 and (MinResizeFactorPerItem.Offset>CurScale.Offset) then 2124 CurScale.Offset:=MinResizeFactorPerItem.Offset; 2125 2126 ShrinkChilds(CurScale); 2127 inc(i); 2128 if i>1000 then RaiseGDBException('TAutoSizeBox.ResizeChilds consistency error'); 2129 end; 2130 end; 2131end; 2132 2133procedure TAutoSizeBox.ResizeTable(ChildSizing: TControlChildSizing; 2134 TargetWidth, TargetHeight: integer); 2135begin 2136 // resize rows and columns 2137 ResizeChildren(ChildSizing,asboHorizontal,TargetWidth); 2138 ComputeLeftTops(asboHorizontal); 2139 ResizeChildren(ChildSizing,asboVertical,TargetHeight); 2140 ComputeLeftTops(asboVertical); 2141end; 2142 2143{procedure TAutoSizeBox.AlignToRight(TargetWidth: integer); 2144 2145 function GetChildTotalSize(Orientation: TAutoSizeBoxOrientation): integer; 2146 // computes the total preferred size of all children of this Orientation 2147 var 2148 i: Integer; 2149 Child: TAutoSizeBox; 2150 begin 2151 Result:=0; 2152 for i:=0 to ChildCount[Orientation]-1 do begin 2153 Child:=Children[Orientation][i]; 2154 if i=0 then 2155 inc(Result,Child.BorderLeftTop[Orientation]); 2156 if Child.PreferredSize[Orientation]<1 then 2157 Child.PreferredSize[Orientation]:=1; 2158 inc(Result,Child.PreferredSize[Orientation]); 2159 inc(Result,Child.BorderRightBottom[Orientation]); 2160 end; 2161 end; 2162 2163var 2164 Orientation: TAutoSizeBoxOrientation; 2165 i: Integer; 2166 Child: TAutoSizeBox; 2167 dx: Integer; 2168begin 2169 Orientation:=asboHorizontal; 2170 dx:=TargetWidth-GetChildTotalSize(Orientation); 2171 2172 for i:=ChildCount[Orientation]-1 downto 0 do begin 2173 Child:=Children[Orientation][i]; 2174 inc(Child.LeftTop[Orientation],dx); 2175 end; 2176end; 2177} 2178procedure TAutoSizeBox.ComputeTableControlBounds( 2179 ChildSizing: TControlChildSizing; BiDiMode: TBiDiMode); 2180var 2181 y: Integer; 2182 RowBox: TAutoSizeBox; 2183 x: Integer; 2184 ColBox: TAutoSizeBox; 2185 ControlBox: TAutoSizeBox; 2186 CurControl: TControl; 2187 NewBounds: TRect; 2188 CellBounds: TRect; 2189 NewWidth: LongInt; 2190 NewHeight: LongInt; 2191begin 2192 //WriteDebugReport; 2193 for y:=0 to ChildCount[asboVertical]-1 do begin 2194 RowBox:=Children[asboVertical][y]; 2195 for x:=0 to RowBox.ChildCount[asboHorizontal]-1 do begin 2196 ControlBox:=RowBox.Children[asboHorizontal][x]; 2197 ColBox:=ControlBox.Parent[asboVertical]; 2198 CurControl:=ControlBox.Control; 2199 if CurControl=nil then continue; 2200 CellBounds:=Bounds(ColBox.LeftTop[asboHorizontal], 2201 RowBox.LeftTop[asboVertical], 2202 ColBox.PreferredSize[asboHorizontal], 2203 RowBox.PreferredSize[asboVertical]); 2204 NewBounds.Left:=CellBounds.Left; 2205 NewBounds.Top:=CellBounds.Top; 2206 NewWidth:=ControlBox.PreferredSize[asboHorizontal]; 2207 NewHeight:=ControlBox.PreferredSize[asboVertical]; 2208 if (NewWidth<ColBox.PreferredSize[asboHorizontal]) then begin 2209 // column is bigger than preferred width of the control 2210 //DebugLn('TAutoSizeBox.SetTableControlBounds ',DbgSName(CurControl),' ',dbgs(ord(CurControl.BorderSpacing.CellAlignHorizontal))); 2211 case CurControl.BorderSpacing.CellAlignHorizontal of 2212 ccaFill: NewWidth:=CellBounds.Right-CellBounds.Left; 2213 ccaLeftTop,ccaRightBottom: 2214 if (CurControl.BorderSpacing.CellAlignHorizontal=ccaRightBottom) 2215 =(BidiMode=bdLeftToRight) 2216 then 2217 NewBounds.Left:=CellBounds.Right-NewWidth; 2218 ccaCenter: NewBounds.Left:=NewBounds.Left 2219 +(CellBounds.Right-CellBounds.Left-NewWidth) div 2; 2220 end; 2221 end else if (NewWidth>ColBox.PreferredSize[asboHorizontal]) then begin 2222 // column is smaller than preferred width of the control 2223 if ChildSizing.ShrinkHorizontal 2224 in [crsScaleChilds,crsHomogenousChildResize] 2225 then 2226 NewWidth:=CellBounds.Right-CellBounds.Left; 2227 end; 2228 if (NewHeight<ColBox.PreferredSize[asboVertical]) then begin 2229 // column is bigger than preferred height of the control 2230 case CurControl.BorderSpacing.CellAlignVertical of 2231 ccaFill: NewHeight:=CellBounds.Bottom-CellBounds.Top; 2232 ccaLeftTop: ; 2233 ccaRightBottom: NewBounds.Top:=CellBounds.Bottom-NewHeight; 2234 ccaCenter: NewBounds.Top:=NewBounds.Top 2235 +(CellBounds.Bottom-CellBounds.Top-NewHeight) div 2; 2236 end; 2237 end else if (NewHeight>ColBox.PreferredSize[asboVertical]) then begin 2238 // column is smaller than preferred height of the control 2239 if ChildSizing.ShrinkVertical 2240 in [crsScaleChilds,crsHomogenousChildResize] 2241 then 2242 NewHeight:=CellBounds.Bottom-CellBounds.Top; 2243 end; 2244 2245 NewBounds.Right:=NewBounds.Left+NewWidth; 2246 NewBounds.Bottom:=NewBounds.Top+NewHeight; 2247 ControlBox.NewControlBounds:=NewBounds; 2248 {$IFDEF CHECK_POSITION} 2249 if CheckPosition(CurControl) then 2250 DebugLn(['TAutoSizeBox.ComputeTableControlBounds ',DbgSName(CurControl), 2251 ' CellBounds=',dbgs(CellBounds), 2252 ' Preferred=',ControlBox.PreferredSize[asboHorizontal],'x',ControlBox.PreferredSize[asboVertical], 2253 ' NewBounds=',dbgs(NewBounds)]); 2254 {$ENDIF} 2255 end; 2256 end; 2257end; 2258 2259function TAutoSizeBox.SetTableControlBounds(ChildSizing: TControlChildSizing 2260 ): boolean; 2261var 2262 y: Integer; 2263 RowBox: TAutoSizeBox; 2264 x: Integer; 2265 ControlBox: TAutoSizeBox; 2266 CurControl: TControl; 2267 NewBounds: TRect; 2268 OldBounds: TRect; 2269begin 2270 Result:=false; 2271 //WriteDebugReport; 2272 for y:=0 to ChildCount[asboVertical]-1 do begin 2273 RowBox:=Children[asboVertical][y]; 2274 for x:=0 to RowBox.ChildCount[asboHorizontal]-1 do begin 2275 ControlBox:=RowBox.Children[asboHorizontal][x]; 2276 CurControl:=ControlBox.Control; 2277 if CurControl=nil then continue; 2278 NewBounds:=ControlBox.NewControlBounds; 2279 OldBounds:=CurControl.BoundsRect; 2280 if not CompareRect(@NewBounds,@OldBounds) then begin 2281 Result:=true; 2282 CurControl.SetBoundsKeepBase(NewBounds.Left, 2283 NewBounds.Top, 2284 NewBounds.Right-NewBounds.Left, 2285 NewBounds.Bottom-NewBounds.Top); 2286 end; 2287 end; 2288 end; 2289end; 2290 2291function TAutoSizeBox.AlignControlsInTable(ListOfControls: TFPList; 2292 ChildSizing: TControlChildSizing; BiDiMode: TBiDiMode; 2293 TargetWidth, TargetHeight: integer; 2294 Apply: boolean): boolean; 2295// true if a control was modified 2296begin 2297 SetTableControls(ListOfControls,ChildSizing,BiDiMode); 2298 //WriteDebugReport('after SetTableControls'); 2299 SumTable; 2300 //WriteDebugReport('after SumTable'); 2301 ResizeTable(ChildSizing,TargetWidth,TargetHeight); 2302 //WriteDebugReport('after ResizeTable'); 2303 2304// Michl: Commented procedure AlignToRight because of issue #28483, afaics 2305// it isn't needed, I'll remove code, if there are no regressions. 2306// Commented in revision 55209 2307// if BiDiMode=bdRightToLeft then 2308// AlignToRight(TargetWidth); 2309 2310 //WriteDebugReport('after AlignToRight'); 2311 ComputeTableControlBounds(ChildSizing,BiDiMode); 2312 //WriteDebugReport('after ComputeTableControlBounds'); 2313 Result:=Apply and SetTableControlBounds(ChildSizing); 2314end; 2315 2316procedure TAutoSizeBox.WriteDebugReport(const Title: string); 2317var 2318 y: Integer; 2319 RowBox: TAutoSizeBox; 2320 x: Integer; 2321 CellBox: TAutoSizeBox; 2322 ColBox: TAutoSizeBox; 2323begin 2324 DebugLn('TAutoSizeBox.WriteDebugReport '+Title 2325 +' ChildCounts=',dbgs(ChildCount[asboHorizontal]),'x',dbgs(ChildCount[asboVertical])); 2326 for y:=0 to ChildCount[asboVertical]-1 do begin 2327 RowBox:=Children[asboVertical][y]; 2328 DbgOut(' Row='+dbgs(y), 2329 ' MinY='+dbgs(RowBox.MinimumSize[asboVertical]), 2330 ' MaxY='+dbgs(RowBox.MaximumSize[asboVertical]), 2331 ' PrefY='+dbgs(RowBox.PreferredSize[asboVertical]), 2332 ' BorderTop=',dbgs(RowBox.BorderLeftTop[asboVertical]), 2333 ' #Col='+dbgs(RowBox.ChildCount[asboHorizontal])); 2334 for x:=0 to RowBox.ChildCount[asboHorizontal]-1 do begin 2335 CellBox:=RowBox.Children[asboHorizontal][x]; 2336 DbgOut(' CellControl=',DbgSName(CellBox.Control), 2337 ' Min='+dbgs(CellBox.MinimumSize[asboHorizontal])+'x'+dbgs(CellBox.MinimumSize[asboVertical]), 2338 ' Max='+dbgs(CellBox.MaximumSize[asboHorizontal])+'x'+dbgs(CellBox.MaximumSize[asboVertical]), 2339 ' BorderLeft=',dbgs(CellBox.BorderLeftTop[asboHorizontal]), 2340 ' Pref='+dbgs(CellBox.PreferredSize[asboHorizontal])+'x'+dbgs(CellBox.PreferredSize[asboVertical]), 2341 ''); 2342 end; 2343 DebugLn; 2344 end; 2345 DbgOut(' Columns: '); 2346 for x:=0 to ChildCount[asboHorizontal]-1 do begin 2347 ColBox:=Children[asboHorizontal][x]; 2348 DbgOut(' Col='+dbgs(ColBox.Index[asboHorizontal]), 2349 ' Min='+dbgs(ColBox.MinimumSize[asboHorizontal]), 2350 ' Max='+dbgs(ColBox.MaximumSize[asboHorizontal]), 2351 ' Pref='+dbgs(ColBox.PreferredSize[asboHorizontal]), 2352 ''); 2353 end; 2354 DebugLn; 2355end; 2356 2357destructor TAutoSizeBox.Destroy; 2358var 2359 o: TAutoSizeBoxOrientation; 2360begin 2361 // unlink from parent 2362 for o:=Low(TAutoSizeBoxOrientation) to high(TAutoSizeBoxOrientation) do 2363 if Parent[o]<>nil then 2364 Parent[o].Children[o][Index[o]]:=nil; 2365 Clear; 2366 inherited Destroy; 2367end; 2368 2369procedure TAutoSizeBox.Clear; 2370var 2371 o: TAutoSizeBoxOrientation; 2372 i: Integer; 2373begin 2374 // free all children 2375 for o:=Low(TAutoSizeBoxOrientation) to high(TAutoSizeBoxOrientation) do 2376 for i:=0 to ChildCount[o]-1 do 2377 Children[o][i].Free; 2378 // free children arrays 2379 for o:=Low(TAutoSizeBoxOrientation) to high(TAutoSizeBoxOrientation) do 2380 ReallocMem(Children[o],0); 2381end; 2382 2383{------------------------------------------------------------------------------ 2384 function TWinControl.AutoSizePhases: TControlAutoSizePhases; 2385------------------------------------------------------------------------------} 2386function TWinControl.AutoSizePhases: TControlAutoSizePhases; 2387begin 2388 if Parent<>nil then 2389 Result:=Parent.AutoSizePhases 2390 else begin 2391 Result:=[]; 2392 if ([wcfCreatingHandle,wcfCreatingChildHandles]*FWinControlFlags<>[]) then 2393 Include(Result,caspCreatingHandles); 2394 if fAutoSizingAll then 2395 Include(Result,caspComputingBounds); 2396 if wcfRealizingBounds in FWinControlFlags then 2397 Include(Result,caspRealizingBounds); 2398 if wcfUpdateShowing in FWinControlFlags then 2399 Include(Result,caspShowing); 2400 if FAutoSizingLockCount>0 then 2401 Include(Result,caspChangingProperties); 2402 end; 2403end; 2404 2405{------------------------------------------------------------------------------ 2406 function TWinControl.AutoSizeDelayed: boolean; 2407------------------------------------------------------------------------------} 2408function TWinControl.AutoSizeDelayed: boolean; 2409begin 2410 Result:=(csDestroyingHandle in ControlState) 2411 or (inherited AutoSizeDelayed); 2412 //if Result then debugln('TWinControl.AutoSizeDelayed A ',DbgSName(Self),' wcfCreatingChildHandles=',dbgs(wcfCreatingChildHandles in FWinControlFlags),' csLoading=',dbgs(csLoading in ComponentState)); 2413 {$IFDEF VerboseCanAutoSize} 2414 if Result {and AutoSize} then begin 2415 if not HandleAllocated then 2416 debugln('TWinControl.AutoSizeDelayed Self='+DbgSName(Self)+' not HandleAllocated'); 2417 end; 2418 {$ENDIF} 2419end; 2420 2421function TWinControl.AutoSizeDelayedReport: string; 2422begin 2423 if csDestroyingHandle in ControlState then 2424 Result:='csDestroyingHandle' 2425 else 2426 Result:=inherited AutoSizeDelayedReport; 2427end; 2428 2429{------------------------------------------------------------------------------ 2430 TWinControl AutoSizeDelayedHandle 2431 2432 Returns true if AutoSize should be skipped / delayed because of its handle. 2433 A TWinControl needs a parent handle. 2434------------------------------------------------------------------------------} 2435function TWinControl.AutoSizeDelayedHandle: Boolean; 2436begin 2437 Result := (Parent = nil) and (ParentWindow = 0); 2438end; 2439 2440{------------------------------------------------------------------------------ 2441 TWinControl AdjustClientRect 2442------------------------------------------------------------------------------} 2443procedure TWinControl.AdjustClientRect(var ARect: TRect); 2444begin 2445 // Can be overriden. 2446 // It's called often, so don't put expensive code here, or cache the result 2447end; 2448 2449procedure TWinControl.GetAdjustedLogicalClientRect(out ARect: TRect); 2450begin 2451 if not (wcfAdjustedLogicalClientRectValid in FWinControlFlags) then begin 2452 FAdjustClientRect:=GetLogicalClientRect; 2453 AdjustClientRect(FAdjustClientRect); 2454 Include(FWinControlFlags,wcfAdjustedLogicalClientRectValid); 2455 end; 2456 ARect:=FAdjustClientRect; 2457end; 2458 2459{------------------------------------------------------------------------------ 2460 TWinControl CreateControlAlignList 2461 2462 Creates a list of controls that need to be aligned via TheAlign. 2463------------------------------------------------------------------------------} 2464procedure TWinControl.CreateControlAlignList(TheAlign: TAlign; 2465 AlignList: TFPList; StartControl: TControl); 2466 2467 function InsertBefore(Control1, Control2: TControl; AAlign: TAlign): Boolean; 2468 begin 2469 case AAlign of 2470 alTop: begin 2471 Result := (Control1.Top < Control2.Top) 2472 or ( (Control1.Top = Control2.Top) 2473 and (Control1.FBaseBounds.Top < Control2.FBaseBounds.Top)); 2474 end; 2475 alLeft: begin 2476 Result := (Control1.Left < Control2.Left) 2477 or ( (Control1.Left = Control2.Left) 2478 and (Control1.FBaseBounds.Left < Control2.FBaseBounds.Left)); 2479 end; 2480 // contrary to VCL, LCL uses > for alBottom, alRight 2481 // Maybe it is a bug in the VCL. 2482 // This results in first control is put rightmost/bottommost 2483 alBottom: begin 2484 Result := ((Control1.Top + Control1.Height) > (Control2.Top + Control2.Height)) 2485 or ( ((Control1.Top + Control1.Height) = (Control2.Top + Control2.Height)) 2486 and (Control1.FBaseBounds.Bottom > Control2.FBaseBounds.Bottom)); 2487 end; 2488 alRight: begin 2489 Result := ((Control1.Left + Control1.Width) > (Control2.Left + Control2.Width)) 2490 or ( ((Control1.Left + Control1.Width) = (Control2.Left + Control2.Width)) 2491 and (Control1.FBaseBounds.Right > Control2.FBaseBounds.Right)); 2492 end; 2493 alCustom: begin 2494 // CustomAlignInsertBefore returns true when Control2 is inserted before Control1 2495 // We return true when Control1 is inserted before Control2 2496 // So swap controls 2497 Result := CustomAlignInsertBefore(Control2, Control1); 2498 end; 2499 else 2500 Result := False; 2501 end; 2502 end; 2503 2504var 2505 I, X: Integer; 2506 Control: TControl; 2507begin 2508 AlignList.Clear; 2509 2510 // first add the current control 2511 if (StartControl <> nil) and (StartControl.Align = TheAlign) and 2512 ((TheAlign = alNone) or StartControl.IsControlVisible) then 2513 AlignList.Add(StartControl); 2514 2515 // then add all other 2516 for I := 0 to FAlignOrder.Count - 1 do 2517 begin 2518 Control := TControl(FAlignOrder[I]); 2519 2520 if (Control.Align = TheAlign) and Control.IsControlVisible then 2521 begin 2522 if Control = StartControl then Continue; 2523 2524 X := 0; 2525 while (X < AlignList.Count) and 2526 not InsertBefore(Control, TControl(AlignList[X]), TheAlign) do 2527 Inc(X); 2528 AlignList.Insert(X, Control); 2529 end; 2530 end; 2531end; 2532 2533procedure TWinControl.UpdateAlignIndex(aChild: TControl); 2534// Move child control to position 0 of FAlignOrder 2535var 2536 i: Integer; 2537begin 2538 if FAlignOrder=nil then 2539 FAlignOrder:=TFPList.Create; 2540 i:=FAlignOrder.IndexOf(aChild); 2541 if i<0 then 2542 FAlignOrder.Insert(0,aChild) 2543 else 2544 FAlignOrder.Move(i,0); 2545end; 2546 2547{------------------------------------------------------------------------------ 2548 TWinControl AlignControls 2549 2550 Align child controls 2551------------------------------------------------------------------------------} 2552procedure TWinControl.AlignControls(AControl: TControl; 2553 var RemainingClientRect: TRect); 2554{ $DEFINE CHECK_POSITION} 2555var 2556 AlignList: TFPList; 2557 BoundsMutated: boolean; 2558 LastBoundsMutated: TControl; 2559 LastBoundsMutatedOld: TRect; 2560 ParentClientWidth: integer; 2561 ParentClientHeight: integer; 2562 RemainingBorderSpace: TRect; // borderspace around RemainingClientRect 2563 // e.g. Right=3 means borderspace of 3 2564 2565 function NeedAlignWork: Boolean; 2566 var 2567 I: Integer; 2568 CurControl: TControl; 2569 begin 2570 Result := True; 2571 for I := ControlCount - 1 downto 0 do 2572 begin 2573 CurControl:=Controls[I]; 2574 if (CurControl.Align <> alNone) 2575 or (CurControl.Anchors <> [akLeft, akTop]) 2576 or (CurControl.AnchorSide[akLeft].Control<>nil) 2577 or (CurControl.AnchorSide[akTop].Control<>nil) 2578 or (cfAutoSizeNeeded in CurControl.FControlFlags) 2579 or (ChildSizing.Layout<>cclNone) 2580 then Exit; 2581 end; 2582 Result := False; 2583 end; 2584 2585 function Anchored(Align: TAlign; Anchors: TAnchors): Boolean; 2586 begin 2587 case Align of 2588 alLeft: Result := akLeft in Anchors; 2589 alTop: Result := akTop in Anchors; 2590 alRight: Result := akRight in Anchors; 2591 alBottom: Result := akBottom in Anchors; 2592 alClient: Result := Anchors = [akLeft, akTop, akRight, akBottom]; 2593 else 2594 Result := False; 2595 end; 2596 end; 2597 2598 procedure DoPosition(Control: TControl; AAlign: TAlign; AControlIndex: Integer); 2599 var 2600 NewLeft, NewTop, NewWidth, NewHeight: Integer; 2601 ParentBaseClientSize: TSize; 2602 CurBaseBounds: TRect; 2603 NewRight: Integer;// temp variable, not always valid, use with care ! 2604 NewBottom: Integer;// temp variable, not always valid, use with care ! 2605 2606 MinWidth: Integer; 2607 MaxWidth: Integer; 2608 MinHeight: Integer; 2609 MaxHeight: Integer; 2610 CurRemainingClientRect: TRect; 2611 CurRemainingBorderSpace: TRect; // borderspace around RemainingClientRect 2612 // e.g. Right=3 means borderspace of 3 2613 ChildAroundSpace: TRect; 2614 AnchorSideCacheValid: array[TAnchorKind] of boolean; 2615 AnchorSideCache: array[TAnchorKind] of integer; 2616 CurAnchors: TAnchors; 2617 CurAlignAnchors: TAnchors; 2618 OldBounds: TRect; 2619 NewBounds: TRect; 2620 2621 AlignInfo: TAlignInfo; // alCustom 2622 PrefWidth: integer; 2623 PrefHeight: integer; 2624 2625 function ConstraintWidth(NewWidth: integer): Integer; 2626 begin 2627 Result:=NewWidth; 2628 if (MaxWidth>=MinWidth) and (Result>MaxWidth) and (MaxWidth>0) then 2629 Result:=MaxWidth; 2630 if Result<MinWidth then Result:=MinWidth; 2631 end; 2632 2633 procedure ConstraintWidth(var NewLeft, NewWidth: integer); 2634 var 2635 ConWidth: LongInt; 2636 begin 2637 ConWidth:=ConstraintWidth(NewWidth); 2638 if ConWidth<>NewWidth then begin 2639 if [akLeft,akRight]*CurAnchors=[akRight] then 2640 // move left side, keep right 2641 inc(NewLeft,NewWidth-ConWidth); 2642 NewWidth:=ConWidth; 2643 end; 2644 end; 2645 2646 function ConstraintHeight(NewHeight: integer): Integer; 2647 begin 2648 Result:=NewHeight; 2649 if (MaxHeight>=MinHeight) and (Result>MaxHeight) and (MaxHeight>0) then 2650 Result:=MaxHeight; 2651 if Result<MinHeight then Result:=MinHeight; 2652 end; 2653 2654 procedure ConstraintHeight(var NewTop, NewHeight: integer); 2655 var 2656 ConHeight: LongInt; 2657 begin 2658 ConHeight:=ConstraintHeight(NewHeight); 2659 if ConHeight<>NewHeight then begin 2660 if [akTop,akBottom]*CurAnchors=[akBottom] then 2661 // move top side, keep bottom 2662 inc(NewTop,NewHeight-ConHeight); 2663 NewHeight:=ConHeight; 2664 end; 2665 end; 2666 2667 procedure InitAnchorSideCache; 2668 var 2669 a: TAnchorKind; 2670 begin 2671 for a:=Low(TAnchorKind) to High(TAnchorKind) do 2672 AnchorSideCacheValid[a]:=false; 2673 end; 2674 2675 function GetAnchorSidePosition(Kind: TAnchorKind; 2676 DefaultPosition: Integer): integer; 2677 // calculates the position in pixels of a side due to anchors 2678 // For example: if akLeft is set, it returns the coordinate for the left anchor 2679 var 2680 CurAnchorSide: TAnchorSide; 2681 ReferenceControl: TControl; 2682 ReferenceSide: TAnchorSideReference; 2683 Position: Integer; 2684 begin 2685 if AnchorSideCacheValid[Kind] then begin 2686 Result:=AnchorSideCache[Kind]; 2687 exit; 2688 end; 2689 Result:=DefaultPosition; 2690 CurAnchorSide:=Control.AnchorSide[Kind]; 2691 //if CheckPosition(Control) and (Kind=akLeft) then debugln(['GetAnchorSidePosition A Self=',DbgSName(Self),' Control=',DbgSName(Control),' CurAnchorSide.Control=',DbgSName(CurAnchorSide.Control),' Spacing=',Control.BorderSpacing.GetSpace(Kind)]); 2692 CurAnchorSide.GetSidePosition(ReferenceControl,ReferenceSide,Position); 2693 if ReferenceControl<>nil then begin 2694 //DebugLn(['GetAnchorSidePosition ',DbgSName(Control),' ReferenceControl=',DbgSName(ReferenceControl)]); 2695 Result:=Position; 2696 end; 2697 //if CheckPosition(Control) and (Kind=akRight) then begin 2698 // debugln('GetAnchorSidePosition B Self=',DbgSName(Self),' Control=',DbgSName(Control),' Result=',dbgs(Result),' ReferenceControl=',dbgsName(ReferenceControl)); 2699 // if ReferenceControl<>nil then DebugLn(['GetAnchorSidePosition ReferenceControl.BoundsRect=',dbgs(ReferenceControl.BoundsRect)]); 2700 //end; 2701 AnchorSideCacheValid[Kind]:=true; 2702 AnchorSideCache[Kind]:=Result; 2703 if ReferenceSide=asrTop then ; 2704 end; 2705 2706 begin 2707 {$IFDEF CHECK_POSITION} 2708 if CheckPosition(Control) then 2709 with Control do 2710 DebugLn('[TWinControl.AlignControls.DoPosition] A Control=',dbgsName(Control),' ', 2711 dbgs(Left),',',dbgs(Top),',',dbgs(Width),',',dbgs(Height), 2712 ' recalculate the anchors=',dbgs(Control.Anchors <> AnchorAlign[AAlign]), 2713 ' Align=',DbgS(AAlign)); 2714 {$ENDIF} 2715 2716 with Control do begin 2717 // get constraints 2718 MinWidth:=Constraints.EffectiveMinWidth; 2719 if MinWidth<0 then MinWidth:=0; 2720 MaxWidth:=Constraints.EffectiveMaxWidth; 2721 MinHeight:=Constraints.EffectiveMinHeight; 2722 if MinHeight<0 then MinHeight:=0; 2723 MaxHeight:=Constraints.EffectiveMaxHeight; 2724 2725 // get anchors set by Align 2726 CurAlignAnchors:=[]; 2727 if Align in [alLeft,alRight,alBottom,alTop,alClient] then 2728 CurAlignAnchors:=AnchorAlign[Align]; 2729 CurAnchors:=Anchors+CurAlignAnchors; 2730 2731 // get default bounds 2732 NewLeft:=Left; 2733 NewTop:=Top; 2734 NewWidth:=Width; 2735 NewHeight:=Height; 2736 if AutoSize then begin 2737 GetPreferredSize(PrefWidth,PrefHeight); 2738 if PrefWidth>0 then NewWidth:=PrefWidth; 2739 if PrefHeight>0 then NewHeight:=PrefHeight; 2740 end; 2741 ConstraintWidth(NewLeft,NewWidth); 2742 ConstraintHeight(NewTop,NewHeight); 2743 end; 2744 2745 InitAnchorSideCache; 2746 2747 { Recalculate the anchors 2748 2749 Use Anchors to ensure that a control maintains its current position 2750 relative to an edge of its parent or another sibling. 2751 This is controlled with the AnchorSide properties. 2752 2753 1. If AnchorSide[].Control is not set, the distance is kept relative to 2754 the edges of the client area of its parent. 2755 When its parent is resized, the control holds its position relative to the 2756 edges to which it is anchored. 2757 If a control is anchored to opposite edges of its parent, the control 2758 stretches when its parent is resized. For example, if a control has its 2759 Anchors property set to [akLeft,akRight], the control stretches when the 2760 width of its parent changes. 2761 Anchors is enforced only when the parent is resized. Thus, for example, 2762 if a control is anchored to opposite edges of a form at design time and 2763 the form is created in a maximized state, the control is not stretched 2764 because the form is not resized after the control is created. 2765 2766 2. If AnchorSide[].Control is set, the BorderSpace properties defines the 2767 distance to another sibling (i.e. AnchorSide[].Control). 2768 } 2769 if (AAlign = alNone) or (Control.Anchors <> CurAlignAnchors) 2770 then begin 2771 // at least one side is anchored without align 2772 2773 // Get the base bounds. The base bounds are the user defined bounds 2774 // without automatic aligning and/or anchoring 2775 2776 // get base size of parents client area 2777 ParentBaseClientSize:=Control.FBaseParentClientSize; 2778 if (ParentBaseClientSize.cx=0) 2779 and (ParentBaseClientSize.cy=0) then 2780 ParentBaseClientSize:=Size(ParentClientWidth,ParentClientHeight); 2781 2782 // get base bounds of Control 2783 CurBaseBounds:=Control.FBaseBounds; 2784 if not (cfBaseBoundsValid in FControlFlags) then 2785 CurBaseBounds:=Control.BoundsRect; 2786 2787 {$IFDEF CHECK_POSITION} 2788 //if csDesigning in ComponentState then 2789 if CheckPosition(Control) then 2790 DebugLn('[TWinControl.AlignControls.DoPosition] Before Anchoring ', 2791 ' Self='+DbgSName(Self),' Control='+DbgSName(Control), 2792 ' CurBaseBounds='+dbgs(CurBaseBounds.Left)+','+dbgs(CurBaseBounds.Top)+','+dbgs(CurBaseBounds.Right-CurBaseBounds.Left)+','+dbgs(CurBaseBounds.Bottom-CurBaseBounds.Top), 2793 ' ParentBaseClientSize='+dbgs(ParentBaseClientSize.cx)+','+dbgs(ParentBaseClientSize.cy), 2794 ' ControlParent.Client='+dbgs(ParentClientWidth)+','+dbgs(ParentClientHeight), 2795 ' NewBounds='+dbgs(NewLeft)+','+dbgs(NewTop)+','+dbgs(NewWidth)+','+dbgs(NewHeight), 2796 ''); 2797 {$ENDIF} 2798 2799 if akLeft in CurAnchors then begin 2800 // keep distance to left side of parent or another sibling 2801 NewLeft:=GetAnchorSidePosition(akLeft,CurBaseBounds.Left); 2802 if akRight in CurAnchors then begin 2803 // keep distance to right side of parent or another sibling 2804 // -> change the width 2805 NewRight:=ParentClientWidth 2806 -(ParentBaseClientSize.cx-CurBaseBounds.Right); 2807 if (not (akRight in CurAlignAnchors)) 2808 and (akRight in Control.Anchors) then 2809 NewRight:=GetAnchorSidePosition(akRight,NewRight); 2810 NewWidth:=ConstraintWidth(NewRight-NewLeft); 2811 end else begin 2812 // do not anchor to the right 2813 // -> keep new width 2814 end; 2815 end else begin 2816 // do not anchor to the left 2817 if akRight in CurAnchors then begin 2818 // keep distance to right side of parent 2819 // and keep new width 2820 NewRight:=ParentClientWidth 2821 -(ParentBaseClientSize.cx-CurBaseBounds.Right); 2822 if (not (akRight in CurAlignAnchors)) 2823 and (akRight in Control.Anchors) then 2824 NewRight:=GetAnchorSidePosition(akRight,NewRight); 2825 NewLeft:=NewRight-NewWidth; 2826 end else begin 2827 // do not anchor to the right 2828 // -> keep new width and scale center position. 2829 NewLeft:=MulDiv(ParentClientWidth, 2830 (CurBaseBounds.Left+CurBaseBounds.Right) div 2, 2831 ParentBaseClientSize.cx) 2832 -(NewWidth div 2); 2833 end; 2834 end; 2835 2836 if akTop in CurAnchors then begin 2837 // keep distance to top side of parent 2838 NewTop:=GetAnchorSidePosition(akTop,CurBaseBounds.Top); 2839 if akBottom in CurAnchors then begin 2840 // keep distance to bottom side of parent 2841 // -> change the height 2842 NewBottom:=ParentClientHeight 2843 -(ParentBaseClientSize.cy-CurBaseBounds.Bottom); 2844 if (not (akBottom in CurAlignAnchors)) 2845 and (akBottom in Control.Anchors) then 2846 NewBottom:=GetAnchorSidePosition(akBottom,NewBottom); 2847 NewHeight:=ConstraintHeight(NewBottom-NewTop); 2848 end else begin 2849 // do not anchor to the bottom 2850 // -> keep new height 2851 end; 2852 end else begin 2853 // do not anchor to the top 2854 if akBottom in CurAnchors then begin 2855 // keep distance to bottom side of parent 2856 // and keep new height 2857 NewBottom:=ParentClientHeight 2858 -(ParentBaseClientSize.cy-CurBaseBounds.Bottom); 2859 if (not (akBottom in CurAlignAnchors)) 2860 and (akBottom in Control.Anchors) then 2861 NewBottom:=GetAnchorSidePosition(akBottom,NewBottom); 2862 NewTop:=NewBottom-NewHeight; 2863 end else begin 2864 // do not anchor to the bottom 2865 // -> keep new height and scale center position. 2866 NewTop:=MulDiv(ParentClientHeight, 2867 (CurBaseBounds.Top+CurBaseBounds.Bottom) div 2, 2868 ParentBaseClientSize.cy) 2869 -(NewHeight div 2); 2870 end; 2871 end; 2872 {$IFDEF CHECK_POSITION} 2873 //if csDesigning in ComponentState then 2874 if CheckPosition(Control) then 2875 with Control do begin 2876 DebugLn(['[TWinControl.AlignControls.DoPosition] After Anchoring', 2877 ' Self=',DbgSName(Self), 2878 ' Align=',DbgS(AAlign), 2879 ' Control=',dbgsName(Control), 2880 ' Old= l=',Left,',t=',Top,',w=',Width,',h=',Height, 2881 ' New= l=',NewLeft,',t=',NewTop,',w=',NewWidth,',h=',NewHeight, 2882 '']); 2883 DebugLn(['DoPosition akRight=',akRight in CurAnchors,' ',GetAnchorSidePosition(akRight,NewLeft+NewWidth)]); 2884 end; 2885 {$ENDIF} 2886 end; 2887 2888 // set min size to stop cycling (this should not be needed. But if someone 2889 // plays/fixes the above code, new bugs can enter and there are far too many 2890 // combinations to test, and so the LCL can loop for some applications. 2891 // Prevent this, so users can at least report a bug.) 2892 if NewWidth<0 then NewWidth:=0; 2893 if NewHeight<0 then NewHeight:=0; 2894 2895 case AAlign of 2896 alLeft,alTop,alRight,alBottom,alClient: begin 2897 { Realign 2898 2899 Use Align to align a control to the top, bottom, left, right of a 2900 form or panel and have it remain there even if the size of the form, 2901 panel, or component that contains the control changes. When the parent 2902 is resized, an aligned control also resizes so that it continues to span 2903 the top, bottom, left, or right edge of the parent (more exact: 2904 span the remaining client area of its parent). 2905 } 2906 NewRight:=NewLeft+NewWidth; 2907 NewBottom:=NewTop+NewHeight; 2908 2909 // calculate current RemainingClientRect for the current Control 2910 CurRemainingClientRect:=RemainingClientRect; 2911 CurRemainingBorderSpace:=RemainingBorderSpace; 2912 Control.BorderSpacing.GetSpaceAround(ChildAroundSpace); 2913 AdjustBorderSpace(CurRemainingClientRect,CurRemainingBorderSpace, 2914 ChildAroundSpace); 2915 {$IFDEF CHECK_POSITION} 2916 if CheckPosition(Control) then 2917 DebugLn('DoPosition Before aligning ',dbgsName(Control),' akRight in AnchorAlign[AAlign]=',DbgS(akRight in AnchorAlign[AAlign]), 2918 ' akLeft in Control.Anchors=',DbgS(akLeft in Control.Anchors), 2919 //' ARect=',ARect.Left,',',ARect.Top,',',ARect.Right,',',ARect.Bottom, 2920 ' New=',DbgS(NewLeft,NewTop,NewRight,NewBottom)); 2921 {$ENDIF} 2922 2923 if akLeft in AnchorAlign[AAlign] 2924 then begin 2925 if (akRight in CurAnchors) 2926 then begin 2927 // left align and keep right border 2928 NewLeft:=CurRemainingClientRect.Left; 2929 NewRight:=NewLeft+ConstraintWidth(NewRight-NewLeft); 2930 end 2931 else begin 2932 // left align and right border free to move (-> keep width) 2933 dec(NewRight,NewLeft-CurRemainingClientRect.Left); 2934 NewLeft:=CurRemainingClientRect.Left; 2935 end; 2936 end; 2937 2938 if akTop in AnchorAlign[AAlign] 2939 then begin 2940 if (akBottom in CurAnchors) 2941 then begin 2942 // top align and keep bottom border 2943 NewTop:=CurRemainingClientRect.Top; 2944 NewBottom:=NewTop+ConstraintHeight(NewBottom-NewTop); 2945 end 2946 else begin 2947 // top align and bottom border is free to move (-> keep height) 2948 dec(NewBottom,NewTop-CurRemainingClientRect.Top); 2949 NewTop:=CurRemainingClientRect.Top; 2950 end; 2951 end; 2952 2953 if akRight in AnchorAlign[AAlign] 2954 then begin 2955 if (akLeft in CurAnchors) 2956 then begin 2957 // right align and keep left border 2958 NewWidth:=ConstraintWidth(CurRemainingClientRect.Right-NewLeft); 2959 if Align=alRight 2960 then begin 2961 // align to right (this overrides the keeping of left border) 2962 NewRight:=CurRemainingClientRect.Right; 2963 NewLeft:=NewRight-NewWidth; 2964 end 2965 else begin 2966 // keep left border overrides keeping right border 2967 NewRight:=NewLeft+NewWidth; 2968 end; 2969 end 2970 else begin 2971 // right align and left border free to move (-> keep width) 2972 inc(NewLeft,CurRemainingClientRect.Right-NewRight); 2973 NewRight:=CurRemainingClientRect.Right; 2974 end; 2975 end; 2976 2977 if akBottom in AnchorAlign[AAlign] 2978 then begin 2979 if (akTop in CurAnchors) 2980 then begin 2981 // bottom align and keep top border 2982 NewHeight:=ConstraintHeight(CurRemainingClientRect.Bottom-NewTop); 2983 if AAlign=alBottom 2984 then begin 2985 // align to bottom (this overrides the keeping of top border) 2986 NewBottom:=CurRemainingClientRect.Bottom; 2987 NewTop:=NewBottom-NewHeight; 2988 end 2989 else begin 2990 // keeping top border overrides keeping bottom border 2991 NewBottom:=NewTop+NewHeight; 2992 end; 2993 end 2994 else begin 2995 // bottom align and top border free to move (-> keep height) 2996 inc(NewTop,CurRemainingClientRect.Bottom-NewBottom); 2997 NewBottom:=CurRemainingClientRect.Bottom; 2998 end; 2999 end; 3000 3001 NewWidth:=Max(0,NewRight-NewLeft); 3002 NewHeight:=Max(0,NewBottom-NewTop); 3003 3004 {$IFDEF CHECK_POSITION} 3005 //if csDesigning in Control.ComponentState then 3006 if CheckPosition(Control) then 3007 with Control do 3008 DebugLn('[TWinControl.AlignControls.DoPosition] After Aligning', 3009 ' ',Name,':',ClassName, 3010 ' Align=',DbgS(AAlign), 3011 ' Control=',Name,':',ClassName, 3012 ' Old=',DbgS(Left,Top,Width,Height), 3013 ' New=',DbgS(NewLeft,NewTop,NewWidth,NewHeight), 3014 //' ARect=',ARect.Left,',',ARect.Top,',',ARect.Right-ARect.Left,',',ARect.Bottom-ARect.Top, 3015 ''); 3016 {$ENDIF} 3017 end; 3018 alCustom: begin 3019 AlignInfo.AlignList := AlignList; 3020 AlignInfo.Align := alCustom; 3021 AlignInfo.ControlIndex := AControlIndex; 3022 CustomAlignPosition(Control, NewLeft, NewTop, NewWidth, NewHeight, RemainingClientRect, AlignInfo); 3023 end; 3024 end; 3025 3026 // apply the constraints 3027 NewWidth:=ConstraintWidth(NewWidth); 3028 NewHeight:=ConstraintHeight(NewHeight); 3029 NewRight:=NewLeft+NewWidth; 3030 NewBottom:=NewTop+NewHeight; 3031 3032 // set the new bounds 3033 if (Control.Left <> NewLeft) or (Control.Top <> NewTop) 3034 or (Control.Width <> NewWidth) or (Control.Height <> NewHeight) then begin 3035 {$IFDEF CHECK_POSITION} 3036 //if csDesigning in Control.ComponentState then 3037 if CheckPosition(Control) then 3038 with Control do 3039 DebugLn('[TWinControl.AlignControls.DoPosition] NEW BOUNDS Control=',DbgSName(Control), 3040 ' New=l=',dbgs(NewLeft)+',t='+dbgs(NewTop)+',w='+dbgs(NewWidth)+',h='+dbgs(NewHeight)); 3041 {$ENDIF} 3042 // lock the base bounds, so that the new automatic bounds do not override 3043 // the user settings 3044 OldBounds:=Control.BoundsRect; 3045 Control.SetBoundsKeepBase(NewLeft, NewTop, NewWidth, NewHeight); 3046 //DebugLn(['DoPosition ',DbgSName(Control),' ',cfAutoSizeNeeded in Control.FControlFlags]); 3047 NewBounds:=Control.BoundsRect; 3048 BoundsMutated:=not CompareRect(@OldBounds,@NewBounds); 3049 if BoundsMutated then begin 3050 LastBoundsMutated:=Control; 3051 LastBoundsMutatedOld:=OldBounds; 3052 end; 3053 // Sometimes SetBounds change the bounds. For example due to constraints. 3054 // update the new bounds 3055 with Control do 3056 begin 3057 NewLeft:=Left; 3058 NewTop:=Top; 3059 NewWidth:=Width; 3060 NewHeight:=Height; 3061 end; 3062 {$IFDEF CHECK_POSITION} 3063 //if csDesigning in Control.ComponentState then 3064 if CheckPosition(Control) then 3065 with Control do 3066 DebugLn('[TWinControl.AlignControls.DoPosition] AFTER SETBOUND Control=',DbgSName(Control),' Bounds=',DbgS(Control.BoundsRect)); 3067 {$ENDIF} 3068 end; 3069 3070 // adjust the remaining client area 3071 case AAlign of 3072 alTop: 3073 begin 3074 RemainingClientRect.Top:=Min(NewTop+NewHeight,RemainingClientRect.Bottom); 3075 RemainingBorderSpace.Top:=0; 3076 AdjustBorderSpace(RemainingClientRect,RemainingBorderSpace, 3077 0,Max(ChildSizing.VerticalSpacing,ChildAroundSpace.Bottom),0,0); 3078 end; 3079 alBottom: 3080 begin 3081 RemainingClientRect.Bottom:=Max(NewTop,RemainingClientRect.Top); 3082 RemainingBorderSpace.Bottom:=0; 3083 AdjustBorderSpace(RemainingClientRect,RemainingBorderSpace, 3084 0,0,0,Max(ChildSizing.VerticalSpacing,ChildAroundSpace.Top)); 3085 end; 3086 alLeft: 3087 begin 3088 RemainingClientRect.Left:=Min(NewLeft+NewWidth,RemainingClientRect.Right); 3089 RemainingBorderSpace.Left:=0; 3090 AdjustBorderSpace(RemainingClientRect,RemainingBorderSpace, 3091 Max(ChildSizing.HorizontalSpacing,ChildAroundSpace.Right),0,0,0); 3092 end; 3093 alRight: 3094 begin 3095 RemainingClientRect.Right:=Max(NewLeft,RemainingClientRect.Left); 3096 RemainingBorderSpace.Right:=0; 3097 AdjustBorderSpace(RemainingClientRect,RemainingBorderSpace, 3098 0,0,Max(ChildSizing.HorizontalSpacing,ChildAroundSpace.Left),0); 3099 end; 3100 alClient: 3101 begin 3102 // For VCL compatibility alClient should *not* reduce the free space, 3103 // so that several alClient controls can overlap. This can be used 3104 // for example to simulate a two page control and edit both pages 3105 // at designtime with SendToBack. 3106 // At runtime programs should use Visible instead of BringToFront to 3107 // reduce overhead. 3108 // See bug 10380. 3109 end; 3110 end; 3111 3112 {$IFDEF CHECK_POSITION} 3113 if CheckPosition(Control) then 3114 with Control do 3115 DebugLn('[TWinControl.AlignControls.DoPosition] END Control=', 3116 Name,':',ClassName, 3117 ' ',DbgS(Left,Top,Width,Height), 3118 ' Align=',DbgS(AAlign), 3119 //' ARect=',ARect.Left,',',ARect.Top,',',ARect.Right-ARect.Left,',',ARect.Bottom-ARect.Top, 3120 ''); 3121 {$ENDIF} 3122 end; 3123 3124 procedure DoAlign(AAlign: TAlign); 3125 var 3126 I: Integer; 3127 Control: TControl; 3128 begin 3129 //DebugLn(['DoAlign ',DbgSName(Self),' ',dbgs(AALign),' ClientRect=',dbgs(ClientRect),' ControlCount=',ControlCount]); 3130 CreateControlAlignList(AAlign,AlignList,AControl); 3131 {$IFDEF CHECK_POSITION} 3132 if CheckPosition(Self) then 3133 if AlignList.Count>0 then 3134 begin 3135 DbgOut('[TWinControl.AlignControls.DoAlign] Self=',DbgSName(Self),' Control=',dbgsName(AControl), 3136 ' current align=',DbgS(AAlign),' AlignList=['); 3137 for i:=0 to AlignList.Count-1 do 3138 begin 3139 if i>0 then DbgOut(','); 3140 DbgOut(DbgSName(TObject(AlignList[i]))); 3141 end; 3142 DebugLn(']'); 3143 end; 3144 {$ENDIF} 3145 3146 // let override handle them 3147 if DoAlignChildControls(AAlign, AControl, AlignList, RemainingClientRect) then 3148 exit; 3149 // remove controls that are positioned by other means 3150 if (AAlign = alNone) and (AutoSize or (ChildSizing.Layout <> cclNone)) then 3151 for I := AlignList.Count - 1 downto 0 do 3152 begin 3153 Control := TControl(AlignList[I]); 3154 if IsNotAligned(Control) then AlignList.Delete(I); 3155 end; 3156 // anchor/align control 3157 for I := 0 to AlignList.Count - 1 do 3158 DoPosition(TControl(AlignList[I]), AAlign, I); 3159 end; 3160 3161 procedure DoAlignNotAligned; 3162 // All controls, not aligned by their own properties, can be auto aligned. 3163 var 3164 i: Integer; 3165 Control: TControl; 3166 begin 3167 // check if ChildSizing aligning is enabled 3168 if (ChildSizing.Layout = cclNone) then 3169 exit; 3170 3171 /// collect all 'not aligned' controls 3172 AlignList.Clear; 3173 for i := 0 to ControlCount - 1 do 3174 begin 3175 Control := Controls[i]; 3176 if IsNotAligned(Control) and Control.IsControlVisible then 3177 AlignList.Add(Control); 3178 end; 3179 //debugln('DoAlignNotAligned ',DbgSName(Self),' AlignList.Count=',dbgs(AlignList.Count)); 3180 if AlignList.Count = 0 then exit; 3181 3182 LastBoundsMutated := nil; 3183 AlignNonAlignedControls(AlignList, BoundsMutated); 3184 end; 3185 3186var 3187 i: Integer; 3188 OldRemainingClientRect: TRect; 3189 OldRemainingBorderSpace: TRect; 3190 MaxTries: LongInt; 3191 r: TRect; 3192begin 3193 //DebugLn(['TWinControl.AlignControls ',DbgSName(Self),' ',not (wcfAligningControls in FWinControlFlags)]); 3194 if wcfAligningControls in FWinControlFlags then exit; 3195 Include(FWinControlFlags,wcfAligningControls); 3196 try 3197 //if csDesigning in ComponentState then begin 3198 //DebugLn('[TWinControl.AlignControls] ',Name,':',Classname,' ',Left,',',Top,',',Width,',',Height,' AlignWork=',NeedAlignWork,' ControlCount=',ControlCount); 3199 //if AControl<>nil then DebugLn(' AControl=',AControl.Name,':',AControl.ClassName); 3200 //end; 3201 // first let the DockManager align controls 3202 if DockSite and UseDockManager and (DockManager<>nil) then 3203 DockManager.ResetBounds(false); 3204 AdjustClientRect(RemainingClientRect); 3205 r:=GetLogicalClientRect; 3206 ParentClientWidth:=r.Right; 3207 ParentClientHeight:=r.Bottom; 3208 3209 if NeedAlignWork then 3210 begin 3211 //DebugLn(['TWinControl.AlignControls ',DbgSName(Self),' RemainingClientRect=',dbgs(RemainingClientRect),' ',dbgs(ClientRect)]); 3212 RemainingBorderSpace:=Rect(0,0,0,0); 3213 // adjust RemainingClientRect by ChildSizing properties 3214 AdjustBorderSpace(RemainingClientRect,RemainingBorderSpace, 3215 ChildSizing.LeftRightSpacing,ChildSizing.TopBottomSpacing, 3216 ChildSizing.LeftRightSpacing,ChildSizing.TopBottomSpacing); 3217 //DebugLn('[TWinControl.AlignControls] ',Name,':',Classname,' ',Left,',',Top,',',Width,',',Height,' ClientRect=',RemainingClientRect.Left,',',RemainingClientRect.Top,',',RemainingClientRect.Right,',',RemainingClientRect.Bottom); 3218 AlignList := TFPList.Create; 3219 try 3220 // Auto aligning/anchoring can be very interdependent. 3221 // In worst case the n-2 depends on the n-1, the n-3 depends on n-2 3222 // and so forth. This is allowed, so do up to n loop step. 3223 // Do not more, to avoid endless loops, if there are circlular 3224 // dependencies. 3225 MaxTries:=ControlCount; 3226 {$IFDEF CHECK_POSITION}inc(MaxTries);{$ENDIF} 3227 for i:=1 to MaxTries do begin 3228 // align and anchor child controls 3229 BoundsMutated:=false; 3230 OldRemainingClientRect:=RemainingClientRect; 3231 OldRemainingBorderSpace:=RemainingBorderSpace; 3232 DoAlign(alTop); 3233 DoAlign(alBottom); 3234 DoAlign(alLeft); 3235 DoAlign(alRight); 3236 DoAlign(alClient); 3237 DoAlign(alCustom); 3238 DoAlign(alNone); 3239 DoAlignNotAligned; 3240 if not BoundsMutated then break; 3241 if (i=ControlCount+1) then begin 3242 DebugLn(['Warning: TWinControl.AlignControls ENDLESS LOOP STOPPED ',DbgSName(Self),' i=',i]); 3243 if LastBoundsMutated<>nil then 3244 DebugLn(['Warning: TWinControl.AlignControls LAST CHANGED: ',DbgSName(LastBoundsMutated),' Old=',dbgs(LastBoundsMutatedOld),' Now=',dbgs(LastBoundsMutated.BoundsRect)]); 3245 end; 3246 // update again 3247 RemainingClientRect:=OldRemainingClientRect; 3248 RemainingBorderSpace:=OldRemainingBorderSpace; 3249 end; 3250 finally 3251 AlignList.Free; 3252 end; 3253 end; 3254 ControlsAligned; 3255 finally 3256 Exclude(FWinControlFlags,wcfAligningControls); 3257 end; 3258end; 3259 3260function TWinControl.CustomAlignInsertBefore(AControl1, AControl2: TControl): Boolean; 3261begin 3262 Result := Assigned(FOnAlignInsertBefore) 3263 and FOnAlignInsertBefore(Self, AControl1, AControl2); 3264end; 3265 3266procedure TWinControl.CustomAlignPosition(AControl: TControl; var ANewLeft, ANewTop, 3267 ANewWidth, ANewHeight: Integer; var AlignRect: TRect; AlignInfo: TAlignInfo); 3268begin 3269 if Assigned(FOnAlignPosition) 3270 then FOnAlignPosition(Self, AControl, ANewLeft, ANewTop, ANewWidth, ANewHeight, AlignRect, AlignInfo); 3271end; 3272 3273function TWinControl.DoAlignChildControls(TheAlign: TAlign; AControl: TControl; 3274 AControlList: TFPList; var ARect: TRect): Boolean; 3275begin 3276 Result:=false; 3277end; 3278 3279procedure TWinControl.DoChildSizingChange(Sender: TObject); 3280begin 3281 //debugln('TWinControl.DoChildSizingChange ',DbgSName(Self)); 3282 if ControlCount=0 then exit; 3283 InvalidatePreferredSize; 3284 ReAlign; 3285end; 3286 3287procedure TWinControl.InvalidatePreferredChildSizes; 3288var 3289 AControl: TControl; 3290 i: Integer; 3291begin 3292 for i:=0 to ControlCount-1 do begin 3293 AControl:=Controls[i]; 3294 Exclude(AControl.FControlFlags,cfPreferredSizeValid); 3295 Exclude(AControl.FControlFlags,cfPreferredMinSizeValid); 3296 if AControl is TWinControl then 3297 Exclude(TWinControl(AControl).FWinControlFlags,wcfAdjustedLogicalClientRectValid); 3298 if AControl is TWinControl then 3299 TWinControl(AControl).InvalidatePreferredChildSizes; 3300 end; 3301end; 3302 3303{------------------------------------------------------------------------------- 3304 procedure TWinControl.DoAutoSize; 3305 3306 Shrink or enlarge to fit children. 3307-------------------------------------------------------------------------------} 3308procedure TWinControl.DoAutoSize; 3309var 3310 HasVisibleChilds: boolean; 3311 3312 procedure GetMoveDiffForNonAlignedChilds(const CurClientRect: TRect; 3313 out dx, dy: integer); 3314 // how much can non-aligned-children be moved up and left 3315 // non-aligned-children: no fixed anchoring or autosizing, 3316 // (Align=alNone, visible, AnchorSide[].Control=nil) 3317 // borderspacing is used 3318 // e.g. dx=10 means all non-align-children should be moved 10 pixels to the left 3319 var 3320 NewClientWidth, NewClientHeight: integer; 3321 Layout: TAutoSizeCtrlData; 3322 begin 3323 if ChildSizing.Layout<>cclNone then begin 3324 dx:=0; 3325 dy:=0; 3326 exit; 3327 end; 3328 3329 // get the move requirements for the child controls 3330 Layout:=nil; 3331 try 3332 Layout:=TAutoSizeCtrlData.Create(Self); 3333 Layout.ComputePreferredClientArea( 3334 not (csAutoSizeKeepChildLeft in ControlStyle), 3335 not (csAutoSizeKeepChildTop in ControlStyle), 3336 dx,dy,NewClientWidth,NewClientHeight); 3337 if (NewClientWidth<>0) or (NewClientHeight<>0) then ; 3338 //if (dx<>0) or (dy<>0) then DebugLn(['GetMoveDiffForNonAlignedChilds ',DbgSName(Self),' dx=',dx,' dy=',dy]); 3339 finally 3340 Layout.Free; 3341 end; 3342 end; 3343 3344var 3345 I: Integer; 3346 AControl: TControl; 3347 PreferredWidth: LongInt; 3348 PreferredHeight: LongInt; 3349 CurClientRect: TRect; 3350 WidthIsFixed: boolean; 3351 HeightIsFixed: boolean; 3352 NewLeft: LongInt; 3353 NewTop: LongInt; 3354 CurAnchors: TAnchors; 3355 dx: Integer; 3356 dy: Integer; 3357 NewChildBounds: TRect; 3358 OldChildBounds: TRect; 3359begin 3360 {$IFDEF VerboseAllAutoSize} 3361 debugln('TWinControl.DoAutoSize ',DbgSName(Self)); 3362 {$ENDIF} 3363 if not (caspComputingBounds in AutoSizePhases) then begin 3364 {$IFDEF VerboseAllAutoSize} 3365 DebugLn(['TWinControl.DoAutoSize DELAYED AutoSizePhases=',dbgs(AutoSizePhases)]); 3366 {$ENDIF} 3367 AdjustSize; 3368 exit; 3369 end; 3370 3371 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.DoAutoSize'){$ENDIF}; 3372 try 3373 // test if resizing is possible 3374 HasVisibleChilds:=false; 3375 for i:=0 to ControlCount-1 do 3376 if Controls[i].IsControlVisible then begin 3377 HasVisibleChilds:=true; 3378 break; 3379 end; 3380 3381 CurAnchors:=Anchors; 3382 if Align<>alNone then CurAnchors:=CurAnchors+AnchorAlign[Align]; 3383 WidthIsFixed:=WidthIsAnchored; 3384 HeightIsFixed:=HeightIsAnchored; 3385 3386 // move free children as much as possible to left and top (all free children the same) 3387 if HasVisibleChilds then begin 3388 CurClientRect:=GetLogicalClientRect; 3389 AdjustClientRect(CurClientRect); 3390 // get minimum left, top of non aligned children 3391 GetMoveDiffForNonAlignedChilds(CurClientRect,dx,dy); 3392 //DebugLn(['TWinControl.DoAutoSize ',DbgSName(Self),' CurClientRect=',dbgs(CurClientRect)]); 3393 3394 if (dx<>0) or (dy<>0) then begin 3395 // move all free children to left and top of client area 3396 //DebugLn(['TWinControl.DoAutoSize ',DbgSName(Self),' dx=',dbgs(dx),' dy=',dbgs(dy),' CurClientRect=',dbgs(CurClientRect),' CurAnchors=',dbgs(CurAnchors),' IsFixed: w=',WidthIsFixed,' h=',HeightIsFixed]); 3397 for I := 0 to ControlCount - 1 do begin 3398 AControl:=Controls[I]; 3399 if not AControl.IsControlVisible then continue; 3400 if AControl.Align<>alNone then continue; 3401 //DebugLn(['TWinControl.DoAutoSize BEFORE ',DbgSName(AControl),' ',dbgs(AControl.BoundsRect)]); 3402 NewChildBounds:=AControl.BoundsRect; 3403 if (akLeft in AControl.Anchors) 3404 and (AControl.AnchorSide[akLeft].Control=nil) then begin 3405 dec(NewChildBounds.Left,dx); 3406 if not (akRight in AControl.Anchors) then 3407 dec(NewChildBounds.Right,dx); 3408 end; 3409 if (akTop in AControl.Anchors) 3410 and (AControl.AnchorSide[akTop].Control=nil) then begin 3411 dec(NewChildBounds.Top,dy); 3412 if not (akBottom in AControl.Anchors) then 3413 dec(NewChildBounds.Bottom,dy); 3414 end; 3415 // Important: change the BaseBounds too, otherwise the changes will be undone by AlignControls 3416 OldChildBounds:=AControl.BoundsRect; 3417 if not CompareRect(@OldChildBounds,@NewChildBounds) then begin 3418 //DebugLn(['TWinControl.DoAutoSize moving child: ',DbgSName(AControl),' Old=',dbgs(OldChildBounds),' New=',dbgs(NewChildBounds)]); 3419 AControl.BoundsRect:=NewChildBounds; 3420 //DebugLn(['TWinControl.DoAutoSize AFTER ',DbgSName(AControl),' ',dbgs(AControl.BoundsRect)]); 3421 end; 3422 end; 3423 end; 3424 end; 3425 3426 // autosize control to preferred size 3427 if (not WidthIsFixed) or (not HeightIsFixed) then begin 3428 GetPreferredSize(PreferredWidth,PreferredHeight, 3429 false,// with constraints 3430 true // with theme space 3431 ); 3432 //if ControlCount>0 then DebugLn(['TWinControl.DoAutoSize ',DbgSName(Self),' PreferredWidth=',PreferredWidth,' PreferredHeight=',PreferredHeight,' ControlCount=',ControlCount]); 3433 end else begin 3434 PreferredWidth:=0; 3435 PreferredHeight:=0; 3436 end; 3437 if WidthIsFixed or (PreferredWidth<0) 3438 or ((PreferredWidth=0) and (not (csAutoSize0x0 in ControlStyle))) then 3439 PreferredWidth:=Constraints.MinMaxWidth(Width); 3440 if HeightIsFixed or (PreferredHeight<0) 3441 or ((PreferredHeight=0) and (not (csAutoSize0x0 in ControlStyle))) then 3442 PreferredHeight:=Constraints.MinMaxHeight(Height); 3443 3444 // set new size 3445 {$IF defined(VerboseAutoSize) or defined(VerboseAllAutoSize)} 3446 debugln(['TWinControl.DoAutoSize A ',DbgSName(Self),' Cur=',Width,'x',Height,' Prefer=',PreferredWidth,'x',PreferredHeight,' WidgetClass=',WidgetSetClass.ClassName,' Fixed=',WidthIsFixed,'x',HeightIsFixed]); 3447 {$ENDIF} 3448 if (PreferredWidth<>Width) or (PreferredHeight<>Height) then begin 3449 // adjust Left/Top as well to reduce auto sizing overhead 3450 NewLeft:=Left; 3451 NewTop:=Top; 3452 if akRight in CurAnchors then 3453 inc(NewLeft,Width-PreferredWidth); 3454 if akBottom in CurAnchors then 3455 inc(NewTop,Height-PreferredHeight); 3456 //if CompareText(Name,'NewUnitOkButton')=0 then 3457 //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)]); 3458 SetBoundsKeepBase(NewLeft,NewTop,PreferredWidth,PreferredHeight); 3459 end; 3460 finally 3461 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.DoAutoSize'){$ENDIF}; 3462 end; 3463end; 3464 3465procedure TWinControl.DoAllAutoSize; 3466 3467 function CheckHandleAllocated(AWinControl: TWinControl): boolean; 3468 // true if a handle was missing 3469 var 3470 i: Integer; 3471 ChildWinControl: TWinControl; 3472 begin 3473 if AWinControl.HandleObjectShouldBeVisible and (not AWinControl.HandleAllocated) then 3474 begin 3475 {$IFDEF VerboseAllAutoSize} 3476 DebugLn(['TWinControl.DoAllAutoSize CREATE HANDLE ',DbgSName(AWinControl)]); 3477 {$ENDIF} 3478 AWinControl.HandleNeeded; 3479 Exit(True); 3480 end; 3481 Result := False; 3482 for i := 0 to AWinControl.ControlCount - 1 do 3483 begin 3484 ChildWinControl := TWinControl(AWinControl.Controls[i]); 3485 if (ChildWinControl is TWinControl) and CheckHandleAllocated(ChildWinControl) then 3486 Result:=true; 3487 end; 3488 end; 3489 3490 procedure ClearRequests(AControl: TControl); 3491 var 3492 i: Integer; 3493 begin 3494 Exclude(AControl.FControlFlags,cfAutoSizeNeeded); 3495 if AControl is TWinControl then 3496 for i:=0 to TWinControl(AControl).ControlCount-1 do 3497 ClearRequests(TWinControl(AControl).Controls[i]); 3498 end; 3499 3500 procedure UpdateShowingRecursive(AWinControl: TWinControl; 3501 OnlyChildren: boolean); 3502 var 3503 i: Integer; 3504 begin 3505 // first make the children visible 3506 if AWinControl.FControls<>nil then 3507 for i:=0 to AWinControl.FControls.Count-1 do 3508 if TObject(AWinControl.FControls[i]) is TWinControl then 3509 UpdateShowingRecursive(TWinControl(AWinControl.FControls[i]),false); 3510 // then make the control visible 3511 if not OnlyChildren and AWinControl.HandleObjectShouldBeVisible and not AWinControl.Showing then 3512 AWinControl.UpdateShowing; 3513 end; 3514 3515var 3516 RealizeCounter: Integer; 3517 UpdateShowingCounter: Integer; 3518begin 3519 if wcfAllAutoSizing in FWinControlFlags then exit; 3520 if AutoSizeDelayed then exit; 3521 3522 {$IFDEF VerboseAllAutoSize} 3523 DebugLn(['TWinControl.DoAllAutoSize START ',DbgSName(Self),' ',dbgs(BoundsRect)]); 3524 {$ENDIF} 3525 Include(FWinControlFlags,wcfAllAutoSizing); 3526 try 3527 // create needed handles 3528 if HandleObjectShouldBeVisible then begin 3529 if CheckHandleAllocated(Self) then begin 3530 // a new handle was created 3531 end; 3532 end else begin 3533 // no autosize possible => remove needed flags 3534 ClearRequests(Self); 3535 exit; 3536 end; 3537 3538 RealizeCounter:=0; 3539 UpdateShowingCounter:=0; 3540 while (not AutoSizeDelayed) do 3541 begin 3542 // compute all sizes for LCL objects without touching the widgetset 3543 {$IFDEF VerboseAllAutoSize} 3544 DebugLn(['TWinControl.DoAllAutoSize COMPUTE BOUNDS ',DbgSName(Self),' old=',dbgs(BoundsRect)]); 3545 {$ENDIF} 3546 inherited DoAllAutoSize; 3547 if cfAutoSizeNeeded in FControlFlags then RaiseGDBException(''); 3548 AllAutoSized; 3549 // send all new bounds to widgetset 3550 {$IFDEF VerboseAllAutoSize} 3551 DebugLn(['TWinControl.DoAllAutoSize REALIZE BOUNDS ',DbgSName(Self),' lclbounds=',dbgs(BoundsRect)]); 3552 {$ENDIF} 3553 inc(RealizeCounter); 3554 if RealizeCounter=100 then 3555 Include(FWinControlFlags,wcfKillIntfSetBounds); 3556 RealizeBoundsRecursive; 3557 if (cfAutoSizeNeeded in FControlFlags) then continue; // repeat computing bounds 3558 RealizeCounter:=0; 3559 inc(UpdateShowingCounter); 3560 // make child handles visible 3561 {$IFDEF VerboseAllAutoSize} 3562 DebugLn(['TWinControl.DoAllAutoSize UPDATESHOWING children ',DbgSName(Self),' lclbounds=',dbgs(BoundsRect)]); 3563 {$ENDIF} 3564 Include(FWinControlFlags,wcfUpdateShowing); 3565 try 3566 UpdateShowingRecursive(Self,true); 3567 finally 3568 Exclude(FWinControlFlags,wcfUpdateShowing); 3569 end; 3570 // check if another turn is needed 3571 if not (cfAutoSizeNeeded in FControlFlags) then break; // complete 3572 end; 3573 {$IFDEF VerboseAllAutoSize} 3574 DebugLn(['TWinControl.DoAllAutoSize END ',DbgSName(Self),' ',dbgs(BoundsRect)]); 3575 {$ENDIF} 3576 finally 3577 FWinControlFlags:=FWinControlFlags-[wcfAllAutoSizing,wcfKillIntfSetBounds]; 3578 end; 3579 // make handle visible => this can trigger events like Form.OnShow where 3580 // application does arbitrary stuff 3581 {$IFDEF VerboseAllAutoSize} 3582 DebugLn(['TWinControl.DoAllAutoSize UPDATESHOWING self ',DbgSName(Self),' lclbounds=',dbgs(BoundsRect)]); 3583 {$ENDIF} 3584 if not (wcfUpdateShowing in FWinControlFlags) then 3585 begin 3586 Include(FWinControlFlags, wcfUpdateShowing); 3587 try 3588 if HandleObjectShouldBeVisible and not Showing then 3589 UpdateShowing 3590 else begin 3591 {$IFDEF VerboseAllAutoSize} 3592 DebugLn(['TWinControl.DoAllAutoSize not UPDATESHOWING self ',DbgSName(Self),' because HandleObjectShouldBeVisible=',HandleObjectShouldBeVisible,' Showing=',Showing]); 3593 {$ENDIF} 3594 end; 3595 finally 3596 Exclude(FWinControlFlags, wcfUpdateShowing); 3597 end; 3598 end; 3599end; 3600 3601procedure TWinControl.AllAutoSized; 3602begin 3603 // see TCustomForm.AllAutoSized 3604end; 3605 3606{------------------------------------------------------------------------------ 3607 TWinControl BroadCast 3608------------------------------------------------------------------------------} 3609procedure TWinControl.BroadCast(var ToAllMessage); 3610var 3611 I: Integer; 3612begin 3613 for I := 0 to ControlCount - 1 do 3614 begin 3615 Controls[I].WindowProc(TLMessage(ToAllMessage)); 3616 if TLMessage(ToAllMessage).Result <> 0 then Exit; 3617 end; 3618end; 3619 3620procedure TWinControl.NotifyControls(Msg: Word); 3621var 3622 ToAllMessage: TLMessage; 3623begin 3624 ToAllMessage.Msg := Msg; 3625 ToAllMessage.WParam := 0; 3626 ToAllMessage.LParam := 0; 3627 ToAllMessage.Result := 0; 3628 Broadcast(ToAllMessage); 3629end; 3630 3631procedure TWinControl.DefaultHandler(var AMessage); 3632begin 3633 TWSWinControlClass(WidgetSetClass).DefaultWndHandler(Self, AMessage); 3634end; 3635 3636 3637{------------------------------------------------------------------------------ 3638 TWinControl CanFocus 3639 3640 3641------------------------------------------------------------------------------} 3642function TWinControl.CanFocus: Boolean; 3643var 3644 Control: TWinControl; 3645 Form: TCustomForm; 3646begin 3647 Result := False; 3648 //Verify that every parent is enabled and visible before returning true. 3649 Form := GetParentForm(Self); 3650 if Form <> nil then 3651 begin 3652 Control := Self; 3653 repeat 3654 if Control = Form then break; 3655 // test all except the Form if it is visible and enabled 3656 if not (Control.IsControlVisible and Control.Enabled) then Exit; 3657 Control := Control.Parent; 3658 until False; 3659 Result := True; 3660 end; 3661end; 3662 3663{------------------------------------------------------------------------------ 3664 TWinControl CanSetFocus 3665 3666 CanSetFocus should be prefered over CanFocus if used in CanSetFocus/SetFocus 3667 combination 3668 3669 if MyControl.CanSetFocus then 3670 MyControl.SetFocus; 3671 3672 because it checks also if the parent form can receive focus and thus prevents 3673 the "cannot focus an invisible window" LCL exception. 3674------------------------------------------------------------------------------} 3675function TWinControl.CanSetFocus: Boolean; 3676var 3677 Control: TWinControl; 3678begin 3679 Control := Self; 3680 while True do 3681 begin 3682 // test if all are visible and enabled 3683 if not (Control.IsControlVisible and Control.Enabled) then 3684 Exit(False); 3685 if not Assigned(Control.Parent) then 3686 Break; 3687 Control := Control.Parent; 3688 end; 3689 Result := Control is TCustomForm;//the very top parent must be a form 3690end; 3691 3692{------------------------------------------------------------------------------ 3693 TWinControl CreateSubClass 3694------------------------------------------------------------------------------} 3695procedure TWinControl.CreateSubClass(var Params: TCreateParams; 3696 ControlClassName: PChar); 3697begin 3698 // TODO: Check if we need this method 3699end; 3700 3701{------------------------------------------------------------------------------ 3702 TWinControl DisableAlign 3703------------------------------------------------------------------------------} 3704procedure TWinControl.DisableAlign; 3705begin 3706 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.DisableAlign'){$ENDIF}; 3707end; 3708 3709{------------------------------------------------------------------------------- 3710 TWinControl DoAdjustClientRectChange 3711 3712 Asks the interface if clientrect has changed since last AlignControl 3713 and calls AdjustSize on change. 3714-------------------------------------------------------------------------------} 3715procedure TWinControl.DoAdjustClientRectChange(const InvalidateRect: Boolean = True); 3716var 3717 R: TRect; 3718begin 3719 if InvalidateRect then 3720 InvalidateClientRectCache(False); 3721 R := GetClientRect; 3722 AdjustClientRect(R); 3723 //if CheckPosition(Self) then 3724 //DebugLn(['TWinControl.DoAdjustClientRectChange ',DbgSName(Self),' new=',dbgs(r),' old=',dbgs(FAdjustClientRectRealized),' ',CompareRect(@r,@FAdjustClientRectRealized)]); 3725 if not CompareRect(@R, @FAdjustClientRectRealized) then 3726 begin 3727 // client rect changed since last AlignControl 3728 {$IF defined(VerboseAllAutoSize) or defined(VerboseClientRectBugFix) or defined(VerboseIntfSizing) or defined(VerboseOnResize)} 3729 DebugLn(['TWinControl.DoAdjustClientRectChange ClientRect changed ',DbgSName(Self), 3730 ' Old=',Dbgs(FAdjustClientRectRealized),' New=',DbgS(R)]); 3731 {$ENDIF} 3732 FAdjustClientRectRealized := R; 3733 AdjustSize; 3734 Resize; 3735 end; 3736end; 3737 3738{------------------------------------------------------------------------------- 3739 TWinControl DoConstraintsChange 3740 Params: Sender : TObject 3741 3742 Call inherited, then send the constraints to the interface 3743-------------------------------------------------------------------------------} 3744procedure TWinControl.DoConstraintsChange(Sender : TObject); 3745begin 3746 inherited DoConstraintsChange(Sender); 3747 //debugln('TWinControl.DoConstraintsChange ',DbgSName(Self),' HandleAllocated=',dbgs(HandleAllocated)); 3748 if HandleAllocated then 3749 TWSWinControlClass(WidgetSetClass).ConstraintsChange(Self); 3750end; 3751 3752{------------------------------------------------------------------------------- 3753 TWinControl InvalidateClientRectCache(WithChildControls: boolean) 3754 3755 The clientrect is cached. Call this procedure to invalidate the cache, so that 3756 next time the clientrect is fetched from the interface. 3757-------------------------------------------------------------------------------} 3758procedure TWinControl.InvalidateClientRectCache(WithChildControls: boolean); 3759var 3760 I: Integer; 3761begin 3762 {$IFDEF VerboseClientRectBugFix} 3763 if Name=CheckClientRectName then begin 3764 DebugLn(['TWinControl.InvalidateClientRectCache ',DbgSName(Self)]); 3765 //DumpStack; 3766 end; 3767 {$ENDIF} 3768 Exclude(FWinControlFlags,wcfAdjustedLogicalClientRectValid); 3769 Include(FWinControlFlags,wcfClientRectNeedsUpdate); 3770 3771 if WithChildControls then begin 3772 // invalidate clients too 3773 if Assigned(FControls) then 3774 for I := 0 to FControls.Count - 1 do 3775 if TObject(FControls.Items[I]) is TWinControl then 3776 TWinControl(FControls.Items[I]).InvalidateClientRectCache(true); 3777 end; 3778 InvalidatePreferredSize; 3779end; 3780 3781{------------------------------------------------------------------------------- 3782 TWinControl ClientRectNeedsInterfaceUpdate 3783 3784 The clientrect is cached. Check if cache is valid. 3785-------------------------------------------------------------------------------} 3786function TWinControl.ClientRectNeedsInterfaceUpdate: boolean; 3787var 3788 InterfaceWidth, InterfaceHeight: integer; 3789 IntfClientRect: TRect; 3790begin 3791 if (not HandleAllocated) or (csDestroyingHandle in ControlState) 3792 or (csDestroying in ComponentState) 3793 then 3794 exit(false); 3795 if wcfClientRectNeedsUpdate in FWinControlFlags then 3796 exit(true); 3797 // get the current interface bounds 3798 LCLIntf.GetWindowSize(Handle,InterfaceWidth,InterfaceHeight); 3799 LCLIntf.GetClientRect(Handle,IntfClientRect); 3800 // The LCL is not always in sync with the interface. 3801 // Add the difference between LCL size and interface size to the 3802 // interface clientrect 3803 inc(IntfClientRect.Right,Width-InterfaceWidth); 3804 inc(IntfClientRect.Bottom,Height-InterfaceHeight); 3805 Result:=(FClientWidth<>IntfClientRect.Right) 3806 or (FClientHeight<>IntfClientRect.Bottom); 3807 {$IFDEF VerboseClientRectBugFix} 3808 if (Name=CheckClientRectName) and Result then 3809 DebugLn(['TWinControl.ClientRectNeedsInterfaceUpdate ',DbgSName(Self),' ',dbgs(IntfClientRect)]); 3810 {$ENDIF} 3811end; 3812 3813{------------------------------------------------------------------------------- 3814 TWinControl DoSetBounds 3815 Params: ALeft, ATop, AWidth, AHeight : integer 3816 3817 Anticipate the new clientwidth/height and call inherited 3818 3819 Normally the clientwidth/clientheight is adjusted automatically by the 3820 interface. But it is up to interface when this will be done. The gtk for 3821 example just puts resize requests into a queue. The LCL would resize the 3822 children just after this procedure due to the clientrect. On complex forms with 3823 lots of nested controls, this would result in thousands of resizes. 3824 Changing the clientrect in the LCL to the most probable size reduces 3825 unneccessary resizes. 3826-------------------------------------------------------------------------------} 3827procedure TWinControl.DoSetBounds(ALeft, ATop, AWidth, AHeight : integer); 3828var 3829 OldWidth: LongInt; 3830 OldHeight: LongInt; 3831begin 3832 //DbgOut('[TWinControl.DoSetBounds] ',Name,':',ClassName,' OldHeight=',DbgS(FHeight),' NewHeight=',DbgS(AHeight)); 3833 OldWidth:=Width; 3834 OldHeight:=Height; 3835 inherited DoSetBounds(ALeft, ATop, AWidth, AHeight); 3836 // adapt Clientrect 3837 if not(cfLoading in FControlFlags) 3838 or (cfWidthLoaded in FControlFlags) then // adapt only if Width is valid 3839 inc(FClientWidth,Width-OldWidth); 3840 if not(cfLoading in FControlFlags) 3841 or (cfHeightLoaded in FControlFlags) then // adapt only if Height is valid 3842 inc(FClientHeight,Height-OldHeight); 3843 if FClientWidth<0 then FClientWidth:=0; 3844 if FClientHeight<0 then FClientHeight:=0; 3845 Exclude(FWinControlFlags,wcfAdjustedLogicalClientRectValid); 3846end; 3847 3848function TWinControl.DoubleBufferedIsStored: Boolean; 3849begin 3850 Result := not FParentDoubleBuffered; 3851end; 3852 3853{------------------------------------------------------------------------------ 3854 TWinControl EnableAlign 3855------------------------------------------------------------------------------} 3856procedure TWinControl.EnableAlign; 3857begin 3858 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.DisableAlign'){$ENDIF}; 3859end; 3860 3861procedure TWinControl.WriteLayoutDebugReport(const Prefix: string); 3862var 3863 i: Integer; 3864begin 3865 inherited WriteLayoutDebugReport(Prefix); 3866 for i:=0 to ControlCount-1 do 3867 Controls[i].WriteLayoutDebugReport(Prefix+' '); 3868end; 3869 3870procedure TWinControl.AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy; 3871 const AFromPPI, AToPPI, AOldFormWidth, ANewFormWidth: Integer); 3872var 3873 i: Integer; 3874begin 3875 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.AutoAdjustLayout'){$ENDIF}; 3876 try 3877 for i:=0 to ControlCount-1 do 3878 Controls[i].AutoAdjustLayout(AMode, AFromPPI, AToPPI, AOldFormWidth, ANewFormWidth); 3879 3880 inherited; 3881 finally 3882 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.AutoAdjustLayout'){$ENDIF}; 3883 end; 3884end; 3885 3886{------------------------------------------------------------------------------ 3887 TWinControl.CanTab 3888------------------------------------------------------------------------------} 3889function TWinControl.CanTab: Boolean; 3890begin 3891 Result := CanFocus and TWSWinControlClass(WidgetSetClass).CanFocus(Self); 3892end; 3893 3894function TWinControl.DoDragMsg(ADragMessage: TDragMessage; APosition: TPoint; ADragObject: TDragObject; ATarget: TControl; ADocking: Boolean):LRESULT; 3895var 3896 TargetControl: TControl; 3897begin 3898 case ADragMessage of 3899 dmFindTarget: 3900 begin 3901 {$IFDEF VerboseDrag} 3902 DebugLn('TWinControl.DoDragMsg dmFindTarget ',Name,':',ClassName,' Start DragMsg.DragRec^.Pos=',IntToStr(APosition.X),',',IntToStr(APosition.Y)); 3903 {$ENDIF} 3904 TargetControl := ControlAtPos(ScreentoClient(APosition), 3905 [capfAllowWinControls,capfRecursive]); 3906 if TargetControl = nil then TargetControl := Self; 3907 {$IFDEF VerboseDrag} 3908 DebugLn('TWinControl.DoDragMsg dmFindTarget ',Name,':',ClassName,' end Result=',TargetControl.Name,':',TargetControl.ClassName); 3909 {$ENDIF} 3910 Result := LRESULT(TargetControl); 3911 end; 3912 else 3913 Result := inherited; 3914 end; 3915end; 3916 3917{------------------------------------------------------------------------------ 3918 TWinControl GetChildren 3919------------------------------------------------------------------------------} 3920procedure TWinControl.GetChildren(Proc: TGetChildProc; Root: TComponent); 3921var 3922 I : Integer; 3923 Control : TControl; 3924begin 3925 for I := 0 to ControlCount-1 do 3926 begin 3927 Control := Controls[i]; 3928 if Control.Owner = Root then Proc(Control); 3929 end; 3930end; 3931 3932{------------------------------------------------------------------------------- 3933 function TWinControl.ChildClassAllowed(ChildClass: TClass): boolean; 3934 3935 Allow TControl as child. 3936-------------------------------------------------------------------------------} 3937function TWinControl.ChildClassAllowed(ChildClass: TClass): boolean; 3938begin 3939 Result:=(ChildClass<>nil) and ChildClass.InheritsFrom(TControl); 3940end; 3941 3942{------------------------------------------------------------------------------- 3943 TWinControl GetClientOrigin 3944 Result: TPoint 3945 3946 returns the screen coordinate of the topleft coordinate 0,0 of the client area 3947 Note that this value is the position as stored in the interface and is not 3948 always in sync with the LCL. When a control is moved, the LCL sets the bounds 3949 to the wanted position and sends a move message to the interface. It is up to 3950 the interface to handle moves instantly or queued. 3951-------------------------------------------------------------------------------} 3952function TWinControl.GetClientOrigin: TPoint; 3953var 3954 AControl: TWinControl; 3955begin 3956 Result.X := 0; 3957 Result.Y := 0; 3958 if HandleAllocated then 3959 begin 3960 // get the interface idea where the client area is on the screen 3961 LCLIntf.ClientToScreen(Handle, Result); 3962 // adjust the result by all bounds, that are not yet sent to the interface 3963 AControl := Self; 3964 repeat 3965 inc(Result.X, AControl.Left - AControl.FBoundsRealized.Left); 3966 inc(Result.Y, AControl.Top - AControl.FBoundsRealized.Top); 3967 AControl := AControl.Parent; 3968 until AControl = nil; 3969 end else 3970 if Parent <> nil then 3971 Result := inherited GetClientOrigin; 3972end; 3973 3974{------------------------------------------------------------------------------- 3975 TWinControl GetClientRect 3976 Result: TRect 3977 3978 returns the client area. Starting at 0,0. 3979-------------------------------------------------------------------------------} 3980function TWinControl.GetClientRect: TRect; 3981 3982 procedure StoreClientRect(NewClientRect: TRect); 3983 var 3984 ClientSizeChanged: boolean; 3985 begin 3986 if wcfClientRectNeedsUpdate in FWinControlFlags then begin 3987 ClientSizeChanged:=(FClientWidth<>NewClientRect.Right) 3988 or (FClientHeight<>NewClientRect.Bottom); 3989 if ClientSizeChanged then begin 3990 FClientWidth:=NewClientRect.Right; 3991 FClientHeight:=NewClientRect.Bottom; 3992 {$IF defined(VerboseNewAutoSize) or defined(CHECK_POSITION)} 3993 {$IFDEF CHECK_POSITION} 3994 if CheckPosition(Self) then 3995 {$ENDIF} 3996 DebugLn(['StoreClientRect ',Name,':',ClassName,' ',FClientWidth,',',FClientHeight,' HandleAllocated=',HandleAllocated]); 3997 {$ENDIF} 3998 {$IFDEF VerboseClientRectBugFix} 3999 DebugLn(['StoreClientRect ',DbgSName(Self),' ',FClientWidth,',',FClientHeight,' HandleAllocated=',HandleAllocated,' wcfBoundsRealized=',wcfBoundsRealized in FWinControlFlags]); 4000 {$ENDIF} 4001 Exclude(FWinControlFlags,wcfAdjustedLogicalClientRectValid); 4002 end; 4003 Exclude(FWinControlFlags,wcfClientRectNeedsUpdate); 4004 end; 4005 end; 4006 4007 procedure GetDefaults(var r: TRect); 4008 begin 4009 r:=inherited GetClientRect; 4010 if csLoading in ComponentState then begin 4011 if cfClientWidthLoaded in FControlFlags then 4012 r.Right:=FLoadedClientSize.cx; 4013 if cfClientHeightLoaded in FControlFlags then 4014 r.Bottom:=FLoadedClientSize.cy; 4015 end; 4016 end; 4017 4018var 4019 InterfaceWidth, InterfaceHeight: integer; 4020begin 4021 if wcfClientRectNeedsUpdate in FWinControlFlags then begin 4022 //DebugLn(['TWinControl.GetClientRect ',DbgSName(Self),' ',HandleAllocated,' ',wcfBoundsRealized in FWinControlFlags]); 4023 if TWSWinControlClass(WidgetSetClass).GetDefaultClientRect(Self, 4024 Left, Top, Width, Height, Result) 4025 then begin 4026 // the LCL interface provided a ClientRect 4027 end 4028 else if HandleAllocated then 4029 begin 4030 // update clientrect from interface 4031 LCLIntf.GetClientRect(Handle, Result); 4032 // the LCL is not always in sync with the interface 4033 // -> adjust client rect based on LCL bounds 4034 // for example: if the Width in LCL differ from the Width of the Interface 4035 // object, then adjust the clientwidth accordingly 4036 // this often anticipates later LM_SIZE messages from the interface 4037 // and reduces resizes 4038 LCLIntf.GetWindowSize(Handle, InterfaceWidth, InterfaceHeight); 4039 {$IF defined(VerboseNewAutoSize) or defined(CHECK_POSITION)} 4040 {$IFDEF CHECK_POSITION} 4041 if CheckPosition(Self) then 4042 {$ENDIF} 4043 debugln('TWinControl.GetClientRect ',DbgSName(Self),' Interface=',dbgs(InterfaceWidth),',',dbgs(InterfaceHeight),' Result=',dbgs(Result),' Bounds=',dbgs(BoundsRect)); 4044 {$ENDIF} 4045 {$IFDEF VerboseClientRectBugFix} 4046 //if Name=CheckClientRectName then 4047 debugln('TWinControl.GetClientRect ',DbgSName(Self),' InterfaceSize=',dbgs(InterfaceWidth),',',dbgs(InterfaceHeight),' Result=',dbgs(Result),' Bounds=',dbgs(BoundsRect)); 4048 {$ENDIF} 4049 if (Width<>InterfaceWidth) 4050 or (Height<>InterfaceHeight) then 4051 begin 4052 // the LCL is not in sync with the interface 4053 if wcfBoundsRealized in FWinControlFlags then 4054 begin 4055 // no bounds were sent yet to the interface and it didn't initialize 4056 // them on its own 4057 // => the client bounds from the interface are not yet ready 4058 // they will probably change 4059 // to avoid resizes it is better use the defaults 4060 GetDefaults(Result); 4061 end else begin 4062 // -> adjust client rect based on LCL bounds 4063 // for example: if the Width in LCL differ from the Width of the Interface 4064 // object, then adjust the clientwidth accordingly 4065 // this often anticipates later LM_SIZE messages from the interface 4066 // and reduces resizes 4067 inc(Result.Right,Width-InterfaceWidth); 4068 inc(Result.Bottom,Height-InterfaceHeight); 4069 end; 4070 end; 4071 end else begin 4072 // no handle and no interface help => use defaults 4073 GetDefaults(Result); 4074 end; 4075 Result.Right:=Max(Result.Left,Result.Right); 4076 Result.Bottom:=Max(Result.Top,Result.Bottom); 4077 StoreClientRect(Result); 4078 4079 {r:=inherited GetClientRect; 4080 if (r.Left<>Result.Left) 4081 or (r.Top<>Result.Top) 4082 or (r.Right<>Result.Right) 4083 or (r.Bottom<>Result.Bottom) then begin 4084 //DebugLn(' TWinControl.GetClientRect ',Name,':',ClassName, 4085 // ' Old=',r.Left,',',r.Top,',',r.Right,',',r.Bottom, 4086 // ' New=',Result.Left,',',Result.Top,',',Result.Right,',',Result.Bottom 4087 // ); 4088 end;} 4089 4090 end else begin 4091 Result:=Rect(0,0,FClientWidth,FClientHeight); 4092 end; 4093end; 4094 4095{------------------------------------------------------------------------------- 4096 TWinControl GetControlOrigin 4097 Result: TPoint 4098 4099 Returns the screen coordinate of the topleft coordinate 0,0 of the control 4100 area. (The topleft pixel of the control on the screen) 4101 Note that this value is the position as stored in the interface and is not 4102 always in sync with the LCL. When a control is moved, the LCL sets the bounds 4103 to the wanted position and sends a move message to the interface. It is up to 4104 the interface to handle moves instantly or queued. 4105-------------------------------------------------------------------------------} 4106function TWinControl.GetControlOrigin: TPoint; 4107var 4108 AControl: TWinControl; 4109 IntfBounds: TRect; 4110begin 4111 if HandleAllocated then 4112 begin 4113 // get the interface idea where the client area is on the screen 4114 LCLIntf.GetWindowRect(Handle,IntfBounds); 4115 Result.X := IntfBounds.Left; 4116 Result.Y := IntfBounds.Top; 4117 // adjust the result by all bounds, that are not yet sent to the interface 4118 AControl := Self; 4119 repeat 4120 inc(Result.X, AControl.Left - AControl.FBoundsRealized.Left); 4121 inc(Result.Y, AControl.Top - AControl.FBoundsRealized.Top); 4122 AControl := AControl.Parent; 4123 until AControl = nil; 4124 end else 4125 Result:=inherited GetControlOrigin; 4126end; 4127 4128{------------------------------------------------------------------------------ 4129 function TWinControl.GetChildrenRect(Scrolled: boolean): TRect; 4130 4131 Returns the Client rectangle relative to the controls left, top. 4132 If Scrolled is true, the rectangle is moved by the current scrolling values 4133 (for an example see TScrollingWincontrol). 4134------------------------------------------------------------------------------} 4135function TWinControl.GetChildrenRect(Scrolled: boolean): TRect; 4136var 4137 ScrolledOffset: TPoint; 4138begin 4139 if HandleAllocated then begin 4140 LCLIntf.GetClientBounds(Handle,Result); 4141 if Scrolled then begin 4142 ScrolledOffset:=GetClientScrollOffset; 4143 inc(Result.Left,ScrolledOffset.X); 4144 inc(Result.Top,ScrolledOffset.Y); 4145 inc(Result.Right,ScrolledOffset.X); 4146 inc(Result.Bottom,ScrolledOffset.Y); 4147 end; 4148 end else 4149 Result:=inherited GetChildrenRect(Scrolled); 4150end; 4151 4152{------------------------------------------------------------------------------ 4153 TWinControl SetBorderStyle 4154------------------------------------------------------------------------------} 4155procedure TWinControl.SetBorderStyle(NewStyle: TBorderStyle); 4156begin 4157 if FBorderStyle = NewStyle then Exit; 4158 FBorderStyle := NewStyle; 4159 if HandleAllocated then 4160 TWSWinControlClass(WidgetSetClass).SetBorderStyle(Self, NewStyle); 4161end; 4162 4163{------------------------------------------------------------------------------ 4164 TWinControl SetBorderWidth 4165------------------------------------------------------------------------------} 4166procedure TWinControl.SetBorderWidth(Value: TBorderWidth); 4167begin 4168 if FBorderWidth = Value then exit; 4169 FBorderWidth := Value; 4170 Perform(CM_BORDERCHANGED, 0, 0); 4171end; 4172 4173procedure TWinControl.SetParentWindow(const AValue: HWND); 4174begin 4175 if (ParentWindow = AValue) or Assigned(Parent) then Exit; 4176 FParentWindow := AValue; 4177 if HandleAllocated then 4178 if (AValue <> 0) then 4179 LCLIntf.SetParent(Handle, AValue) 4180 else 4181 DestroyHandle; 4182 UpdateControlState; 4183end; 4184 4185{------------------------------------------------------------------------------ 4186 TWinControl.SetChildZPosition 4187 4188 Set the position of the child control in the TWinControl(s) 4189------------------------------------------------------------------------------} 4190procedure TWinControl.SetChildZPosition(const AChild: TControl; 4191 const APosition: Integer); 4192var 4193 OldPos, NewPos: Integer; 4194 IsWinControl: boolean; 4195 i: Integer; 4196 WinControls: TFPList; 4197begin 4198 if AChild = nil 4199 then begin 4200 DebugLn('WARNING: TWinControl.SetChildZPosition: Child = nil'); 4201 Exit; 4202 end; 4203 4204 IsWinControl := AChild is TWincontrol; 4205 4206 if FControls = nil then 4207 begin 4208 DebugLn('WARNING: TWinControl.SetChildZPosition: Unknown child'); 4209 Exit; 4210 end; 4211 OldPos := FControls.IndexOf(AChild); 4212 if OldPos<0 then begin 4213 DebugLn('WARNING: TWinControl.SetChildZPosition: Not a child'); 4214 Exit; 4215 end; 4216 4217 NewPos := APosition; 4218 4219 if NewPos < 0 then 4220 NewPos := 0; 4221 if NewPos >= FControls.Count then 4222 NewPos := FControls.Count - 1; 4223 4224 if NewPos = OldPos then Exit; 4225 4226 FControls.Move(OldPos, NewPos); 4227 4228 if IsWinControl then 4229 begin 4230 if HandleAllocated and TWinControl(AChild).HandleAllocated then 4231 begin 4232 // ignore children without handle 4233 WinControls:=TFPList.Create; 4234 try 4235 for i:=FControls.Count-1 downto 0 do 4236 begin 4237 if (TObject(FControls[i]) is TWinControl) then 4238 begin 4239 WinControls.Add(FControls[i]); 4240 end else begin 4241 if i<OldPos then dec(OldPos); 4242 if i<NewPos then dec(NewPos); 4243 end; 4244 end; 4245 TWSWinControlClass(WidgetSetClass).SetChildZPosition(Self, 4246 TWinControl(AChild), OldPos, NewPos, WinControls); 4247 finally 4248 WinControls.Free; 4249 end; 4250 end; 4251 end 4252 else begin 4253 AChild.InvalidateControl(AChild.IsVisible, True, True); 4254 end; 4255end; 4256 4257{------------------------------------------------------------------------------ 4258 TWinControl.SetTabOrder 4259------------------------------------------------------------------------------} 4260procedure TWinControl.SetTabOrder(NewTabOrder: TTabOrder); 4261begin 4262 if csLoading in ComponentState then 4263 FTabOrder := NewTabOrder 4264 else 4265 UpdateTabOrder(NewTabOrder); 4266end; 4267 4268procedure TWinControl.SetTabStop(NewTabStop: Boolean); 4269begin 4270 if FTabStop = NewTabStop then 4271 Exit; 4272 FTabStop := NewTabStop; 4273 UpdateTabOrder(FTabOrder); 4274 Perform(CM_TABSTOPCHANGED, 0, 0); 4275end; 4276 4277{------------------------------------------------------------------------------ 4278 TControl UpdateTabOrder 4279------------------------------------------------------------------------------} 4280procedure TWinControl.UpdateTabOrder(NewTabOrder: TTabOrder); 4281var 4282 Count: Integer; 4283begin 4284 if FParent <> nil then 4285 begin 4286 FTabOrder := GetTabOrder; 4287 Count := ListCount(FParent.FTabList); 4288 if NewTabOrder < 0 then 4289 NewTabOrder := Count; 4290 if FTabOrder = -1 then 4291 Inc(Count); 4292 if NewTabOrder > Count then 4293 NewTabOrder := Count; 4294 if NewTabOrder <> FTabOrder then 4295 begin 4296 if FTabOrder <> - 1 then 4297 ListDelete(FParent.FTabList,FTabOrder); 4298 if NewTabOrder <> -1 then 4299 begin 4300 if NewTabOrder = Count then 4301 ListAdd(FParent.FTabList,Self) 4302 else 4303 ListInsert(FParent.FTabList,NewTabOrder,Self); 4304 FTabOrder := NewTabOrder; 4305 end; 4306 end; 4307 end; 4308end; 4309 4310{------------------------------------------------------------------------------- 4311 procedure TWinControl.SendMoveSizeMessages(SizeChanged, PosChanged: boolean); 4312 4313 Send Move and Size messages through the LCL message paths. This simulates the 4314 VCL behaviour and has no real effect. 4315-------------------------------------------------------------------------------} 4316procedure TWinControl.SendMoveSizeMessages(SizeChanged, PosChanged: boolean); 4317var 4318 SizeMsg : TLMSize; 4319 MoveMsg : TLMMove; 4320 //Flags: UINT; 4321begin 4322 if (not HandleAllocated) 4323 or ((not SizeChanged) and (not PosChanged)) then exit; 4324 4325 if SizeChanged then 4326 begin 4327 with SizeMsg do 4328 begin 4329 Msg := LM_SIZE; 4330 SizeType := 6; // force realign 4331 if (FWidth < Low(Word)) or (FWidth > High(Word)) 4332 or (FHeight < Low(Word)) or (FHeight > High(Word)) then 4333 raise ELayoutException.CreateFmt('Size range overflow in %s.SendMoveSizeMessages:' 4334 +' Width=%d, Height=%d.', [Name, FWidth, FHeight]); 4335 Width := FWidth; 4336 Height := FHeight; 4337 {$IFDEF CHECK_POSITION} 4338 if CheckPosition(Self) then 4339 DebugLn(' [TControl.SendMoveSizeMessages] ',Name,':',ClassName,' SizeMsg Width=',DbgS(Width),' Height=',DbgS(Height)); 4340 {$ENDIF} 4341 end; 4342 WindowProc(TLMessage(SizeMsg)); 4343 end; 4344 4345 if PosChanged then 4346 begin 4347 with MoveMsg do 4348 begin 4349 Msg:= LM_MOVE; 4350 MoveType:= 1; 4351 if (FLeft < Low(Smallint)) or (FLeft > High(Smallint)) 4352 or (FTop < Low(Smallint)) or (FTop > High(Smallint)) then 4353 raise ELayoutException.CreateFmt('Position range overflow in %s.SendMoveSizeMessages:' 4354 +' Left=%d, Top=%d.', [Name, FLeft, FTop]); 4355 XPos := FLeft; 4356 YPos := FTop; 4357 {$IFDEF CHECK_POSITION} 4358 if CheckPosition(Self) then 4359 DebugLn(' [TControl.SendMoveSizeMessages] ',Name,':',ClassName,' MoveMsg XPos=',Dbgs(XPos),' YPos=',Dbgs(YPos)); 4360 {$ENDIF} 4361 end; 4362 WindowProc(TLMessage(MoveMsg)); 4363 end; 4364end; 4365 4366{------------------------------------------------------------------------------ 4367 TWinControl UpdateShowing 4368 4369 Check control's handle visibility. 4370 If handle should become visible the handle and child handles are created. 4371 The 4372------------------------------------------------------------------------------} 4373procedure TWinControl.UpdateShowing; 4374 4375 procedure ChangeShowing(bShow: Boolean); 4376 begin 4377 if FShowing = bShow then Exit; 4378 FShowing := bShow; 4379 try 4380 {$IFDEF VerboseShowing} 4381 DebugLn(['ChangeShowing ',DbgSName(Self),' new FShowing=',FShowing]); 4382 {$ENDIF} 4383 Perform(CM_SHOWINGCHANGED, 0, 0); // see TWinControl.CMShowingChanged 4384 finally 4385 if FShowing<>(wcfHandleVisible in FWinControlFlags) then 4386 begin 4387 FShowing := wcfHandleVisible in FWinControlFlags; 4388 DebugLn(['TWinControl.UpdateShowing.ChangeShowing failed for ',DbgSName(Self),', Showing reset to ',FShowing]); 4389 end; 4390 end; 4391 end; 4392 4393var 4394 bShow: Boolean; 4395 n: Integer; 4396begin 4397 bShow := HandleObjectShouldBeVisible; 4398 4399 if bShow then 4400 begin 4401 if not HandleAllocated then CreateHandle; 4402 if Assigned(FControls) then 4403 begin 4404 for n := 0 to FControls.Count - 1 do 4405 if TObject(FControls[n]) is TWinControl then 4406 TWinControl(FControls[n]).UpdateShowing; 4407 end; 4408 end; 4409 if not HandleAllocated then 4410 begin 4411 {$IFDEF VerboseShowing} 4412 if bShow then 4413 DebugLn(['TWinControl.UpdateShowing ',DbgSName(Self),' handle not allocated']); 4414 {$ENDIF} 4415 Exit; 4416 end; 4417 4418 if FShowing = bShow then Exit; 4419 //DebugLn(['TWinControl.UpdateShowing ',dbgsName(Self),' FShowing=',dbgs(FShowing),' bShow=',dbgs(bShow), ' IsWindowVisible=', IsWindowVisible(FHandle)]); 4420 if bShow then 4421 begin 4422 // the Handle should become visible 4423 // delay this until all other autosizing has been processed 4424 if AutoSizeDelayed or (not (caspShowing in AutoSizePhases)) then 4425 begin 4426 {$IFDEF VerboseShowing} 4427 if AutoSizeDelayed then DebugLn(['TWinControl.UpdateShowing ',DbgSName(Self),' SKIPPING because AutoSizeDelayed: ',AutoSizeDelayedReport]); 4428 if (not (caspShowing in AutoSizePhases)) then DebugLn(['TWinControl.UpdateShowing ',DbgSName(Self),' SKIPPING because wrong phase']); 4429 {$ENDIF} 4430 exit; 4431 end; 4432 end; 4433 ChangeShowing(bShow); 4434end; 4435 4436procedure TWinControl.Update; 4437begin 4438 if HandleAllocated then UpdateWindow(Handle); 4439end; 4440 4441{------------------------------------------------------------------------------ 4442 TWinControl Focused 4443------------------------------------------------------------------------------} 4444function TWinControl.Focused: Boolean; 4445begin 4446 Result := CanTab and (HandleAllocated and (FindOwnerControl(GetFocus)=Self)); 4447end; 4448 4449function TWinControl.PerformTab(ForwardTab: boolean): boolean; 4450var 4451 NewFocus: TWinControl; 4452 ParentForm: TCustomForm; 4453begin 4454 Result := True; 4455 ParentForm := GetParentForm(Self); 4456 if ParentForm = nil then 4457 Exit; 4458 NewFocus := ParentForm.FindNextControl(Self, ForwardTab, True, False); 4459 if NewFocus = nil then 4460 Exit; 4461 4462 NewFocus.SetFocus; 4463 Result := NewFocus.Focused; 4464end; 4465 4466{------------------------------------------------------------------------------ 4467 TWinControl SelectNext 4468 4469 Find next control (Tab control or Child control). 4470 Like VCL the CurControl parameter is ignored. 4471------------------------------------------------------------------------------} 4472procedure TWinControl.SelectNext(CurControl: TWinControl; GoForward, 4473 CheckTabStop: Boolean); 4474begin 4475 CurControl := FindNextControl(CurControl, GoForward, 4476 CheckTabStop, not CheckTabStop); 4477 if CurControl <> nil then CurControl.SetFocus; 4478end; 4479 4480procedure TWinControl.SetTempCursor(Value: TCursor); 4481begin 4482 if not HandleAllocated then exit; 4483 TWSWinControlClass(WidgetSetClass).SetCursor(Self, Screen.Cursors[Value]); 4484end; 4485 4486{------------------------------------------------------------------------------ 4487 TWinControl FindChildControl 4488------------------------------------------------------------------------------} 4489function TWinControl.FindChildControl(const ControlName: String): TControl; 4490var 4491 I: Integer; 4492begin 4493 if FControls <> nil then 4494 for I := 0 to FControls.Count - 1 do begin 4495 Result:=TControl(FControls[I]); 4496 if CompareText(Result.Name, ControlName) = 0 then 4497 exit; 4498 end; 4499 Result := nil; 4500end; 4501 4502procedure TWinControl.FlipChildren(AllLevels: Boolean); 4503var 4504 i: Integer; 4505 FlipControls: TFPList; 4506 CurControl: TControl; 4507begin 4508 if ControlCount = 0 then exit; 4509 FlipControls := TFPList.Create; 4510 4511 DisableAlign; 4512 try 4513 // Collect all controls with Align Right and Left 4514 for i := 0 to ControlCount - 1 do begin 4515 CurControl:=Controls[i]; 4516 if CurControl.Align in [alLeft,alRight] then 4517 FlipControls.Add(CurControl); 4518 end; 4519 // flip the rest 4520 DoFlipChildren; 4521 // reverse Right and Left alignments 4522 while FlipControls.Count > 0 do begin 4523 CurControl:=TControl(FlipControls[FlipControls.Count-1]); 4524 if CurControl.Align=alLeft then 4525 CurControl.Align:=alRight 4526 else if CurControl.Align=alRight then 4527 CurControl.Align:=alLeft; 4528 FlipControls.Delete(FlipControls.Count - 1); 4529 end; 4530 finally 4531 FlipControls.Free; 4532 EnableAlign; 4533 end; 4534 FFlipped := not FFlipped; // toggle FFlipped status 4535 // flip recursively 4536 if AllLevels then begin 4537 for i := 0 to ControlCount - 1 do begin 4538 CurControl:=Controls[i]; 4539 if CurControl is TWinControl then 4540 TWinControl(CurControl).FlipChildren(true); 4541 end; 4542 end; 4543end; 4544 4545procedure TWinControl.ScaleBy(Multiplier, Divider: Integer); 4546begin 4547 ChangeScale(Multiplier, Divider); 4548end; 4549 4550{------------------------------------------------------------------------------} 4551{ TWinControl FindNextControl } 4552{------------------------------------------------------------------------------} 4553function TWinControl.FindNextControl(CurrentControl: TWinControl; GoForward, 4554 CheckTabStop, CheckParent: Boolean): TWinControl; 4555var 4556 List: TFPList; 4557 Next: TWinControl; 4558 I, J: Longint; 4559begin 4560 try 4561 Result := nil; 4562 List := TFPList.Create; 4563 GetTabOrderList(List); 4564 //for i:=0 to List.Count-1 do 4565 // debugln(['TWinControl.FindNextControl TabOrderList ',dbgs(i),' ',DbgSName(TObject(List[i]))]); 4566 if List.Count > 0 then 4567 begin 4568 J := List.IndexOf(CurrentControl); 4569 if J < 0 then 4570 begin 4571 if GoForward then 4572 J := List.Count - 1 4573 else 4574 J := 0; 4575 end; 4576 //DebugLn(['TWinControl.FindNextControl A ',DbgSName(CurrentControl),' ',dbgs(J), 4577 // ' GoForward='+dbgs(GoForward)+' CheckTabStop='+dbgs(CheckTabStop)+' CheckParent='+dbgs(CheckParent)]); 4578 I := J; 4579 repeat 4580 if GoForward then 4581 begin 4582 Inc(I); 4583 if I >= List.Count then 4584 I := 0; 4585 end else 4586 begin 4587 Dec(I); 4588 if I < 0 then 4589 I := List.Count - 1; 4590 end; 4591 4592 Next := TWinControl(List[I]); 4593{ DebugLn(['TWinControl.FindNextControl B ',Next.Name,' ',dbgs(I), 4594 ' ChckTabStop='+dbgs(CheckTabStop)+' TabStop='+dbgs(Next.TabStop) 4595 +' ChckParent='+dbgs(CheckParent)+' Parent=Self='+dbgs(Next.Parent = Self) 4596 +' Enabled='+dbgs(Next.Enabled) 4597 +' TestTab='+dbgs(((Not CheckTabStop) or Next.TabStop)) 4598 +' TestPar='+dbgs(((not CheckParent) or (Next.Parent = Self))) 4599 +' TestEnVi='+dbgs(Next.Enabled and Next.IsVisible)]);} 4600 if (((not CheckTabStop) or Next.TabStop) 4601 and ((not CheckParent) or (Next.Parent = Self))) 4602 and (Next.Enabled and Next.IsVisible) then 4603 Result := Next; 4604 4605 // if we reached the start then exit because we traversed the loop and 4606 // did not find any control 4607 if I = J then 4608 break; 4609 until (Result <> nil); 4610 //DebugLn(['TWinControl.FindNextControl END ',DbgSName(Result),' I=',dbgs(I)]); 4611 end; 4612 finally 4613 List.Free; 4614 end; 4615end; 4616 4617procedure TWinControl.FixDesignFontsPPIWithChildren(const ADesignTimePPI: Integer); 4618 procedure FixChildren(const AParent: TWinControl); 4619 var 4620 I: Integer; 4621 begin 4622 for I := 0 to AParent.ControlCount-1 do 4623 begin 4624 AParent.Controls[I].FixDesignFontsPPI(ADesignTimePPI); 4625 if AParent.Controls[I] is TWinControl then 4626 FixChildren(TWinControl(AParent.Controls[I])); 4627 end; 4628 end; 4629begin 4630 FixDesignFontsPPI(ADesignTimePPI); 4631 FixChildren(Self); 4632end; 4633 4634procedure TWinControl.SelectFirst; 4635var 4636 Form : TCustomForm; 4637 Control : TWinControl; 4638begin 4639 Form := GetParentForm(Self); 4640 if Form <> nil then begin 4641 Control := FindNextControl(nil, true, true, false); 4642 if Control = nil then 4643 Control := FindNextControl(nil, true, false, false); 4644 if Control <> nil then 4645 Form.ActiveControl := Control; 4646 end; 4647end; 4648 4649procedure TWinControl.FixupTabList; 4650var 4651 I, J: Integer; 4652 Control: TWinControl; 4653 List: TFPList; 4654 WinControls: TFPList; 4655begin 4656 if FControls <> nil then 4657 begin 4658 List := TFPList.Create; 4659 WinControls:=TFPList.Create; 4660 try 4661 for i:=0 to FControls.Count-1 do 4662 if TObject(FControls[i]) is TWinControl then 4663 WinControls.Add(FControls[i]); 4664 List.Count := WinControls.Count; 4665 for I := 0 to WinControls.Count - 1 do 4666 begin 4667 Control := TWinControl(WinControls[I]); 4668 J := Control.FTabOrder; 4669 if (J >= 0) and (J < WinControls.Count) then 4670 List[J] := Control; 4671 end; 4672 for I := 0 to List.Count - 1 do 4673 begin 4674 Control := TWinControl(List[I]); 4675 if Control <> nil then 4676 Control.UpdateTabOrder(TTabOrder(I)); 4677 end; 4678 finally 4679 List.Free; 4680 WinControls.Free; 4681 end; 4682 end; 4683end; 4684 4685{------------------------------------------------------------------------------ 4686 TWinControl GetTabOrderList 4687------------------------------------------------------------------------------} 4688procedure TWinControl.GetTabOrderList(List: TFPList); 4689var 4690 I: Integer; 4691 lWinControl: TWinControl; 4692begin 4693 if FTabList <> nil then 4694 for I := 0 to FTabList.Count - 1 do 4695 begin 4696 lWinControl := TWinControl(FTabList[I]); 4697 // The tab order list should exclude injected LCL-CustomDrawn controls 4698 if lWinControl.CanFocus and (not LCLIntf.IsCDIntfControl(lWinControl)) then 4699 List.Add(lWinControl); 4700 lWinControl.GetTabOrderList(List); 4701 end; 4702end; 4703 4704{------------------------------------------------------------------------------ 4705 TWinControl IsControlMouseMsg 4706------------------------------------------------------------------------------} 4707function TWinControl.IsControlMouseMsg(var TheMessage): Boolean; 4708var 4709 MouseMessage: TLMMouse absolute TheMessage; 4710 MouseEventMessage: TLMMouseEvent; 4711 Control: TControl; 4712 ScrolledOffset, P: TPoint; 4713 ClientBounds: TRect; 4714begin 4715 { CaptureControl = nil means that widgetset has captured input, but it does 4716 not know anything about TControl controls } 4717 if (FindOwnerControl(GetCapture) = Self) and (CaptureControl <> nil) then 4718 begin 4719 Control := nil; 4720 //DebugLn(['TWinControl.IsControlMouseMsg A ', DbgSName(CaptureControl), ', ',DbgSName(CaptureControl.Parent),', Self: ', DbgSName(Self)]); 4721 if (CaptureControl.Parent = Self) then 4722 Control := CaptureControl; 4723 end 4724 else 4725 begin 4726 // do query wincontrol children, in case they overlap 4727 Control := ControlAtPos(SmallPointToPoint(MouseMessage.Pos), []); 4728 end; 4729 4730 //DebugLn(['TWinControl.IsControlMouseMsg B ',DbgSName(Self),' Control=',DbgSName(Control),' Msg=',TheMessage.Msg]); 4731 Result := False; 4732 if Control <> nil then 4733 begin 4734 // map mouse coordinates to control 4735 ScrolledOffset := GetClientScrollOffset; 4736 4737 P.X := MouseMessage.XPos - Control.Left + ScrolledOffset.X; 4738 P.Y := MouseMessage.YPos - Control.Top + ScrolledOffset.Y; 4739 if (Control is TWinControl) and TWinControl(Control).HandleAllocated then 4740 begin 4741 // map coordinates to client area of control 4742 LCLIntf.GetClientBounds(TWinControl(Control).Handle, ClientBounds); 4743 dec(P.X, ClientBounds.Left); 4744 dec(P.Y, ClientBounds.Top); 4745 {$IFDEF VerboseMouseBugfix} 4746 DebugLn(['TWinControl.IsControlMouseMsg ',Name,' -> ',Control.Name, 4747 ' MsgPos=',MouseMessage.Pos.X,',',MouseMessage.Pos.Y, 4748 ' Control=',Control.Left,',',Control.Top, 4749 ' ClientBounds=',ClientBounds.Left,',',ClientBounds.Top, 4750 ' Scrolled=',GetClientScrollOffset.X,',',GetClientScrollOffset.Y, 4751 ' P=',P.X,',',P.Y] 4752 ); 4753 {$ENDIF} 4754 end; 4755 if (MouseMessage.Msg = LM_MOUSEWHEEL) or 4756 (MouseMessage.Msg = LM_MOUSEHWHEEL) then 4757 begin 4758 MouseEventMessage := TLMMouseEvent(TheMessage); 4759 {$PUSH} 4760 {$R-}{$Q-} // no range, no overflow checks 4761 MouseEventMessage.X := P.X; 4762 MouseEventMessage.Y := P.Y; 4763 {$POP} 4764 Control.Dispatch(MouseEventMessage); 4765 MouseMessage.Result := MouseEventMessage.Result; 4766 Result := (MouseMessage.Result <> 0); 4767 end 4768 else 4769 begin 4770 MouseMessage.Result := Control.Perform(MouseMessage.Msg, WParam(MouseMessage.Keys), 4771 LParam(Integer(PointToSmallPointNoChecks(P)))); 4772 Result := True; 4773 end; 4774 end; 4775end; 4776 4777procedure TWinControl.FontChanged(Sender: TObject); 4778begin 4779 if HandleAllocated and ([csLoading, csDestroying] * ComponentState = []) then 4780 begin 4781 TWSWinControlClass(WidgetSetClass).SetFont(Self, TFont(Sender)); 4782 Exclude(FWinControlFlags, wcfFontChanged); 4783 end 4784 else 4785 Include(FWinControlFlags, wcfFontChanged); 4786 inherited FontChanged(Sender); 4787 NotifyControls(CM_PARENTFONTCHANGED); 4788end; 4789 4790procedure TWinControl.SetColor(Value: TColor); 4791begin 4792 if Value = Color then Exit; 4793 inherited SetColor(Value); 4794 if BrushCreated then 4795 if Color = clDefault then 4796 FBrush.Color := GetDefaultColor(dctBrush) 4797 else 4798 FBrush.Color := Color; 4799 if HandleAllocated and ([csLoading,csDestroying]*ComponentState=[]) then 4800 begin 4801 TWSWinControlClass(WidgetSetClass).SetColor(Self); 4802 Exclude(FWinControlFlags, wcfColorChanged); 4803 end 4804 else 4805 Include(FWinControlFlags, wcfColorChanged); 4806 NotifyControls(CM_PARENTCOLORCHANGED); 4807end; 4808 4809procedure TWinControl.PaintHandler(var TheMessage: TLMPaint); 4810 4811 function ControlMustBeClipped(AControl: TControl): boolean; 4812 begin 4813 Result := (csOpaque in AControl.ControlStyle) and AControl.IsVisible; 4814 end; 4815 4816var 4817 I, Clip, SaveIndex: Integer; 4818 DC: HDC; 4819 PS: TPaintStruct; //defined in LCLIntf.pp 4820 ControlsNeedsClipping: boolean; 4821 CurControl: TControl; 4822begin 4823 //DebugLn('[TWinControl.PaintHandler] ',Name,':',ClassName,' DC=',DbgS(TheMessage.DC,8)); 4824 if (csDestroying in ComponentState) or (not HandleAllocated) then exit; 4825 4826 {$IFDEF VerboseResizeFlicker} 4827 DebugLn('TWinControl.PaintHandler A ',Name,':',ClassName); 4828 {$ENDIF} 4829 {$IFDEF VerboseDsgnPaintMsg} 4830 if csDesigning in ComponentState then 4831 DebugLn('TWinControl.PaintHandler A ',Name,':',ClassName); 4832 {$ENDIF} 4833 4834 //DebugLn(Format('Trace:> [TWinControl.PaintHandler] %s --> Msg.DC: 0x%x', [ClassName, TheMessage.DC])); 4835 DC := TheMessage.DC; 4836 if DC = 0 then 4837 DC := BeginPaint(Handle, PS); 4838 4839 try 4840 // check if child controls need clipping 4841 //if Name='GroupBox1' then 4842 //DebugLn('[TWinControl.PaintHandler] ',DbgSName(Self),' B'); 4843 ControlsNeedsClipping:=false; 4844 if FControls<>nil then 4845 for I := 0 to FControls.Count - 1 do 4846 if ControlMustBeClipped(TControl(FControls[I])) then begin 4847 ControlsNeedsClipping:=true; 4848 break; 4849 end; 4850 // exclude child controls and send new paint message 4851 //if Name='GroupBox1' then 4852 //debugln(['TWinControl.PaintHandler ControlsNeedsClipping=',ControlsNeedsClipping,' ControlCount=',ControlCount]); 4853 if not ControlsNeedsClipping then begin 4854 //DebugLn('[TWinControl.PaintHandler] ',DbgSName(Self),' no clipping ...'); 4855 PaintWindow(DC) 4856 end else 4857 begin 4858 SaveIndex := SaveDC(DC); 4859 Clip := SimpleRegion; 4860 for I := 0 to FControls.Count - 1 do begin 4861 CurControl:=TControl(FControls[I]); 4862 if ControlMustBeClipped(CurControl) then 4863 with CurControl do begin 4864 //DebugLn('TWinControl.PaintHandler Exclude Child ',DbgSName(Self),' Control=',DbgSName(CurControl),'(',dbgs(CurControl.BoundsRect),')'); 4865 Clip := ExcludeClipRect(DC, Left, Top, Left + Width, Top + Height); 4866 if Clip = NullRegion then Break; 4867 end; 4868 end; 4869 //DebugLn('[TWinControl.PaintHandler] ',DbgSName(Self),' with clipping ...'); 4870 if Clip <> NullRegion then 4871 PaintWindow(DC); 4872 RestoreDC(DC, SaveIndex); 4873 end; 4874 // paint controls 4875 //DebugLn('[TWinControl.PaintHandler] ',DbgSName(Self),' PaintControls ...'); 4876 if FDockSite and FUseDockManager and Assigned(DockManager) then 4877 DockManager.PaintSite(DC); 4878 PaintControls(DC, nil); 4879 finally 4880 if TheMessage.DC = 0 then 4881 EndPaint(Handle, PS); 4882 end; 4883 //DebugLn(Format('Trace:< [TWinControl.PaintHandler] %s', [ClassName])); 4884//DebugLn('[TWinControl.PaintHandler] END ',Name,':',ClassName,' DC=',DbgS(Message.DC,8)); 4885end; 4886 4887procedure TWinControl.PaintControls(DC: HDC; First: TControl); 4888var 4889 I, Count, SaveIndex: Integer; 4890// FrameBrush: HBRUSH; 4891 TempControl : TControl; 4892 {off $Define VerboseControlDCOrigin} 4893 {$IFDEF VerboseControlDCOrigin} 4894 P: TPoint; 4895 {$ENDIF} 4896begin 4897 {$ifdef DEBUG_WINDOW_ORG} 4898 DebugLn(':> [TWinControl.PaintControls] A'); 4899 {$endif} 4900 4901 //DebugLn('[TWinControl.PaintControls] ',Name,':',ClassName,' DC=',DbgS(DC,8)); 4902 if (csDestroying in ComponentState) 4903 or ((DC=0) and (not HandleAllocated)) then 4904 exit; 4905 4906 {$IFDEF VerboseDsgnPaintMsg} 4907 if csDesigning in ComponentState then 4908 DebugLn('TWinControl.PaintControls A ',Name,':',ClassName); 4909 {$ENDIF} 4910 4911 // Controls that are not TWinControl, have no handle of their own, and so 4912 // they are repainted as part of the parent: 4913 if FControls <> nil then 4914 begin 4915 {$ifdef DEBUG_WINDOW_ORG} 4916 DebugLn(':> [TWinControl.PaintControls] B'); 4917 {$endif} 4918 I := 0; 4919 if First <> nil then 4920 begin 4921 I := FControls.IndexOf(First); 4922 if I < 0 then I := 0; 4923 end; 4924 //debugln(['TWinControl.PaintControls ',DbgSName(Self),' ClientRect=',dbgs(ClientRect)]); 4925 Count := FControls.Count; 4926 while I < Count do 4927 begin 4928 TempControl := TControl(FControls.Items[I]); 4929 {$ifdef DEBUG_WINDOW_ORG} 4930 if Name='GroupBox1' then 4931 DebugLn( 4932 Format(':> [TWinControl.PaintControls] C DC=%d TempControl=%s Left=%d Top=%d Width=%d Height=%d IsVisible=%s RectVisible=%s', 4933 [DC, DbgSName(TempControl), 4934 TempControl.Left, TempControl.Top, TempControl.Width, TempControl.Height, 4935 dbgs(IsVisible), 4936 dbgs(RectVisible(DC, TempControl.BoundsRect)) 4937 ])); 4938 {$endif} 4939 if not (TempControl is TWinControl) then begin 4940 //DebugLn('TWinControl.PaintControls B Self=',Self.Name,':',Self.ClassName,' Control=',TempControl.Name,':',TempControl.ClassName,' ',TempControl.Left,',',TempControl.Top,',',TempControl.Width,',',TempControl.Height); 4941 with TempControl do 4942 if ((WidgetSet.GetLCLCapability(lcCanDrawHidden) = LCL_CAPABILITY_YES) and isControlVisible) 4943 or (IsVisible and RectVisible(DC, TempControl.BoundsRect)) 4944 then 4945 begin 4946 if csPaintCopy in Self.ControlState then 4947 Include(FControlState, csPaintCopy); 4948 SaveIndex := SaveDC(DC); 4949 4950 {$ifdef DEBUG_WINDOW_ORG} 4951 DebugLn( 4952 Format(':> [TWinControl.PaintControls] Control=%s Left=%d Top=%d Width=%d Height=%d', 4953 [Self.Name, Left, Top, Width, Height])); 4954 {$endif} 4955 4956 MoveWindowOrg(DC, Left, Top); 4957 {$IFDEF VerboseControlDCOrigin} 4958 DebugLn('TWinControl.PaintControls B Self=',DbgSName(Self),' Control=',DbgSName(TempControl),' ',dbgs(Left),',',dbgs(Top),',',dbgs(Width),',',dbgs(Height)); 4959 {$ENDIF} 4960 IntersectClipRect(DC, 0, 0, Width, Height); 4961 {$IFDEF VerboseControlDCOrigin} 4962 DebugLn('TWinControl.PaintControls C'); 4963 P:=Point(-1,-1); 4964 GetWindowOrgEx(DC,@P); 4965 debugln(' DCOrigin=',dbgs(P)); 4966 {$ENDIF} 4967 Perform(LM_PAINT, WParam(DC), 0); 4968 {$IFDEF VerboseControlDCOrigin} 4969 DebugLn('TWinControl.PaintControls D TempControl=',DbgSName(TempControl)); 4970 {$ENDIF} 4971 RestoreDC(DC, SaveIndex); 4972 Exclude(FControlState, csPaintCopy); 4973 end; 4974 end; 4975 Inc(I); 4976 end; 4977 end; 4978 //DebugLn('[TWinControl.PaintControls] END ',Name,':',ClassName,' DC=',DbgS(DC,8)); 4979end; 4980 4981procedure TWinControl.PaintWindow(DC: HDC); 4982var 4983 Message: TLMessage; 4984begin 4985 //DebugLn('[TWinControl.PaintWindow] ',Name,':',Classname,' DC=',DbgS(DC)); 4986 if (csDestroying in ComponentState) 4987 or ((DC=0) and (not HandleAllocated)) then 4988 exit; 4989 4990 {$IFDEF VerboseDsgnPaintMsg} 4991 if csDesigning in ComponentState then 4992 DebugLn('TWinControl.PaintWindow A ',Name,':',ClassName); 4993 {$ENDIF} 4994 4995 Message.Msg := LM_PAINT; 4996 Message.WParam := WParam(DC); 4997 Message.LParam := 0; 4998 Message.Result := 0; 4999 DefaultHandler(Message); 5000end; 5001 5002procedure TWinControl.CreateBrush; 5003begin 5004 if BrushCreated then exit; 5005 FBrush := TBrush.Create; 5006 if Color = clDefault then 5007 FBrush.Color := GetDefaultColor(dctBrush) 5008 else 5009 FBrush.Color := Color; 5010end; 5011 5012procedure TWinControl.ScaleControls(Multiplier, Divider: Integer); 5013var 5014 i: Integer; 5015begin 5016 for i := 0 to ControlCount - 1 do 5017 Controls[i].ChangeScale(Multiplier, Divider); 5018end; 5019 5020procedure TWinControl.ChangeScale(Multiplier, Divider: Integer); 5021var 5022 i: Integer; 5023begin 5024 if Multiplier <> Divider then 5025 begin 5026 DisableAlign; 5027 try 5028 ScaleControls(Multiplier, Divider); 5029 inherited; 5030 for i := 0 to ControlCount - 1 do 5031 Controls[i].UpdateAnchorRules; 5032 finally 5033 EnableAlign; 5034 end; 5035 end; 5036end; 5037 5038{------------------------------------------------------------------------------ 5039 procedure TWinControl.EraseBackground; 5040------------------------------------------------------------------------------} 5041procedure TWinControl.EraseBackground(DC: HDC); 5042var 5043 ARect: TRect; 5044begin 5045 if DC = 0 then Exit; 5046 ARect := Rect(0, 0, Width, Height); 5047 FillRect(DC, ARect, HBRUSH(Brush.Reference.Handle)); 5048end; 5049 5050{------------------------------------------------------------------------------ 5051 function TWinControl.IntfUTF8KeyPress(var UTF8Key: TUTF8Char; 5052 RepeatCount: integer; SystemKey: boolean): boolean; 5053 5054 Called by the interface after the navigation and specials keys are handled 5055 (e.g. after KeyDown but before KeyPress). 5056------------------------------------------------------------------------------} 5057function TWinControl.IntfUTF8KeyPress(var UTF8Key: TUTF8Char; 5058 RepeatCount: integer; SystemKey: boolean): boolean; 5059begin 5060 IncLCLRefCount; 5061 try 5062 Result := (RepeatCount > 0) and not SystemKey and DoUTF8KeyPress(UTF8Key); 5063 finally 5064 DecLCLRefCount; 5065 end; 5066end; 5067 5068function TWinControl.IntfGetDropFilesTarget: TWinControl; 5069begin 5070 Result:=Self; 5071 repeat 5072 Result:=GetFirstParentForm(Result); 5073 if Result=nil then exit; 5074 if TCustomForm(Result).AllowDropFiles then exit; 5075 Result:=Result.Parent; 5076 until Result=nil; 5077end; 5078 5079procedure TWinControl.PaintTo(DC: HDC; X, Y: Integer); 5080begin 5081 if HandleAllocated then 5082 TWSWinControlClass(WidgetSetClass).PaintTo(Self, DC, X, Y); 5083end; 5084 5085procedure TWinControl.PaintTo(ACanvas: TCanvas; X, Y: Integer); 5086begin 5087 PaintTo(ACanvas.Handle, X, Y); 5088 ACanvas.Changed; 5089end; 5090 5091procedure TWinControl.SetShape(AShape: TBitmap); 5092begin 5093 if not HandleAllocated then 5094 Exit; 5095 5096 if (AShape <> nil) and (AShape.Width = Width) and (AShape.Height = Height) then 5097 TWSWinControlClass(WidgetSetClass).SetShape(Self, AShape.Handle) 5098 else 5099 if AShape = nil then 5100 TWSWinControlClass(WidgetSetClass).SetShape(Self, 0) 5101end; 5102 5103procedure TWinControl.SetShape(AShape: TRegion); 5104begin 5105 LCLIntf.SetWindowRgn(Handle, AShape.Reference.Handle, True); 5106end; 5107 5108{------------------------------------------------------------------------------ 5109 TWinControl ControlAtPos 5110 Params: const Pos : TPoint 5111 AllowDisabled: Boolean 5112 Results: TControl 5113 5114 Searches a child (not grand child) control, which client area contains Pos. 5115 Pos is relative to the ClientOrigin. 5116------------------------------------------------------------------------------} 5117function TWinControl.ControlAtPos(const Pos: TPoint; AllowDisabled: Boolean): TControl; 5118begin 5119 Result := ControlAtPos(Pos, AllowDisabled, False); 5120end; 5121 5122{------------------------------------------------------------------------------ 5123 TWinControl ControlAtPos 5124 Params: const Pos : TPoint 5125 AllowDisabled, AllowWinControls: Boolean 5126 Results: TControl 5127 5128 Searches a child (not grand child) control, which client area contains Pos. 5129 Pos is relative to the ClientOrigin. 5130------------------------------------------------------------------------------} 5131function TWinControl.ControlAtPos(const Pos: TPoint; 5132 AllowDisabled, AllowWinControls: Boolean): TControl; 5133var 5134 Flags: TControlAtPosFlags; 5135begin 5136 Flags := [capfOnlyClientAreas]; 5137 if AllowDisabled then Include(Flags, capfAllowDisabled); 5138 if AllowWinControls then Include(Flags, capfAllowWinControls); 5139 Result := ControlAtPos(Pos, Flags); 5140end; 5141 5142{------------------------------------------------------------------------------ 5143 TWinControl ControlAtPos 5144 Params: const Pos : TPoint 5145 Flags: TControlAtPosFlags 5146 Results: TControl 5147 5148 Searches a child (not grand child) control, which contains Pos. 5149 Pos is relative to the ClientOrigin. 5150------------------------------------------------------------------------------} 5151function TWinControl.ControlAtPos(const Pos: TPoint; 5152 Flags: TControlAtPosFlags): TControl; 5153var 5154 I: Integer; 5155 P: TPoint; 5156 LControl: TControl; 5157 ClientBounds: TRect; 5158 5159 function GetControlAtPos(AControl: TControl): Boolean; 5160 var 5161 ControlPos: TPoint; 5162 begin 5163 with AControl do 5164 begin 5165 ControlPos := Point(P.X - Left, P.Y - Top); 5166 Result := (ControlPos.X >= 0) and (ControlPos.Y >= 0) and 5167 (ControlPos.X < Width) and (ControlPos.Y < Height); 5168 5169 if Result and (capfOnlyClientAreas in Flags) then 5170 Result := PtInRect(ClientRect, ControlPos); 5171 5172 Result := Result 5173 and ( 5174 ( 5175 (csDesigning in ComponentState) 5176 and not (csNoDesignVisible in ControlStyle) 5177 // Here was a VCL bug: VCL checks if control is Visible, 5178 // which should be ignored at designtime 5179 ) 5180 or 5181 ( 5182 (not (csDesigning in ComponentState)) 5183 and 5184 (Visible) 5185 and 5186 (Enabled or (capfAllowDisabled in Flags)) 5187 and 5188 (Perform(CM_HITTEST, 0, 5189 LParam(Integer(PointToSmallPointNoChecks(ControlPos)))) <> 0) 5190 ) 5191 ); 5192 {$IFDEF VerboseMouseBugfix} 5193 //if Result then 5194 DebugLn(['GetControlAtPos ',Name,':',ClassName, 5195 ' Pos=',Pos.X,',',Pos.Y, 5196 ' P=',P.X,',',P.Y, 5197 ' ControlPos=',dbgs(ControlPos), 5198 ' ClientBounds=',ClientBounds.Left,',',ClientBounds.Top,',',ClientBounds.Right,',',ClientBounds.Bottom, 5199 // ' OnlyCl=',OnlyClientAreas, 5200 ' Result=',Result]); 5201 {$ENDIF} 5202 if Result then 5203 LControl := AControl; 5204 end; 5205 end; 5206 5207var 5208 ScrolledOffset: TPoint; 5209 OldClientOrigin: TPoint; 5210 NewClientOrigin: TPoint; 5211 NewPos: TPoint; 5212begin 5213 //debugln(['TWinControl.ControlAtPos START ',DbgSName(Self),' P=',dbgs(Pos)]); 5214 5215 // check if Pos in visible client area 5216 ClientBounds := GetClientRect; 5217 ScrolledOffset := GetClientScrollOffset; 5218 if capfHasScrollOffset in Flags then 5219 begin 5220 { ClientBounds do not include scrolling offset } 5221 inc(ClientBounds.Left, ScrolledOffset.x); 5222 inc(ClientBounds.Right, ScrolledOffset.x); 5223 inc(ClientBounds.Top, ScrolledOffset.y); 5224 inc(ClientBounds.Bottom, ScrolledOffset.y); 5225 end; 5226 5227 if not PtInRect(ClientBounds, Pos) then 5228 begin 5229 //debugln(['TWinControl.ControlAtPos OUT OF CLIENTBOUNDS ',DbgSName(Self),' P=',dbgs(Pos),' ClientBounds=',dbgs(ClientBounds)]); 5230 Result := nil; 5231 exit; 5232 end; 5233 5234 // map Pos to logical client area 5235 P := Pos; 5236 if not (capfHasScrollOffset in Flags) then 5237 begin 5238 inc(P.X, ScrolledOffset.X); 5239 inc(P.Y, ScrolledOffset.Y); 5240 end; 5241 5242 LControl := nil; 5243 if FControls<>nil then 5244 begin 5245 // check wincontrols 5246 if (capfAllowWinControls in Flags) then 5247 for I := FControls.Count - 1 downto 0 do 5248 if (TObject(FControls[i]) is TWinControl) 5249 and GetControlAtPos(TControl(FControls[I])) then 5250 Break; 5251 // check controls 5252 if (LControl = nil) and not(capfOnlyWinControls in Flags) then 5253 for I := FControls.Count - 1 downto 0 do 5254 if (not (TObject(FControls[i]) is TWinControl)) 5255 and GetControlAtPos(TControl(FControls[I])) then 5256 Break; 5257 end; 5258 Result := LControl; 5259 5260 // check recursive sub children 5261 if (capfRecursive in Flags) and (Result is TWinControl) and 5262 (TWinControl(Result).ControlCount > 0) then 5263 begin 5264 // in LCL ClientOrigin contains the scroll offset. At least this is so 5265 // for win32 and gtk2 5266 OldClientOrigin := ClientOrigin; 5267 NewClientOrigin := TWinControl(Result).ClientOrigin; 5268 NewPos := Pos; 5269 NewPos.X := NewPos.X - NewClientOrigin.X + OldClientOrigin.X; 5270 NewPos.Y := NewPos.Y - NewClientOrigin.Y + OldClientOrigin.Y; 5271 LControl := TWinControl(Result).ControlAtPos(NewPos, Flags + [capfHasScrollOffset]); 5272 //debugln(['TWinControl.RECURSED ControlAtPos Result=',DbgSName(Result),' LControl=',DbgSName(LControl),' ',dbgs(NewPos),' AllowDisabled=',AllowDisabled,' OnlyClientAreas=',OnlyClientAreas]); 5273 if LControl <> nil then 5274 Result := LControl; 5275 end; 5276 //debugln(['TWinControl.ControlAtPos END ',DbgSName(Self),' P=',dbgs(Pos),' Result=',DbgSName(Result)]); 5277end; 5278 5279{------------------------------------------------------------------------------- 5280 function TWinControl.GetControlIndex(AControl: TControl): integer; 5281 5282 5283-------------------------------------------------------------------------------} 5284function TWinControl.GetControlIndex(AControl: TControl): integer; 5285begin 5286 if FControls <> nil then 5287 Result := FControls.IndexOf(AControl) 5288 else 5289 Result := -1; 5290end; 5291 5292{------------------------------------------------------------------------------- 5293 function TWinControl.GetControlIndex(AControl: TControl): integer; 5294 5295 5296-------------------------------------------------------------------------------} 5297procedure TWinControl.SetControlIndex(AControl: TControl; NewIndex: integer); 5298begin 5299 SetChildZPosition(AControl, NewIndex); 5300end; 5301 5302{------------------------------------------------------------------------------ 5303 TWinControl DestroyHandle 5304------------------------------------------------------------------------------} 5305procedure TWinControl.DestroyHandle; 5306var 5307 i: integer; 5308 AControl: TControl; 5309begin 5310 //DebugLn(['TWinControl.DestroyHandle START ',DbgSName(Self)]); 5311 if not HandleAllocated then begin 5312 DebugLn('Warning: TWinControl.DestroyHandle ',Name,':',ClassName,' Handle not Allocated'); 5313 //RaiseGDBException(''); 5314 end; 5315 5316 // First destroy all children handles 5317 //DebugLn(['TWinControl.DestroyHandle DESTROY CHILDS ',DbgSName(Self)]); 5318 Include(FControlState, csDestroyingHandle); 5319 try 5320 if FControls <> nil then begin 5321 for i:= 0 to FControls.Count - 1 do begin 5322 //DebugLn([' ',i,' ',DbgSName(TObject(FWinControls[i]))]); 5323 AControl:=TControl(FControls[i]); 5324 if (AControl is TWinControl) and TWinControl(AControl).HandleAllocated then 5325 TWinControl(AControl).DestroyHandle; 5326 end; 5327 end; 5328 //DebugLn(['TWinControl.DestroyHandle DESTROY SELF ',DbgSName(Self)]); 5329 DestroyWnd; 5330 finally 5331 Exclude(FControlState, csDestroyingHandle); 5332 end; 5333 //DebugLn(['TWinControl.DestroyHandle END ',DbgSName(Self)]); 5334end; 5335 5336{------------------------------------------------------------------------------ 5337 TWinControl WndPRoc 5338------------------------------------------------------------------------------} 5339procedure TWinControl.WndProc(var Message: TLMessage); 5340var 5341 Form: TCustomForm; 5342begin 5343 //debugln(['TWinControl.WndProc ',DbgSName(Self),' ',Message.Msg]); 5344 //DebugLn(Format('Trace:[TWinControl.WndPRoc] %s(%s) --> Message = %d', [ClassName, Name, Message.Msg])); 5345 case Message.Msg of 5346 LM_SETFOCUS: 5347 begin 5348 //DebugLn(Format('Trace:[TWinControl.WndPRoc] %s --> LM_SETFOCUS', [ClassName])); 5349 {$IFDEF VerboseFocus} 5350 DebugLn('TWinControl.WndProc LM_SetFocus ',DbgSName(Self)); 5351 {$ENDIF} 5352 Form := GetParentForm(Self); 5353 if Assigned(Form) and not (csDestroyingHandle in ControlState) and not (csDestroying in ComponentState) then 5354 begin 5355 if not Form.SetFocusedControl(Self) then 5356 begin 5357 {$IFDEF VerboseFocus} 5358 DebugLn('TWinControl.WndProc LM_SetFocus ',DbgSName(Self),' form=',DbgSName(Form),' Form.SetFocusedControl FAILED'); 5359 {$ENDIF} 5360 Exit; 5361 end; 5362 Message.Result := 0; 5363 end; 5364 {$IFDEF VerboseFocus} 5365 DebugLn('TWinControl.WndProc AFTER form LM_SetFocus ',DbgSName(Self)); 5366 {$ENDIF} 5367 end; 5368 5369 LM_KILLFOCUS: 5370 begin 5371 //DebugLn(Format('Trace:[TWinControl.WndPRoc] %s --> _KILLFOCUS', [ClassName])); 5372 if csFocusing in ControlState then 5373 begin 5374 {$IFDEF VerboseFocus} 5375 DebugLn('TWinControl.WndProc LM_KillFocus during focusing ',Name,':',ClassName); 5376 {$ENDIF} 5377 Exit; 5378 end; 5379 Message.Result:=0; 5380 end; 5381 5382 // exclude only LM_MOUSEENTER, LM_MOUSELEAVE 5383 LM_MOUSEFIRST..LM_MOUSELAST, 5384 LM_MOUSEFIRST2..LM_RBUTTONQUADCLK, 5385 LM_XBUTTONTRIPLECLK..LM_MOUSELAST2: 5386 begin 5387 {$IFDEF VerboseMouseBugfix} 5388 DebugLn('TWinControl.WndPRoc A ',Name,':',ClassName); 5389 {$ENDIF} 5390 //if Message.Msg=LM_RBUTTONUP then begin DebugLn(['TWinControl.WndProc ',DbgSName(Self)]); DumpStack end; 5391 DoBeforeMouseMessage; 5392 if IsControlMouseMSG(Message) then 5393 Exit 5394 else 5395 begin 5396 if FDockSite and FUseDockManager and Assigned(DockManager) then 5397 DockManager.MessageHandler(Self, Message); 5398 end; 5399 {$IFDEF VerboseMouseBugfix} 5400 DebugLn('TWinControl.WndPRoc B ',Name,':',ClassName); 5401 {$ENDIF} 5402 end; 5403 5404 LM_KEYFIRST..LM_KEYLAST: 5405 if Dragging then Exit; 5406 5407 LM_CANCELMODE: 5408 if (FindOwnerControl(GetCapture) = Self) 5409 and (CaptureControl <> nil) 5410 and (CaptureControl.Parent = Self) 5411 then CaptureControl.Perform(LM_CANCELMODE,0,0); 5412 CM_MOUSEENTER, 5413 CM_MOUSELEAVE: 5414 begin 5415 if FDockSite and FUseDockManager and Assigned(DockManager) then 5416 DockManager.MessageHandler(Self, Message); 5417 end; 5418 CM_TEXTCHANGED, CM_VISIBLECHANGED, LM_SIZE, LM_MOVE: 5419 begin 5420 // forward message to the dock manager is we are docked 5421 if (HostDockSite <> nil) and (HostDockSite.UseDockManager) and 5422 Assigned(HostDockSite.DockManager) then 5423 HostDockSite.DockManager.MessageHandler(Self, Message); 5424 end; 5425 end; 5426 5427 inherited WndProc(Message); 5428end; 5429 5430procedure TWinControl.WSSetText(const AText: String); 5431begin 5432 TWSWinControlClass(WidgetSetClass).SetText(Self, AText); 5433end; 5434 5435{------------------------------------------------------------------------------ 5436 procedure TWinControl.DoAddDockClient(Client: TControl; const ARect: TRect); 5437 5438 Default method for adding a dock client. Become the new parent and break 5439 old anchored controls. 5440 ------------------------------------------------------------------------------} 5441procedure TWinControl.DoAddDockClient(Client: TControl; const ARect: TRect); 5442begin 5443 //DebugLn(['TWinControl.DoAddDockClient ',DbgSName(Self),' Client=',DbgSName(Client),' OldParent=',DbgSName(Client.Parent),' Client.AnchoredControlCount=',Client.AnchoredControlCount]); 5444 Client.Parent := Self; 5445end; 5446 5447{------------------------------------------------------------------------------ 5448 procedure TWinControl.DockOver(Source: TDragDockObject; X, Y: Integer; 5449 State: TDragState; var Accept: Boolean); 5450 5451 Called to check whether this control allows docking and where. 5452 ------------------------------------------------------------------------------} 5453procedure TWinControl.DockOver(Source: TDragDockObject; X, Y: Integer; 5454 State: TDragState; var Accept: Boolean); 5455begin 5456 if State = dsDragMove then 5457 PositionDockRect(Source); 5458 DoDockOver(Source, X, Y, State, Accept); 5459end; 5460 5461{------------------------------------------------------------------------------ 5462 procedure TWinControl.DoDockOver(Source: TDragDockObject; X, Y: Integer; 5463 State: TDragState; var Accept: Boolean); 5464 ------------------------------------------------------------------------------} 5465procedure TWinControl.DoDockOver(Source: TDragDockObject; X, Y: Integer; 5466 State: TDragState; var Accept: Boolean); 5467begin 5468 if Assigned(FOnDockOver) then 5469 FOnDockOver(Self, Source, X, Y, State, Accept); 5470end; 5471 5472{------------------------------------------------------------------------------ 5473 procedure TWinControl.DoRemoveDockClient(Client: TControl); 5474 5475 Called to remove client from dock list. 5476 This method exists for descendent overrides. 5477 ------------------------------------------------------------------------------} 5478procedure TWinControl.DoRemoveDockClient(Client: TControl); 5479begin 5480 // empty (this method exists for descendent overrides) 5481 {$IFDEF VerboseDocking} 5482 DebugLn(['TWinControl.DoRemoveDockClient ',DbgSName(Self),' ',DbgSName(Client)]); 5483 {$ENDIF} 5484end; 5485 5486{------------------------------------------------------------------------------ 5487 function TWinControl.DoUnDock(NewTarget: TWinControl; Client: TControl 5488 ): Boolean; 5489 ------------------------------------------------------------------------------} 5490function TWinControl.DoUnDock(NewTarget: TWinControl; Client: TControl; 5491 KeepDockSiteSize: Boolean): Boolean; 5492var 5493 NewBounds: TRect; 5494begin 5495 {$IFDEF VerboseDocking} 5496 DebugLn('TWinControl.DoUnDock ',Name,' NewTarget=',DbgSName(NewTarget),' Client=',DbgSName(Client)); 5497 {$ENDIF} 5498 Result := True; 5499 if Assigned(FOnUnDock) then 5500 begin 5501 FOnUnDock(Self, Client, NewTarget, Result); 5502 if not Result then 5503 Exit; 5504 end; 5505 5506 if not KeepDockSiteSize then 5507 begin 5508 NewBounds := BoundsRect; 5509 case Client.Align of 5510 alLeft: 5511 inc(NewBounds.Left, Client.Width); 5512 alTop: 5513 inc(NewBounds.Top, Client.Height); 5514 alRight: 5515 dec(NewBounds.Right, Client.Width); 5516 alBottom: 5517 dec(NewBounds.Bottom, Client.Height); 5518 end; 5519 SetBoundsKeepBase(NewBounds.Left, NewBounds.Top, 5520 NewBounds.Right - NewBounds.Left, 5521 NewBounds.Bottom - NewBounds.Top); 5522 end; 5523 5524 Result := Result and DoUndockClientMsg(NewTarget, Client); 5525end; 5526 5527{------------------------------------------------------------------------------ 5528 procedure TWinControl.GetSiteInfo(Client: TControl; var InfluenceRect: TRect; 5529 MousePos: TPoint; var CanDock: Boolean); 5530 ------------------------------------------------------------------------------} 5531procedure TWinControl.GetSiteInfo(Client: TControl; var InfluenceRect: TRect; 5532 MousePos: TPoint; var CanDock: Boolean); 5533const 5534 ADockMargin = 10; 5535begin 5536 GetWindowRect(Handle, InfluenceRect); 5537 //Margins to test docking (enlarged surface for test) 5538 InfluenceRect.Left := InfluenceRect.Left-ADockMargin; 5539 InfluenceRect.Top := InfluenceRect.Top-ADockMargin; 5540 InfluenceRect.Right := InfluenceRect.Right+ADockMargin; 5541 InfluenceRect.Bottom := InfluenceRect.Bottom+ADockMargin; 5542 5543 if UseDockManager then 5544 CanDock:=DockManager.IsEnabledControl(Client); 5545 5546 if Assigned(FOnGetSiteInfo) then 5547 FOnGetSiteInfo(Self, Client, InfluenceRect, MousePos, CanDock); 5548end; 5549 5550{------------------------------------------------------------------------------ 5551 function TWinControl.GetParentHandle: HWND; 5552 ------------------------------------------------------------------------------} 5553function TWinControl.GetParentHandle: HWND; 5554begin 5555 if Parent <> nil then 5556 Result := Parent.Handle 5557 else 5558 Result := ParentWindow; 5559end; 5560 5561{------------------------------------------------------------------------------ 5562 function TWinControl.GetTopParentHandle: HWND; 5563 ------------------------------------------------------------------------------} 5564function TWinControl.GetTopParentHandle: HWND; 5565var 5566 AWinControl: TWinControl; 5567begin 5568 AWinControl := Self; 5569 while AWinControl.Parent <> nil do 5570 AWinControl := AWinControl.Parent; 5571 if AWinControl.ParentWindow = 0 then 5572 Result := AWinControl.Handle 5573 else 5574 Result := AWinControl.ParentWindow; 5575end; 5576 5577{------------------------------------------------------------------------------ 5578 procedure TWinControl.ReloadDockedControl(const AControlName: string; 5579 var AControl: TControl); 5580 ------------------------------------------------------------------------------} 5581procedure TWinControl.ReloadDockedControl(const AControlName: string; 5582 var AControl: TControl); 5583begin 5584 AControl := Owner.FindComponent(AControlName) as TControl; 5585end; 5586 5587{------------------------------------------------------------------------------ 5588 function TWinControl.CreateDockManager: TDockManager; 5589 ------------------------------------------------------------------------------} 5590function TWinControl.CreateDockManager: TDockManager; 5591begin 5592 if (DockManager = nil) and DockSite and UseDockManager then 5593 // this control can dock other controls, so it needs a TDockManager 5594 Result := DefaultDockManagerClass.Create(Self) 5595 else 5596 Result := DockManager; 5597end; 5598 5599procedure TWinControl.SetDockManager(AMgr: TDockManager); 5600begin 5601 //use FDockManager only here! 5602 if Assigned(DockManager) and (DockManager <> AMgr) then 5603 if FDockManager.AutoFreeByControl then 5604 FDockManager.Free; 5605 FDockManager := AMgr; //can be nil 5606end; 5607 5608{------------------------------------------------------------------------------ 5609 procedure TWinControl.SetUseDockManager(const AValue: Boolean); 5610 ------------------------------------------------------------------------------} 5611procedure TWinControl.SetUseDockManager(const AValue: Boolean); 5612begin 5613 if FUseDockManager=AValue then exit; 5614 FUseDockManager:=AValue; 5615 if FUseDockManager and ([csDesigning,csDestroying]*ComponentState=[]) 5616 and (DockManager=nil) then 5617 DockManager := CreateDockManager; 5618end; 5619 5620procedure TWinControl.DoFloatMsg(ADockSource: TDragDockObject); 5621var 5622 WasVisible: Boolean; 5623begin 5624 if FloatingDockSiteClass = ClassType then 5625 begin 5626 WasVisible := Visible; 5627 try 5628 Dock(nil, ADockSource.DockRect); 5629 finally 5630 if WasVisible then BringToFront; 5631 end; 5632 end 5633 else 5634 inherited DoFloatMsg(ADockSource); 5635end; 5636 5637function TWinControl.GetDockCaption(AControl: TControl): String; 5638begin 5639 Result := AControl.GetDefaultDockCaption; 5640 DoGetDockCaption(AControl, Result); 5641end; 5642 5643procedure TWinControl.UpdateDockCaption(Exclude: TControl); 5644begin 5645 { Called when this is a hostdocksite and either the list of docked clients have 5646 changed or one of their captions. 5647 Exclude an currently undocking control. } 5648end; 5649 5650procedure TWinControl.DoGetDockCaption(AControl: TControl; var ACaption: String); 5651begin 5652 if Assigned(FOnGetDockCaption) then 5653 OnGetDockCaption(Self, AControl, ACaption); 5654end; 5655 5656{------------------------------------------------------------------------------ 5657 procedure TWinControl.MainWndProc(var Message : TLMessage); 5658 5659 The message handler of this wincontrol. 5660 Only needed by controls, which needs features not yet supported by the LCL. 5661 ------------------------------------------------------------------------------} 5662procedure TWinControl.MainWndProc(var Msg: TLMessage); 5663begin 5664 //DebugLn(Format('Trace:[TWinControl.MainWndPRoc] %s(%s) --> Message = %d', [ClassName, Name, Msg.Msg])); 5665end; 5666 5667{------------------------------------------------------------------------------ 5668 TWinControl SetFocus 5669------------------------------------------------------------------------------} 5670procedure TWinControl.SetFocus; 5671var 5672 Form: TCustomForm; 5673begin 5674 {$IFDEF VerboseFocus} 5675 DebugLn('[TWinControl.SetFocus] ',Name,':',ClassName,' Visible=',dbgs(Visible),' HandleAllocated=',dbgs(HandleAllocated)); 5676 {$ENDIF} 5677 Form := GetParentForm(Self); 5678 if Form <> nil then 5679 Form.FocusControl(Self) 5680 else 5681 if IsVisible and HandleAllocated then 5682 LCLIntf.SetFocus(Handle); 5683end; 5684 5685{------------------------------------------------------------------------------ 5686 TWinControl KeyDown 5687------------------------------------------------------------------------------} 5688procedure TWinControl.KeyDown(var Key: Word; Shift: TShiftState); 5689begin 5690 if Assigned(FOnKeyDown) then FOnKeyDown(Self, Key, Shift); 5691 if Key <> 0 then 5692 DoCallKeyEventHandler(chtOnKeyDown, Key, Shift); 5693end; 5694 5695{------------------------------------------------------------------------------ 5696 TWinControl KeyDownBeforeInterface 5697------------------------------------------------------------------------------} 5698procedure TWinControl.KeyDownBeforeInterface(var Key: Word; Shift: TShiftState); 5699begin 5700 KeyDown(Key, Shift); 5701end; 5702 5703{------------------------------------------------------------------------------ 5704 TWinControl KeyDownAfterInterface 5705------------------------------------------------------------------------------} 5706procedure TWinControl.KeyDownAfterInterface(var Key: Word; Shift: TShiftState); 5707begin 5708 5709end; 5710 5711{------------------------------------------------------------------------------ 5712 TWinControl KeyPress 5713------------------------------------------------------------------------------} 5714procedure TWinControl.KeyPress(var Key: char); 5715begin 5716 if Assigned(FOnKeyPress) then FOnKeyPress(Self, Key); 5717end; 5718 5719{------------------------------------------------------------------------------ 5720 TWinControl UTF8KeyPress 5721 5722 Called before KeyPress. 5723------------------------------------------------------------------------------} 5724procedure TWinControl.UTF8KeyPress(var UTF8Key: TUTF8Char); 5725begin 5726 if Assigned(FOnUTF8KeyPress) then FOnUTF8KeyPress(Self, UTF8Key); 5727end; 5728 5729{------------------------------------------------------------------------------ 5730 TWinControl KeyUp 5731------------------------------------------------------------------------------} 5732procedure TWinControl.KeyUp(var Key: Word; Shift : TShiftState); 5733begin 5734 if Assigned(FOnKeyUp) then FOnKeyUp(Self, Key, Shift); 5735end; 5736 5737procedure TWinControl.KeyUpBeforeInterface(var Key: Word; Shift: TShiftState); 5738begin 5739 //debugln('TWinControl.KeyUpBeforeInterface ',DbgSName(Self)); 5740 KeyUp(Key,Shift); 5741end; 5742 5743procedure TWinControl.KeyUpAfterInterface(var Key: Word; Shift: TShiftState); 5744begin 5745 //debugln('TWinControl.KeyUpAfterInterface ',DbgSName(Self)); 5746end; 5747 5748{------------------------------------------------------------------------------ 5749 TWinControl DoKeyDownBeforeInterface 5750 5751 returns true if handled 5752------------------------------------------------------------------------------} 5753function TWinControl.DoKeyDownBeforeInterface(var Message: TLMKey; IsRecurseCall: Boolean): Boolean; 5754 5755 function IsShortCut: Boolean; 5756 var 5757 AParent: TWinControl; 5758 APopupMenu: TPopupMenu; 5759 begin 5760 Result := False; 5761 // check popup menu 5762 APopupMenu := PopupMenu; 5763 if Assigned(APopupMenu) and APopupMenu.IsShortCut(Message) then 5764 Exit(True); 5765 5766 if IsRecurseCall then 5767 Exit; 5768 5769 // let each parent form handle shortcuts 5770 AParent := Parent; 5771 while Assigned(AParent) do 5772 begin 5773 if (AParent is TCustomForm) and TCustomForm(AParent).IsShortcut(Message) then 5774 Exit(True); 5775 AParent := AParent.Parent; 5776 end; 5777 5778 // let application handle shortcut 5779 if Assigned(Application) and Application.IsShortcut(Message) then 5780 Exit(True); 5781 end; 5782 5783var 5784 F: TCustomForm; 5785 ShiftState: TShiftState; 5786 AParent: TWinControl; 5787begin 5788 //debugln('TWinControl.DoKeyDown ',DbgSName(Self),' ShiftState=',dbgs(KeyDataToShiftState(Message.KeyData)),' CharCode=',dbgs(Message.CharCode)); 5789 Result := True; 5790 5791 with Message do 5792 begin 5793 if CharCode = VK_UNKNOWN then Exit; 5794 ShiftState := KeyDataToShiftState(KeyData); 5795 5796 if not IsRecurseCall then 5797 begin 5798 // let application handle the key 5799 if Assigned(Application) then 5800 begin 5801 Application.NotifyKeyDownBeforeHandler(Self, CharCode, ShiftState); 5802 if CharCode = VK_UNKNOWN then Exit; 5803 end; 5804 5805 // let each parent form with keypreview handle the key 5806 AParent := Parent; 5807 while Assigned(AParent) do 5808 begin 5809 if (AParent is TCustomForm) then 5810 begin 5811 F := TCustomForm(AParent); 5812 if (F.KeyPreview) and (F.DoKeyDownBeforeInterface(Message, True)) then Exit; 5813 end; 5814 AParent := AParent.Parent; 5815 end; 5816 5817 if CharCode = VK_UNKNOWN then Exit; 5818 ShiftState := KeyDataToShiftState(KeyData); 5819 5820 // let drag object handle the key 5821 if DragManager.IsDragging then 5822 begin 5823 DragManager.KeyDown(CharCode, ShiftState); 5824 if CharCode = VK_UNKNOWN then Exit; 5825 end; 5826 end; 5827 5828 // let user handle the key 5829 if not (csNoStdEvents in ControlStyle) then 5830 begin 5831 KeyDownBeforeInterface(CharCode, ShiftState); 5832 if CharCode = VK_UNKNOWN then Exit; 5833 end; 5834 5835 // check the shortcuts 5836 if IsShortCut then Exit; 5837 end; 5838 5839 Result := False; 5840end; 5841 5842function TWinControl.ChildKey(var Message: TLMKey): boolean; 5843begin 5844 if Assigned(Parent) then 5845 Result := Parent.ChildKey(Message) 5846 else 5847 Result := false; 5848end; 5849 5850function TWinControl.DialogChar(var Message: TLMKey): boolean; 5851var 5852 I: integer; 5853begin 5854 // broadcast to children 5855 Result := False; 5856 for I := 0 to ControlCount - 1 do 5857 begin 5858 // for Delphi compatibility send it to all controls, 5859 // even those that can not focus or are disabled 5860 Result := Controls[I].DialogChar(Message); 5861 if Result then Exit; 5862 end; 5863end; 5864 5865{------------------------------------------------------------------------------ 5866 TWinControl DoRemainingKeyDown 5867 5868 Returns True if key handled 5869------------------------------------------------------------------------------} 5870function TWinControl.DoRemainingKeyDown(var Message: TLMKeyDown): Boolean; 5871var 5872 ShiftState: TShiftState; 5873begin 5874 Result := True; 5875 5876 ShiftState := KeyDataToShiftState(Message.KeyData); 5877 5878 // let parent(s) handle key from child key 5879 if Assigned(Parent) and Parent.ChildKey(Message) then 5880 Exit; 5881 5882 // handle LCL special keys 5883 ControlKeyDown(Message.CharCode, ShiftState); 5884 if Message.CharCode = VK_UNKNOWN then Exit; 5885 5886 //DebugLn('TWinControl.WMKeyDown ',Name,':',ClassName); 5887 if not (csNoStdEvents in ControlStyle) then 5888 begin 5889 KeyDownAfterInterface(Message.CharCode, ShiftState); 5890 if Message.CharCode = VK_UNKNOWN then Exit; 5891 // Note: Message.CharCode can now be different or even 0 5892 end; 5893 5894 // let application handle the remaining key 5895 if Assigned(Application) then 5896 Application.NotifyKeyDownHandler(Self, Message.CharCode, ShiftState); 5897 if Message.CharCode = VK_UNKNOWN then Exit; 5898 5899 Result := False; 5900end; 5901 5902{------------------------------------------------------------------------------ 5903 TWinControl DoKeyPress 5904 5905 Returns True if key handled 5906------------------------------------------------------------------------------} 5907function TWinControl.DoKeyPress(var Message : TLMKey): Boolean; 5908var 5909 F: TCustomForm; 5910 C: char; 5911 AParent: TWinControl; 5912begin 5913 Result := True; 5914 5915 // let each parent form with keypreview handle the key 5916 AParent := Parent; 5917 while (AParent <> nil) do 5918 begin 5919 if (AParent is TCustomForm) then 5920 begin 5921 F := TCustomForm(AParent); 5922 if F.KeyPreview and F.DoKeyPress(Message) then Exit; 5923 end; 5924 AParent := AParent.Parent; 5925 end; 5926 5927 if not (csNoStdEvents in ControlStyle) then 5928 with Message do 5929 begin 5930 C := Char(CharCode); 5931 KeyPress(C); 5932 CharCode := Ord(C); 5933 if Char(CharCode) = #0 then Exit; 5934 end; 5935 5936 Result := False; 5937end; 5938 5939{------------------------------------------------------------------------------ 5940 TWinControl DoRemainingKeyPress 5941 5942 Returns True if key handled 5943------------------------------------------------------------------------------} 5944function TWinControl.SendDialogChar(var Message : TLMKey): Boolean; 5945var 5946 ParentForm: TCustomForm; 5947begin 5948 Result := False; 5949 if WidgetSet.GetLCLCapability(lcAccelleratorKeys) = LCL_CAPABILITY_NO then Exit; 5950 ParentForm := GetParentForm(Self); 5951 if ParentForm <> nil then 5952 begin 5953 Result := ParentForm.DialogChar(Message); 5954 if Result then 5955 Message.CharCode := VK_UNKNOWN; 5956 end; 5957end; 5958 5959function TWinControl.DoRemainingKeyUp(var Message: TLMKeyDown): Boolean; 5960var 5961 ShiftState: TShiftState; 5962begin 5963 //debugln('TWinControl.DoRemainingKeyUp ',DbgSName(Self)); 5964 Result := True; 5965 5966 ShiftState := KeyDataToShiftState(Message.KeyData); 5967 5968 // handle LCL special keys 5969 ControlKeyUp(Message.CharCode,ShiftState); 5970 if Message.CharCode=VK_UNKNOWN then exit; 5971 5972 if not (csNoStdEvents in ControlStyle) then 5973 begin 5974 KeyUpAfterInterface(Message.CharCode, ShiftState); 5975 if Message.CharCode=VK_UNKNOWN then exit; 5976 // Note: Message.CharCode can now be different or even 0 5977 end; 5978 Result := False; 5979end; 5980 5981{------------------------------------------------------------------------------ 5982 TWinControl DoUTF8KeyPress 5983 5984 Returns True if key handled 5985------------------------------------------------------------------------------} 5986function TWinControl.DoUTF8KeyPress(var UTF8Key: TUTF8Char): boolean; 5987var 5988 AParent: TWinControl; 5989 F: TCustomForm; 5990begin 5991 Result := True; 5992 5993 // let each parent form with keypreview handle the key 5994 AParent := Parent; 5995 while Assigned(AParent) do 5996 begin 5997 if (AParent is TCustomForm) then 5998 begin 5999 F := TCustomForm(AParent); 6000 if (F.KeyPreview) and F.DoUTF8KeyPress(UTF8Key) then Exit; 6001 end; 6002 AParent := AParent.Parent; 6003 end; 6004 6005 if not (csNoStdEvents in ControlStyle) then 6006 begin 6007 UTF8KeyPress(UTF8Key); 6008 if UTF8Key = '' then Exit; 6009 end; 6010 6011 // redirect to designer 6012 if (csDesigning in ComponentState) then 6013 begin 6014 F := GetDesignerForm(Self); 6015 if Assigned(F) and Assigned(F.Designer) then 6016 begin 6017 F.Designer.UTF8KeyPress(UTF8Key); 6018 if UTF8Key = '' then Exit; 6019 end; 6020 end; 6021 6022 Result := False; 6023end; 6024 6025{------------------------------------------------------------------------------ 6026 TWinControl DoKeyUpBeforeInterface 6027 6028 Returns True if key handled 6029------------------------------------------------------------------------------} 6030function TWinControl.DoKeyUpBeforeInterface(var Message : TLMKey): Boolean; 6031var 6032 F: TCustomForm; 6033 ShiftState: TShiftState; 6034 AParent: TWinControl; 6035begin 6036 Result := True; 6037 6038 // let each parent form with keypreview handle the key 6039 AParent:=Parent; 6040 while (AParent<>nil) do begin 6041 if (AParent is TCustomForm) then begin 6042 F := TCustomForm(AParent); 6043 if (F.KeyPreview) 6044 and (F.DoKeyUpBeforeInterface(Message)) then Exit; 6045 end; 6046 AParent:=AParent.Parent; 6047 end; 6048 6049 with Message do 6050 begin 6051 ShiftState := KeyDataToShiftState(KeyData); 6052 6053 if DragManager.IsDragging then 6054 begin 6055 DragManager.KeyUp(CharCode, ShiftState); 6056 if CharCode = VK_UNKNOWN then Exit; 6057 end; 6058 6059 if not (csNoStdEvents in ControlStyle) 6060 then begin 6061 KeyUpBeforeInterface(CharCode, ShiftState); 6062 if CharCode = VK_UNKNOWN then Exit; 6063 end; 6064 6065 // TODO 6066 //if (CharCode = VK_APPS) and not (ssAlt in ShiftState) then 6067 // CheckMenuPopup(SmallPoint(0, 0)); 6068 end; 6069 Result := False; 6070end; 6071 6072{------------------------------------------------------------------------------ 6073 TWinControl ControlKeyDown 6074------------------------------------------------------------------------------} 6075procedure TWinControl.ControlKeyDown(var Key: Word; Shift: TShiftState); 6076begin 6077 Application.ControlKeyDown(Self,Key,Shift); 6078end; 6079 6080procedure TWinControl.ControlKeyUp(var Key: Word; Shift: TShiftState); 6081begin 6082 //debugln('TWinControl.ControlKeyUp ',DbgSName(Self)); 6083 Application.ControlKeyUp(Self,Key,Shift); 6084end; 6085 6086{------------------------------------------------------------------------------ 6087 TWinControl CreateParams 6088------------------------------------------------------------------------------} 6089procedure TWinControl.CreateParams(var Params : TCreateParams); 6090begin 6091 FillChar(Params, SizeOf(Params),0); 6092 Params.Caption := PChar(FCaption); 6093 Params.Style := WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN; 6094 Params.ExStyle := 0; 6095 if csAcceptsControls in ControlStyle then 6096 Params.ExStyle := Params.ExStyle or WS_EX_CONTROLPARENT; 6097 if BorderStyle = bsSingle then 6098 Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE; 6099 if TabStop then 6100 Params.Style := Params.Style or WS_TABSTOP; 6101 6102 if (Parent <> nil) then 6103 Params.WndParent := Parent.Handle 6104 else 6105 Params.WndParent := ParentWindow; 6106 6107 Params.X := Left; 6108 Params.Y := Top; 6109 Params.Width := Width; 6110 Params.Height := Height; 6111end; 6112 6113{------------------------------------------------------------------------------ 6114 TWinControl Invalidate 6115------------------------------------------------------------------------------} 6116procedure TWinControl.Invalidate; 6117begin 6118 //DebugLn(['TWinControl.Invalidate ',DbgSName(Self),' HandleAllocated=',HandleAllocated]); 6119 if HandleAllocated and ([csDestroying,csLoading]*ComponentState=[]) then 6120 TWSWinControlClass(WidgetSetClass).Invalidate(Self); 6121end; 6122 6123{------------------------------------------------------------------------------ 6124 TWinControl AddControl 6125 6126 Add Handle object to parents Handle object. 6127------------------------------------------------------------------------------} 6128procedure TWinControl.AddControl; 6129begin 6130 TWSControlClass(WidgetSetClass).AddControl(Self); 6131end; 6132 6133{------------------------------------------------------------------------------ 6134 TWinControl Repaint 6135------------------------------------------------------------------------------} 6136procedure TWinControl.Repaint; 6137begin 6138 if (not HandleAllocated) or (csDestroying in ComponentState) then exit; 6139 {$IFDEF VerboseDsgnPaintMsg} 6140 if csDesigning in ComponentState then 6141 DebugLn('TWinControl.Repaint A ',Name,':',ClassName); 6142 {$ENDIF} 6143 TWSWinControlClass(WidgetSetClass).Repaint(Self); 6144end; 6145 6146{------------------------------------------------------------------------------ 6147 TWinControl Insert 6148------------------------------------------------------------------------------} 6149procedure TWinControl.Insert(AControl : TControl); 6150begin 6151 Insert(AControl,ControlCount); 6152end; 6153 6154{------------------------------------------------------------------------------ 6155 procedure TWinControl.Insert(AControl: TControl; Index: integer); 6156------------------------------------------------------------------------------} 6157procedure TWinControl.Insert(AControl: TControl; Index: integer); 6158begin 6159 if AControl = nil then exit; 6160 if AControl.FParent<>nil then 6161 raise EInvalidOperation.Create('control has already a parent'); 6162 6163 if AControl = Self then 6164 raise EInvalidOperation.Create(rsAControlCanNotHaveItselfAsParent); 6165 6166 ListInsert(FControls, Index, AControl); 6167 if AControl is TWinControl then 6168 begin 6169 ListAdd(FTabList, AControl); 6170 6171 if (csDesigning in ComponentState) and (not (csLoading in ComponentState)) 6172 and AControl.CanTab then 6173 TWinControl(AControl).TabStop := true; 6174 end; 6175 6176 AControl.FParent := Self; 6177 if AControl.FAutoSizingLockCount>0 then 6178 begin 6179 // the AControl has disabled autosizing => disable it for the parent=self too 6180 //DebugLn([Space(FAutoSizingLockCount*2+2),'TWinControl.Insert ',DbgSName(Self),' Control=',DbgSName(AControl),' disable Parent']); 6181 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TControl.DisableAutoSizing'){$ENDIF}; 6182 end; 6183end; 6184 6185{------------------------------------------------------------------------------ 6186 TWinControl ReAlign 6187 6188 Realign all children 6189------------------------------------------------------------------------------} 6190procedure TWinControl.ReAlign; 6191begin 6192 AdjustSize; 6193end; 6194 6195procedure TWinControl.ScrollBy_WS(DeltaX, DeltaY: Integer); 6196begin 6197 if HandleAllocated then 6198 TWSWinControlClass(WidgetSetClass).ScrollBy(Self, DeltaX, DeltaY) 6199 else 6200 raise Exception.Create('TWinControl.ScrollBy_WS: Handle not allocated'); 6201end; 6202 6203procedure TWinControl.ScrollBy(DeltaX, DeltaY: Integer); 6204var 6205 i: Integer; 6206begin 6207 // scroll inner controls 6208 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.ScrollBy'){$ENDIF}; 6209 try 6210 for i := 0 to ControlCount - 1 do 6211 with Controls[i] do 6212 SetBounds(Left + DeltaX, Top + DeltaY, Width, Height); 6213 finally 6214 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.ScrollBy'){$ENDIF}; 6215 end; 6216end; 6217 6218{------------------------------------------------------------------------------ 6219 TWinControl Remove 6220------------------------------------------------------------------------------} 6221procedure TWinControl.Remove(AControl : TControl); 6222begin 6223 if AControl <> nil then 6224 begin 6225 //DebugLn(Format('trace:[TWinControl.Remove] %s(%S) --> Remove: %s(%s)', [ClassName, Name, AControl.ClassName, AControl.Name])); 6226 if AControl is TWinControl then 6227 ListRemove(FTabList, AControl); 6228 ListRemove(FControls, AControl); 6229 ListRemove(FAlignOrder, AControl); 6230 AControl.FParent := nil; 6231 if AControl.FAutoSizingLockCount>0 then 6232 begin 6233 // AControl has disabled autosizing and thus for its parent=Self too 6234 // end disable autosize for parent=self 6235 //DebugLn([Space(FAutoSizingLockCount*2),'TWinControl.Remove ',DbgSName(Self),' Control=',DbgSName(AControl),' enable Parent']); 6236 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TControl.DisableAutoSizing'){$ENDIF}; 6237 end; 6238 end; 6239end; 6240 6241procedure TWinControl.AlignNonAlignedControls(ListOfControls: TFPList; 6242 var BoundsModified: Boolean); 6243{ All controls, not aligned/anchored by their own properties, can be auto aligned. 6244 6245 Example: 6246 cclLeftToRightThenTopToBottom 6247 6248 +-----------------------------------+ 6249 |+---------------------------------+| 6250 || Control1 | Control2 | Control 3 || 6251 |+---------------------------------+| 6252 |+---------------------------------+| 6253 || Control4 | Control5 | Control 6 || 6254 |+---------------------------------+| 6255 |+---------------------+ | 6256 || Control7 | Control8 | | 6257 |+---------------------+ | 6258 +-----------------------------------+ 6259} 6260var 6261 Box: TAutoSizeBox; 6262 r: TRect; 6263begin 6264 // check if ChildSizing aligning is enabled 6265 if (ChildSizing.Layout=cclNone) or (ListOfControls.Count=0) then 6266 exit; 6267 6268 //debugln('TWinControl.AlignNonAlignedControls ',DbgSName(Self),' ListOfControls.Count=',dbgs(ListOfControls.Count),' ',dbgs(ord(ChildSizing.EnlargeHorizontal))); 6269 6270 Box:=TAutoSizeBox.Create; 6271 try 6272 r:=GetLogicalClientRect; 6273 BoundsModified:=Box.AlignControlsInTable(ListOfControls,ChildSizing,BiDiMode, 6274 r.Right,r.Bottom,true); 6275 finally 6276 Box.Free; 6277 end; 6278end; 6279 6280class procedure TWinControl.WSRegisterClass; 6281const 6282 Registered : boolean = False; 6283begin 6284 if Registered then 6285 Exit; 6286 inherited WSRegisterClass; 6287 RegisterWinControl; 6288 RegisterPropertyToSkip(TWinControl, 'ParentDoubleBuffered', 'VCL compatibility property', ''); 6289 RegisterPropertyToSkip(TWinControl, 'ImeMode', 'VCL compatibility property', ''); 6290 RegisterPropertyToSkip(TWinControl, 'ImeName', 'VCL compatibility property', ''); 6291 Registered := True; 6292end; 6293 6294function TWinControl.IsClientHeightStored: boolean; 6295begin 6296 // The ClientHeight is needed to restore children anchored akBottom 6297 Result:=ControlCount>0; 6298end; 6299 6300function TWinControl.IsClientWidthStored: boolean; 6301begin 6302 // The ClientWidth is needed to restore children anchored akRight 6303 Result:=ControlCount>0; 6304end; 6305 6306{------------------------------------------------------------------------------ 6307 TWinControl RemoveFocus 6308------------------------------------------------------------------------------} 6309procedure TWinControl.RemoveFocus(Removing : Boolean); 6310var 6311 Form: TCustomForm; 6312begin 6313 Form := GetParentForm(Self); 6314 if Form <> nil then Form.DefocusControl(Self, Removing); 6315end; 6316 6317{------------------------------------------------------------------------------ 6318 TWinControl UpdateControlState 6319 6320 Called by: RecreateWnd, TCustomTabControl.ShowCurrentPage, 6321 TWinControl.SetParentWindow, TWinControl.InsertControl, 6322 TWinControl.CMVisibleChanged 6323------------------------------------------------------------------------------} 6324procedure TWinControl.UpdateControlState; 6325begin 6326 if HandleObjectShouldBeVisible then 6327 AdjustSize // this will trigger DoAllAutoSize, which calls UpdateShowing 6328 else 6329 UpdateShowing; // hide immediately 6330end; 6331 6332{------------------------------------------------------------------------------ 6333 TWinControl InsertControl 6334------------------------------------------------------------------------------} 6335procedure TWinControl.InsertControl(AControl: TControl); 6336begin 6337 InsertControl(AControl, ControlCount); 6338end; 6339 6340procedure TWinControl.InsertControl(AControl: TControl; Index: integer); 6341begin 6342 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.InsertControl'){$ENDIF}; 6343 try 6344 AControl.ValidateContainer(Self); 6345 Perform(CM_CONTROLLISTCHANGE, WParam(AControl), LParam(True)); 6346 Insert(AControl,Index); 6347 Assert(AControl.Parent = Self, 'TWinControl.InsertControl: AControl.Parent <> Self'); 6348 UpdateAlignIndex(AControl); 6349 if not (csReading in AControl.ComponentState) then 6350 begin 6351 AControl.Perform(CM_PARENTCOLORCHANGED, 0, 0); 6352 AControl.Perform(CM_PARENTSHOWHINTCHANGED, 0, 0); 6353 AControl.Perform(CM_PARENTBIDIMODECHANGED, 0, 0); 6354 AControl.Perform(CM_PARENTFONTCHANGED, 0, 0); 6355 AControl.Perform(CM_PARENTDOUBLEBUFFEREDCHANGED, 0, 0); 6356 AControl.UpdateBaseBounds(false,true,false); 6357 if AControl is TWinControl then 6358 TWinControl(AControl).UpdateControlState 6359 else 6360 if HandleAllocated then 6361 AControl.Invalidate; 6362 //DebugLn('TWinControl.InsertControl ',Name,':',ClassName); 6363 end; 6364 AdjustSize; 6365 Perform(CM_CONTROLCHANGE, WParam(AControl), LParam(True)); 6366 finally 6367 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.InsertControl'){$ENDIF}; 6368 end; 6369 //debugln(['TWinControl.InsertControl ',DbgSName(Self),' ',csDesigning in ComponentState,' ',DbgSName(AControl),' ',csDesigning in AControl.ComponentState]); 6370end; 6371 6372{------------------------------------------------------------------------------ 6373 TWinControl removeControl 6374------------------------------------------------------------------------------} 6375procedure TWinControl.RemoveControl(AControl: TControl); 6376var 6377 AWinControl: TWinControl; 6378 AGrControl: TGraphicControl; 6379begin 6380 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.RemoveControl'){$ENDIF}; 6381 try 6382 Perform(CM_CONTROLCHANGE, WParam(AControl), LParam(False)); 6383 if AControl is TWinControl then 6384 begin 6385 AWinControl := TWinControl(AControl); 6386 AWinControl.RemoveFocus(True); 6387 if AWinControl.HandleAllocated then 6388 AWinControl.DestroyHandle; 6389 end 6390 else 6391 begin 6392 if AControl is TGraphicControl then 6393 begin 6394 AGrControl := TGraphicControl(AControl); 6395 if (AGrControl.Canvas<>nil) then 6396 TControlCanvas(AGrControl.Canvas).FreeHandle; 6397 end; 6398 if HandleAllocated then 6399 AControl.InvalidateControl(AControl.IsVisible, False, True); 6400 end; 6401 Remove(AControl); 6402 Perform(CM_CONTROLLISTCHANGE, WParam(AControl), LParam(False)); 6403 if not (csDestroying in ComponentState) then 6404 begin 6405 InvalidatePreferredSize; 6406 AdjustSize; 6407 end; 6408 finally 6409 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.RemoveControl'){$ENDIF}; 6410 end; 6411end; 6412 6413function TWinControl.GetEnumeratorControls: TWinControlEnumerator; 6414begin 6415 Result:=TWinControlEnumerator.Create(Self,true); 6416end; 6417 6418function TWinControl.GetEnumeratorControlsReverse: TWinControlEnumerator; 6419begin 6420 Result:=TWinControlEnumerator.Create(Self,false); 6421end; 6422 6423{------------------------------------------------------------------------------ 6424 TWinControl AlignControl 6425------------------------------------------------------------------------------} 6426procedure TWinControl.AlignControl(AControl: TControl); 6427var 6428 ARect: TRect; 6429 NewRect: TRect; 6430begin 6431 //if csDesigning in ComponentState then begin 6432 // DbgOut('TWinControl.AlignControl ',Name,':',ClassName); 6433 // if AControl<>nil then DebugLn(' AControl=',AControl.Name,':',AControl.ClassName) else DebugLn(' AControl=nil');; 6434 //end; 6435 if csDestroying in ComponentState then exit; 6436 6437 // only called by DoAllAutoSize, so no check needed 6438 6439 DisableAlign; 6440 try 6441 // store 6442 ARect := GetClientRect; 6443 AdjustClientRect(ARect); 6444 FAdjustClientRectRealized:=ARect; 6445 6446 ARect:=GetLogicalClientRect; 6447 AlignControls(AControl, ARect); 6448 // some widgetsets updates their clientrect when the first child was moved 6449 // do a second pass if ClientRect changed 6450 NewRect:=GetLogicalClientRect; 6451 if not CompareRect(@ARect,@NewRect) then 6452 AlignControls(AControl, NewRect); 6453 finally 6454 EnableAlign; 6455 end; 6456end; 6457 6458{------------------------------------------------------------------------------ 6459 Method: TWinControl.ContainsControl 6460 Params: Control: the control to be checked 6461 Returns: Self is a (super)parent of Control 6462 6463 Checks if Control is a child of Self 6464 ------------------------------------------------------------------------------} 6465function TWinControl.ContainsControl(Control: TControl): Boolean; 6466begin 6467 while (Control <> nil) and (Control <> Self) do Control := Control.Parent; 6468 Result := Control = Self; 6469end; 6470 6471function TWinControl.GetBorderStyle: TBorderStyle; 6472begin 6473 Result := TBorderStyle(FBorderStyle); 6474end; 6475 6476function TWinControl.GetBrush: TBrush; 6477begin 6478 if not BrushCreated then 6479 CreateBrush; 6480 Result := FBrush; 6481end; 6482 6483function TWinControl.GetControl(const Index: Integer): TControl; 6484begin 6485 Result := TControl(FControls[Index]); 6486end; 6487 6488function TWinControl.GetControlCount: Integer; 6489begin 6490 if FControls <> nil then 6491 Result := FControls.Count 6492 else 6493 Result := 0; 6494end; 6495 6496function TWinControl.GetDockClientCount: Integer; 6497begin 6498 if FDockClients <> nil then 6499 Result := FDockClients.Count 6500 else 6501 Result := 0; 6502end; 6503 6504function TWinControl.GetDockClients(Index: Integer): TControl; 6505begin 6506 if FDockClients <> nil then 6507 Result := TControl(FDockClients[Index]) 6508 else 6509 Result := nil; 6510end; 6511 6512function TWinControl.GetHandle: HWND; 6513begin 6514 //if not HandleAllocated then DebugLn('TWinControl.GetHandle Creating handle on the fly: ',DbgSName(Self)); 6515 HandleNeeded; 6516 Result := FHandle; 6517end; 6518 6519{------------------------------------------------------------------------------ 6520 TWinControl SetHandle 6521 Params: NewHandle 6522 Returns: Nothing 6523-------------------------------------------------------------------------------} 6524procedure TWinControl.SetHandle(NewHandle: HWND); 6525begin 6526 //if (NewHandle=0) and (AnsiCompareText(ClassName,'TPAGE')=0) then 6527 // RaiseGDBException('TWincontrol.SetHandle'); 6528 FHandle:=NewHandle; 6529 InvalidatePreferredSize; 6530end; 6531 6532procedure TWinControl.SetParentBackground(const AParentBackground: Boolean); 6533begin 6534 if ParentBackground = AParentBackground then 6535 Exit; 6536 6537 if AParentBackground then 6538 ControlStyle := ControlStyle + [csParentBackground] 6539 else 6540 ControlStyle := ControlStyle - [csParentBackground]; 6541 Invalidate; 6542end; 6543 6544procedure TWinControl.SetParentDoubleBuffered(Value: Boolean); 6545begin 6546 if FParentDoubleBuffered <> Value then 6547 begin 6548 FParentDoubleBuffered := Value; 6549 if Assigned(FParent) and not (csReading in ComponentState) then 6550 Perform(CM_PARENTDOUBLEBUFFEREDCHANGED, 0, 0); 6551 end; 6552end; 6553 6554{------------------------------------------------------------------------------ 6555 Method: TWinControl.Create 6556 Params: None 6557 Returns: Nothing 6558 6559 Constructor for the class. 6560 ------------------------------------------------------------------------------} 6561constructor TWinControl.Create(TheOwner : TComponent); 6562begin 6563 // do not set borderstyle, because TCustomForm needs to set it before calling 6564 // inherited, to have it set before handle is created via streaming 6565 // use property that bsNone is zero 6566 //FBorderStyle := bsNone; 6567 inherited Create(TheOwner); 6568 FParentDoubleBuffered := True; 6569 FCompStyle := csWinControl; 6570 FChildSizing:=TControlChildSizing.Create(Self); 6571 FChildSizing.OnChange:=@DoChildSizingChange; 6572 FBrush := nil; // Brush will be created on demand. Only few controls need it. 6573 FTabOrder := -1; 6574 FTabStop := False; 6575 InvalidateClientRectCache(false); 6576end; 6577 6578{------------------------------------------------------------------------------ 6579 TWinControl CreateParented 6580------------------------------------------------------------------------------} 6581constructor TWinControl.CreateParented(AParentWindow: HWND); 6582begin 6583 FParentWindow := AParentWindow; 6584 Create(nil); 6585end; 6586 6587{------------------------------------------------------------------------------ 6588 TWinControl CreateParentedControl 6589------------------------------------------------------------------------------} 6590class function TWinControl.CreateParentedControl(AParentWindow: HWND 6591 ): TWinControl; 6592begin 6593 Result := CreateParented(AParentWindow); 6594end; 6595 6596{------------------------------------------------------------------------------ 6597 Method: TWinControl.Destroy 6598 Params: None 6599 Returns: Nothing 6600 6601 Destructor for the class. 6602 ------------------------------------------------------------------------------} 6603destructor TWinControl.Destroy; 6604var 6605 n: Integer; 6606 Control: TControl; 6607begin 6608 //DebugLn('[TWinControl.Destroy] A ',Name,':',ClassName); 6609 // prevent parent to try to focus a to be destroyed control 6610 if Parent <> nil then 6611 RemoveFocus(true); 6612 if HandleAllocated then 6613 DestroyHandle; 6614 //DebugLn('[TWinControl.Destroy] B ',Name,':',ClassName); 6615 6616 //for n:=0 to ComponentCount-1 do 6617 // DebugLn(' n=',n,' ',Components[n].ClassName); 6618 6619 n := ControlCount; 6620 6621 while n > 0 do 6622 begin 6623 Control := Controls[n - 1]; 6624 //DebugLn('[TWinControl.Destroy] C ',Name,':',ClassName,' ',Control.Name,':',Control.ClassName); 6625 Remove(Control); // this sets Control.Parent to nil 6626 //DebugLn(['TWinControl.Destroy ',DbgSName(Control.HostDockSite)]); 6627 if Control.HostDockSite = Self then 6628 Control.HostDockSite := nil; 6629 // don't free the control, controls are freed by the owner 6630 n := ControlCount; 6631 end; 6632 6633 // undock controls that use this as HostDockSite 6634 while DockClientCount>0 do begin 6635 Control:=DockClients[DockClientCount-1]; 6636 //DebugLn(['TWinControl.Destroy ',DbgSName(Self),' undocking ',DbgSName(Control)]); 6637 Control.HostDockSite:=nil; 6638 end; 6639 6640 FreeAndNil(FAlignOrder); 6641 FreeThenNil(FBrush); 6642 FreeThenNil(FChildSizing); 6643 if (FDockManager<>nil) then 6644 if FDockManager.AutoFreeByControl then 6645 FreeThenNil(FDockManager) 6646 else 6647 FDockManager:=nil; 6648 FreeThenNil(FDockClients); 6649 FreeThenNil(FTabList); 6650 //DebugLn('[TWinControl.Destroy] D ',Name,':',ClassName); 6651 inherited Destroy; 6652 //DebugLn('[TWinControl.Destroy] END ',Name,':',ClassName); 6653end; 6654 6655{------------------------------------------------------------------------------ 6656 Method: TWinControl.DoEnter 6657 Params: none 6658 Returns: Nothing 6659 6660 Call user's callback for OnEnter. 6661 ------------------------------------------------------------------------------} 6662procedure TWinControl.DoEnter; 6663begin 6664 if Assigned(FOnEnter) then FOnEnter(Self); 6665end; 6666 6667{------------------------------------------------------------------------------ 6668 Method: TWinControl.DoExit 6669 Params: none 6670 Returns: Nothing 6671 6672 Call user's callback for OnExit. 6673 ------------------------------------------------------------------------------} 6674procedure TWinControl.DoExit; 6675begin 6676 if Assigned(FOnExit) then FOnExit(Self); 6677end; 6678 6679{------------------------------------------------------------------------------ 6680 procedure TWinControl.DoFlipChildren; 6681 6682 Flip children horizontally. That means mirroring the left position. 6683 ------------------------------------------------------------------------------} 6684procedure TWinControl.DoFlipChildren; 6685var 6686 i: Integer; 6687 CurControl: TControl; 6688 AWidth: Integer; 6689 SaveLeft: Integer; 6690begin 6691 AWidth:=GetLogicalClientRect.Right; 6692 DisableAlign; 6693 for i:=0 to ControlCount-1 do begin 6694 CurControl:=Controls[i]; 6695 // flip BorderSpacing 6696 SaveLeft := CurControl.BorderSpacing.Left; 6697 CurControl.BorderSpacing.Left := CurControl.BorderSpacing.Right; 6698 CurControl.BorderSpacing.Right := SaveLeft; 6699 // flip control and anchors 6700 CurControl.Left:=AWidth-CurControl.Left-CurControl.Width; 6701 CurControl.Anchors := BidiFlipAnchors(CurControl, True); 6702 end; 6703 EnableAlign; 6704end; 6705 6706{------------------------------------------------------------------------------ 6707 Method: TWinControl.CMEnabledChanged 6708 Params: Message 6709 Returns: Nothing 6710 6711 Called when enabled is changed. Takes action to enable control 6712 ------------------------------------------------------------------------------} 6713procedure TWinControl.CMEnabledChanged(var Message: TLMessage); 6714begin 6715 if not Enabled and (Parent <> nil) 6716 then RemoveFocus(False); 6717 6718 if HandleAllocated and not (csDesigning in ComponentState) then begin 6719 //if (not Enabled) then debugln('TWinControl.CMEnabledChanged disable ',Name,':',CLassName); 6720 EnableWindow(Handle, Enabled); 6721 end; 6722 inherited; 6723end; 6724 6725{------------------------------------------------------------------------------ 6726 Method: TWinControl.CMShowHintChanged 6727 Params: Message 6728 Returns: Nothing 6729 6730 Called when showhint is changed. Notifies children 6731 ------------------------------------------------------------------------------} 6732procedure TWinControl.CMShowHintChanged(var Message: TLMessage); 6733begin 6734 NotifyControls(CM_PARENTSHOWHINTCHANGED); 6735end; 6736 6737procedure TWinControl.CMBiDiModeChanged(var Message: TLMessage); 6738begin 6739 inherited CMBiDiModeChanged(Message); 6740 NotifyControls(CM_PARENTBIDIMODECHANGED); 6741 if HandleAllocated and (Message.wParam = 0) then 6742 TWSWinControlClass(WidgetSetClass).SetBiDiMode(Self, 6743 UseRightToLeftAlignment, UseRightToLeftReading, UseRightToLeftScrollBar); 6744 AdjustSize; 6745end; 6746 6747procedure TWinControl.CMBorderChanged(var Message: TLMessage); 6748begin 6749 DoAdjustClientRectChange; 6750 AdjustSize; 6751 Invalidate; 6752end; 6753 6754procedure TWinControl.CMDoubleBufferedChanged(var Message: TLMessage); 6755begin 6756 NotifyControls(CM_PARENTDOUBLEBUFFEREDCHANGED); 6757 Invalidate; 6758end; 6759 6760{------------------------------------------------------------------------------ 6761 Method: TWinControl.WMSetFocus 6762 Params: Message 6763 Returns: Nothing 6764 6765 SetFocus event handler 6766 ------------------------------------------------------------------------------} 6767procedure TWinControl.WMSetFocus(var Message: TLMSetFocus); 6768begin 6769 {$IFDEF VerboseFocus} 6770 DebugLn('TWinControl.WMSetFocus A ',Name,':',ClassName); 6771 {$ENDIF} 6772end; 6773 6774{------------------------------------------------------------------------------ 6775 Method: TWinControl.LMKillFocus 6776 Params: Msg: The message 6777 Returns: nothing 6778 6779 event handler. 6780 ------------------------------------------------------------------------------} 6781procedure TWinControl.WMKillFocus(var Message: TLMKillFocus); 6782var 6783 ParentForm: TCustomForm; 6784begin 6785 //DebugLn('TWinControl.WMKillFocus A ',Name,':',ClassName); 6786 //DebugLn(Format('Trace: %s', [ClassName])); 6787 if [csLoading,csDestroying,csDesigning]*ComponentState=[] then 6788 begin 6789 ParentForm := GetParentForm(Self); 6790 if Assigned(ParentForm) and ParentForm.Active then 6791 EditingDone; 6792 end; 6793end; 6794 6795{------------------------------------------------------------------------------ 6796 Method: TWinControl.WMPaint 6797 Params: Msg: The paint message 6798 Returns: nothing 6799 6800 Paint event handler. 6801 ------------------------------------------------------------------------------} 6802procedure TWinControl.WMPaint(var Msg: TLMPaint); 6803var 6804 DC,MemDC: HDC; 6805{$ifdef BUFFERED_WMPAINT} 6806 MemBitmap, OldBitmap : HBITMAP; 6807 MemWidth: Integer; 6808 MemHeight: Integer; 6809{$ENDIF} 6810 PS : TPaintStruct; 6811 ClientBoundRect: TRect; 6812begin 6813 //DebugLn('[TWinControl.WMPaint] ',DbgSName(Self),' ',DbgS(Msg.DC)); 6814 {$IFDEF VerboseResizeFlicker} 6815 DebugLn('[TWinControl.WMPaint] ',DbgSName(Self),' Bounds=',dbgs(BoundsRect),' ClientRect=',dbgs(ClientRect)); 6816 {$ENDIF} 6817 if ([csDestroying,csLoading]*ComponentState<>[]) or (not HandleAllocated) then 6818 exit; 6819 6820 {$IFDEF VerboseDsgnPaintMsg} 6821 if csDesigning in ComponentState then 6822 DebugLn('TWinControl.WMPaint A ',Name,':',ClassName); 6823 {$ENDIF} 6824 6825 //if Name='GroupBox1' then 6826 // debugln(['TWinControl.WMPaint ',DbgSName(Self),' DoubleBuffered=',DoubleBuffered,' Msg.DC=',dbgs(Msg.DC),' csCustomPaint=',csCustomPaint in ControlState,' ControlCount=',ControlCount,' ClientRect=',dbgs(ClientRect)]); 6827 if (Msg.DC <> 0) or not TWSWinControlClass(WidgetSetClass).GetDoubleBuffered(Self) then 6828 begin 6829 if not (csCustomPaint in ControlState) and (ControlCount = 0) then 6830 begin 6831 DefaultHandler(Msg); 6832 end 6833 else 6834 PaintHandler(Msg); 6835 end 6836 else begin 6837 // NOTE: not every interface uses this part 6838 //DebugLn('TWinControl.WMPaint Painting doublebuffered ',Name,':',classname); 6839{$ifdef BUFFERED_WMPAINT} 6840 DC := GetDC(0); 6841 MemWidth:=Width; 6842 MemHeight:=Height; 6843 MemBitmap := CreateCompatibleBitmap(DC, MemWidth, MemHeight); 6844 ReleaseDC(0, DC); 6845 MemDC := CreateCompatibleDC(0); 6846 OldBitmap := SelectObject(MemDC, MemBitmap); 6847{$ENDIF} 6848 try 6849 // Fetch a DC of the whole Handle (including client area) 6850 DC := BeginPaint(Handle, PS); 6851 if DC=0 then exit; 6852{$ifNdef BUFFERED_WMPAINT} 6853 MemDC := DC; 6854{$ENDIF} 6855 // erase background 6856 Include(FWinControlFlags,wcfEraseBackground); 6857 Perform(LM_ERASEBKGND, WParam(MemDC), 0); 6858 Exclude(FWinControlFlags,wcfEraseBackground); 6859 // create a paint message to paint the child controls. 6860 // WMPaint expects the DC origin to be equal to the client origin of its 6861 // parent 6862 // -> Move the DC Origin to the client origin 6863 if not GetClientBounds(Handle,ClientBoundRect) then exit; 6864 MoveWindowOrgEx(MemDC,ClientBoundRect.Left,ClientBoundRect.Top); 6865 // handle the paint message 6866 Msg.DC := MemDC; 6867 Perform(LM_PAINT, WParam(MemDC), 0); 6868 Msg.DC := 0; 6869 // restore the DC origin 6870 MoveWindowOrgEx(MemDC,-ClientBoundRect.Left,-ClientBoundRect.Top); 6871{$ifdef BUFFERED_WMPAINT} 6872 BitBlt(DC, 0,0, MemWidth, MemHeight, MemDC, 0, 0, SRCCOPY); 6873{$ENDIF} 6874 EndPaint(Handle, PS); 6875 finally 6876 Exclude(FWinControlFlags,wcfEraseBackground); 6877{$ifdef BUFFERED_WMPAINT} 6878 SelectObject(MemDC, OldBitmap); 6879 DeleteDC(MemDC); 6880 DeleteObject(MemBitmap); 6881{$ENDIF} 6882 end; 6883 end; 6884 //DebugLn(Format('Trace:< [TWinControl.WMPaint] %s', [ClassName])); 6885//DebugLn('[TWinControl.WMPaint] END ',Name,':',ClassName); 6886end; 6887 6888{------------------------------------------------------------------------------ 6889 Method: TWinControl.WMDestroy 6890 Params: Msg: The destroy message 6891 Returns: nothing 6892 6893 event handler. 6894 ------------------------------------------------------------------------------} 6895procedure TWinControl.WMDestroy(var Message: TLMDestroy); 6896begin 6897 //DebugLn(Format('Trace: [TWinControl.LMDestroy] %s', [ClassName])); 6898 //DebugLn('TWinControl.WMDestroy ',Name,':',ClassName); 6899 // Our widget/window doesn't exist anymore 6900 Handle := 0; 6901end; 6902 6903{------------------------------------------------------------------------------ 6904 Method: TWinControl.WMMove 6905 Params: Msg: The message 6906 Returns: nothing 6907 6908 event handler. 6909 ------------------------------------------------------------------------------} 6910procedure TWinControl.WMMove(var Message: TLMMove); 6911var 6912 NewWidth, NewHeight: Integer; 6913 NewBoundsRealized: TRect; 6914 TopParent: TControl; 6915 6916 procedure RaiseLoop; 6917 begin 6918 raise ELayoutException.Create('TWinControl.WMMove loop detected: '+DbgSName(Self)+' BoundsRealized='+dbgs(FBoundsRealized)+' NewBoundsRealized='+dbgs(NewBoundsRealized)); 6919 end; 6920 6921begin 6922 {$IF defined (VerboseSizeMsg) or defined(VerboseIntfSizing)} 6923 if (Message.MoveType and Move_SourceIsInterface)>0 then 6924 DebugLn(['TWinControl.WMMove A ',DbgSName(Self),' Message=',Message.XPos,',',Message.YPos, 6925 ' BoundsRealized=',FBoundsRealized.Left,',',FBoundsRealized.Top, 6926 ' FromIntf=',Message.MoveType=Move_SourceIsInterface, 6927 ',',FBoundsRealized.Right-FBoundsRealized.Left, 6928 'x',FBoundsRealized.Bottom-FBoundsRealized.Top]); 6929 {$ENDIF} 6930 NewWidth := Width; 6931 NewHeight := Height; 6932 if (Message.MoveType and Move_SourceIsInterface)>0 then 6933 begin 6934 if not (wcfBoundsRealized in FWinControlFlags) then exit; 6935 // interface widget has moved 6936 // -> update size and realized bounds 6937 NewWidth := FBoundsRealized.Right - FBoundsRealized.Left; 6938 NewHeight := FBoundsRealized.Bottom - FBoundsRealized.Top; 6939 // skip size update when window is minimized 6940 if HandleAllocated and (not IsIconic(Handle)) then 6941 GetWindowSize(Handle, NewWidth, NewHeight); 6942 6943 NewBoundsRealized:=Bounds(Message.XPos, Message.YPos, NewWidth, NewHeight); 6944 if CompareRect(@NewBoundsRealized,@FBoundsRealized) then exit; 6945 6946 TopParent:=GetTopParent; 6947 if (TopParent is TWinControl) 6948 and (wcfKillIntfSetBounds in TWinControl(TopParent).FWinControlFlags) then 6949 RaiseLoop; 6950 6951 FBoundsRealized := NewBoundsRealized; 6952 if ([caspCreatingHandles,caspComputingBounds]*AutoSizePhases<>[]) then 6953 begin 6954 // while the LCL is creating handles the widgetset may send default bounds 6955 // we have not yet told the widgetset the final bounds 6956 // => the InvalidatePreferredSize and the InvalidateClientRectCache 6957 // (invoked by the widgetset) may trigger a further loop in the auto 6958 // size algorithm to take care of the new bounds 6959 // => do not call SetBounds, as this will set the Bounds to the widgetset 6960 // default values. 6961 //DebugLn(['TWinControl.WMMove from intf ignored, because phases=',dbgs(AutoSizePhases),' boundsrealized=',wcfBoundsRealized in FWinControlFlags]); 6962 exit; 6963 end; 6964 end; 6965 SetBounds(Message.XPos, Message.YPos, NewWidth, NewHeight); 6966end; 6967 6968{------------------------------------------------------------------------------ 6969 Method: TWinControl.WMSize 6970 Params: Message: TLMSize 6971 Returns: nothing 6972 6973 Event handler for size messages. This is called, whenever width, height, 6974 clientwidth or clientheight have changed. 6975 If the source of the message is the interface, the new size is stored 6976 in FBoundsRealized to avoid sending a size message back to the interface. 6977 ------------------------------------------------------------------------------} 6978procedure TWinControl.WMSize(var Message: TLMSize); 6979var 6980 NewLeft, NewTop: integer; 6981 NewBoundsRealized: TRect; 6982 TopParent: TControl; 6983 OldClientSize: TSize; 6984 NewClientSize: TSize; 6985 6986 procedure RaiseLoop; 6987 var 6988 s: String; 6989 begin 6990 s:='TWinControl.WMSize loop detected, the widgetset does not like the LCL bounds or sends unneeded wmsize messages: '+DbgSName(Self)+' BoundsRealized='+dbgs(FBoundsRealized)+' NewBoundsRealized='+dbgs(NewBoundsRealized); 6991 if (OldClientSize.cx<>NewClientSize.cx) 6992 or (OldClientSize.cy<>NewClientSize.cy) 6993 then 6994 s:=s+' OldClientSize='+dbgs(OldClientSize)+' NewClientSize='+dbgs(NewClientSize); 6995 raise ELayoutException.Create(s); 6996 end; 6997 6998begin 6999 {$IF defined(VerboseSizeMsg) or defined(CHECK_POSITION) or defined(VerboseIntfSizing)} 7000 {$IFDEF CHECK_POSITION} 7001 if CheckPosition(Self) then 7002 {$ENDIF} 7003 if (Message.SizeType and Size_SourceIsInterface) > 0 then 7004 DebugLn(['TWinControl.WMSize A ',Name,':',ClassName,' Message=',Message.Width,',',Message.Height, 7005 ' BoundsRealized=',dbgs(FBoundsRealized), 7006 ' WChg=',FBoundsRealized.Right-FBoundsRealized.Left<>Message.Width, 7007 ' HChg=',FBoundsRealized.Bottom-FBoundsRealized.Top<>Message.Height, 7008 ' FromIntf=',(Message.SizeType and Size_SourceIsInterface)>0,' ClientRectInvalid=',ClientRectNeedsInterfaceUpdate]); 7009 {$ENDIF} 7010 7011 NewLeft := Left; 7012 NewTop := Top; 7013 if ((Message.SizeType and Size_SourceIsInterface) > 0) then 7014 begin 7015 // interface widget has resized 7016 // -> update realized position and realized bounds 7017 {$IFDEF VerboseAllAutoSize} 7018 DebugLn(['TWinControl.WMSize FromIntf ',dbgsname(Self),' Message=',Message.Width,',',Message.Height, 7019 ' BoundsRealized=',dbgs(FBoundsRealized), 7020 ' wcfClientRectNeedsUpdate=',wcfClientRectNeedsUpdate in FWinControlFlags]); 7021 {$ENDIF} 7022 if not (wcfBoundsRealized in FWinControlFlags) then exit; 7023 {$IFDEF VerboseClientRectBugFix} 7024 //if Name=CheckClientRectName then 7025 DebugLn(['TWinControl.WMSize FromIntf ',dbgsname(Self),' Message=',Message.Width,',',Message.Height, 7026 ' BoundsRealized=',dbgs(FBoundsRealized), 7027 ' wcfClientRectNeedsUpdate=',wcfClientRectNeedsUpdate in FWinControlFlags]); 7028 {$ENDIF} 7029 7030 //if CheckPosition(Self) then 7031 //DebugLn(['TWinControl.WMSize GetWindowRelativePosition: ',DbgSName(Self),' ',NewLeft,',',NewTop,' ClientRectNeedsInterfaceUpdate=',ClientRectNeedsInterfaceUpdate]); 7032 NewBoundsRealized := Bounds(NewLeft, NewTop, Message.Width, Message.Height); 7033 OldClientSize := Size(0, 0); 7034 NewClientSize := Size(0, 0); 7035 if CompareRect(@NewBoundsRealized, @FBoundsRealized) then 7036 begin 7037 if not (wcfClientRectNeedsUpdate in FWinControlFlags) then 7038 begin 7039 OldClientSize := Size(FClientWidth, FClientHeight); 7040 NewClientSize := Size(ClientWidth, ClientHeight); 7041 if (OldClientSize.cx = NewClientSize.cx) and 7042 (OldClientSize.cy = NewClientSize.cy) then 7043 Exit; 7044 end; 7045 end; 7046 {$IFDEF VerboseAllAutoSize} 7047 {$IFDEF CHECK_POSITION} 7048 if CheckPosition(Self) then 7049 {$ENDIF} 7050 DebugLn(['TWinControl.WMSize Changed From Intf ',dbgsname(Self),' Message=',Message.Width,',',Message.Height, 7051 ' BoundsRealized=',dbgs(FBoundsRealized), 7052 ' wcfClientRectNeedsUpdate=',wcfClientRectNeedsUpdate in FWinControlFlags, 7053 ' ClientRectNeedsInterfaceUpdate=',ClientRectNeedsInterfaceUpdate]); 7054 {$ENDIF} 7055 7056 TopParent := GetTopParent; 7057 if (TopParent is TWinControl) and (wcfKillIntfSetBounds in TWinControl(TopParent).FWinControlFlags) then 7058 RaiseLoop; 7059 7060 FBoundsRealized := NewBoundsRealized; 7061 //DebugLn(['TWinControl.WMSize ',DbgSName(Self),' phases=',dbgs(AutoSizePhases)]); 7062 if ([caspCreatingHandles, caspComputingBounds] * AutoSizePhases <> []) then 7063 begin 7064 // while the LCL is creating handles the widgetset may send default bounds 7065 // we have not yet told the widgetset the final bounds 7066 // => the InvalidatePreferredSize and the InvalidateClientRectCache 7067 // (invoked by the widgetset) may trigger a further loop in the auto 7068 // size algorithm to take care of the new bounds 7069 // => do not call SetBounds, as this will set the Bounds to the widgetset 7070 // default values. 7071 {$IFDEF CHECK_POSITION} 7072 if CheckPosition(Self) then 7073 {$ENDIF} 7074 // DebugLn(['TWinControl.WMSize from intf ignored, because phases=',dbgs(AutoSizePhases),' boundsrealized=',wcfBoundsRealized in FWinControlFlags]); 7075 Exit; 7076 end; 7077 7078 if Assigned(Parent) then 7079 InvalidatePreferredSize; 7080 end; 7081 7082 if Assigned(Parent) and not (Self is TCustomForm) then 7083 SetBoundsKeepBase(NewLeft, NewTop, Message.Width, Message.Height) 7084 else 7085 SetBounds(NewLeft, NewTop, Message.Width, Message.Height); 7086 //if CheckPosition(Self) then 7087 //debugln(['TWinControl.WMSize ',DbgSName(Self),' ClientRectNeedsInterfaceUpdate=',ClientRectNeedsInterfaceUpdate]); 7088 if ((Message.SizeType and Size_SourceIsInterface) > 0) and ((Message.SizeType and SIZE_MINIMIZED) = 0) 7089 and ClientRectNeedsInterfaceUpdate then 7090 DoAdjustClientRectChange; 7091 {$IFDEF VerboseClientRectBugFix} 7092 {$IFDEF CHECK_POSITION} 7093 if CheckPosition(Self) then 7094 {$ENDIF} 7095 if ((Message.SizeType and Size_SourceIsInterface) > 0) then 7096 DebugLn(['TWinControl.WMSize END ',dbgsname(Self),' Message=',Message.Width,',',Message.Height, 7097 ' BoundsRealized=',dbgs(FBoundsRealized),' ClientRect=',dbgs(ClientRect), 7098 ' ']); 7099 {$ENDIF} 7100end; 7101 7102{------------------------------------------------------------------------------ 7103 Method: TWinControl.WMWindowPosChanged 7104 Params: Message: TLMWindowPosChanged 7105 Returns: nothing 7106 7107 Event handler for size/move messages. This is called, whenever left, top, 7108 width, height, clientwidth or clientheight have changed. 7109 If the source of the message is the interface, the new size is stored 7110 in FBoundsRealized to avoid sending a SetBounds back to the interface. 7111 ------------------------------------------------------------------------------} 7112procedure TWinControl.WMWindowPosChanged(var Message: TLMWindowPosChanged); 7113var 7114 NewLeft, NewTop, NewWidth, NewHeight: integer; 7115 NewBoundsRealized: TRect; 7116 TopParent: TControl; 7117 7118 procedure RaiseLoop; 7119 begin 7120 raise ELayoutException.Create('TWinControl.WMWindowPosChanged loop detected: '+DbgSName(Self)+' BoundsRealized='+dbgs(FBoundsRealized)+' NewBoundsRealized='+dbgs(NewBoundsRealized)); 7121 end; 7122 7123begin 7124 if not Assigned(Message.WindowPos) or 7125 ((Message.WindowPos^.flags and SWP_SourceIsInterface) = 0) then 7126 begin 7127 inherited WMWindowPosChanged(Message); 7128 Exit; 7129 end; 7130 7131 {$IFDEF VerboseAllAutoSize} 7132 DebugLn(DbgSName(Self) + ' : ' + DbgSWindowPosFlags(Message.WindowPos^.flags)); 7133 {$ENDIF} 7134 7135 NewLeft := Message.WindowPos^.x; 7136 NewTop := Message.WindowPos^.y; 7137 NewWidth := Message.WindowPos^.cx; 7138 NewHeight := Message.WindowPos^.cy; 7139 7140 {$IF defined(VerboseSizeMsg) or defined(CHECK_POSITION) or defined(VerboseIntfSizing)} 7141 {$IFDEF CHECK_POSITION} 7142 if CheckPosition(Self) then 7143 {$ENDIF} 7144 DebugLn(['TWinControl.WMWindowPosChanged START ',DbgSName(Self),' Message=',NewLeft,',',NewTop,',',NewWidth,'x',NewHeight, 7145 ' BoundsRealized=',dbgs(FBoundsRealized),' FromIntf=',(Message.WindowPos^.flags and SWP_SourceIsInterface)>0,' ClientRectInvalid=',ClientRectNeedsInterfaceUpdate]); 7146 {$ENDIF} 7147 7148 // interface widget has moved/resized 7149 // -> update realized bounds 7150 {$IFDEF VerboseAllAutoSize} 7151 DebugLn(['TWinControl.WMWindowPosChanged FROM INTF ',dbgsname(Self),' Message=',NewLeft,',',NewTop,',',NewWidth,'x',NewHeight, 7152 ' BoundsRealized=',dbgs(FBoundsRealized), 7153 ' wcfClientRectNeedsUpdate=',wcfClientRectNeedsUpdate in FWinControlFlags]); 7154 {$ENDIF} 7155 //DebugLn('TWinControl.WMSize B ',Name,':',ClassName,' ',NewLeft,',',NewTop); 7156 NewBoundsRealized := Bounds(NewLeft, NewTop, NewWidth, NewHeight); 7157 if CompareRect(@NewBoundsRealized,@FBoundsRealized) 7158 and (not (wcfClientRectNeedsUpdate in FWinControlFlags)) then 7159 exit; 7160 7161 {$IFDEF VerboseAllAutoSize} 7162 DebugLn(['TWinControl.WMWindowPosChanged CHANGED BY INTF ',dbgsname(Self),' Message=',NewLeft,',',NewTop,',',NewWidth,'x',NewHeight, 7163 ' BoundsRealized=',dbgs(FBoundsRealized), 7164 ' wcfClientRectNeedsUpdate=',wcfClientRectNeedsUpdate in FWinControlFlags]); 7165 {$ENDIF} 7166 7167 TopParent:=GetTopParent; 7168 if (TopParent is TWinControl) 7169 and (wcfKillIntfSetBounds in TWinControl(TopParent).FWinControlFlags) 7170 then 7171 RaiseLoop; 7172 7173 FBoundsRealized := NewBoundsRealized; 7174 //DebugLn(['TWinControl.WMSize ',DbgSName(Self),' phases=',dbgs(AutoSizePhases)]); 7175 if ([caspCreatingHandles,caspComputingBounds]*AutoSizePhases<>[]) 7176 or (not (wcfBoundsRealized in FWinControlFlags)) 7177 then begin 7178 // while the LCL is creating handles the widgetset may send default bounds 7179 // we have not yet told the widgetset the final bounds 7180 // => the InvalidatePreferredSize and the InvalidateClientRectCache 7181 // (invoked by the widgetset) may trigger a further loop in the auto 7182 // size algorithm to take care of the new bounds 7183 // => do not call SetBounds, as this will set the Bounds to the widgetset 7184 // default values. 7185 //DebugLn(['TWinControl.WMSize from intf ignored, because phases=',dbgs(AutoSizePhases),' boundsrealized=',wcfBoundsRealized in FWinControlFlags]); 7186 exit; 7187 end; 7188 7189 if Parent<>nil then 7190 InvalidatePreferredSize; 7191 7192 if Parent<>nil then 7193 SetBoundsKeepBase(NewLeft, NewTop, NewWidth, NewHeight) 7194 else 7195 SetBounds(NewLeft, NewTop, NewWidth, NewHeight); 7196 if ((Message.WindowPos^.flags and SWP_SourceIsInterface) > 0) 7197 and ClientRectNeedsInterfaceUpdate then 7198 DoAdjustClientRectChange; 7199end; 7200 7201{------------------------------------------------------------------------------ 7202 Method: TWinControl.CNKeyDown 7203 Params: Msg: The message 7204 Returns: nothing 7205 7206 event handler. 7207 ------------------------------------------------------------------------------} 7208procedure TWinControl.CNKeyDown(var Message: TLMKeyDown); 7209begin 7210 //DebugLn('TWinControl.CNKeyDown ',Name,':',ClassName); 7211 if DoKeyDownBeforeInterface(Message, False) then 7212 Message.Result := 1 7213 else 7214 {inherited}; // there is nothing to inherit 7215end; 7216 7217{------------------------------------------------------------------------------ 7218 procedure TWinControl.CNSysKeyDown(var Message: TLMKeyDown); 7219 ------------------------------------------------------------------------------} 7220procedure TWinControl.CNSysKeyDown(var Message: TLMKeyDown); 7221begin 7222 if DoKeyDownBeforeInterface(Message, False) then 7223 Message.Result := 1 7224 else 7225 {inherited}; // there is nothing to inherit 7226end; 7227 7228{------------------------------------------------------------------------------ 7229 procedure TWinControl.CNSysKeyUp(var Message: TLMKeyUp); 7230 ------------------------------------------------------------------------------} 7231procedure TWinControl.CNSysKeyUp(var Message: TLMKeyUp); 7232begin 7233 if DoKeyUpBeforeInterface(Message) then 7234 Message.Result := 1 7235 else 7236 {inherited}; // there is nothing to inherit 7237end; 7238 7239{------------------------------------------------------------------------------ 7240 Method: TWinControl.CNKeyUp 7241 Params: Msg: The message 7242 Returns: nothing 7243 7244 event handler. 7245 ------------------------------------------------------------------------------} 7246procedure TWinControl.CNKeyUp(var Message: TLMKeyUp); 7247begin 7248 if DoKeyUpBeforeInterface(Message) then 7249 Message.Result := 1 7250 else 7251 {inherited}; // there is nothing to inherit 7252end; 7253 7254{------------------------------------------------------------------------------ 7255 Method: TWinControl.CNChar 7256 Params: Msg: The message 7257 Returns: nothing 7258 7259 event handler. 7260 CNChar is sent by the interface before it has handled the keypress itself. 7261 ------------------------------------------------------------------------------} 7262procedure TWinControl.CNChar(var Message: TLMKeyUp); 7263var 7264 c: TUTF8Char; 7265begin 7266 //debugln('TWinControl.CNChar B ',DbgSName(Self),' ',dbgs(Message.CharCode)); 7267 if Widgetset.GetLCLCapability(lcSendsUTF8KeyPress) = LCL_CAPABILITY_NO then 7268 begin 7269 // current interface does not (yet) send UTF8 key press notifications -> emulate 7270 if (Message.CharCode < %11000000) then 7271 begin 7272 c:=chr(Message.CharCode); 7273 IntfUTF8KeyPress(c,1,false); 7274 if (length(c)<>1) or (c[1]<>chr(Message.CharCode)) then 7275 begin 7276 // character changed 7277 if length(c)=1 then 7278 Message.CharCode:=ord(c[1]) 7279 else 7280 Message.CharCode:=0; 7281 end; 7282 end; 7283 if Message.CharCode=0 then 7284 begin 7285 Message.Result := 1; 7286 exit; 7287 end; 7288 end; 7289 7290 {$ifdef VerboseKeyboard} 7291 debugln('TWinControl.CNChar A ',DbgSName(Self),' ',dbgs(Message.CharCode)); 7292 {$endif} 7293 7294 if DoKeyPress(Message) then 7295 Message.Result := 1 7296 else 7297 {inherited}; // there is nothing to inherit 7298end; 7299 7300procedure TWinControl.WMSysChar(var Message: TLMKeyUp); 7301begin 7302 if SendDialogChar(Message) then 7303 Message.Result := 1 7304 else 7305 {inherited}; // there is nothing to inherit 7306end; 7307 7308{------------------------------------------------------------------------------ 7309 Method: TWinControl.WMNofity 7310 Params: Msg: The message 7311 Returns: nothing 7312 7313 event handler. 7314 ------------------------------------------------------------------------------} 7315procedure TWinControl.WMNotify(var Message: TLMNotify); 7316begin 7317 if not DoControlMsg(Message.NMHdr^.hwndfrom, Message) then 7318 inherited; 7319end; 7320 7321{------------------------------------------------------------------------------ 7322 Method: TWinControl.WMShowWindow 7323 Params: Msg: The message 7324 Returns: nothing 7325 7326 event handler. 7327 ------------------------------------------------------------------------------} 7328procedure TWinControl.WMShowWindow(var Message: TLMShowWindow); 7329begin 7330 // DebugLn(['TWinControl.LMShowWindow ', dbgsName(self)]); 7331end; 7332 7333{------------------------------------------------------------------------------ 7334 Method: TWinControl.WMEnter 7335 Params: Msg: The message 7336 Returns: nothing 7337 7338 event handler. 7339 ------------------------------------------------------------------------------} 7340procedure TWinControl.WMEnter(var Message: TLMEnter); 7341begin 7342 //DebugLn(Format('Trace: TODO: [TWinControl.LMEnter] %s', [ClassName])); 7343end; 7344 7345{------------------------------------------------------------------------------ 7346 Method: TWinControl.WMEraseBkgnd 7347 Params: Msg: The message 7348 Returns: nothing 7349 7350 event handler. 7351 ------------------------------------------------------------------------------} 7352procedure TWinControl.WMEraseBkgnd(var Message: TLMEraseBkgnd); 7353begin 7354 if (Message.DC <> 0) and (wcfEraseBackground in FWinControlFlags) then 7355 begin 7356 EraseBackground(Message.DC); 7357 Message.Result := 1; 7358 end; 7359end; 7360 7361{------------------------------------------------------------------------------ 7362 Method: TWinControl.WMExit 7363 Params: Msg: The message 7364 Returns: nothing 7365 7366 event handler. 7367 ------------------------------------------------------------------------------} 7368procedure TWinControl.WMExit(var Message: TLMExit); 7369begin 7370 //DebugLn(Format('Trace: TODO: [TWinControl.LMExit] %s', [ClassName])); 7371end; 7372 7373{------------------------------------------------------------------------------ 7374 Method: TWinControl.WMChar 7375 Params: Msg: The message 7376 Returns: nothing 7377 7378 event handler. 7379 WMChar is sent by the interface after it has handled the keypress by itself. 7380 ------------------------------------------------------------------------------} 7381procedure TWinControl.WMChar(var Message: TLMChar); 7382begin 7383 //debugln('TWinControl.WMChar ',DbgSName(Self),' ',dbgs(Message.CharCode)); 7384 if SendDialogChar(Message) then 7385 Message.Result := 1; 7386 //DebugLn(Format('Trace:[TWinControl.WMChar] %s', [ClassName])); 7387end; 7388 7389{------------------------------------------------------------------------------ 7390 Method: TWinControl.WMKeyDown 7391 Params: Msg: The message 7392 Returns: nothing 7393 7394 Event handler for keys not handled by the interface 7395 ------------------------------------------------------------------------------} 7396procedure TWinControl.WMKeyDown(var Message: TLMKeyDown); 7397begin 7398 if DoRemainingKeyDown(Message) then 7399 Message.Result := 1; 7400end; 7401 7402procedure TWinControl.WMSysKeyDown(var Message: TLMKeyDown); 7403begin 7404 if DoRemainingKeyDown(Message) then 7405 Message.Result := 1; 7406end; 7407 7408{------------------------------------------------------------------------------ 7409 procedure TWinControl.WMSysKeyUp(var Message: TLMKeyUp); 7410 ------------------------------------------------------------------------------} 7411procedure TWinControl.WMSysKeyUp(var Message: TLMKeyUp); 7412begin 7413 //debugln('TWinControl.WMSysKeyUp ',DbgSName(Self)); 7414 if DoRemainingKeyUp(Message) then 7415 Message.Result := 1; 7416end; 7417 7418{------------------------------------------------------------------------------ 7419 Method: TWinControl.WMKeyUp 7420 Params: Msg: The message 7421 Returns: nothing 7422 7423 event handler. 7424 ------------------------------------------------------------------------------} 7425procedure TWinControl.WMKeyUp(var Message: TLMKeyUp); 7426begin 7427 //debugln('TWinControl.WMKeyUp ',DbgSName(Self)); 7428 if DoRemainingKeyUp(Message) then 7429 Message.Result := 1; 7430end; 7431 7432{------------------------------------------------------------------------------ 7433 function: TWinControl.HandleAllocated 7434 Params: None 7435 Returns: True is handle is allocated 7436 7437 Checks if a handle is allocated. I.E. if the control is mapped 7438 ------------------------------------------------------------------------------} 7439function TWinControl.HandleAllocated : Boolean; 7440begin 7441 HandleAllocated := (FHandle <> 0); 7442end; 7443 7444{------------------------------------------------------------------------------ 7445 Method: TWinControl.CreateHandle 7446 Params: None 7447 Returns: Nothing 7448 7449 Creates the handle ( = object) if not already done. 7450 ------------------------------------------------------------------------------} 7451procedure TWinControl.CreateHandle; 7452begin 7453 if (not HandleAllocated) then CreateWnd; 7454end; 7455 7456{------------------------------------------------------------------------------ 7457 Method: TWinControl.CreateWnd 7458 Params: None 7459 Returns: Nothing 7460 7461 Creates the interface object and assigns the handle 7462 ------------------------------------------------------------------------------} 7463procedure TWinControl.CreateWnd; 7464var 7465 Params: TCreateParams; 7466 i: Integer; 7467 AWinControl: TWinControl; 7468 7469{ procedure WriteClientRect(const Prefix: string); 7470 var r: TRect; 7471 begin 7472 LCLIntf.GetClientRect(Handle,r); 7473 if csDesigning in ComponentState then 7474 DebugLn('WriteClientRect ',Prefix,' ',Name,':',ClassName,' r=',r.Right,',',r.Bottom); 7475 end;} 7476 7477begin 7478 //DebugLn('[TWinControl.CreateWnd] START ',DbgSName(Self)); 7479 if (csDestroying in ComponentState) or Assigned(Parent) and (csDestroying in Parent.ComponentState) then 7480 begin 7481 DebugLn('[TWinControl.CreateWnd] NOTE: csDestroying ',DbgSName(Self)); 7482 RaiseGDBException(''); 7483 exit; 7484 end; 7485 7486 if wcfInitializing in FWinControlFlags then 7487 begin 7488 DebugLn('[WARNING] Recursive call to CreateWnd for ',DbgSName(Self), ' while initializing'); 7489 RaiseGDBException(''); 7490 Exit; 7491 end; 7492 7493 if wcfCreatingHandle in FWinControlFlags then 7494 begin 7495 DebugLn('[WARNING] Recursive call to CreateWnd for ',DbgSName(Self), ' while creating handle'); 7496 RaiseGDBException(''); 7497 Exit; 7498 end; 7499 7500 if wcfCreatingChildHandles in FWinControlFlags then 7501 begin 7502 DebugLn('[WARNING] Recursive call to CreateWnd for ',DbgSName(Self), ' while creating children'); 7503 RaiseGDBException(''); 7504 Exit; 7505 end; 7506 7507 if [csLoading,csDesigning]*ComponentState=[csLoading] then 7508 begin 7509 DebugLn('[HINT] TWinControl.CreateWnd creating Handle during loading ',DbgSName(Self),' csDesigning=',dbgs(csDesigning in ComponentState)); 7510 //DumpStack; 7511 //RaiseGDBException(''); 7512 end; 7513 7514 FBoundsRealized := Rect(0,0,0,0); 7515 Exclude(FWinControlFlags, wcfBoundsRealized); 7516 7517 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.CreateWnd'){$ENDIF}; 7518 try 7519 if Assigned(Parent) and not Parent.HandleAllocated then 7520 begin 7521 // first create the parent handle 7522 Parent.HandleNeeded; 7523 if HandleAllocated then exit; 7524 DebugLn(['WARNING: TWinControl.CreateWnd: parent created handles, but not ours']); 7525 end; 7526 // Control is not visible at this moment. It will be shown in UpdateShowing 7527 FShowing := False; 7528 Exclude(FWinControlFlags, wcfHandleVisible); 7529 7530 Include(FWinControlFlags, wcfCreatingHandle); 7531 try 7532 CreateParams(Params); 7533 with Params do 7534 begin 7535 if (WndParent = 0) and (Style and WS_CHILD <> 0) then 7536 begin 7537 DebugLn(['TWinControl.CreateWnd ',DbgSName(Self),' Parent=',DbgSName(Parent),' ERROR WndParent=0']); 7538 raise EInvalidOperation.CreateFmt(rsControlHasNoParentWindow, [Name]); 7539 end; 7540 end; 7541 7542 //DebugLn(['TWinControl.CreateWnd Creating handle ... ',DbgSName(WidgetSetClass),' ',DbgSName(Self)]); 7543 FHandle := TWSWinControlClass(WidgetSetClass).CreateHandle(Self, Params); 7544 if not HandleAllocated then 7545 begin 7546 if WidgetSet.LCLPlatform=lpNoGUI then 7547 RaiseGDBException('TWinControl.CreateWnd: The nogui widgetset does not support visual controls.') 7548 else 7549 RaiseGDBException('TWinControl.CreateWnd: Handle creation failed creating '+DbgSName(Self)); 7550 end; 7551 //debugln('TWinControl.CreateWnd update constraints ... ',DbgSName(Self)); 7552 TWSWinControlClass(WidgetSetClass).SetBiDiMode(Self, 7553 UseRightToLeftAlignment, UseRightToLeftReading, UseRightToLeftScrollBar); 7554 7555 Constraints.UpdateInterfaceConstraints; 7556 InvalidateClientRectCache(False); 7557 TWSWinControlClass(WidgetSetClass).ConstraintsChange(Self); 7558 7559 //WriteClientRect('A'); 7560 if Assigned(Parent) and (Params.Style and WS_POPUP = 0) then 7561 AddControl 7562 else 7563 if ParentWindow <> 0 then 7564 LCLIntf.SetParent(FHandle, ParentWindow); 7565 //WriteClientRect('B'); 7566 7567 Include(FWinControlFlags, wcfInitializing); 7568 //DebugLn(['TWinControl.CreateWnd initializing window ...']); 7569 InitializeWnd; 7570 7571 finally 7572 Exclude(FWinControlFlags, wcfInitializing); 7573 Exclude(FWinControlFlags, wcfCreatingHandle); 7574 end; 7575 7576 Include(FWinControlFlags, wcfCreatingChildHandles); 7577 try 7578 //DebugLn('[TWinControl.CreateWnd] ',Name,':',ClassName,' ',Left,',',Top,',',Width,',',Height); 7579 //WriteClientRect('C'); 7580 7581 if FControls <> nil then 7582 begin 7583 for i := 0 to FControls.Count - 1 do 7584 begin 7585 AWinControl := TWinControl(FControls.Items[i]); 7586 //DebugLn(['TWinControl.CreateWnd create child handles self=',DbgSName(Self),' Child=',DbgSName(AWinControl)]); 7587 if (AWinControl is TWinControl) and AWinControl.IsControlVisible then 7588 AWinControl.HandleNeeded; 7589 end; 7590 end; 7591 7592 ChildHandlesCreated; 7593 finally 7594 Exclude(FWinControlFlags, wcfCreatingChildHandles); 7595 end; 7596 7597 InvalidatePreferredSize; 7598 if Assigned(FControls) then 7599 for i := 0 to FControls.Count - 1 do 7600 TControl(FControls[i]).InvalidatePreferredSize; 7601 // size this control 7602 AdjustSize; 7603 finally 7604 //DebugLn(['TWinControl.CreateWnd created ',DbgSName(Self),' enable autosizing ...']); 7605 (* If an error occurred and FHandle was not created, 7606 then EnableAutoSizing must not be called. 7607 EnableAutoSizing will need the Handle, and trigger another attempt to create it. 7608 This leads to an endless loop/recursion. 7609 As a side effect the current control will be left in autosize-disabled *) 7610 if FHandle <> 0 then 7611 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.CreateWnd'){$ENDIF}; 7612 end; 7613 7614 //DebugLn('[TWinControl.CreateWnd] END ',Name,':',Classname); 7615 //WriteClientRect('D'); 7616end; 7617 7618{------------------------------------------------------------------------------ 7619 Method: TWinControl.InitializeWnd 7620 Params: none 7621 Returns: Nothing 7622 7623 Gets called after the window is created, but before the child controls are 7624 created. Place cached property code here. 7625 ------------------------------------------------------------------------------} 7626procedure TWinControl.InitializeWnd; 7627var 7628 CachedText: string; 7629begin 7630 //DebugLn(Format('Trace:[TWinControl.InitializeWnd] %s', [ClassName])); 7631 // set all cached properties 7632 7633 //DebugLn('[TWinControl.InitializeWnd] ',Name,':',ClassName,':', FCaption,' ',dbgs(Left),',',dbgs(Top),',',dbgs(Width),',',dbgs(Height)); 7634 7635 // First set the WinControl property some interfaces depends on it 7636 SetProp(Handle,'WinControl',TWinControl(Self)); 7637 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.InitializeWnd'){$ENDIF}; 7638 try 7639 {$IFDEF CHECK_POSITION} 7640 if CheckPosition(Self) then 7641 DebugLn('[TWinControl.InitializeWnd] A ',DbgSName(Self), 7642 ' OldRelBounds=',dbgs(FBoundsRealized), 7643 ' -> NewBounds=',dbgs(BoundsRect)); 7644 {$ENDIF} 7645 7646 if wcfColorChanged in FWinControlFlags then 7647 begin 7648 // replace by update style call 7649 TWSWinControlClass(WidgetSetClass).SetColor(Self); 7650 Exclude(FWinControlFlags, wcfColorChanged); 7651 end; 7652 if wcfFontChanged in FWinControlFlags then 7653 begin 7654 // replace by update style call 7655 TWSWinControlClass(WidgetSetClass).SetFont(Self,Font); 7656 Exclude(FWinControlFlags, wcfFontChanged); 7657 end; 7658 7659 if not (csDesigning in ComponentState) then 7660 EnableWindow(Handle, Enabled); 7661 7662 // Delay the setting of text until it is completely loaded 7663 if not (csLoading in ComponentState) then 7664 begin 7665 if GetCachedText(CachedText) then 7666 WSSetText(CachedText); 7667 InvalidatePreferredSize; 7668 end; 7669 7670 if csDesigning in ComponentState then 7671 TWSWinControlClass(WidgetSetClass).SetCursor(Self, Screen.Cursors[crDefault]) 7672 else 7673 TWSWinControlClass(WidgetSetClass).SetCursor(Self, Screen.Cursors[Cursor]); 7674 finally 7675 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.InitializeWnd'){$ENDIF}; 7676 end; 7677 // send pending OnResize 7678 {$IFDEF VerboseOnResize} 7679 debugln(['TWinControl.InitializeWnd ',DbgSName(Self),' calling Resize ...']); 7680 {$ENDIF} 7681 Resize; 7682end; 7683 7684procedure TWinControl.FinalizeWnd; 7685var 7686 S: string; 7687begin 7688 if not HandleAllocated then 7689 RaiseGDBException('TWinControl.FinalizeWnd Handle already destroyed'); 7690 // make sure our text is saved 7691 if TWSWinControlClass(WidgetSetClass).GetText(Self, S) then 7692 FCaption := S; 7693 // if color has changed make sure it will be restored 7694 if FColor <> {$ifdef UseCLDefault}clDefault{$else}clWindow{$endif} then 7695 Include(FWinControlFlags,wcfColorChanged); 7696 RemoveProp(Handle,'WinControl'); 7697 FAdjustClientRectRealized := Rect(0,0,0,0); 7698end; 7699 7700{------------------------------------------------------------------------------ 7701 procedure TWinControl.ParentFormHandleInitialized; 7702 7703 Called after all children handles of the ParentForm are created. 7704 ------------------------------------------------------------------------------} 7705procedure TWinControl.ParentFormHandleInitialized; 7706var 7707 i: Integer; 7708begin 7709 inherited ParentFormHandleInitialized; 7710 // tell all controls about the final end of the handle creation phase 7711 if FControls<>nil then begin 7712 for i:=0 to FControls.Count-1 do 7713 TControl(FControls[i]).ParentFormHandleInitialized; 7714 end; 7715 //debugln('TWinControl.ParentFormHandleInitialized A ',DbgSName(Self)); 7716end; 7717 7718{------------------------------------------------------------------------------ 7719 procedure TWinControl.ChildHandlesCreated; 7720 7721 Called after all children handles are created. 7722 ------------------------------------------------------------------------------} 7723procedure TWinControl.ChildHandlesCreated; 7724begin 7725 Exclude(FWinControlFlags,wcfCreatingChildHandles); 7726end; 7727 7728function TWinControl.GetMouseCapture: Boolean; 7729begin 7730 Result:=HandleAllocated and (GetCaptureControl=Self); 7731end; 7732 7733function TWinControl.GetParentBackground: Boolean; 7734begin 7735 Result := csParentBackground in ControlStyle; 7736end; 7737 7738{------------------------------------------------------------------------------ 7739 function TWinControl.ParentHandlesAllocated: boolean; 7740 7741 Checks if all Handles of all Parents are created. 7742 ------------------------------------------------------------------------------} 7743function TWinControl.ParentHandlesAllocated: boolean; 7744var 7745 CurControl: TWinControl; 7746begin 7747 Result:=false; 7748 CurControl:=Self; 7749 while CurControl<>nil do begin 7750 if (not CurControl.HandleAllocated) 7751 or (csDestroying in CurControl.ComponentState) 7752 or (csDestroyingHandle in CurControl.ControlState) then 7753 exit; 7754 CurControl:=CurControl.Parent; 7755 end; 7756 Result:=true; 7757end; 7758 7759{------------------------------------------------------------------------------ 7760 procedure TWinControl.Loaded; 7761 ------------------------------------------------------------------------------} 7762procedure TWinControl.Loaded; 7763var 7764 CachedText: string; 7765 i: Integer; 7766 AChild: TControl; 7767 LoadedClientSize: TSize; 7768 CurControl: TWinControl; 7769begin 7770 //DebugLn(['TWinControl.Loaded START ',DbgSName(Self),' cfWidthLoaded=',cfWidthLoaded in FControlFlags,' cfHeightLoaded=',cfHeightLoaded in FControlFlags,' ']); 7771 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.Loaded'){$ENDIF}; 7772 try 7773 //DebugLn(['TWinControl.Loaded ',DbgSName(Self),' cfWidthLoaded=',cfWidthLoaded in FControlFlags,' cfHeightLoaded=',cfHeightLoaded in FControlFlags,' ']); 7774 if cfClientWidthLoaded in FControlFlags then 7775 LoadedClientSize.cx:=FLoadedClientSize.cx 7776 else begin 7777 CurControl:=Self; 7778 while CurControl<>nil do begin 7779 LoadedClientSize.cx:=CurControl.ClientWidth; 7780 if LoadedClientSize.cx>0 then break; 7781 LoadedClientSize.cx:=CurControl.Width; 7782 if LoadedClientSize.cx>0 then break; 7783 CurControl:=CurControl.Parent; 7784 end; 7785 end; 7786 if cfClientHeightLoaded in FControlFlags then 7787 LoadedClientSize.cy:=FLoadedClientSize.cy 7788 else begin 7789 CurControl:=Self; 7790 while CurControl<>nil do begin 7791 LoadedClientSize.cy:=CurControl.ClientHeight; 7792 if LoadedClientSize.cy>0 then break; 7793 LoadedClientSize.cy:=CurControl.Height; 7794 if LoadedClientSize.cy>0 then break; 7795 CurControl:=CurControl.Parent; 7796 end; 7797 end; 7798 for i:=0 to ControlCount-1 do begin 7799 AChild:=Controls[i]; 7800 if AChild=nil then ; 7801 AChild.FBaseParentClientSize:=LoadedClientSize; 7802 //DebugLn(['TWinControl.Loaded Self=',DbgSName(Self),' AChild=',AChild,' AChild.FBaseParentClientSize=',dbgs(AChild.FBaseParentClientSize)]); 7803 end; 7804 if HandleAllocated then 7805 begin 7806 // Set cached caption 7807 if GetCachedText(CachedText) then 7808 WSSetText(CachedText); 7809 InvalidatePreferredSize; 7810 7811 if wcfColorChanged in FWinControlFlags then 7812 begin 7813 TWSWinControlClass(WidgetSetClass).SetColor(Self); 7814 NotifyControls(CM_PARENTCOLORCHANGED); 7815 Exclude(FWinControlFlags, wcfColorChanged); 7816 end; 7817 if wcfFontChanged in FWinControlFlags then 7818 begin 7819 TWSWinControlClass(WidgetSetClass).SetFont(Self,Font); 7820 NotifyControls(CM_PARENTFONTCHANGED); 7821 FWinControlFlags:=FWinControlFlags-[wcfFontChanged]; 7822 end; 7823 end; 7824 7825 inherited Loaded; 7826 7827 FixupTabList; 7828 7829 finally 7830 //DebugLn(['TWinControl.Loaded enableautosizing ',DbgSName(Self),' ',dbgs(BoundsRect)]); 7831 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.Loaded'){$ENDIF}; 7832 //DebugLn(['TWinControl.Loaded END ',DbgSName(Self),' ',dbgs(BoundsRect)]); 7833 end; 7834end; 7835 7836procedure TWinControl.FormEndUpdated; 7837var 7838 i: Integer; 7839begin 7840 inherited FormEndUpdated; 7841 for i:=0 to ControlCount-1 do 7842 Controls[i].FormEndUpdated; 7843end; 7844 7845{------------------------------------------------------------------------------ 7846 Method: TWinControl.DestroyWnd 7847 Params: None 7848 Returns: Nothing 7849 7850 Destroys the interface object. 7851 ------------------------------------------------------------------------------} 7852procedure TWinControl.DestroyWnd; 7853var 7854 i: integer; 7855begin 7856 if HandleAllocated then 7857 begin 7858 //DebugLn(['TWinControl.DestroyWnd ',DbgSName(Self)]); 7859 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.DestroyWnd'){$ENDIF}; 7860 try 7861 FinalizeWnd; 7862 7863 if FControls <> nil then 7864 for i := 0 to FControls.Count - 1 do 7865 TControl(FControls[i]).DoOnParentHandleDestruction; 7866 7867 TWSWinControlClass(WidgetSetClass).DestroyHandle(Self); 7868 Handle := 0; 7869 Exclude(FWinControlFlags,wcfBoundsRealized); 7870 // Maybe handle is not needed at moment but later it will be created once 7871 // again. To propely initialize control after we need to restore color 7872 // and font. Request update. 7873 FWinControlFlags := FWinControlFlags + [wcfColorChanged, wcfFontChanged]; 7874 if (CaptureControl=Self) then 7875 SetCaptureControl(nil); 7876 finally 7877 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.DestroyWnd'){$ENDIF}; 7878 end; 7879 end; 7880end; 7881 7882{------------------------------------------------------------------------------ 7883 Method: TWinControl.HandleNeeded 7884 Params: None 7885 Returns: Nothing 7886 7887 Description of the procedure for the class. 7888 ------------------------------------------------------------------------------} 7889procedure TWinControl.HandleNeeded; 7890begin 7891 if (not HandleAllocated) and (not (csDestroying in ComponentState)) then 7892 begin 7893 if Parent = Self 7894 then begin 7895 //DebugLn(Format('Trace:[TWinControl.HandleNeeded] Somebody set Parent := Self in %s. DONT DO THAT !!', [Classname])); 7896 end 7897 else begin 7898 if (Parent <> nil) then 7899 begin 7900 Parent.HandleNeeded; 7901 // has parent triggered us to create our handle ? 7902 if HandleAllocated then 7903 exit; 7904 end; 7905 end; 7906 CreateHandle; 7907 end; 7908end; 7909 7910function TWinControl.BrushCreated: Boolean; 7911begin 7912 Result := Assigned(FBrush); 7913end; 7914 7915{------------------------------------------------------------------------------ 7916 Method: TWinControl.BeginUpdateBounds 7917 Params: None 7918 Returns: Nothing 7919 7920 increases the BoundsLockCount 7921 ------------------------------------------------------------------------------} 7922procedure TWinControl.BeginUpdateBounds; 7923begin 7924 inc(FBoundsLockCount); 7925end; 7926 7927procedure TWinControl.InvalidateBoundsRealized; 7928begin 7929 FBoundsRealized := Rect(0, 0, 0, 0); 7930end; 7931 7932{------------------------------------------------------------------------------ 7933 Method: TControl.EndUpdateBounds 7934 Params: None 7935 Returns: Nothing 7936 7937 decreases the BoundsLockCount 7938 ------------------------------------------------------------------------------} 7939procedure TWinControl.EndUpdateBounds; 7940begin 7941 if FBoundsLockCount <= 0 then 7942 raise ELayoutException.CreateFmt('TWinControl.EndUpdateBounds %s too many calls.', 7943 [DbgSName(Self)]); 7944 dec(FBoundsLockCount); 7945 if FBoundsLockCount = 0 then 7946 SetBounds(Left, Top, Width, Height); 7947end; 7948 7949procedure TWinControl.LockRealizeBounds; 7950begin 7951 inc(FRealizeBoundsLockCount); 7952end; 7953 7954procedure TWinControl.UnlockRealizeBounds; 7955begin 7956 if FRealizeBoundsLockCount<=0 then 7957 RaiseGDBException('UnlockRealizeBounds'); 7958 dec(FRealizeBoundsLockCount); 7959 if (FRealizeBoundsLockCount=0) 7960 and (not AutoSizeDelayed) and (caspRealizingBounds in AutoSizePhases) 7961 then 7962 RealizeBounds; 7963end; 7964 7965{------------------------------------------------------------------------------ 7966 procedure TWinControl.DockDrop(DockObject: TDragDockObject; X, Y: Integer); 7967 7968 Docks the DockObject.Control onto this control. 7969 X, Y are only default values. More important is the DockObject.DropAlign 7970 property, which defines how to align DockObject.Control. 7971 ------------------------------------------------------------------------------} 7972procedure TWinControl.DockDrop(DragDockObject: TDragDockObject; X, Y: Integer); 7973begin 7974 if DoDockClientMsg(DragDockObject, Point(X, Y)) and Assigned(FOnDockDrop) then 7975 FOnDockDrop(Self, DragDockObject, X, Y); 7976end; 7977 7978{------------------------------------------------------------------------------ 7979 Method: TControl.GetIsResizing 7980 Params: None 7981 Returns: Nothing 7982 7983 decreases the BoundsLockCount 7984 ------------------------------------------------------------------------------} 7985function TWinControl.GetIsResizing: boolean; 7986begin 7987 Result:=BoundsLockCount>0; 7988end; 7989 7990function TWinControl.GetIsSpecialSubControl: Boolean; 7991begin 7992 Result := wcfSpecialSubControl in FWinControlFlags; 7993end; 7994 7995function TWinControl.GetTabOrder: TTabOrder; 7996begin 7997 if FParent <> nil then 7998 Result := ListIndexOf(FParent.FTabList,Self) 7999 else 8000 Result := FTabOrder; 8001end; 8002 8003function TWinControl.GetVisibleDockClientCount: Integer; 8004var 8005 i: integer; 8006begin 8007 Result := 0; 8008 if FDockClients=nil then exit; 8009 for i:=FDockClients.Count-1 downto 0 do 8010 if TControl(FDockClients[I]).Visible then inc(Result); 8011end; 8012 8013procedure TWinControl.SetChildSizing(const AValue: TControlChildSizing); 8014begin 8015 if (FChildSizing=AValue) then exit; 8016 FChildSizing.Assign(AValue); 8017end; 8018 8019procedure TWinControl.SetDesignerDeleting(AValue: Boolean); 8020begin 8021 if AValue then 8022 Include(FWinControlFlags, wcfDesignerDeleting) 8023 else 8024 Exclude(FWinControlFlags, wcfDesignerDeleting); 8025end; 8026 8027{------------------------------------------------------------------------------ 8028 procedure TWinControl.SetDockSite(const NewDockSite: Boolean); 8029 8030 If NewDockSite=true it means, this control can dock other controls. 8031 ------------------------------------------------------------------------------} 8032procedure TWinControl.SetDockSite(const NewDockSite: Boolean); 8033begin 8034 if FDockSite=NewDockSite then exit; 8035 FDockSite := NewDockSite; 8036 if not (csDesigning in ComponentState) then begin 8037 DragManager.RegisterDockSite(Self,NewDockSite); 8038 if not NewDockSite then begin 8039 FreeAndNil(FDockClients); 8040 FDockClients := nil; 8041 DockManager := nil; 8042 end 8043 else begin 8044 if FDockClients = nil then FDockClients := TFPList.Create; 8045 DockManager := CreateDockManager; 8046 end; 8047 end; 8048end; 8049 8050procedure TWinControl.SetDoubleBuffered(Value: Boolean); 8051var 8052 AChanged: Boolean; 8053begin 8054 AChanged := FDoubleBuffered <> Value; 8055 FDoubleBuffered := Value; 8056 FParentDoubleBuffered := False; 8057 if AChanged then 8058 Perform(CM_DOUBLEBUFFEREDCHANGED, 0, 0); 8059end; 8060 8061function TWinControl.DoDockClientMsg(DragDockObject: TDragDockObject; 8062 aPosition: TPoint): boolean; 8063var 8064 DestRect: TRect; 8065 Form: TCustomForm; 8066begin 8067 with DragDockObject do begin 8068 DestRect := DockRect; 8069 DisableAlign; 8070 try 8071 {$IFDEF VerboseDocking} 8072 Debugln(['TWinControl.DoDockClientMsg ',DbgSName(Self),' Control=',DbgSName(DragDockObject.Control),' DestRect=',dbgs(DestRect)]); 8073 {$ENDIF} 8074 DragDockObject.Control.Dock(Self, DestRect); 8075 if FUseDockManager and (DockManager <> nil) then 8076 DockManager.InsertControl(DragDockObject); 8077 finally 8078 EnableAlign; 8079 end; 8080 Form := GetParentForm(Self); 8081 if Form <> nil then Form.BringToFront; 8082 Result := true; 8083 end; 8084end; 8085 8086function TWinControl.DoUndockClientMsg(NewTarget, Client: TControl): boolean; 8087begin 8088 Result := True; 8089 {$IFDEF VerboseDocking} 8090 DebugLn(['TWinControl.DoUnDockClientMsg ',DbgSName(Self),' Client=',DbgSName(Client),' Client.Parent=',DbgSName(Client.Parent)]); 8091 {$ENDIF} 8092 if FUseDockManager and (DockManager <> nil) then 8093 DockManager.RemoveControl(Client); 8094end; 8095 8096{------------------------------------------------------------------------------ 8097 Method: TWinControl.SetBounds 8098 Params: aLeft, aTop, aWidth, aHeight 8099 Returns: Nothing 8100 8101 Sets the bounds of the control. 8102 ------------------------------------------------------------------------------} 8103procedure TWinControl.SetBounds(ALeft, ATop, AWidth, AHeight: integer); 8104 8105 procedure CheckDesignBounds; 8106 begin 8107 if FRealizeBoundsLockCount > 0 then Exit; 8108 // the user changed the bounds 8109 if AWidth < 0 then 8110 raise ELayoutException.CreateFmt('TWinControl.SetBounds (%s): Negative width %d not allowed.', 8111 [DbgSName(Self), AWidth]); 8112 if AHeight < 0 then 8113 raise ELayoutException.CreateFmt('TWinControl.SetBounds (%s): Negative height %d not allowed.', 8114 [DbgSName(Self), AHeight]); 8115 end; 8116 8117var 8118 NewBounds, OldBounds: TRect; 8119begin 8120 {$IFDEF CHECK_POSITION} 8121 //if csDesigning in ComponentState then 8122 if CheckPosition(Self) then 8123 DebugLn(['[TWinControl.SetBounds] START ',DbgSName(Self), 8124 ' Old=',dbgs(Bounds(Left,Top,Width,Height)), 8125 ' -> New=',dbgs(Bounds(ALeft,ATop,AWidth,AHeight)), 8126 ' Lock=',BoundsLockCount, 8127 ' Realized=',dbgs(FBoundsRealized) 8128 ]); 8129 {$ENDIF} 8130 if BoundsLockCount <> 0 then 8131 Exit; 8132 OldBounds := BoundsRect; 8133 NewBounds := Bounds(ALeft, ATop, AWidth, AHeight); 8134 8135 if not CompareRect(@NewBounds, @OldBounds) then 8136 begin 8137 if [csDesigning,csDestroying,csLoading]*ComponentState=[csDesigning] then 8138 CheckDesignBounds; 8139 // LCL bounds are not up2date -> process new bounds 8140 DisableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.SetBounds'){$ENDIF}; 8141 try 8142 {$IFDEF CHECK_POSITION} 8143 //if csDesigning in ComponentState then 8144 if CheckPosition(Self) then 8145 DebugLn(['[TWinControl.SetBounds] Set LCL Bounds ',DbgSName(Self), 8146 ' OldBounds=',Dbgs(Bounds(Left,Top,Width,Height)), 8147 ' -> New=',Dbgs(Bounds(ALeft,ATop,AWidth,AHeight))]); 8148 {$ENDIF} 8149 inherited SetBounds(ALeft, ATop, AWidth, AHeight); 8150 //DebugLn(['TWinControl.SetBounds ',DbgSName(Self),' FUseDockManager=',FUseDockManager,' ',DbgSName(DockManager)]); 8151 finally 8152 EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TWinControl.SetBounds'){$ENDIF}; 8153 end; 8154 end; 8155end; 8156 8157{------------------------------------------------------------------------------ 8158 procedure TWinControl.CalculatePreferredSize(var PreferredWidth, 8159 PreferredHeight: integer; WithThemeSpace" Boolean); 8160 8161 Calculates the default/preferred width and height for a TWinControl, which is 8162 used by the LCL autosizing algorithms as default size. Only positive values 8163 are valid. Negative or 0 are treated as undefined and the LCL uses other sizes 8164 instead (exception: csAutoSize0x0). 8165 TWinControl overrides this: 8166 If there are children, their total preferred size is calculated. 8167 If this value can not be computed (e.g. the children depend too much on their 8168 parent clientrect), then the interface is asked for the preferred size. 8169 For example the preferred size of a TButton is the size, where the label fits 8170 exactly. This depends heavily on the current theme and widgetset. 8171 8172 This value is independent of constraints and siblings, only the inner parts 8173 are relevant. 8174 8175 WithThemeSpace: If true, adds space for stacking. For example: TRadioButton 8176 has a minimum size. But for stacking multiple TRadioButtons there should be 8177 some space around. This space is theme dependent, so it passed parameter to 8178 the widgetset. 8179 ------------------------------------------------------------------------------} 8180procedure TWinControl.CalculatePreferredSize(var PreferredWidth, 8181 PreferredHeight: integer; WithThemeSpace: Boolean); 8182 8183 {$IFDEF VerboseCalculatePreferredSize} 8184 procedure trav(aControl: TControl; Prefix: string); 8185 var 8186 w: integer; 8187 h: integer; 8188 i: Integer; 8189 begin 8190 if not aControl.IsVisible then exit; 8191 if aControl<>Self then begin 8192 aControl.GetPreferredSize(w,h,true,true); 8193 debugln([Prefix,'Child ',DbgSName(aControl),' ',dbgs(aControl.BoundsRect),' Pref=',w,'x',h]); 8194 end; 8195 if aControl is TWinControl then 8196 for i:=0 to TWinControl(aControl).ControlCount-1 do 8197 trav(TWinControl(aControl).Controls[i],Prefix+' '); 8198 end; 8199 8200 function IsVerbose: boolean; 8201 begin 8202 Result:=(Name='MainScrollBox'); 8203 end; 8204 {$ENDIF} 8205 8206var 8207 Layout: TAutoSizeCtrlData; 8208 NewClientWidth: Integer; 8209 NewClientHeight: Integer; 8210 NewMoveLeft, NewMoveRight: integer; 8211 FrameWidth: integer; 8212 FrameHeight: integer; 8213begin 8214 inherited CalculatePreferredSize(PreferredWidth,PreferredHeight,WithThemeSpace); 8215 8216 if HandleAllocated then begin 8217 TWSWinControlClass(WidgetSetClass).GetPreferredSize(Self, 8218 PreferredWidth, PreferredHeight, WithThemeSpace); 8219 {$IFDEF VerboseCalculatePreferredSize} 8220 if IsVerbose then debugln(['TWinControl.CalculatePreferredSize Widget ',DbgSName(Self),' ',DbgSName(WidgetSetClass),' Pref=',PreferredWidth,'x',PreferredHeight]); 8221 {$ENDIF} 8222 end; 8223 8224 if ControlCount>0 then begin 8225 // Beware: ControlCount>0 does not mean that there are visible children 8226 8227 // get the size requirements for the child controls 8228 Layout:=nil; 8229 try 8230 Layout:=TAutoSizeCtrlData.Create(Self); 8231 Layout.ComputePreferredClientArea(false,false,NewMoveLeft,NewMoveRight, 8232 NewClientWidth,NewClientHeight); 8233 //if (Name='OtherInfoGroupBox') or (Name='ProjectVersionInfoOptionsFrame') then 8234 // debugln(['TWinControl.CalculatePreferredSize NewClientWidth=',NewClientWidth,' NewClientHeight=',NewClientHeight]); 8235 if (NewMoveLeft<>0) or (NewMoveRight<>0) then ; 8236 finally 8237 Layout.Free; 8238 end; 8239 8240 // add clientarea frame 8241 GetPreferredSizeClientFrame(FrameWidth,FrameHeight); 8242 8243 {$IF defined(VerboseAutoSize) or defined(VerboseAllAutoSize) or defined(VerboseCalculatePreferredSize)} 8244 {$IFDEF VerboseCalculatePreferredSize} 8245 if IsVerbose then 8246 trav(Self,' '); 8247 if IsVerbose then 8248 {$ENDIF} 8249 //if (Name='OtherInfoGroupBox') or (Name='ProjectVersionInfoOptionsFrame') then 8250 debugln(['TWinControl.CalculatePreferredSize ',DbgSName(Self), 8251 ' HandleAllocated=',HandleAllocated, 8252 ' Cur=',Width,'x',Height, 8253 ' Client=',ClientWidth,'x',ClientHeight, 8254 ' PrefClient=',NewClientWidth,'x',NewClientHeight]); 8255 {$ENDIF} 8256 if NewClientWidth>0 then 8257 PreferredWidth:=Max(PreferredWidth,NewClientWidth+FrameWidth); 8258 if NewClientHeight>0 then 8259 PreferredHeight:=Max(PreferredHeight,NewClientHeight+FrameHeight); 8260 end; 8261 8262 // add borderspacing 8263 if (PreferredWidth>0) 8264 or ((PreferredWidth=0) and (csAutoSize0x0 in ControlStyle)) then 8265 inc(PreferredWidth,BorderSpacing.InnerBorder*2); 8266 if (PreferredHeight>0) 8267 or ((PreferredHeight=0) and (csAutoSize0x0 in ControlStyle)) then 8268 inc(PreferredHeight,BorderSpacing.InnerBorder*2); 8269 {$IF defined(VerboseAutoSize) or defined(VerboseCalculatePreferredSize)} 8270 {$IFDEF VerboseCalculatePreferredSize} 8271 if IsVerbose then 8272 {$ENDIF} 8273 debugln(['TWinControl.CalculatePreferredSize ',DbgSName(Self), 8274 ' HandleAllocated=',dbgs(HandleAllocated), 8275 ' ClientFrame=',FrameWidth,'x',FrameHeight, 8276 ' Preferred=',dbgs(PreferredWidth),'x',dbgs(PreferredHeight)]); 8277 {$ENDIF} 8278end; 8279 8280procedure TWinControl.GetPreferredSizeClientFrame(out aWidth, aHeight: integer); 8281begin 8282 aWidth:=Width-ClientWidth; 8283 aHeight:=Height-ClientHeight; 8284end; 8285 8286{------------------------------------------------------------------------------ 8287 Method: TWinControl.RealGetText 8288 Params: None 8289 Returns: The text 8290 8291 Gets the text/caption of a control 8292 ------------------------------------------------------------------------------} 8293function TWinControl.RealGetText: TCaption; 8294begin 8295 Result := ''; 8296 {$IFDEF VerboseTWinControlRealText} 8297 DebugLn(['TWinControl.RealGetText ',DbgSName(Self),' HandleAllocated=',HandleAllocated,' csLoading=',csLoading in ComponentState,' ']); 8298 if not HandleAllocated 8299 or (csLoading in ComponentState) then begin 8300 DebugLn(['TWinControl.RealGetText using inherited RealGetText']); 8301 Result := inherited RealGetText; 8302 end else begin 8303 DebugLn(['TWinControl.RealGetText using ',DbgSName(WidgetSetClass),' GetText']); 8304 if (not TWSWinControlClass(WidgetSetClass).GetText(Self, Result)) then begin 8305 DebugLn(['TWinControl.RealGetText FAILED, using RealGetText']); 8306 Result := inherited RealGetText; 8307 end; 8308 end; 8309 DebugLn(['TWinControl.RealGetText Result="',Result,'"']); 8310 {$ELSE} 8311 if not HandleAllocated 8312 or (csLoading in ComponentState) 8313 or (not TWSWinControlClass(WidgetSetClass).GetText(Self, Result)) 8314 then Result := inherited RealGetText; 8315 {$ENDIF} 8316end; 8317 8318{------------------------------------------------------------------------------ 8319 Method: TWinControl.GetTextLen 8320 Params: None 8321 Returns: The length of the text 8322 8323 Gets the length of the text/caption of a control 8324 ------------------------------------------------------------------------------} 8325function TWinControl.GetTextLen: Integer; 8326begin 8327 Result := 0; 8328 if not HandleAllocated 8329 or (csLoading in ComponentState) 8330 or not TWSWinControlClass(WidgetSetClass).GetTextLen(Self, Result) 8331 then Result := inherited GetTextLen; 8332end; 8333 8334{------------------------------------------------------------------------------ 8335 Method: TWinControl.RealSetText 8336 Params: Value: the text to be set 8337 Returns: Nothing 8338 8339 Sets the text/caption of a control 8340 ------------------------------------------------------------------------------} 8341procedure TWinControl.RealSetText(const AValue: TCaption); 8342begin 8343 {$IFDEF VerboseTWinControlRealText} 8344 DebugLn(['TWinControl.RealSetText ',DbgSName(Self),' AValue="',AValue,'" HandleAllocated=',HandleAllocated,' csLoading=',csLoading in ComponentState]); 8345 {$ENDIF} 8346 if HandleAllocated and (not (csLoading in ComponentState)) then 8347 begin 8348 WSSetText(AValue); 8349 InvalidatePreferredSize; 8350 inherited RealSetText(AValue); 8351 AdjustSize; 8352 end 8353 else inherited RealSetText(AValue); 8354 {$IFDEF VerboseTWinControlRealText} 8355 DebugLn(['TWinControl.RealSetText ',DbgSName(Self),' END']); 8356 {$ENDIF} 8357end; 8358 8359{------------------------------------------------------------------------------ 8360 Method: TWinControl.GetDeviceContext 8361 Params: WindowHandle: the windowhandle of this control 8362 Returns: a Devicecontext 8363 8364 Get the devicecontext for this WinControl. 8365 ------------------------------------------------------------------------------} 8366function TWinControl.GetDeviceContext(var WindowHandle: HWND): HDC; 8367begin 8368 Result := GetDC(Handle); 8369 //DebugLn('[TWinControl.GetDeviceContext] ',ClassName,' DC=',DbgS(Result,8),' Handle=',DbgS(FHandle)); 8370 if Result = 0 then 8371 raise EOutOfResources.CreateFmt(rsErrorCreatingDeviceContext, [Name, ClassName]); 8372 8373 WindowHandle := Handle; 8374end; 8375 8376{------------------------------------------------------------------------------ 8377 Method: TWinControl.CMVisibleChanged 8378 Params: Message : not used 8379 Returns: nothing 8380 8381 Performs actions when visibility has changed 8382 ------------------------------------------------------------------------------} 8383procedure TWinControl.CMVisibleChanged(var Message : TLMessage); 8384begin 8385 if not FVisible and Assigned(Parent) then 8386 RemoveFocus(False); 8387 8388 if not (csDesigning in ComponentState) or (csNoDesignVisible in ControlStyle) then 8389 UpdateControlState; 8390end; 8391 8392procedure TWinControl.CMEnter(var Message: TLMessage); 8393begin 8394 DoEnter; 8395end; 8396 8397procedure TWinControl.CMExit(var Message: TLMessage); 8398begin 8399 DoExit; 8400end; 8401 8402procedure TWinControl.CMParentDoubleBufferedChanged(var Message: TLMessage); 8403begin 8404 if FParentDoubleBuffered then 8405 begin 8406 if Assigned(FParent) then 8407 DoubleBuffered := FParent.DoubleBuffered; // call CM_DOUBLEBUFFEREDCHANGED 8408 FParentDoubleBuffered := True; 8409 end; 8410end; 8411 8412procedure TWinControl.WMContextMenu(var Message: TLMContextMenu); 8413var 8414 Child: TControl; 8415begin 8416 // Check if at the click place we have a control and if so then pass the 8417 // message to it. 8418 // Don't check csDesigning here - let a child control check it. 8419 if (Message.Result <> 0) then 8420 Exit; 8421 8422 if Message.XPos <> -1 then 8423 begin 8424 // don't allow disabled and don't search wincontrols - they receive their 8425 // message themself 8426 Child := ControlAtPos(ScreenToClient(SmallPointToPoint(Message.Pos)), []); 8427 if Assigned(Child) then 8428 with Message do 8429 begin 8430 Result := Child.Perform(Msg, WParam(hWnd), LParam(Integer(Pos))); 8431 if (Result <> 0) then 8432 Exit; 8433 end; 8434 end; 8435 8436 inherited; 8437end; 8438 8439procedure TWinControl.DoSendShowHideToInterface; 8440var 8441 NewVisible: Boolean; 8442begin 8443 NewVisible := HandleObjectShouldBeVisible; 8444 if NewVisible <> (wcfHandleVisible in FWinControlFlags) then 8445 begin 8446 if NewVisible then 8447 Include(FWinControlFlags, wcfHandleVisible) 8448 else 8449 Exclude(FWinControlFlags, wcfHandleVisible); 8450 {$IF defined(VerboseNewAutoSize) or defined(VerboseIntfSizing) or defined(VerboseShowing)} 8451 DebugLn(['TWinControl.DoSendShowHideToInterface ',DbgSName(Self),' FBoundsRealized=',dbgs(FBoundsRealized),' New=',HandleObjectShouldBeVisible]); 8452 {$ENDIF} 8453 TWSWinControlClass(WidgetSetClass).ShowHide(Self); 8454 end; 8455end; 8456 8457procedure TWinControl.ControlsAligned; 8458begin 8459 8460end; 8461 8462procedure TWinControl.DoSendBoundsToInterface; 8463var 8464 NewBounds: TRect; 8465 OldClientRect: TRect; 8466 NewClientRect: TRect; 8467 {$IF defined(VerboseResizeFlicker) or defined(VerboseSizeMsg)} 8468 OldBounds: TRect; 8469 {$ENDIF} 8470begin 8471 if (Parent = nil) and (not HandleObjectShouldBeVisible) then 8472 begin 8473 { do not move invisible forms 8474 Reason: It is common to do this: 8475 Form1:=TForm1.Create(nil); 8476 Form1.Top:=100; 8477 Form1.Left:=100; 8478 Form1.Show; 8479 This moves the form around and confuses some windowmanagers. 8480 Only send the last bounds. } 8481 Exit; 8482 end; 8483 NewBounds := Bounds(Left, Top, Width, Height); 8484 {$IF defined(VerboseResizeFlicker) or defined(VerboseSizeMsg)} 8485 if HandleAllocated then begin 8486 GetWindowRelativePosition(Handle,OldBounds.Left,OldBounds.Top); 8487 GetWindowSize(Handle,OldBounds.Right,OldBounds.Bottom); 8488 inc(OldBounds.Right,OldBounds.Left); 8489 inc(OldBounds.Bottom,OldBounds.Top); 8490 end else 8491 OldBounds:=NewBounds; 8492 DebugLn(['[TWinControl.DoSendBoundsToInterface] ',DbgSName(Self), 8493 ' Old=',dbgs(OldBounds), 8494 ' New=',dbgs(NewBounds), 8495 ' PosChanged=',(OldBounds.Left<>NewBounds.Left) or (OldBounds.Top<>NewBounds.Top), 8496 ' SizeChanged=w',(OldBounds.Right-OldBounds.Left<>NewBounds.Right-NewBounds.Left), 8497 ',h', (OldBounds.Bottom-OldBounds.Top<>NewBounds.Bottom-NewBounds.Top), 8498 ' CurClient=',FClientWidth,'x',FClientHeight 8499 ]); 8500 {$ENDIF} 8501 {$IFDEF CHECK_POSITION} 8502 if CheckPosition(Self) then 8503 DebugLn('[TWinControl.DoSendBoundsToInterface] A ',DbgSName(Self), 8504 ' OldRelBounds=',dbgs(FBoundsRealized), 8505 ' -> NewBounds=',dbgs(NewBounds), 8506 ' ClientRect=',dbgs(ClientRect)); 8507 {$ENDIF} 8508 8509 {$IFDEF VerboseClientRectBugFix} 8510 //if Name=CheckClientRectName then 8511 DebugLn('[TWinControl.DoSendBoundsToInterface] A ',DbgSName(Self), 8512 ' OldRelBounds=',dbgs(FBoundsRealized), 8513 ' -> NewBounds=',dbgs(NewBounds) 8514 //,' Parent.Bounds=',dbgs(Parent.BoundsRect) 8515 //,' Parent.ClientRect=',dbgs(Parent.ClientRect) 8516 ); 8517 {$ENDIF} 8518 8519 {$IFDEF VerboseIntfSizing} 8520 if Visible then begin 8521 DebugLn('[TWinControl.DoSendBoundsToInterface] A ',DbgSName(Self), 8522 ' OldRelBounds=',dbgs(FBoundsRealized), 8523 ' -> NewBounds=',dbgs(NewBounds)); 8524 end; 8525 {$ENDIF} 8526 FBoundsRealized := NewBounds; 8527 OldClientRect := ClientRect; // during a resize this is the anticipated new ClientRect 8528 Include(FWinControlFlags, wcfBoundsRealized); // Note: set before calling widgetset, because used in WMSize 8529 //if Parent=nil then DebugLn(['TWinControl.DoSendBoundsToInterface ',DbgSName(Self),' ',dbgs(BoundsRect)]); 8530 // this can trigger WMSize messages 8531 TWSWinControlClass(WidgetSetClass).SetBounds(Self, Left, Top, Width, Height); 8532 NewClientRect := ClientRect; 8533 if Visible and (not CompareRect(@OldClientRect,@NewClientRect)) then 8534 begin 8535 // the widgetset has changed the clientrect in an unexpected way 8536 {$IFDEF VerboseIntfSizing} 8537 debugln(['TWinControl.DoSendBoundsToInterface WS has changed ClientRect in an unexpected way: ', 8538 DbgSName(Self),' Bounds=',dbgs(BoundsRect),' ExpectedClientRect=',dbgs(OldClientRect),' New=',dbgs(NewClientRect)]); 8539 {$ENDIF} 8540 //DebugLn(['TWinControl.DoSendBoundsToInterface ',DbgSName(Self),' Bounds=',dbgs(BoundsRect),' OldClientRect=',dbgs(OldClientRect),' NewClientRect=',dbgs(NewClientRect)]); 8541 AdjustSize; 8542 end; 8543end; 8544 8545procedure TWinControl.RealizeBounds; 8546 8547 procedure Check; 8548 var 8549 c: TWinControl; 8550 begin 8551 c:=Self; 8552 while c<>nil do begin 8553 DebugLn(['Check ',DbgSName(c),' ',c.HandleAllocated, 8554 ' wcfCreatingHandle=',wcfCreatingHandle in FWinControlFlags, 8555 ' wcfInitializing=',wcfInitializing in FWinControlFlags, 8556 ' wcfCreatingChildHandles=',wcfCreatingChildHandles in FWinControlFlags, 8557 '']); 8558 c:=c.Parent; 8559 end; 8560 RaiseGDBException(''); 8561 end; 8562 8563var 8564 NewBounds: TRect; 8565begin 8566 NewBounds:=Bounds(Left, Top, Width, Height); 8567 if HandleAllocated 8568 and ([csLoading,csDestroying]*ComponentState=[]) 8569 and (not (csDestroyingHandle in ControlState)) 8570 and (not CompareRect(@NewBounds,@FBoundsRealized)) 8571 then begin 8572 // the new bounds were not yet sent to the InterfaceObject -> send them 8573 {$IFDEF CHECK_POSITION} 8574 //if csDesigning in ComponentState then 8575 if CheckPosition(Self) then 8576 DebugLn('[TWinControl.RealizeBounds] A ',DbgSName(Self), 8577 ' OldRelBounds=',dbgs(FBoundsRealized), 8578 ' -> NewBounds=',dbgs(NewBounds)); 8579 {$ENDIF} 8580 BeginUpdateBounds; 8581 try 8582 DoSendBoundsToInterface; 8583 finally 8584 EndUpdateBounds; 8585 end; 8586 end else begin 8587 {$IFDEF CHECK_POSITION} 8588 if CheckPosition(Self) then begin 8589 DbgOut('[TWinControl.RealizeBounds] NOT REALIZING ',DbgSName(Self), 8590 ' OldRelBounds=',dbgs(FBoundsRealized), 8591 ' -> NewBounds=',dbgs(NewBounds), 8592 ', because '); 8593 if not HandleAllocated then debugln('not HandleAllocated'); 8594 if (csLoading in ComponentState) then debugln('csLoading'); 8595 if (csDestroying in ComponentState) then debugln('csDestroying'); 8596 if (CompareRect(@NewBounds,@FBoundsRealized)) then debugln('bounds not changed'); 8597 end; 8598 {$ENDIF} 8599 if not HandleAllocated then Check; 8600 end; 8601end; 8602 8603procedure TWinControl.RealizeBoundsRecursive; 8604var 8605 i: Integer; 8606 OldRealizing: boolean; 8607 AControl: TControl; 8608begin 8609 if not HandleAllocated then exit; 8610 OldRealizing:=wcfRealizingBounds in FWinControlFlags; 8611 Include(FWinControlFlags,wcfRealizingBounds); 8612 try 8613 if FControls<>nil then begin 8614 for i:=0 to FControls.Count-1 do begin 8615 AControl:=TControl(FControls[i]); 8616 if (AControl is TWinControl) then 8617 TWinControl(AControl).RealizeBoundsRecursive; 8618 end; 8619 end; 8620 RealizeBounds; 8621 finally 8622 if not OldRealizing then 8623 Exclude(FWinControlFlags,wcfRealizingBounds); 8624 end; 8625end; 8626 8627{------------------------------------------------------------------------------ 8628 Method: TWinControl.CMShowingChanged 8629 Params: Message : not used 8630 Returns: nothing 8631 8632 Shows or hides a control 8633 Called by UpdateShowing 8634 ------------------------------------------------------------------------------} 8635procedure TWinControl.CMShowingChanged(var Message: TLMessage); 8636begin 8637 {$IFDEF VerboseShowing} 8638 DebugLn(['TWinControl.CMShowingChanged ',DbgSName(Self),' HandleAllocated=',HandleAllocated,' ',dbgs(ComponentState)]); 8639 {$ENDIF} 8640 if HandleAllocated and ([csDestroying,csLoading]*ComponentState=[]) then 8641 DoSendShowHideToInterface 8642 else 8643 Exclude(FWinControlFlags, wcfHandleVisible); 8644end; 8645 8646{------------------------------------------------------------------------------ 8647 Method: TWinControl.ShowControl 8648 Params: AControl: Control to show 8649 Returns: nothing 8650 8651 Called by a child control (in TControl.Show), before setting Visible=true. 8652 Asks to show the child control and recursively shows the parents. 8653 ------------------------------------------------------------------------------} 8654procedure TWinControl.ShowControl(AControl: TControl); 8655begin 8656 if Parent <> nil then Parent.ShowControl(Self); 8657end; 8658 8659{ TWinControlEnumerator } 8660 8661function TWinControlEnumerator.GetCurrent: TControl; 8662begin 8663 if (FIndex>=0) and (FIndex<FParent.ControlCount) then 8664 Result:=FParent.Controls[FIndex] 8665 else 8666 Result:=nil; 8667end; 8668 8669constructor TWinControlEnumerator.Create(Parent: TWinControl; 8670 aLowToHigh: boolean); 8671begin 8672 FParent:=Parent; 8673 FLowToHigh:=aLowToHigh; 8674 if FLowToHigh then 8675 FIndex:=-1 8676 else 8677 FIndex:=FParent.ControlCount; 8678end; 8679 8680function TWinControlEnumerator.GetEnumerator: TWinControlEnumerator; 8681begin 8682 Result:=Self; 8683end; 8684 8685function TWinControlEnumerator.MoveNext: Boolean; 8686begin 8687 if FLowToHigh then 8688 begin 8689 inc(FIndex); 8690 Result:=FIndex<FParent.ControlCount; 8691 end 8692 else begin 8693 dec(FIndex); 8694 Result:=FIndex>=0 8695 end; 8696end; 8697 8698{ $UNDEF CHECK_POSITION} 8699 8700{$IFDEF ASSERT_IS_ON} 8701 {$UNDEF ASSERT_IS_ON} 8702 {$C-} 8703{$ENDIF} 8704