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