{%MainUnit ../controls.pp}
{  $Id$  }

{******************************************************************************
                                     TControl
 ******************************************************************************

 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.modifiedLGPL, included in this distribution,        *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************
}

{$IFOPT C-}
// Uncomment for local trace
//  {$C+}
//  {$DEFINE ASSERT_IS_ON}
{$ENDIF}

{ $DEFINE CHECK_POSITION}

{------------------------------------------------------------------------------
  TControl.AdjustSize

  Calls DoAutoSize smart.
  During loading and handle creation the calls are delayed.

  This method do the same as TWinControl.DoAutoSize at the beginning.
  But since DoAutoSize is commonly overriden by existing Delphi components,
  they do not all tests, which can result in too much overhead. To reduce this
  the LCL calls AdjustSize instead.
------------------------------------------------------------------------------}
procedure TControl.Adjustsize;
begin
  If not AutoSizeCanStart then exit;
  if AutoSizeDelayed then begin
    //debugln('TControl.AdjustSize AutoSizeDelayed ',DbgSName(Self));
    Include(FControlFlags,cfAutoSizeNeeded);
    exit;
  end;
  //debugln('TControl.AdjustSize DoAutoSize ',DbgSName(Self));
  DoAutoSize;
end;

{------------------------------------------------------------------------------
  Method: TControl.BeginDrag
  Params: Immediate: Drag behaviour
          Threshold: distance to move before dragging starts
                     -1 uses the default value of Mouse.DragThreshold
  Returns: Nothing

  Starts the dragging of a control. If the Immediate flag is set, dragging
  starts immediately.
 ------------------------------------------------------------------------------}
procedure TControl.BeginDrag(Immediate: Boolean; Threshold: Integer);
var
  P : TPoint;
begin
  // start a drag operation, if not already running
  if (DragControl = nil) then begin

    // if the last mouse down was not followed by a mouse up, simulate a
    // mouse up. This way applications need only to react to mouse up to
    // clean up.
    DebugLn('TControl.BeginDrag ',DbgSName(Self),' Immediate=',dbgs(Immediate));
    if Immediate then
      SetCaptureControl(nil);
    if csLButtonDown in ControlState then begin
      GetCursorPos(p);
      P := ScreenToClient(p);
      Perform(LM_LBUTTONUP, 0, Integer(PointToSmallPoint(p)));
    end;

    if Threshold < 0 then
      Threshold := Mouse.DragThreshold;
    DragInitControl(Self,Immediate,Threshold);
  end;
end;

{------------------------------------------------------------------------------
       TControl.BeginAutoDrag
------------------------------------------------------------------------------}
Procedure TControl.BeginAutoDrag;
begin
  BeginDrag(Mouse.DragImmediate,Mouse.DragThreshold);
end;

{------------------------------------------------------------------------------
  procedure TControl.DoEndDock(Target: TObject; X, Y: Integer);
------------------------------------------------------------------------------}
procedure TControl.DoEndDock(Target: TObject; X, Y: Integer);
begin
  if Assigned(FOnEndDock) then
    FOnEndDock(Self,Target,X,Y);
end;

{------------------------------------------------------------------------------
  procedure TControl.DoDock(NewDockSite: TWinControl; var ARect: TRect);
------------------------------------------------------------------------------}
procedure TControl.DoDock(NewDockSite: TWinControl; var ARect: TRect);
begin
  if (NewDockSite = nil) then Parent := nil;
  if NewDockSite<>nil then begin
    DebugLn('TControl.DoDock BEFORE Adjusting ',Name,' ',dbgs(ARect));
    // adjust new bounds, so that they at least fit into the client area of
    // its parent
    LCLProc.MoveRectToFit(ARect,NewDockSite.ClientRect);
    // consider Align to increase chance the width/height is kept
    case Align of
    alLeft: OffsetRect(ARect,-ARect.Left,0);
    alTop: OffsetRect(ARect,0,-ARect.Top);
    alRight: OffsetRect(ARect,NewDockSite.ClientWidth-ARect.Right,0);
    alBottom: OffsetRect(ARect,0,NewDockSite.ClientHeight-ARect.Bottom);
    end;
    DebugLn('TControl.DoDock AFTER Adjusting ',Name,' ',dbgs(ARect),' Align=',AlignNames[Align],' NewDockSite.ClientRect=',dbgs(NewDockSite.ClientRect));
  end;
  //debugln('TControl.DoDock BEFORE MOVE ',Name,' BoundsRect=',dbgs(BoundsRect),' NewRect=',dbgs(ARect));
  if Parent<>NewDockSite then
    BoundsRectForNewParent := ARect
  else
    BoundsRect := ARect;
  debugln('TControl.DoDock AFTER MOVE ',Name,' BoundsRect=',dbgs(BoundsRect),' TriedRect=',dbgs(ARect));
end;

{------------------------------------------------------------------------------
  procedure TControl.DoStartDock(var DragObject: TDragObject);
------------------------------------------------------------------------------}
procedure TControl.DoStartDock(var DragObject: TDragObject);
begin
  if Assigned(FOnStartDock) then
    FOnStartDock(Self,TDragDockObject(DragObject));
end;

{------------------------------------------------------------------------------
  function TControl.GetDockEdge(const MousePos: TPoint): TAlign;

  Calculate the dock side depending on current MousePos.
  
  Important: MousePos is relative to this control's Left, Top.
------------------------------------------------------------------------------}
function TControl.GetDockEdge(const MousePos: TPoint): TAlign;
var
  BestDistance: Integer;

  procedure FindMinDistance(CurAlign: TAlign; CurDistance: integer);
  begin
    if CurDistance>=BestDistance then exit;
    Result:=CurAlign;
    BestDistance:=CurDistance;
  end;

begin
  // check if MousePos outside the control
  if MousePos.X<=0 then
    Result:=alLeft
  else if MousePos.Y<=0 then
    Result:=alTop
  else if MousePos.X>=Width then
    Result:=alRight
  else if MousePos.Y>=Height then
    Result:=alBottom
  else begin
    // MousePos is inside the control -> find nearest edge
    BestDistance:=MousePos.X;
    Result:=alLeft;
    FindMinDistance(alRight,Width-MousePos.X);
    FindMinDistance(alTop,MousePos.Y);
    FindMinDistance(alBottom,Height-MousePos.Y);
  end;
end;

{------------------------------------------------------------------------------
  procedure TControl.PositionDockRect(DragDockObject: TDragDockObject);
  
  
------------------------------------------------------------------------------}
procedure TControl.PositionDockRect(DragDockObject: TDragDockObject);
var
  NewWidth: LongInt;
  NewHeight: LongInt;
  NewLeft: LongInt;
  NewTop: LongInt;
  WinDragTarget: TWinControl;
begin
  with DragDockObject do begin
    if (DragTarget is TWinControl) and TWinControl(DragTarget).UseDockManager
    then begin
      WinDragTarget:=TWinControl(DragTarget);
      GetWindowRect(WinDragTarget.Handle, FDockRect);
      if (WinDragTarget.DockManager<>nil) then
        WinDragTarget.DockManager.PositionDockRect(Control,DropOnControl,
                                                   DropAlign,FDockRect);
    end else begin
      NewWidth := Control.UndockWidth;
      NewHeight := Control.UndockHeight;
      NewLeft := DragPos.X;
      NewTop := DragPos.Y;
      with FDockRect do
      begin
        Left := NewLeft;
        Top := NewTop;
        Right := Left + NewWidth;
        Bottom := Top + NewHeight;
      end;
      // let user adjust dock rect
      AdjustDockRect(FDockRect);
    end;
  end;
end;

{------------------------------------------------------------------------------
       TControl.BoundsChanged

------------------------------------------------------------------------------}
procedure TControl.BoundsChanged;
begin
  { Notifications can be performed here }
end;

{------------------------------------------------------------------------------}
{       TControl.Bringtofront
}
{------------------------------------------------------------------------------}
Procedure TControl.BringToFront;
begin
  SetZOrder(true);
end;

{------------------------------------------------------------------------------}
{       TControl.CanTab
}
{------------------------------------------------------------------------------}
Function TControl.CanTab: Boolean;
begin
  Result := False;
end;

{------------------------------------------------------------------------------
       TControl.Change
------------------------------------------------------------------------------}
Procedure TControl.Changed;
Begin
  Perform(CM_CHANGED, 0, LParam(self));
End;

{------------------------------------------------------------------------------
  TControl.EditingDone
  
  Called when user has finished editing. This procedure can be used by data
  links to commit the changes.
  For example:
  - When focus switches to another control (default)
  - When user selected another item
  It's totally up to the control, what events will commit.
------------------------------------------------------------------------------}
procedure TControl.EditingDone;
begin
  if Assigned(OnEditingDone) then OnEditingDone(Self);
end;

procedure TControl.FontChanged(Sender: TObject);
begin
  ParentFont := False;
  Invalidate;
end;

procedure TControl.ParentFontChanged;
begin
  if csLoading in ComponentState then exit;

  if FParentFont then
  begin
    Font := FParent.Font;
    FParentFont := true;
  end;
end;

procedure TControl.SetAction(Value: TBasicAction);
begin
  if (Value=Action) then exit;
  //debugln('TControl.SetAction A ',Name,':',ClassName,' Old=',DbgS(Action),' New=',DbgS(Value));
  if Value = nil then begin
    ActionLink.Free;
    ActionLink:=nil;
    Exclude(FControlStyle, csActionClient);
  end
  else
  begin
    Include(FControlStyle, csActionClient);
    if ActionLink = nil then
      ActionLink := GetActionLinkClass.Create(Self);
    ActionLink.Action := Value;
    ActionLink.OnChange := @DoActionChange;
    ActionChange(Value, csLoading in Value.ComponentState);
    Value.FreeNotification(Self);
  end;
end;

{------------------------------------------------------------------------------
       TControl.ChangeBounds
------------------------------------------------------------------------------}
procedure TControl.ChangeBounds(ALeft, ATop, AWidth, AHeight : integer);
var
  SizeChanged, PosChanged : boolean;
  OldLeft: Integer;
  OldTop: Integer;
  OldWidth: Integer;
  OldHeight: Integer;
  CurBounds: TRect;
  NewBounds: TRect;

  function UpdatePosSizeChanged: boolean;
  begin
    SizeChanged:= (FWidth <> OldWidth) or (FHeight <> OldHeight);
    PosChanged:= (FLeft <> OldLeft) or (FTop <> OldTop);
    Result:=(not SizeChanged) and (not PosChanged);
  end;

begin
  {$IFDEF VerboseSizeMsg}
  DebugLn('TControl.ChangeBounds A ',Name,':',ClassName,
    ' Old='+dbgs(Left)+','+dbgs(Top)+','+dbgs(Width),',',dbgs(Height),
    ' New='+dbgs(ALeft)+','+dbgs(ATop)+','+dbgs(AWidth),',',dbgs(AHeight));
  {$ENDIF}
  // constraint the size
  DoConstrainedResize(ALeft, ATop, AWidth, AHeight);

  // check, if we are already processing this bound change
  NewBounds:=Bounds(ALeft,ATop,AWidth,AHeight);
  if CompareRect(@FLastChangebounds,@NewBounds) then exit;
  FLastChangebounds:=NewBounds;

  OldLeft:=FLeft;
  OldTop:=FTop;
  OldWidth:=FWidth;
  OldHeight:=FHeight;

  // check if something would change
  SizeChanged:= (FWidth <> AWidth) or (FHeight <> AHeight);
  PosChanged:= (FLeft <> ALeft) or (FTop <> ATop);
  if (not SizeChanged) and (not PosChanged) then exit;

  //DebugLn('TControl.ChangeBounds A ',Name,':',ClassName);
  if (not (csLoading in ComponentState))
  and (not (Self is TWinControl)) then
    InvalidateControl(IsControlVisible, False, true);
  //DebugLn('TControl.ChangeBounds B ',Name,':',ClassName);
  DoSetBounds(ALeft,ATop,AWidth,AHeight);

  // change base bounds
  // (base bounds are the base for the automatic resizing)
  UpdateAnchorRules;
  // lock the base bounds while automatic resizing
  LockBaseBounds;
  // lock size messages
  inc(FSizeLock);
  try
    // lock the autosizing of the child controls
    if Self is TWinControl then
      TWinControl(Self).DisableAlign;
    try
      // resize parents client area
      If Parent <> nil then
        Parent.AdjustSize;
      if UpdatePosSizeChanged then exit;
      // notify before autosizing
      BoundsChanged;
      if UpdatePosSizeChanged then exit;
      //if csDesigning in ComponentState then
      //  DebugLn('TControl.ChangeBounds ',Name,':',ClassName,' ',Left,',',Top,',',Width,',',Height);
      
      // autosize this control and its brothers
      RequestAlign;
      if UpdatePosSizeChanged then exit;
      // autosize childs
      if SizeChanged and (Self is TWinControl) then
        TWinControl(Self).ReAlign;
    finally
      // unlock the autosizing of the child controls
      // (this will autosize the childs)
      if Self is TWinControl then
        TWinControl(Self).EnableAlign;
    end;
  finally
    dec(FSizeLock);
    UnlockBaseBounds;
  end;
  if UpdatePosSizeChanged then exit;

  // send messages, if this is the top level call
  if FSizeLock>0 then exit;

  // invalidate
  if (not (csLoading in ComponentState))
  and (not (Self is TWinControl)) then
    Invalidate;
  // notify user about resize
  if (not (csLoading in ComponentState)) then begin
    Resize;
    CurBounds:=BoundsRect;
    if not CompareRect(@FLastDoChangeBounds,@CurBounds) then begin
      FLastDoChangeBounds:=CurBounds;
      DoOnChangeBounds;
    end;
    // for delphi compatibility send size/move messages
    SendMoveSizeMessages(SizeChanged,PosChanged);
  end;
end;

{-------------------------------------------------------------------------------
  TControl.DoSetBounds
  Params: ALeft, ATop, AWidth, AHeight : integer

  store bounds in private variables
-------------------------------------------------------------------------------}
procedure TControl.DoSetBounds(ALeft, ATop, AWidth, AHeight : integer);

  procedure BoundsOutOfBounds;
  begin
    DebugLn('TControl.DoSetBounds ',Name,':',ClassName,
      ' Old=',dbgs(Left,Top,Width,Height),
      ' New=',dbgs(aLeft,aTop,aWidth,aHeight),
      '');
    RaiseGDBException('TControl.DoSetBounds '+Name+':'+ClassName+' Invalid bounds');
  end;

begin
  if (AWidth>100000) or (AHeight>100000) then
    BoundsOutOfBounds;
  {$IFDEF CHECK_POSITION}
  if csDesigning in ComponentState then
    DebugLn('TControl.DoSetBounds ',Name,':',ClassName,
      ' Old=',DbgS(Left,Top,Width,Height),
      ' New=',DbgS(aLeft,aTop,aWidth,aHeight),
      '');
  {$ENDIF}
  FLeft:= ALeft;
  FTop:= ATop;
  FWidth:= AWidth;
  FHeight:= AHeight;
  if Parent<>nil then Parent.InvalidatePreferredSize;
end;

{------------------------------------------------------------------------------
       TControl.ChangeScale

  Scale contorl by factor Multiplier/Divider
------------------------------------------------------------------------------}
Procedure TControl.ChangeScale(Multiplier, Divider: Integer);
Begin
  // TODO: TCONTROL.CHANGESCALE
  //Assert(False, 'Trace:TODO: [TControl.ChangeScale]');
end;

{------------------------------------------------------------------------------
       TControl.CheckMenuPopup

       returns whether was handled
------------------------------------------------------------------------------}
function TControl.CheckMenuPopup(const P: TSmallPoint): boolean;
var
  Control: TControl;
  TempPopupMenu: TPopupMenu;
  P2: TPoint;
begin
  Result:=false;
  if csDesigning in ComponentState then Exit;

  P2 := SmallPointToPoint(P);
  DoContextPopup(P2,Result);
  if Result then exit;

  Control := Self;
  while Control <> nil do
  begin
    TempPopupMenu := Control.GetPopupMenu;
    if (TempPopupMenu <> nil) then
    begin
      if not TempPopupMenu.AutoPopup then Exit;
//      SendCancelMode(nil);
      TempPopupMenu.PopupComponent := Control;
      P2 := ClientToScreen(P2);
      TempPopupMenu.Popup(P2.X, P2.Y);
      Result := true;
      Exit;
    end;
    Control := Control.Parent;
  end;
end;

{------------------------------------------------------------------------------}
{       TControl.GetClientHeight                                               }
{------------------------------------------------------------------------------}
function TControl.GetClientHeight: Integer;
begin
  Result := ClientRect.Bottom;
end;

{------------------------------------------------------------------------------}
{       TControl.GetClientWidth                                                }
{------------------------------------------------------------------------------}
function TControl.GetClientWidth: Integer;
begin
  Result := ClientRect.Right;
end;

{------------------------------------------------------------------------------
  procedure TControl.CalculateDockSizes;

  Compute docking width, height based on docking properties.
------------------------------------------------------------------------------}
procedure TControl.CalculateDockSizes;
begin
  if Floating then begin
    // the control is floating. Save Width and Height for undocking
    UndockHeight:=Height;
    UndockWidth:=Width;
  end
  else if HostDockSite<>nil then begin
    // the control is docked into a HostSite. That means some of it bounds
    // were maximized to fit into the HostSite.
    if (DockOrientation=doHorizontal)
    or (HostDockSite.Align in [alLeft,alRight]) then
      // the control is aligned left/right, that means its width is not
      // maximized. Save Width for docking.
      LRDockWidth:=Width
    else if (DockOrientation=doVertical)
    or (HostDockSite.Align in [alTop,alBottom]) then
      // the control is aligned top/bottom, that means its height is not
      // maximized. Save Height for docking.
      TBDockHeight:=Height;
  end;
end;

{------------------------------------------------------------------------------
  function TControl.CreateFloatingDockSite(const Bounds: TRect): TWinControl;
------------------------------------------------------------------------------}
function TControl.CreateFloatingDockSite(const Bounds: TRect): TWinControl;
var
  FloatingClass: TWinControlClass;
  NewWidth: Integer;
  NewHeight: Integer;
  NewClientWidth: Integer;
  NewClientHeight: Integer;
begin
  Result := nil;
  FloatingClass:=FloatingDockSiteClass;
  if (FloatingClass<>nil) and (FloatingClass<>TWinControlClass(ClassType)) then
  begin
    Result := FloatingClass.Create(Application);
    // resize with minimal resizes
    NewClientWidth:=Bounds.Right-Bounds.Left;
    NewClientHeight:=Bounds.Bottom-Bounds.Top;
    NewWidth:=Result.Width-Result.ClientWidth+NewClientWidth;
    NewHeight:=Result.Height-Result.ClientHeight+NewClientHeight;
    Result.SetBounds(Bounds.Left,Bounds.Top,NewWidth,NewHeight);
    Result.SetClientSize(Point(NewClientWidth,NewClientHeight));
    debugln('TControl.CreateFloatingDockSite A ',DbgSName(Self),' ',DbgSName(Result),' ',dbgs(Result.BoundsRect));
  end;
end;

procedure TControl.ExecuteDefaultAction;
begin
end;

procedure TControl.ExecuteCancelAction;
begin
end;

{------------------------------------------------------------------------------
  function TControl.GetFloating: Boolean;
------------------------------------------------------------------------------}
function TControl.GetFloating: Boolean;
var
  CurHostDockSite: TWinControl;
begin
  CurHostDockSite:=HostDockSite;
  Result := (CurHostDockSite <> nil)
            and (CurHostDockSite is FloatingDockSiteClass);
end;

{------------------------------------------------------------------------------
  function TControl.GetFloatingDockSiteClass: TWinControlClass;
------------------------------------------------------------------------------}
function TControl.GetFloatingDockSiteClass: TWinControlClass;
begin
  Result := FFloatingDockSiteClass;
end;

{------------------------------------------------------------------------------
  function TControl.GetLRDockWidth: Integer;
------------------------------------------------------------------------------}
function TControl.GetLRDockWidth: Integer;
begin
  if FLRDockWidth>0 then
    Result := FLRDockWidth
  else
    Result := UndockWidth;
end;

{------------------------------------------------------------------------------
  function TControl.IsHelpContextStored: boolean;
------------------------------------------------------------------------------}
function TControl.IsHelpContextStored: boolean;
begin
  if ActionLink=nil then
    Result := HelpContext<>0
  else
    Result := not ActionLink.IsHelpContextLinked;
end;

{------------------------------------------------------------------------------
  function TControl.IsHelpKeyWordStored: boolean;
------------------------------------------------------------------------------}
function TControl.IsHelpKeyWordStored: boolean;
begin
  if ActionLink=nil then
    Result := HelpKeyword<>''
  else
    Result := not ActionLink.IsHelpContextLinked;
end;

function TControl.IsOnClickStored: Boolean;
begin
  Result := (ActionLink = nil) or not ActionLink.IsOnExecuteLinked;
end;

function TControl.IsShowHintStored: Boolean;
begin
  Result := not ParentShowHint;
end;

function TControl.IsVisibleStored: Boolean;
begin
  Result := (ActionLink = nil) or not ActionLink.IsVisibleLinked;
end;

function TControl.GetUndockHeight: Integer;
begin
  if FUndockHeight>0 then
    Result := FUndockHeight
  else
    Result := Height;
end;

function TControl.GetUndockWidth: Integer;
begin
  if FUndockWidth>0 then
    Result := FUndockWidth
  else
    Result := Width;
end;

function TControl.IsAnchorsStored: boolean;
begin
  Result:=(Anchors<>AnchorAlign[Align]);
end;

function TControl.IsVisible: Boolean;
begin
  Result := (FVisible
             or ((csDesigning in ComponentState)
                  and (not (csNoDesignVisible in ControlStyle))))
             and ((Parent = nil) or (Parent.IsVisible));
end;

function TControl.IsControlVisible: Boolean;
begin
  Result := (FVisible
             or ((csDesigning in ComponentState)
                  and (not (csNoDesignVisible in ControlStyle))));
end;

{------------------------------------------------------------------------------
       TControl.LMCaptureChanged
------------------------------------------------------------------------------}
Procedure TControl.LMCaptureChanged(Var Message: TLMessage);
Begin
  //DebugLn('[LMCaptureChanged for '+Name+':'+Classname+']');
  CaptureChanged;
End;

{------------------------------------------------------------------------------
       TControl.CMENABLEDCHANGED
------------------------------------------------------------------------------}
procedure TControl.CMEnabledChanged(var Message: TLMEssage);
begin
  Invalidate;
end;

{------------------------------------------------------------------------------
       TControl.CMHITTEST
------------------------------------------------------------------------------}
procedure TControl.CMHITTEST(var Message : TCMHitTest);
begin
  Message.Result := 1;
end;

{------------------------------------------------------------------------------
       TControl.CMMouseEnter
------------------------------------------------------------------------------}
Procedure TControl.CMMouseEnter(var Message: TLMessage);
Begin
  // this is a LCL based mouse message, so don't call DoBeforeMouseMessage
  //DebugLn('TControl.CMMouseEnter ',Name,':',ClassName,' ',FMouseEntered,' ',Message.LParam);
  if (Message.LParam=0) and (not FMouseEntered) then begin
    FMouseEntered:=true;
    MouseEnter;
    if FParent <> nil then
      FParent.Perform(CM_MOUSEENTER, 0, LParam(Self));
  end;
end;

{------------------------------------------------------------------------------
       TControl.CMMouseLeave
------------------------------------------------------------------------------}
Procedure TControl.CMMouseLeave(var Message: TLMessage);
Begin
  // this is a LCL based mouse message, so don't call DoBeforeMouseMessage
  //DebugLn('TControl.CMMouseLeave ',Name,':',ClassName,' ',FMouseEntered,' ',Message.LParam);
  if (Message.LParam=0) and FMouseEntered then begin
    FMouseEntered:=false;
    MouseLeave;
    if FParent <> nil then
      FParent.Perform(CM_MOUSELEAVE, 0, LParam(Self));
  end;
end;

{------------------------------------------------------------------------------
  procedure TControl.CMHintShow(var Message: TLMessage);
------------------------------------------------------------------------------}
procedure TControl.CMHintShow(var Message: TLMessage);
begin
  DoOnShowHint(TCMHintShow(Message).HintInfo);
  if (ActionLink <> nil)
  and not ActionLink.DoShowHint(TCMHintShow(Message).HintInfo^.HintStr)
  then
    Message.Result := 1;
end;

{------------------------------------------------------------------------------
       TControl.CMVisibleChanged
------------------------------------------------------------------------------}
procedure TControl.CMVisibleChanged(var Message : TLMessage);
begin
  if (not (csDesigning in ComponentState)
    or (csNoDesignVisible in ControlStyle))
  and (not (csLoading in ComponentState)) then begin
    InvalidateControl(true, FVisible and (csOpaque in ControlStyle),true);
  end;
end;

procedure TControl.CMTextChanged(var Message: TLMessage);
begin
  TextChanged;
end;

{------------------------------------------------------------------------------
       TControl.CMParentColorChanged

       assumes: FParent <> nil
------------------------------------------------------------------------------}
procedure TControl.CMParentColorChanged(var Message: TLMessage);
begin
  if csLoading in ComponentState then exit;
  
  if FParentColor then
  begin
    Color := FParent.Color;
    FParentColor := true;
  end;
end;

{------------------------------------------------------------------------------
       TControl.CMShowHintChanged

       assumes: FParent <> nil
------------------------------------------------------------------------------}
procedure TControl.CMParentShowHintChanged(var Message: TLMessage);
begin
  if FParentShowHint then
  begin
    ShowHint := FParent.ShowHint;
    FParentShowHint := true;
  end;
end;

{------------------------------------------------------------------------------}
{       TControl.ConstrainedResize                                             }
{------------------------------------------------------------------------------}
procedure TControl.ConstrainedResize(var MinWidth, MinHeight,
  MaxWidth, MaxHeight : TConstraintSize);
begin
  if Assigned(FOnConstrainedResize) then
    FOnConstrainedResize(Self, MinWidth, MinHeight, MaxWidth, MaxHeight);
end;

{------------------------------------------------------------------------------
  procedure TControl.CalculatePreferredSize(var PreferredWidth,
    PreferredHeight: integer);

  Calculates the default/preferred width and height for a control, which is used
  by the LCL autosizing algorithms as default size. Only positive values are
  valid. Negative or 0 are treated as undefined and the LCL uses other sizes
  instead.
  TWinControl overrides this and asks the interface for theme dependent values.
  See TWinControl.GetPreferredSize for more information.
 ------------------------------------------------------------------------------}
procedure TControl.CalculatePreferredSize(var PreferredWidth,
  PreferredHeight: integer);
begin
  PreferredWidth:=0;
  PreferredHeight:=0;
end;

{------------------------------------------------------------------------------
  function TControl.GetPalette: HPalette;
------------------------------------------------------------------------------}
function TControl.GetPalette: HPalette;
begin
  Result:=0;
end;

function TControl.ChildClassAllowed(ChildClass: TClass): boolean;
begin
  Result:=false;
end;

{------------------------------------------------------------------------------
  procedure TControl.DoOnResize;

  Call events
------------------------------------------------------------------------------}
procedure TControl.DoOnResize;
begin
  if Assigned(FOnResize) then FOnResize(Self);
  DoCallNotifyHandler(chtOnResize);
end;

{------------------------------------------------------------------------------
  procedure TControl.DoOnChangeBounds;

  Call events
------------------------------------------------------------------------------}
procedure TControl.DoOnChangeBounds;
begin
  if Assigned(FOnChangeBounds) then FOnChangeBounds(Self);
  DoCallNotifyHandler(chtOnChangeBounds);
end;

{------------------------------------------------------------------------------
  procedure TControl.DoBeforeMouseMessage;
------------------------------------------------------------------------------}
procedure TControl.DoBeforeMouseMessage;
begin
  if Application<>nil then
    Application.DoBeforeMouseMessage(Self);
end;

{------------------------------------------------------------------------------
  function TControl.ColorIsStored: boolean;
------------------------------------------------------------------------------}
function TControl.ColorIsStored: boolean;
begin
  Result:=(Color<>clWindow);
  if Result and ParentColor and (Parent<>nil) then
    Result:=false;
end;

{------------------------------------------------------------------------------
       TControl.DoConstrainedResize
------------------------------------------------------------------------------}
procedure TControl.DoConstrainedResize(var NewLeft, NewTop,
  NewWidth, NewHeight: integer);
var MinWidth, MinHeight, MaxWidth, MaxHeight : TConstraintSize;
begin
  MinWidth:= Constraints.EffectiveMinWidth;
  MinHeight:= Constraints.EffectiveMinHeight;
  MaxWidth:= Constraints.EffectiveMaxWidth;
  MaxHeight:= Constraints.EffectiveMaxHeight;

  ConstrainedResize(MinWidth, MinHeight, MaxWidth, MaxHeight);

  if (MinWidth > 0) and (NewWidth < MinWidth) then
  begin
    // right kept position ? interpret as resizing left border
    if (NewLeft+NewWidth) = (Left+Width) then
    begin
      Dec(NewLeft, MinWidth - NewWidth);
      if NewLeft < Left then
        NewLeft := Left;
    end;
    NewWidth:= MinWidth
  end else if (MaxWidth > 0) and (NewWidth > MaxWidth) then
  begin
    if (NewLeft+NewWidth) = (Left+Width) then
    begin
      Inc(NewLeft, NewWidth - MaxWidth);
      if NewLeft > Left then
        NewLeft := Left;
    end;
    NewWidth:= MaxWidth;
  end;

  if (MinHeight > 0) and (NewHeight < MinHeight) then
  begin
    // bottom kept position ? interpret as resizing bottom border
    if (NewTop+NewHeight) = (Top+Height) then
    begin
      Dec(NewTop, MinHeight - NewHeight);
      if NewTop < Top then
        NewTop := Top;
    end;
    NewHeight:= MinHeight
  end else if (MaxHeight > 0) and (NewHeight > MaxHeight) then
  begin
    if (NewTop+NewHeight) = (Top+Height) then
    begin
      Inc(NewTop, NewHeight - MaxHeight);
      if NewTop > Top then
        NewTop := Top;
    end;
    NewHeight:= MaxHeight;
  end;
  //debugln('TControl.DoConstrainedResize ',DbgSName(Self),' ',dbgs(NewWidth),',',dbgs(NewHeight));
end;

{------------------------------------------------------------------------------
       TControl.DoConstraintsChange
------------------------------------------------------------------------------}
procedure TControl.DoConstraintsChange(Sender : TObject);
begin
  AdjustSize;
end;

procedure TControl.DoBorderSpacingChange(Sender: TObject;
  InnerSpaceChanged: Boolean);
begin
  if InnerSpaceChanged then
    AdjustSize
  else
    RequestAlign;
end;

{------------------------------------------------------------------------------
  procedure TControl.SendMoveSizeMessages(SizeChanged, PosChanged: boolean);
------------------------------------------------------------------------------}
procedure TControl.SendMoveSizeMessages(SizeChanged, PosChanged: boolean);
begin

end;

{------------------------------------------------------------------------------
       TControl.DragCanceled
------------------------------------------------------------------------------}
procedure TControl.DragCanceled;
begin
  {$IFDEF VerboseDrag}
  DebugLn('TControl.DragCanceled');
  {$ENDIF}
end;

{------------------------------------------------------------------------------
       TControl.DoStartDrag

------------------------------------------------------------------------------}
procedure TControl.DoStartDrag(var DragObject: TDragObject);
begin
  {$IFDEF VerboseDrag}
  DebugLn('TControl.DoStartDrag ',Name,':',ClassName);
  {$ENDIF}
  if Assigned(FOnStartDrag) then FOnStartDrag(Self, DragObject);
end;

{------------------------------------------------------------------------------
       TControl.DoEndDrag
------------------------------------------------------------------------------}
Procedure TControl.DoEndDrag(Target: TObject; X,Y: Integer);
Begin
  {$IFDEF VerboseDrag}
  DebugLn('TControl.DoEndDrag ',Name,':',ClassName,' XY=',X,',',Y);
  {$ENDIF}
  if Assigned(FOnEndDrag) then FOnEndDrag(Self,Target,X,Y);
end;

{------------------------------------------------------------------------------
       TControl.Perform

------------------------------------------------------------------------------}
Function TControl.Perform(Msg:Cardinal; WParam: WParam; LParam: LParam): LRESULT;
var
  Message : TLMessage;
begin
  Message.Msg := Msg;
  Message.WParam := WParam;
  Message.LParam := LParam;
  Message.Result := 0;
  If Self <> nil then WindowProc(Message);
    Result := Message.Result;
end;

{------------------------------------------------------------------------------
       TControl.GetClientOrigin
------------------------------------------------------------------------------}
function TControl.GetClientOrigin: TPoint;

  procedure RaiseParentNil;
  begin
    raise Exception.Create('TControl.GetClientOrigin: Parent=nil for '
                           +Name+':'+ClassName);
  end;

Begin
  //Assert(False, Format('Trace:[TControl.GetClientOrigin] %s',  [Classname]));
  if Parent = nil then
    RaiseParentNil;
    //raise EInvalidOperation.CreateFmt(SParentRequired, [Name]);
  Result := Parent.ClientOrigin;
  Inc(Result.X, FLeft);
  Inc(Result.Y, FTop);
  //Assert(False, Format('Trace:[TControl.GetClientOrigin] %s --> (%d, %d)',  [Classname, Result.X, Result.Y]));
end;

{------------------------------------------------------------------------------
       TControl.ScreenToClient
------------------------------------------------------------------------------}
Function TControl.ScreenToClient(const APoint: TPoint): TPoint;
var
  P : TPoint;
begin
  P := ClientOrigin;
  Result.X := APoint.X - P.X;
  Result.Y := APoint.Y - P.Y;
end;

{------------------------------------------------------------------------------
  Function TControl.ClientToScreen(const APoint: TPoint): TPoint;
------------------------------------------------------------------------------}
Function TControl.ClientToScreen(const APoint: TPoint): TPoint;
var
  P : TPoint;
begin
  P := ClientOrigin;
  Result.X := APoint.X + P.X;
  Result.Y := APoint.Y + P.Y;
end;

{------------------------------------------------------------------------------
  function TControl.ScreenToControl(const APoint: TPoint): TPoint;
------------------------------------------------------------------------------}
function TControl.ScreenToControl(const APoint: TPoint): TPoint;
var
  P : TPoint;
begin
  P := ControlOrigin;
  Result.X := APoint.X - P.X;
  Result.Y := APoint.Y - P.Y;
end;

{------------------------------------------------------------------------------
  function TControl.ControlToScreen(const APoint: TPoint): TPoint;
------------------------------------------------------------------------------}
function TControl.ControlToScreen(const APoint: TPoint): TPoint;
var
  P : TPoint;
begin
  P := ControlOrigin;
  Result.X := APoint.X + P.X;
  Result.Y := APoint.Y + P.Y;
end;

{------------------------------------------------------------------------------
       TControl.DblClick
------------------------------------------------------------------------------}
procedure TControl.DblClick;
begin
  If Assigned(FOnDblClick) then FOnDblClick(Self);
end;

{------------------------------------------------------------------------------
       TControl.TripleClick
------------------------------------------------------------------------------}
procedure TControl.TripleClick;
begin
  If Assigned(FOnTripleClick) then FOnTripleClick(Self);
end;

{------------------------------------------------------------------------------
       TControl.QuadClick
------------------------------------------------------------------------------}
procedure TControl.QuadClick;
begin
  If Assigned(FOnQuadClick) then FOnQuadClick(Self);
end;

{------------------------------------------------------------------------------
       TControl.DoDragMsg
------------------------------------------------------------------------------}
Procedure TControl.DoDragMsg(var DragMsg: TCMDrag);
var
  Accepts: Boolean;
  Src: TObject;
  P: TPoint;
Begin
  {$IFDEF VerboseDrag}
  DebugLn('TControl.DoDragMsg ',Name,':',ClassName,' DragMsg.DragMessage=',ord(DragMsg.DragMessage));
  {$ENDIF}
  Src := DragMsg.Dragrec^.Source;
  P:=ScreenToClient(DragMsg.Dragrec^.Pos);
  {$IFDEF VerboseDrag}
  DebugLn('TControl.DoDragMsg ',Name,':',ClassName,' DragMsg.Dragrec^.Pos=',DragMsg.Dragrec^.Pos.X,',',DragMsg.Dragrec^.Pos.Y,' -> P=',P.X,P.Y);
  if P.X<0 then RaiseGDBException('');
  {$ENDIF}
  case DragMsg.DragMessage of

    dmFindTarget:
      DragMsg.Result := PtrInt(Self);

    dmDragEnter, dmDragLeave, dmDragMove:
      begin
        Accepts := True;
        case DragMsg.DragMessage of
          dmDragEnter: DragOver(Src,P.X,P.Y,dsDragEnter,Accepts);
          dmDragLeave: DragOver(Src,P.X,P.Y,dsDragLeave,Accepts);
          dmDragMove : DragOver(Src,P.X,P.Y,dsDragMove,Accepts);
        end;
        if Accepts then
          DragMsg.Result := 1
        else
          DragMsg.Result := 0;
      end;

    dmDragDrop:
      DragDrop(Src, P.X, P.Y);

  end; //case
end;

{------------------------------------------------------------------------------
  TControl.DragOver
------------------------------------------------------------------------------}
Procedure TControl.DragOver(Source: TObject; X,Y : Integer; State: TDragState;
  var Accept:Boolean);
begin
  {$IFDEF VerboseDrag}
  DebugLn('TControl.DragOver ',Name,':',ClassName,' XY=',X,',',Y);
  {$ENDIF}
  Accept := False;
  if Assigned(FOnDragOver) then begin
    Accept := True;
    FOnDragOver(Self,Source,X,Y,State,Accept);
  end;
end;

{------------------------------------------------------------------------------
  TControl.DragDrop
------------------------------------------------------------------------------}
Procedure TControl.DragDrop(Source: TObject; X,Y : Integer);
begin
  {$IFDEF VerboseDrag}
  DebugLn('TControl.DragDrop ',Name,':',ClassName,' XY=',X,',',Y);
  {$ENDIF}
  If Assigned(FOnDragDrop) then FOnDragDrop(Self, Source,X,Y);
end;

{------------------------------------------------------------------------------
  TControl Method SetColor  "Sets the default color and tells the widget set"
------------------------------------------------------------------------------}
procedure TControl.SetColor(value : TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    FParentColor := False;
    Invalidate;
  end;
end;

{------------------------------------------------------------------------------
       TControl CanAutoSize
------------------------------------------------------------------------------}
Function TControl.CanAutoSize(Var NewWidth, NewHeight : Integer): Boolean;
Begin
  Result := True;
end;

{------------------------------------------------------------------------------
       TControl Dragging
------------------------------------------------------------------------------}
Function TControl.Dragging: Boolean;
Begin
  Result := (DragControl = self);
end;

{------------------------------------------------------------------------------
       TControl GetBoundsRect
------------------------------------------------------------------------------}
Function TControl.GetBoundsRect: TRect;
Begin
  Result.Left := FLeft;
  Result.Top := FTop;
  Result.Right := FLeft+FWidth;
  Result.Bottom := FTop+FHeight;
end;

{------------------------------------------------------------------------------}
{       TControl GetEnabled                                 }
{------------------------------------------------------------------------------}
function TControl.GetEnabled: Boolean;
begin
  Result := FEnabled;
end;

{------------------------------------------------------------------------------}
{       TControl GetMouseCapture                                 }
{------------------------------------------------------------------------------}
Function TControl.GetMouseCapture : Boolean;
Begin
  Result := GetCaptureControl = Self;
end;

function TControl.GetTBDockHeight: Integer;
begin
  if FTBDockHeight>0 then
    Result := FTBDockHeight
  else
    Result := UndockHeight;
end;

{------------------------------------------------------------------------------}
{       TControl GetPopupMenu                                 }
{------------------------------------------------------------------------------}
function TControl.GetPopupMenu: TPopupMenu;
begin
  Result := FPopupMenu;
end;

{------------------------------------------------------------------------------
  procedure TControl.DoOnShowHint(HintInfo: Pointer);
------------------------------------------------------------------------------}
procedure TControl.DoOnShowHint(HintInfo: Pointer);
begin
  if Assigned(OnShowHint) then
    OnShowHint(Self,HintInfo);
end;

procedure TControl.SetAlignedBounds(aLeft, aTop, aWidth, aHeight: integer);
{ try to set the automatic changed bounds
  If the interface does not like our bounds, it sends a message with the real
  bounds, which invokes the automatic realigning of the control, .. a circle.
  To break the circle, only bounds that are different from the last try will
  be sent.
}
var
  NewBounds: TRect;
begin
  NewBounds:=Bounds(aLeft, aTop, aWidth, aHeight);
  if (cfLastAlignedBoundsValid in FControlFlags)
  and CompareRect(@NewBounds,@fLastAlignedBounds) then
    exit;
  fLastAlignedBounds:=NewBounds;
  Include(FControlFlags,cfLastAlignedBoundsValid);

  //if AnsiCompareText(ClassName,'TSCROLLBAR')=0 then
  //  DebugLn('TControl.SetAlignedBounds A ',Name,':',ClassName,' ',aLeft,',',aTop,',',aWidth,',',aHeight);

  SetBoundsKeepBase(aLeft, aTop, aWidth, aHeight, true);
end;

{------------------------------------------------------------------------------
  procedure TControl.VisibleChanging;
------------------------------------------------------------------------------}
procedure TControl.VisibleChanging;
begin
  DoCallNotifyHandler(chtOnVisibleChanging);
end;

procedure TControl.VisibleChanged;
begin
  DoCallNotifyHandler(chtOnVisibleChanged);
end;

procedure TControl.AddHandler(HandlerType: TControlHandlerType;
  const AMethod: TMethod; AsLast: boolean);
begin
  if FControlHandlers[HandlerType]=nil then
    FControlHandlers[HandlerType]:=TMethodList.Create;
  FControlHandlers[HandlerType].Add(AMethod);
end;

procedure TControl.RemoveHandler(HandlerType: TControlHandlerType;
  const AMethod: TMethod);
begin
  FControlHandlers[HandlerType].Remove(AMethod);
end;

procedure TControl.DoCallNotifyHandler(HandlerType: TControlHandlerType);
var
  i: Integer;
begin
  i:=FControlHandlers[HandlerType].Count;
  while FControlHandlers[HandlerType].NextDownIndex(i) do
    TNotifyEvent(FControlHandlers[HandlerType][i])(Self);
end;

{------------------------------------------------------------------------------
  procedure TControl.DoContextPopup(const MousePos: TPoint;
    var Handled: Boolean);
------------------------------------------------------------------------------}
procedure TControl.DoContextPopup(const MousePos: TPoint; var Handled: Boolean);
begin
  if Assigned(FOnContextPopup) then
    FOnContextPopup(Self, MousePos, Handled);
end;

procedure TControl.ActionChange(Sender: TObject; CheckDefaults: Boolean);
var
  NewAction: TCustomAction;
begin
  if Sender is TCustomAction then begin
    NewAction:=TCustomAction(Sender);
    if (not CheckDefaults)
    or (Caption = '') or (Caption = Name) then
      Caption := NewAction.Caption;
    if not CheckDefaults or Enabled then
      Enabled := NewAction.Enabled;
    if not CheckDefaults or (Hint = '') then
      Hint := NewAction.Hint;
    if not CheckDefaults or Visible then
      Visible := NewAction.Visible;
    if not CheckDefaults or not Assigned(OnClick) then
      OnClick := NewAction.OnExecute;
  end;
end;

procedure TControl.DoActionChange(Sender: TObject);
begin
  if Sender = Action then ActionChange(Sender, False);
end;

function TControl.GetAnchorSide(Kind: TAnchorKind): TAnchorSide;
begin
  Result:=FAnchorSides[Kind];
end;

function TControl.GetAnchorSideIndex(Index: integer): TAnchorSide;
begin
  case Index of
  0: Result:=FAnchorSides[akLeft];
  1: Result:=FAnchorSides[akTop];
  2: Result:=FAnchorSides[akRight];
  3: Result:=FAnchorSides[akBottom];
  else
  Result:=nil;
  end;
end;

function TControl.GetAnchoredControls(Index: integer): TControl;
begin
  Result:=TControl(fAnchoredControls[Index]);
end;

{------------------------------------------------------------------------------
       TControl GetClientRect
------------------------------------------------------------------------------}
function TControl.GetClientRect: TRect;
begin
  Result.Left := 0;
  Result.Top := 0;
  Result.Right := Width;
  Result.Bottom := Height;
end;

{------------------------------------------------------------------------------
  function TControl.GetScrolledClientRect: TRect;

------------------------------------------------------------------------------}
function TControl.GetScrolledClientRect: TRect;
var
  ScrolledOffset: TPoint;
begin
  Result:=GetClientRect;
  ScrolledOffset:=GetClientScrollOffset;
  inc(Result.Left,ScrolledOffset.X);
  inc(Result.Top,ScrolledOffset.Y);
  inc(Result.Right,ScrolledOffset.X);
  inc(Result.Bottom,ScrolledOffset.Y);
end;

{------------------------------------------------------------------------------
  function TControl.GetChildsRect(Scrolled: boolean): TRect;

  Returns the Client rectangle relative to the controls left, top.
  If Scrolled is true, the rectangle is moved by the current scrolling values
  (for an example see TScrollingWincontrol).
------------------------------------------------------------------------------}
function TControl.GetChildsRect(Scrolled: boolean): TRect;
var
  ScrolledOffset: TPoint;
begin
  Result:=ClientRect;
  if Scrolled then begin
    ScrolledOffset:=GetClientScrollOffset;
    inc(Result.Left,ScrolledOffset.X);
    inc(Result.Top,ScrolledOffset.Y);
    inc(Result.Right,ScrolledOffset.X);
    inc(Result.Bottom,ScrolledOffset.Y);
  end;
end;

{------------------------------------------------------------------------------
  function TControl.GetClientScrollOffset: TPoint;

  Returns the scrolling offset of the client area.
------------------------------------------------------------------------------}
function TControl.GetClientScrollOffset: TPoint;
begin
  Result:=Point(0,0);
end;

{------------------------------------------------------------------------------
  function TControl.GetClientScrollOffset: TPoint;

  Returns the screen coordinate of the topleft pixel of the control.
------------------------------------------------------------------------------}
function TControl.GetControlOrigin: TPoint;
var
  ParentsClientOrigin: TPoint;
begin
  Result:=Point(Left,Top);
  if Parent<>nil then begin
    ParentsClientOrigin:=Parent.ClientOrigin;
    inc(Result.X,ParentsClientOrigin.X);
    inc(Result.Y,ParentsClientOrigin.Y);
  end;
end;

{------------------------------------------------------------------------------
       TControl WndPRoc
------------------------------------------------------------------------------}
procedure TControl.WndProc(var TheMessage : TLMessage);
Var
  Form : TCustomForm;
begin
  //DebugLn('CCC TControl.WndPRoc ',Name,':',ClassName);
  if (csDesigning in ComponentState) then
  begin
    // redirect messages to designer
    Form := GetParentForm(Self);
    if (Form <> nil) and (Form.Designer <> nil)
    and Form.Designer.IsDesignMsg(Self,TheMessage) then begin
      Exit;
    end;
  end
  else if (TheMessage.Msg >= LM_KeyFirst) and (TheMessage.Msg <= LM_KeyLast)
  then begin
    // keyboard messages
    Form := GetParentForm(Self);
    if (Form <> nil) and (Form.WantChildKey(Self,TheMessage)) then exit;
  end
  else if ((TheMessage.Msg>=LM_MOUSEFIRST) and (TheMessage.Msg<=LM_MOUSELAST))
  or ((TheMessage.Msg>=LM_MOUSEFIRST2) and (TheMessage.Msg<=LM_MOUSELAST2))
  then begin
    // mouse messages
    
    // map double clicks for controls, that do not want doubleclicks
    if not (csDoubleClicks in ControlStyle) then
    begin
      case TheMessage.Msg of
        LM_LButtonDBLCLK,
        LM_RButtonDBLCLK,
        LM_MButtonDBLCLK:
          Dec(TheMessage.Msg, LM_LBUTTONDBLCLK - LM_LBUTTONDOWN);
      end;
    end;
    // map triple clicks for controls, that do not want tripleclicks
    if not (csTripleClicks in ControlStyle) then
    begin
      case TheMessage.Msg of
        LM_LBUTTONTRIPLECLK: TheMessage.Msg:=LM_LBUTTONDOWN;
        LM_MBUTTONTRIPLECLK: TheMessage.Msg:=LM_MBUTTONDOWN;
        LM_RBUTTONTRIPLECLK: TheMessage.Msg:=LM_RBUTTONDOWN;
      end;
    end;
    // map quad clicks for controls, that do not want quadclicks
    if not (csQuadClicks in ControlStyle) then
    begin
      case TheMessage.Msg of
        LM_LBUTTONQUADCLK: TheMessage.Msg:=LM_LBUTTONDOWN;
        LM_MBUTTONQUADCLK: TheMessage.Msg:=LM_MBUTTONDOWN;
        LM_RBUTTONQUADCLK: TheMessage.Msg:=LM_RBUTTONDOWN;
      end;
    end;

    case TheMessage.Msg of

      LM_MOUSEMOVE:
        begin
          Application.HintMouseMessage(Self, TheMessage);
        end;

      LM_LBUTTONDOWN,
      LM_LBUTTONDBLCLK:
        begin
          if FDragMode = dmAutomatic
          then begin
            BeginAutoDrag;
            { The VCL holds up the mouse down for dmAutomatic
              and sends it, when it decides, if it is a drag operation or
              not.
              This decision requires full control of focus and mouse, which
              do not all LCL interfaces provide. Therefore the mouse down event
              is sent immediately.
            }
            // VCL: exit;
          end;
          Include(FControlState,csLButtonDown);
        end;

      LM_LBUTTONUP:
        begin
          Exclude(FControlState, csLButtonDown);
        end;
    end;
  end;
  Dispatch(TheMessage);
end;

{------------------------------------------------------------------------------
  procedure TControl.ParentFormHandleInitialized;
  
  called by ChildHandlesCreated of parent form
------------------------------------------------------------------------------}
procedure TControl.ParentFormHandleInitialized;
begin
  // The form is real connection to the target screen. For example, the gtk
  // under X gathers some screen information not before form creation.
  // But this information is needed to create DeviceContexts, which
  // are needed to calculate Text Size and such stuff needed for AutoSizing.
  // That's why AdjustSize delays AutoSizing till this moment. Now do the
  // AutoSize.
  AdjustSize;
end;

{------------------------------------------------------------------------------
       TControl Invalidate
------------------------------------------------------------------------------}
procedure TControl.Invalidate;
Begin
  InvalidateControl(IsVisible, csOpaque in ControlStyle);
end;

{------------------------------------------------------------------------------
       TControl DoMouseDown  "Event Handler"
------------------------------------------------------------------------------}
procedure TControl.DoMouseDown(var Message: TLMMouse; Button: TMouseButton;
  Shift: TShiftState);
begin
  //DebugLn('TControl.DoMouseDown ',DbgSName(Self),' ');
  if not (csNoStdEvents in ControlStyle) then begin
    with Message do
      MouseDown(Button, KeysToShiftState(Keys) + Shift, XPos, YPos);
  end;
end;

{------------------------------------------------------------------------------
       TControl DoMouseUp  "Event Handler"
------------------------------------------------------------------------------}
procedure TControl.DoMouseUp(var Message: TLMMouse; Button: TMouseButton);
begin
  if not (csNoStdEvents in ControlStyle)
  then with Message do
    MouseUp(Button, KeysToShiftState(Keys), XPos, YPos);
end;

procedure TControl.SetAnchorSideIndex(Index: integer; const AValue: TAnchorSide
  );
begin
  GetAnchorSideIndex(Index).Assign(AValue);
end;

procedure TControl.SetBorderSpacing(const AValue: TControlBorderSpacing);
begin
  if FBorderSpacing=AValue then exit;
  FBorderSpacing.Assign(AValue);
end;

{------------------------------------------------------------------------------
  Method: TControl.WMLButtonDown
  Params: Message
  Returns: Nothing

  Mouse event handler
 ------------------------------------------------------------------------------}
procedure TControl.WMLButtonDown(var Message: TLMLButtonDown);
begin
  DoBeforeMouseMessage;
  if csCaptureMouse in ControlStyle then begin
    {$IFDEF VerboseMouseCapture}
    DebugLn('TControl.WMLButtonDown ',Name,':',ClassName);
    {$ENDIF}
    MouseCapture := True;
  end;
  if csClickEvents in ControlStyle then Include(FControlState, csClicked);
  DoMouseDown(Message, mbLeft, []);
  //DebugLn('TCONTROL WMLBUTTONDOWN B ',Name,':',ClassName);
end;

{------------------------------------------------------------------------------
  Method: TControl.WMRButtonDown
  Params: Message
  Returns: Nothing

  Mouse event handler
 ------------------------------------------------------------------------------}
procedure TControl.WMRButtonDown(var Message: TLMRButtonDown);
begin
  DoBeforeMouseMessage;
  DoMouseDown(Message, mbRight, []);
end;

{------------------------------------------------------------------------------
  Method: TControl.WMMButtonDown
  Params: Message
  Returns: Nothing

  Mouse event handler
 ------------------------------------------------------------------------------}
procedure TControl.WMMButtonDown(var Message: TLMMButtonDown);
begin
  DoBeforeMouseMessage;
  DoMouseDown(Message, mbMiddle, []);
end;

{------------------------------------------------------------------------------
  Method: TControl.WMLButtonDblClk
  Params: Message
  Returns: Nothing

  Mouse event handler
 ------------------------------------------------------------------------------}
procedure TControl.WMLButtonDblClk(var Message: TLMLButtonDblClk);
begin
  DoBeforeMouseMessage;
  //TODO: SendCancelMode(self);
  if csCaptureMouse in ControlStyle then begin
    {$IFDEF VerboseMouseCapture}
    DebugLn('TControl.WMLButtonDblClk ',Name,':',ClassName);
    {$ENDIF}
    MouseCapture := True;
  end;
  // first send a mouse down
  DoMouseDown(Message, mbLeft ,[ssDouble]);
  // then send the double click
  if csClickEvents in ControlStyle then DblClick;
end;

{------------------------------------------------------------------------------
  Method: TControl.WMRButtonDblClk
  Params: Message
  Returns: Nothing

  Mouse event handler
 ------------------------------------------------------------------------------}
procedure TControl.WMRButtonDblClk(var Message: TLMRButtonDblClk);
begin
  DoBeforeMouseMessage;
  DoMouseDown(Message, mbRight ,[ssDouble]);
end;

{------------------------------------------------------------------------------
  Method: TControl.WMMButtonDblClk
  Params: Message
  Returns: Nothing

  Mouse event handler
 ------------------------------------------------------------------------------}
procedure TControl.WMMButtonDblClk(var Message: TLMMButtonDblClk);
begin
  DoBeforeMouseMessage;
  DoMouseDown(Message, mbMiddle ,[ssDouble]);
end;

{------------------------------------------------------------------------------
  Method: TControl.WMLButtonTripleClk
  Params: Message
  Returns: Nothing

  Mouse event handler
 ------------------------------------------------------------------------------}
procedure TControl.WMLButtonTripleClk(var Message: TLMLButtonTripleClk);
begin
  DoBeforeMouseMessage;
  //TODO: SendCancelMode(self);
  if csCaptureMouse in ControlStyle then begin
    {$IFDEF VerboseMouseCapture}
    DebugLn('TControl.WMLButtonTripleClk ',Name,':',ClassName);
    {$ENDIF}
    MouseCapture := True;
  end;
  if csClickEvents in ControlStyle then TripleClick;
  DoMouseDown(Message, mbLeft ,[ssTriple]);
end;

{------------------------------------------------------------------------------
  Method: TControl.WMRButtonTripleClk
  Params: Message
  Returns: Nothing

  Mouse event handler
 ------------------------------------------------------------------------------}
procedure TControl.WMRButtonTripleClk(var Message: TLMRButtonTripleClk);
begin
  DoBeforeMouseMessage;
  DoMouseDown(Message, mbRight ,[ssTriple]);
end;

{------------------------------------------------------------------------------
  Method: TControl.WMMButtonTripleClk
  Params: Message
  Returns: Nothing

  Mouse event handler
 ------------------------------------------------------------------------------}
procedure TControl.WMMButtonTripleClk(var Message: TLMMButtonTripleClk);
begin
  DoBeforeMouseMessage;
  DoMouseDown(Message, mbMiddle ,[ssTriple]);
end;

{------------------------------------------------------------------------------
  Method: TControl.WMLButtonQuadClk
  Params: Message
  Returns: Nothing

  Mouse event handler
 ------------------------------------------------------------------------------}
procedure TControl.WMLButtonQuadClk(var Message: TLMLButtonQuadClk);
begin
  DoBeforeMouseMessage;
  //TODO: SendCancelMode(self);
  if csCaptureMouse in ControlStyle then begin
    {$IFDEF VerboseMouseCapture}
    DebugLn('TControl.WMLButtonQuadClk ',Name,':',ClassName);
    {$ENDIF}
    MouseCapture := True;
  end;
  if csClickEvents in ControlStyle then QuadClick;
  DoMouseDown(Message, mbLeft ,[ssQuad]);
end;

{------------------------------------------------------------------------------
  Method: TControl.WMRButtonQuadClk
  Params: Message
  Returns: Nothing

  Mouse event handler
 ------------------------------------------------------------------------------}
procedure TControl.WMRButtonQuadClk(var Message: TLMRButtonQuadClk);
begin
  DoBeforeMouseMessage;
  DoMouseDown(Message, mbRight ,[ssQuad]);
end;

{------------------------------------------------------------------------------
  Method: TControl.WMMButtonQuadClk
  Params: Message
  Returns: Nothing

  Mouse event handler
 ------------------------------------------------------------------------------}
procedure TControl.WMMButtonQuadClk(var Message: TLMMButtonQuadClk);
begin
  DoBeforeMouseMessage;
  DoMouseDown(Message, mbMiddle ,[ssQuad]);
end;

{------------------------------------------------------------------------------
  Method: TControl.WMLButtonUp
  Params: Message
  Returns: Nothing

  Mouse event handler
 ------------------------------------------------------------------------------}
procedure TControl.WMLButtonUp(var Message: TLMLButtonUp);
begin
  DoBeforeMouseMessage;
  //DebugLn('TControl.WMLButtonUp A ',Name,':',ClassName,' csCaptureMouse=',DbgS(csCaptureMouse in ControlStyle),' csClicked=',DbgS(csClicked in ControlState));
  if csCaptureMouse in ControlStyle then begin
    {$IFDEF VerboseMouseCapture}
    DebugLn('TControl.WMLButtonUp ',Name,':',ClassName);
    {$ENDIF}
    MouseCapture := False;
  end;

  DoMouseUp(Message, mbLeft);
  if csClicked in ControlState then
  begin
    Exclude(FControlState, csClicked);
    //DebugLn('TControl.WMLButtonUp B ',dbgs(ClientRect.Left),',',dbgs(ClientRect.Top),',',dbgs(ClientRect.Right),',',dbgs(ClientRect.Bottom),' ',dbgs(Message.Pos.X),',',dbgs(Message.Pos.Y));
    if PtInRect(ClientRect, SmallPointToPoint(Message.Pos))
    then begin
      //DebugLn('TControl.WMLButtonUp C');
      Click;
    end;
  end;
  //DebugLn('TControl.WMLButtonUp END');
end;

{------------------------------------------------------------------------------
  Method: TControl.WMRButtonUp
  Params: Message
  Returns: Nothing

  Mouse event handler
 ------------------------------------------------------------------------------}
procedure TControl.WMRButtonUp(var Message: TLMRButtonUp);
begin
  DoBeforeMouseMessage;
  DoMouseUp(Message, mbRight);
  if Message.Result = 0 then 
    if CheckMenuPopup(Message.pos) then
      Message.Result := 1;
end;

{------------------------------------------------------------------------------
  Method: TControl.WMMButtonUp
  Params: Message
  Returns: Nothing

  Mouse event handler
 ------------------------------------------------------------------------------}
procedure TControl.WMMButtonUp(var Message: TLMMButtonUp);
begin
  DoBeforeMouseMessage;
  DoMouseUp(Message, mbMiddle);
end;

{------------------------------------------------------------------------------}
{       TControl Click                                                         }
{------------------------------------------------------------------------------}
Procedure TControl.Click;
Begin
  if (not (csDesigning in ComponentState)) and (ActionLink<>nil)
  and ((Action=nil) or (@FOnClick<>@Action.OnExecute) or Assigned(FOnClick))
  then
    ActionLink.Execute(Self)
  else if Assigned(FOnClick) then
    FOnClick(Self);
end;

{------------------------------------------------------------------------------
  TControl DialogChar
  
  Do something useful with accelerators etc.
------------------------------------------------------------------------------}
function TControl.DialogChar(var Message: TLMKey): boolean;
begin
  Result := false;
end;

{------------------------------------------------------------------------------
  TControl AddControl
  
  Add Handle object to parents Handle object.
------------------------------------------------------------------------------}
procedure TControl.AddControl;
begin
  TWSControlClass(WidgetSetClass).AddControl(Self);
end;

{------------------------------------------------------------------------------
  function TControl.CheckChildClassAllowed(ChildClass: TClass;
    ExceptionOnInvalid: boolean): boolean;
    
  Checks if this control can be the parent of a control of class ChildClass.
------------------------------------------------------------------------------}
function TControl.CheckChildClassAllowed(ChildClass: TClass;
  ExceptionOnInvalid: boolean): boolean;
  
  procedure RaiseInvalidChild;
  begin
    raise Exception.Create(ClassName+' can not have '+ChildClass.ClassName+' as child');
  end;
  
begin
  Result:=ChildClassAllowed(ChildClass);
  if (not Result) and ExceptionOnInvalid then
    RaiseInvalidChild;
end;

{------------------------------------------------------------------------------
  procedure TControl.CheckNewParent(AParent: TWinControl);
  
  Checks if this control can be the child of AParent.
  This check is executed in SetParent.
------------------------------------------------------------------------------}
procedure TControl.CheckNewParent(AParent: TWinControl);
begin
  if (AParent<>nil) then AParent.CheckChildClassAllowed(ClassType,true);
  if AParent = Self then begin
    raise EInvalidOperation.Create('A control can not have itself as parent');
  end;
end;

{------------------------------------------------------------------------------
       TControl SetAutoSize
------------------------------------------------------------------------------}
Procedure TControl.SetAutoSize(const value : Boolean);
Begin
  If AutoSize <> Value then begin
    FAutoSize := Value;
    //debugln('TControl.SetAutoSize ',DbgSName(Self));
    AdjustSize;
  end;
end;

{------------------------------------------------------------------------------
  TControl DoAutoSize

  IMPORTANT: Many Delphi controls override this method and many call this method
  directly after setting some properties.
  During handle creation not all interfaces can create complete Device Contexts
  which are needed to calculate things like text size.
  That's why you should always call AdjustSize instead of DoAutoSize.
------------------------------------------------------------------------------}
Procedure TControl.DoAutoSize;
Begin
  //Handled by TWinControl, or other descendants
end;

procedure TControl.AnchorSideChanged(TheAnchorSide: TAnchorSide);
begin
  //debugln('TControl.AnchorSideChanged ',DbgSName(Self));
  RequestAlign;
end;

procedure TControl.ForeignAnchorSideChanged(TheAnchorSide: TAnchorSide;
  Operation: TAnchorSideChangeOperation);
begin
  //debugln('TControl.ForeignAnchorSideChanged A ',DbgSName(TheAnchorSide.Owner),' Operation=',dbgs(ord(Operation)),' Anchor=',dbgs(ord(TheAnchorSide.Kind)));
  if TheAnchorSide.Control=Self then begin
    if fAnchoredControls=nil then
      fAnchoredControls:=TFPList.Create;
    if fAnchoredControls.IndexOf(TheAnchorSide.Owner)<0 then
      fAnchoredControls.Add(TheAnchorSide.Owner);
  end else if fAnchoredControls<>nil then begin
    fAnchoredControls.Remove(TheAnchorSide.Owner);
  end;
end;

{------------------------------------------------------------------------------
  function TControl.AutoSizeCanStart: boolean;
  
  Returns true if DoAutoSize can start. That means, it tests the minimum
  requirements to start. Some controls need even more.

  It returns false if
  - AutoSize=false
  - or the control is currently autosizing
  - or the control is not visible
  - or the control is destroying
------------------------------------------------------------------------------}
function TControl.AutoSizeCanStart: boolean;
begin
  Result:=AutoSize
          and (not AutoSizing)
          and (not (csDestroying in ComponentState))
          and IsControlVisible;
  if AutoSize and not Result then begin
    {$IFDEF VerboseCanAutoSize}
    DbgOut('TControl.AutoSizeCanStart Self='+DbgSName(Self)+' ');
    if not AutoSize then DebugLn('not AutoSize')
    else if AutoSizing then DebugLn('AutoSizing')
    else if csDestroying in ComponentState then DebugLn('csDestroying in ComponentState')
    else if not IsControlVisible then
      DebugLn('Visible=',dbgs(Visible),
              ' csDesigning=',dbgs(csDesigning in ComponentState),
              ' csNoDesignVisible=',dbgs(csNoDesignVisible in ControlStyle))
    else DebugLn('?');
    {$ENDIF}
  end;
end;

{------------------------------------------------------------------------------
  function TControl.AutoSizeDelayed: boolean;
  
  Returns true, if the DoAutoSize should skip now, because not all parameters
  needed to calculate the AutoSize bounds are loaded or initialized.
------------------------------------------------------------------------------}
function TControl.AutoSizeDelayed: boolean;
begin
  Result:=(FAutoSizingLockCount>0)
          // no autosize during loading or destruction
          or ([csLoading,csDestroying]*ComponentState<>[])
          // no autosize for invisible controls
          or (not IsControlVisible)
          // if there is no parent, then this control is not visible
          //  (TCustomForm will override this)
          or (NeedParentForAutoSize and (Parent=nil))
          // if there is a parent, ask it
          or ((Parent<>nil) and Parent.AutoSizeDelayed);
  {$IFDEF VerboseCanAutoSize}
  if Result {and AutoSize} then begin
    DbgOut('TControl.AutoSizeDelayed Self='+DbgSName(Self)+' ');
    if FAutoSizingLockCount>0 then debugln('FAutoSizingLockCount=',dbgs(FAutoSizingLockCount))
    else if csLoading in ComponentState then debugln('csLoading')
    else if csDestroying in ComponentState then debugln('csDestroying')
    else if not Visible then debugln('Visible')
    else if NeedParentForAutoSize and (Parent=nil) then debugln('NeedParentForAutoSize and (Parent=nil)')
    else if ((Parent<>nil) and Parent.AutoSizeDelayed) then debugln('Parent.AutoSizeDelayed')
    else debugln('?');
  end;
  {$ENDIF}
end;

function TControl.NeedParentForAutoSize: Boolean;
begin
  Result:=true;
end;

{------------------------------------------------------------------------------
       TControl SetBoundsRect
------------------------------------------------------------------------------}
Procedure TControl.SetBoundsRect(const ARect : TRect);
Begin
  {$IFDEF CHECK_POSITION}
  DebugLn('[TControl.SetBoundsRect] ',Name,':',ClassName);
  {$ENDIF}
  with ARect do
    SetBounds(Left,Top,Right - Left, Bottom - Top);
end;

procedure TControl.SetBoundsRectForNewParent(const AValue: TRect);
begin
  Include(FControlFlags,cfBoundsRectForNewParentValid);
  FBoundsRectForNewParent:=AValue;
end;

{------------------------------------------------------------------------------
  TControl SetClientHeight
------------------------------------------------------------------------------}
procedure TControl.SetClientHeight(Value: Integer);
begin
  if csLoading in ComponentState then begin
    FLoadedClientSize.Y:=Value;
    Include(FControlFlags,cfClientHeightLoaded);
  end else begin
    // during loading the ClientHeight is not used to set the Height of the
    // control, but only to restore autosizing. For example Anchors=[akBottom]
    // needs ClientHeight.
    SetClientSize(Point(ClientWidth, Value));
  end;
end;

{------------------------------------------------------------------------------
  TControl SetClientSize
------------------------------------------------------------------------------}
procedure TControl.SetClientSize(Value: TPoint);
var
  Client: TRect;
begin
  Client := GetClientRect;
  SetBounds(FLeft, FTop, Width - Client.Right + Value.X, Height -
    Client.Bottom + Value.Y);
end;

{------------------------------------------------------------------------------}
{  TControl SetClientWidth                                                     }
{------------------------------------------------------------------------------}
procedure TControl.SetClientWidth(Value: Integer);
begin
  if csLoading in ComponentState then begin
    FLoadedClientSize.X:=Value;
    Include(FControlFlags,cfClientWidthLoaded);
  end else begin
    // during loading the ClientWidth is not used to set the Width of the
    // control, but only to restore autosizing. For example Anchors=[akRight]
    // needs ClientWidth.
    SetClientSize(Point(Value, ClientHeight));
  end;
end;

{------------------------------------------------------------------------------}
{  TControl SetTempCursor                                                      }
{------------------------------------------------------------------------------}
procedure TControl.SetTempCursor(Value: TCursor);
begin
  TWSControlClass(WidgetSetClass).SetCursor(Self, Value);
end;

procedure TControl.ActiveDefaultControlChanged(NewControl: TControl);
begin
end;

procedure TControl.UpdateRolesForForm;
begin
  // called by the form when the "role" controls DefaultControl or CancelControl
  // has changed
end;

{------------------------------------------------------------------------------}
{  TControl SetCursor                                                          }
{------------------------------------------------------------------------------}
procedure TControl.SetCursor(Value: TCursor);
begin
  if FCursor <> Value
  then begin
    FCursor := Value;
    SetTempCursor(Value);
  end;
end;

procedure TControl.SetDragCursor(const AValue: TCursor);
begin
  if FDragCursor=AValue then exit;
  FDragCursor:=AValue;
end;

procedure TControl.SetFont(Value: TFont);
begin
  if FFont.IsEqual(Value) then exit;
  FFont.Assign(Value);
  Invalidate;
end;

{------------------------------------------------------------------------------}
{  TControl SetEnabled                                                         }
{------------------------------------------------------------------------------}
procedure TControl.SetEnabled(Value: Boolean);
begin
  if FEnabled <> Value
  then begin
    FEnabled := Value;
    Perform(CM_ENABLEDCHANGED, 0, 0);
  end;
end;

{------------------------------------------------------------------------------}
{  TControl SetMouseCapture                                                    }
{------------------------------------------------------------------------------}
procedure TControl.SetMouseCapture(Value : Boolean);
begin
  if (MouseCapture <> Value) or (not Value and (CaptureControl=Self))
  then begin
    {$IFDEF VerboseMouseCapture}
    DebugLn('TControl.SetMouseCapture ',DbgSName(Self),' NewValue=',DbgS(Value));
    {$ENDIF}
    if Value
    then SetCaptureControl(Self)
    else SetCaptureControl(nil);
  end
end;

{------------------------------------------------------------------------------
   Method:  TControl.SetHint
   Params:  Value: the text of the hint to be set
   Returns: Nothing

   Sets the hint text of a control
 ------------------------------------------------------------------------------}
procedure TControl.SetHint(const Value: TTranslateString);
begin
  if FHint <> Value then FHint := Value;
end;

{------------------------------------------------------------------------------}
{  TControl SetName                                                            }
{------------------------------------------------------------------------------}
procedure TControl.SetName(const Value: TComponentName);
var
  ChangeText: Boolean;
begin
  ChangeText := (csSetCaption in ControlStyle) and
    not (csLoading in ComponentState) and (Name = Text) and
    ((Owner = nil) or not (Owner is TControl) or
     not (csLoading in TControl(Owner).ComponentState));

  inherited SetName(Value);
  if ChangeText then Text := Value;
end;

{------------------------------------------------------------------------------}
{  TControl Show                                                               }
{------------------------------------------------------------------------------}
procedure TControl.Show;
begin
  if Parent <> nil then Parent.ShowControl(Self);
  // do not switch the visible flag in design mode
  if not (csDesigning in ComponentState) or
    (csNoDesignVisible in ControlStyle) then Visible := True;
end;

{------------------------------------------------------------------------------
  TControl Notification
------------------------------------------------------------------------------}
procedure TControl.Notification(AComponent: TComponent; Operation: TOperation);
var
  Kind: TAnchorKind;
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then begin
    if AComponent = PopupMenu then PopupMenu := nil
    else if AComponent = Action then Action := nil;
    //debugln('TControl.Notification A ',DbgSName(Self),' ',DbgSName(AComponent));
    for Kind:=Low(TAnchorKind) to High(TAnchorKind) do begin
      if (FAnchorSides[Kind]<>nil) and (FAnchorSides[Kind].Control=AComponent)
      then
        FAnchorSides[Kind].FControl:=nil;
    end;
  end;
end;

{------------------------------------------------------------------------------
  TControl GetText
------------------------------------------------------------------------------}
function TControl.GetText: TCaption;
var
  len: Integer;
begin
  // Check if GetTextBuf is overridden, otherwise
  // we can call RealGetText directly
  if TMethod(@Self.GetTextBuf).Code = Pointer(@TControl.GetTextBuf)
  then begin
    Result := RealGetText;
  end
  else begin
    // Bummer, we have to do it the compatible way.
    DebugLn('Note: GetTextBuf is overridden for: ', Classname);
    
    len := GetTextLen;
    if len = 0 
    then begin
      Result := '';
    end
    else begin
      SetLength(Result, len+1); // make sure there is room for the extra #0
      FillChar(Result[1], len, #0);
      len := GetTextBuf(@Result[1], len+1); 
      SetLength(Result, len);
    end;
  end;
end;

{------------------------------------------------------------------------------
  TControl RealGetText
------------------------------------------------------------------------------}
function TControl.RealGetText: TCaption;
begin
  Result := FCaption;
end;

function TControl.GetTextLen: Integer; 
begin
  Result := Length(FCaption);
end;

function TControl.GetAction: TBasicAction;
begin
  if ActionLink <> nil then
    Result := ActionLink.Action
  else
    Result := nil;
end;

function TControl.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TControlActionLink;
end;

{------------------------------------------------------------------------------
  TControl IsCaptionStored
------------------------------------------------------------------------------}
Function TControl.IsCaptionStored : Boolean;
Begin
  Result := (ActionLink = nil) or not ActionLink.IsCaptionLinked;
end;

function TControl.IsColorStored: Boolean;
begin
  Result := not ParentColor;
end;

function TControl.IsEnabledStored: Boolean;
begin
  Result := (ActionLink = nil) or not ActionLink.IsEnabledLinked;
end;

function TControl.IsFontStored: Boolean;
begin
  Result := not ParentFont {and not DesktopFont};
end;

function TControl.IsHintStored: Boolean;
begin
  Result := (ActionLink = nil) or not ActionLink.IsHintLinked;
end;

{------------------------------------------------------------------------------
  TControl InvalidateControl
------------------------------------------------------------------------------}
procedure TControl.InvalidateControl(CtrlIsVisible, CtrlIsOpaque: Boolean);
var
  Rect: TRect;

  function BackgroundClipped: Boolean;
  var
    R: TRect;
    List: TFPList;
    I: Integer;
    C: TControl;
  begin
    Result := True;
    List := FParent.FControls;
    if List<>nil then begin
      I := List.IndexOf(Self);
      while I > 0 do
      begin
        Dec(I);
        C := TControl(List[I]);
        with C do
          if C.IsControlVisible and (csOpaque in ControlStyle) then
          begin
            IntersectRect(R, Rect, BoundsRect);
            if EqualRect(R, Rect) then Exit;
          end;
      end;
    end;
    Result := False;
  end;

begin
  if (Parent=nil) or (not Parent.HandleAllocated)
  or ([csLoading,csDestroying]*Parent.ComponentState<>[])
  or ([csLoading,csDestroying]*ComponentState<>[])
  then exit;

  if (CtrlIsVisible or ((csDesigning in ComponentState)
  and not (csNoDesignVisible in ControlStyle)))
  then begin
    Rect := BoundsRect;
    InvalidateRect(Parent.Handle, @Rect, not (CtrlIsOpaque or
      (csOpaque in Parent.ControlStyle) or BackgroundClipped));
  end;
end;

{------------------------------------------------------------------------------
  procedure TControl.InvalidateControl(CtrlIsVisible, CtrlIsOpaque,
    IgnoreWinControls: Boolean);
------------------------------------------------------------------------------}
procedure TControl.InvalidateControl(CtrlIsVisible, CtrlIsOpaque,
  IgnoreWinControls: Boolean);
begin
  if IgnoreWinControls and (Self is TWinControl) then exit;
  InvalidateControl(CtrlIsVisible,CtrlIsOpaque);
end;

{------------------------------------------------------------------------------}
{  TControl Refresh                                                            }
{------------------------------------------------------------------------------}
procedure TControl.Refresh;
begin
  Repaint;
end;

{------------------------------------------------------------------------------}
{  TControl Repaint                                                            }
{------------------------------------------------------------------------------}
procedure TControl.Repaint;
var
  DC: HDC;
begin
  if (Parent=nil) or (not Parent.HandleAllocated)
  or (csDestroying in ComponentState) then exit;

  if IsVisible then
    if csOpaque in ControlStyle then
    begin
      {$IFDEF VerboseDsgnPaintMsg}
      if csDesigning in ComponentState then
        DebugLn('TControl.Repaint A ',Name,':',ClassName);
      {$ENDIF}
      DC := GetDC(Parent.Handle);
      try
        IntersectClipRect(DC, Left, Top, Left + Width, Top + Height);
        Parent.PaintControls(DC, Self);
      finally
        ReleaseDC(Parent.Handle, DC);
      end;
    end else
    begin
      Invalidate;
      Update;
    end;
end;

{------------------------------------------------------------------------------
  TControl Resize

  Calls OnResize
-------------------------------------------------------------------------------}
procedure TControl.Resize;
begin
  if ([csLoading,csDestroying]*ComponentState<>[]) then exit;
  if (FLastResizeWidth<>Width) or (FLastResizeHeight<>Height)
  or (FLastResizeClientWidth<>ClientWidth)
  or (FLastResizeClientHeight<>ClientHeight) then begin
    //if AnsiCompareText('NOTEBOOK',Name)=0 then
    {DebugLn('[TControl.Resize] ',Name,':',ClassName,
    ' Last=',FLastResizeWidth,',',FLastResizeHeight,
    ' LastClient=',FLastResizeClientWidth,',',FLastResizeClientHeight,
    ' New=',Width,',',Height,
    ' NewClient=',ClientWidth,',',ClientHeight);}
    FLastResizeWidth:=Width;
    FLastResizeHeight:=Height;
    FLastResizeClientWidth:=ClientWidth;
    FLastResizeClientHeight:=ClientHeight;
    DoOnResize;
  end;
end;

procedure TControl.Loaded;
begin
  inherited Loaded;
  {DebugLn('TControl.Loaded A ',Name,':',ClassName,
    ' CW=',DbgS(cfClientWidthLoaded in FControlFlags),'=',DbgS(FLoadedClientSize.X),
    ' CH=',DbgS(cfClientHeightLoaded in FControlFlags),'=',DbgS(FLoadedClientSize.Y),
    '');}
    
  if Assigned(Parent) then begin
    if ParentColor then begin
      Color := Parent.Color;
      ParentColor := true;
    end;

    if ParentFont then begin
      Font := Parent.Font;
      ParentFont := true;
    end;
  end;

  UpdateBaseBounds(true,true,true);

  // align this control and the brothers
  if cfRequestAlignNeeded in FControlFlags then
    RequestAlign;
  // autosize this control
  if cfAutoSizeNeeded in FControlFlags then
    AdjustSize;
  if Action <> nil then ActionChange(Action, True);
end;

{------------------------------------------------------------------------------
  procedure TControl.DefineProperties(Filer: TFiler);
------------------------------------------------------------------------------}
procedure TControl.DefineProperties(Filer: TFiler);
begin
  // Optimiziation:
  // do not call inherited: TComponent only defines 'Left' and 'Top' and
  // TControl has them as regular properties.
end;

{------------------------------------------------------------------------------
  procedure TControl.AssignTo(Dest: TPersistent);
------------------------------------------------------------------------------}
procedure TControl.AssignTo(Dest: TPersistent);
begin
  if Dest is TCustomAction then
    with TCustomAction(Dest) do begin
      Enabled := Self.Enabled;
      Hint := Self.Hint;
      Caption := Self.Caption;
      Visible := Self.Visible;
      OnExecute := Self.OnClick;
    end
  else inherited AssignTo(Dest);
end;

{------------------------------------------------------------------------------
  TControl SetBounds
------------------------------------------------------------------------------}
procedure TControl.SetBounds(ALeft, ATop, AWidth, AHeight : integer);
begin
  ChangeBounds(ALeft, ATop, AWidth, AHeight);
end;

{------------------------------------------------------------------------------
  TControl SetConstraints
------------------------------------------------------------------------------}
procedure TControl.SetConstraints(const Value : TSizeConstraints);
begin
  FConstraints.Assign(Value);
end;

{------------------------------------------------------------------------------
  TControl SetAlign
------------------------------------------------------------------------------}
procedure TControl.SetAlign(Value: TAlign);
var
  OldAlign: TAlign;
begin
  if FAlign = Value then exit;
  //DebugLn('TControl.SetAlign ',Name,':',ClassName,' Old=',AlignNames[FAlign],' New=',AlignNames[Value]);
  OldAlign:=FAlign;
  FAlign := Value;
  // if anchors were on default then change them to new default
  // This is done for Delphi compatibility.
  if Anchors=AnchorAlign[OldAlign] then
    Anchors:=AnchorAlign[FAlign];
  RequestAlign;
end;

{------------------------------------------------------------------------------
  TControl SetAnchors
------------------------------------------------------------------------------}
procedure TControl.SetAnchors(const AValue: TAnchors);
begin
  if Anchors=AValue then exit;
  FAnchors:=AValue;
  RequestAlign;
end;

{------------------------------------------------------------------------------
  TControl RequestAlign

  Requests the parent to realign all brothers
------------------------------------------------------------------------------}
procedure TControl.RequestAlign;
begin
  if (Parent = nil) or (csDestroying in ComponentState) then exit;
  if (csLoading in ComponentState) or (not Parent.HandleAllocated) then begin
    //debugln('TControl.RequestAlign csLoading or not HandleAllocated ',DbgSName(Self));
    Include(FControlFlags,cfRequestAlignNeeded);
    exit;
  end;
  //debugln('TControl.RequestAlign AlignControl ',DbgSName(Self));
  Parent.AlignControl(Self);
  Exclude(FControlFlags,cfRequestAlignNeeded);
end;

procedure TControl.UpdateBaseBounds(StoreBounds,
  StoreParentClientSize, UseLoadedValues: boolean);
var
  NewBaseBounds: TRect;
  NewBaseParentClientSize: TPoint;
begin
  if (csLoading in ComponentState) or (fBaseBoundsLock>0) then exit;
  if StoreBounds then
    NewBaseBounds:=BoundsRect
  else
    NewBaseBounds:=FBaseBounds;
  if StoreParentClientSize then begin
    if Parent<>nil then begin
      NewBaseParentClientSize:=Point(Parent.ClientWidth,Parent.ClientHeight);
      if UseLoadedValues then begin
        if cfClientWidthLoaded in Parent.FControlFlags then
          NewBaseParentClientSize.X:=Parent.FLoadedClientSize.X;
        if cfClientHeightLoaded in Parent.FControlFlags then
          NewBaseParentClientSize.Y:=Parent.FLoadedClientSize.Y;
      end;
    end else
      NewBaseParentClientSize:=Point(0,0);
  end else
    NewBaseParentClientSize:=FBaseParentClientSize;
  if CompareRect(@NewBaseBounds,@FBaseBounds)
  and (NewBaseParentClientSize.X=FBaseParentClientSize.X)
  and (NewBaseParentClientSize.Y=FBaseParentClientSize.Y)
  then exit;
  //if csDesigning in ComponentState then
  {if CompareText(ClassName,'TScrollBar')=0 then
    DebugLn('TControl.UpdateBaseBounds '+dbgs(Self)+
    ' OldBounds='+dbgs(FBaseBounds)+
    ' OldClientSize='+dbgs(FBaseParentClientSize)+
    ' NewBounds='+dbgs(NewBaseBounds)+
    ' NewClientSize='+dbgs(NewBaseParentClientSize)+
    '');}
  FBaseBounds:=NewBaseBounds;
  FBaseParentClientSize:=NewBaseParentClientSize;
  fLastAlignedBounds:=Rect(0,0,0,0);
end;

procedure TControl.LockBaseBounds;
begin
  inc(fBaseBoundsLock);
end;

procedure TControl.UnlockBaseBounds;
begin
  dec(fBaseBoundsLock);
  if fBaseBoundsLock<0 then RaiseGDBException('TControl.UnlockBaseBounds');
end;

procedure TControl.WriteLayoutDebugReport(const Prefix: string);
var
  a: TAnchorKind;
  NeedSeparator: Boolean;
begin
  DbgOut(Prefix,'TControl.WriteLayoutDebugReport ');
  DbgOut(DbgSName(Self),' Bounds=',dbgs(BoundsRect));
  if Align<>alNone then
    DbgOut(' Align=',AlignNames[Align]);
  DbgOut(' Anchors=[');
  NeedSeparator:=false;
  for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
    if a in Anchors then begin
      if NeedSeparator then DbgOut(',');
      DbgOut(dbgs(a));
      if AnchorSide[a].Control<>nil then begin
        DbgOut('(',DbgSName(AnchorSide[a].Control),')');
      end;
      NeedSeparator:=true;
    end;
  end;
  DbgOut(']');
  DebugLn;
end;

procedure TControl.UpdateAnchorRules;
begin
  UpdateBaseBounds(true,true,false);
end;

{------------------------------------------------------------------------------
  TControl SetDragmode
------------------------------------------------------------------------------}
procedure TControl.SetDragMode(Value: TDragMode);
begin
  if FDragMode = Value then exit;
  FDragMode := Value;
end;

procedure TControl.DrawDragDockImage(DragDockObject: TDragDockObject);
begin
  DefaultDockImage(DragDockObject, False);
end;

procedure TControl.EraseDragDockImage(DragDockObject: TDragDockObject);
begin
  DefaultDockImage(DragDockObject, True);
end;

{------------------------------------------------------------------------------
  TControl DefaultDockImage
------------------------------------------------------------------------------}
procedure TControl.DefaultDockImage(DragDockObject: TDragDockObject;
  Erase: Boolean);
begin
  // ToDo Dock: draw or erase dock image
end;

{------------------------------------------------------------------------------
  TControl DockTrackNoTarget
------------------------------------------------------------------------------}
procedure TControl.DockTrackNoTarget(Source: TDragDockObject; X, Y: Integer);
begin
  PositionDockRect(Source);
end;

{------------------------------------------------------------------------------
  TControl SetLeft
------------------------------------------------------------------------------}
procedure TControl.SetLeft(Value: Integer);
begin
  {$IFDEF CHECK_POSITION}
  DebugLn('[TControl.SetLeft] ',Name,':',ClassName,' ',DbgS(Value));
  {$ENDIF}
  if csLoading in ComponentState then begin
    inc(FReadBounds.Right,Value-FReadBounds.Left);
    FReadBounds.Left:=Value;
  end;
  SetBounds(Value, FTop, FWidth, FHeight);
end;

{------------------------------------------------------------------------------
  TControl SetTop
------------------------------------------------------------------------------}
procedure TControl.SetTop(Value: Integer);
begin
  {$IFDEF CHECK_POSITION}
  DebugLn('[TControl.SetTop] ',Name,':',ClassName,' ',Dbgs(Value));
  {$ENDIF}
  if csLoading in ComponentState then begin
    inc(FReadBounds.Bottom,Value-FReadBounds.Top);
    FReadBounds.Top:=Value;
  end;
  SetBounds(FLeft, Value, FWidth, FHeight);
end;

{------------------------------------------------------------------------------
  TControl SetWidth
------------------------------------------------------------------------------}
procedure TControl.SetWidth(Value: Integer);

  procedure CheckDesignBounds;
  begin
    // the user changed the width
    if Value<0 then
      raise Exception.Create(
        'TWinControl.SetBounds ('+DbgSName(Self)+'): Negative width '
          +dbgs(Value)+' not allowed.');
    if Value>=10000 then
      raise Exception.Create(
        'TWinControl.SetBounds ('+DbgSName(Self)+'): Width '
          +dbgs(Value)+' not allowed.');
  end;

begin
  {$IFDEF CHECK_POSITION}
  DebugLn('[TControl.SetWidth] ',Name,':',ClassName,' ',dbgs(Value));
  {$ENDIF}
  if csLoading in ComponentState then
    FReadBounds.Right:=FReadBounds.Left+Value;
  if [csDesigning,csDestroying,csLoading]*ComponentState=[csDesigning] then
    CheckDesignBounds;
  SetBounds(FLeft, FTop, Max(0,Value), FHeight);
end;

{------------------------------------------------------------------------------
  TControl SetHeight
------------------------------------------------------------------------------}
procedure TControl.SetHeight(Value: Integer);

  procedure CheckDesignBounds;
  begin
    // the user changed the height
    if Value<0 then
      raise Exception.Create(
        'TWinControl.SetHeight ('+DbgSName(Self)+'): Negative height '
          +dbgs(Value)+' not allowed.');
    if Value>=10000 then
      raise Exception.Create(
        'TWinControl.SetBounds ('+DbgSName(Self)+'): Height '
          +dbgs(Value)+' not allowed.');
  end;

begin
  {$IFDEF CHECK_POSITION}
  DebugLn('[TControl.SetHeight] ',Name,':',ClassName,' ',dbgs(Value));
  {$ENDIF}
  if csLoading in ComponentState then
    FReadBounds.Bottom:=FReadBounds.Top+Value;
  if [csDesigning,csDestroying,csLoading]*ComponentState=[csDesigning] then
    CheckDesignBounds;
  SetBounds(FLeft, FTop, FWidth, Max(0,Value));
end;

{------------------------------------------------------------------------------
  procedure TControl.SetHelpContext(const AValue: THelpContext);
------------------------------------------------------------------------------}
procedure TControl.SetHelpContext(const AValue: THelpContext);
begin
  if FHelpContext=AValue then exit;
  FHelpContext:=AValue;
end;

{------------------------------------------------------------------------------
  procedure TControl.SetHelpKeyword(const AValue: String);
------------------------------------------------------------------------------}
procedure TControl.SetHelpKeyword(const AValue: String);
begin
  if FHelpKeyword=AValue then exit;
  FHelpKeyword:=AValue;
end;

procedure TControl.SetHostDockSite(const AValue: TWinControl);
begin
  if AValue=FHostDockSite then exit;
  Dock(AValue, BoundsRect);
end;

{------------------------------------------------------------------------------
  Procedure TControl.SetParent(NewParent : TWinControl);
------------------------------------------------------------------------------}
Procedure TControl.SetParent(NewParent: TWinControl);
begin
  if FParent = NewParent then exit;
  CheckNewParent(NewParent);
  if FParent <> nil then FParent.RemoveControl(Self);
  if cfBoundsRectForNewParentValid in FControlFlags then begin
    Exclude(FControlFlags,cfBoundsRectForNewParentValid);
    BoundsRect:=BoundsRectForNewParent;
  end;
  if NewParent <> nil then NewParent.InsertControl(Self);
end;

{------------------------------------------------------------------------------
  TControl SetParentComponent
------------------------------------------------------------------------------}
Procedure TControl.SetParentComponent(NewParentComponent: TComponent);
Begin
  if (NewParentComponent is TWinControl) then
    SetParent(TWinControl(NewParentComponent));
end;

{------------------------------------------------------------------------------
  procedure TControl.SetParentColor(Value : Boolean);
------------------------------------------------------------------------------}
procedure TControl.SetParentColor(Value : Boolean);
begin
  if FParentColor <> Value then
  begin
    FParentColor := Value;
    if Assigned(FParent) and not (csReading in ComponentState) then
      Perform(CM_PARENTCOLORCHANGED, 0, 0);
  end;
end;

procedure TControl.SetParentFont(Value: Boolean);
begin
  if FParentFont <> Value then
  begin
    FParentFont := Value;
    if Assigned(FParent) and not (csReading in ComponentState) then
      ParentFontChanged;
  end;
end;

{------------------------------------------------------------------------------
  TControl SetParentShowHint
------------------------------------------------------------------------------}
Procedure TControl.SetParentShowHint(Value : Boolean);
Begin
  if FParentShowHint <> Value
  then begin
    FParentShowHint := Value;
    //Sendmessage to stop/start hints for parent
  end;
end;

{------------------------------------------------------------------------------}
{  TControl SetPopupMenu                                                                 }
{------------------------------------------------------------------------------}
procedure TControl.SetPopupMenu(Value: TPopupMenu);
begin
  FPopupMenu :=  Value;
{    If Value <> nil then
  begin

  end;
}
end;

{------------------------------------------------------------------------------}
{  TControl WMDragStart
}
{------------------------------------------------------------------------------}
Procedure TControl.WMDragStart(Var Message: TLMessage);
Begin
  //do this here?
  BeginDrag(true);
end;


{------------------------------------------------------------------------------}
{  TControl WMMouseMove
}
{------------------------------------------------------------------------------}
Procedure TControl.WMMouseMove(Var Message: TLMMouseMove);
Begin
  {$IFDEF VerboseMouseBugfix}
  DebugLn('[TControl.WMMouseMove] ',Name,':',ClassName,' ',Message.XPos,',',Message.YPos);
  {$ENDIF}
  DoBeforeMouseMessage;
  if not (csNoStdEvents in ControlStyle)
  then with Message do
    MouseMove(KeystoShiftState(Keys), XPos, YPos);
End;

{------------------------------------------------------------------------------}
{  TControl MouseDown
}
{------------------------------------------------------------------------------}

Procedure TControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  P: TPoint;
begin
  if (Button in [mbLeft,mbRight]) and Dragging and (DragObject<>nil) then begin
    P:=ClientToScreen(Point(X,Y));
    DragObject.MouseDown(Button,Shift,P.X,P.Y);
  end;
  if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X,Y);
end;

{------------------------------------------------------------------------------
  TControl MouseMove

------------------------------------------------------------------------------}
Procedure TControl.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
  DragObjectDragging : Boolean;
begin
  if DragObject <> nil then
    DragObjectDragging := true else
    DragObjectDragging := false;
  if DragObjectDragging then begin
    P:=ClientToScreen(Point(X,Y));
    DragObject.MouseMove(Shift,P.X,P.Y);
  end;
  if Assigned(FOnMouseMove) then FOnMouseMove(Self, Shift, X,Y);
end;

{------------------------------------------------------------------------------
  TControl MouseUp
------------------------------------------------------------------------------}
Procedure TControl.MouseUp(Button: TMouseButton; Shift:TShiftState;
  X, Y: Integer);
var
  P: TPoint;
  DragObjectDragging : Boolean;
begin
  if DragObject <> nil then
    DragObjectDragging := true else
    DragObjectDragging := false;
    if (Button in [mbLeft,mbRight]) and DragObjectDragging then begin
    P:=ClientToScreen(Point(X,Y));
    DragObject.MouseUp(Button,Shift,P.X,P.Y);
  end;
  if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, X,Y);
end;

procedure TControl.MouseEnter;
begin
  //DebugLn('TControl.MouseEnter ',Name,':',ClassName,' ',Assigned(FOnMouseEnter));
  if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;

procedure TControl.MouseLeave;
begin
  //DebugLn('TControl.MouseLeave ',Name,':',ClassName,' ',Assigned(FOnMouseLeave));
  if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;

{------------------------------------------------------------------------------
  procedure TControl.CaptureChanged;

------------------------------------------------------------------------------}
procedure TControl.CaptureChanged;
begin
  if Dragging and (DragObject<>nil) then DragObject.CaptureChanged(Self);
end;

{------------------------------------------------------------------------------
  TControl SetShowHint

------------------------------------------------------------------------------}
procedure TControl.SetShowHint(Value : Boolean);
begin
  if FShowHint <> Value then
  begin
    FShowHint := Value;
    FParentShowHint := False;
    Perform(CM_SHOWHINTCHANGED, 0, 0);
  end;
end;

{------------------------------------------------------------------------------
  TControl SetVisible

------------------------------------------------------------------------------}
procedure TControl.SetVisible(Value : Boolean);
begin
  if FVisible <> Value then begin
    VisibleChanging;
    FVisible := Value;
    try
      Perform(CM_VISIBLECHANGED, WParam(Ord(Value)), 0);
      Include(FControlFlags,cfRequestAlignNeeded);
      if FVisible then
        AdjustSize;
      if cfRequestAlignNeeded in FControlFlags then
        RequestAlign;
    finally
      VisibleChanged;
    end;
  end;
  if (csLoading in ComponentState) then
    ControlState:=ControlState+[csVisibleSetInLoading];
end;

{------------------------------------------------------------------------------
       TControl.SetZOrder

------------------------------------------------------------------------------}
procedure TControl.SetZOrder(Topmost: Boolean);
const
  POSITION: array[Boolean] of Integer = (0, MaxInt);
begin
  if FParent = nil then exit;
  FParent.SetChildZPosition(Self, POSITION[TopMost]);
end;


{------------------------------------------------------------------------------
  function TControl.HandleObjectShouldBeVisible
------------------------------------------------------------------------------}
function TControl.HandleObjectShouldBeVisible: boolean;
begin
  Result:=(Visible
          or ((csDesigning in ComponentState)
              and not (csNoDesignVisible in ControlStyle)));
end;

{------------------------------------------------------------------------------
  procedure TControl Hide
------------------------------------------------------------------------------}
procedure TControl.Hide;
begin
  Visible := False;
end;

{------------------------------------------------------------------------------
  function TControl.ParentDestroyingHandle: boolean;
  
  Returns whether any parent is destroying it's handle (and its children's)
 ------------------------------------------------------------------------------}
function TControl.ParentDestroyingHandle: boolean;
var
  CurControl: TControl;
begin
  Result:=true;
  CurControl:=Self;
  while CurControl<>nil do begin
    if csDestroyingHandle in CurControl.ControlState then
      exit;
    CurControl:=CurControl.Parent;
  end;
  Result:=false;
end;

{------------------------------------------------------------------------------
  function TControl.ParentHandlesAllocated: boolean;
------------------------------------------------------------------------------}
function TControl.ParentHandlesAllocated: boolean;
begin
  Result:=(Parent<>nil) and (Parent.ParentHandlesAllocated);
end;

{------------------------------------------------------------------------------
  procedure TControl.InitiateAction;
------------------------------------------------------------------------------}
procedure TControl.InitiateAction;
begin
  if ActionLink <> nil then ActionLink.Update;
end;

{------------------------------------------------------------------------------
  procedure TControl.Dock(NewDockSite: TWinControl; ARect: TRect);
  
  Docks this control into NewDockSite at ARect.
------------------------------------------------------------------------------}
procedure TControl.Dock(NewDockSite: TWinControl; ARect: TRect);

  procedure RaiseAlreadyDocking;
  begin
    RaiseGDBException('TControl.Dock '+Name+':'+ClassName+' csDocking in FControlState');
  end;

var
  OldHostDockSite: TWinControl;
begin
  if (csDocking in FControlState) then
    RaiseAlreadyDocking;
    
  // dock
  Include(FControlState, csDocking);
  try
    OldHostDockSite:=HostDockSite;

    if OldHostDockSite<>NewDockSite then begin
      // HostDockSite will change -> prepare
      if (OldHostDockSite<>nil) and (OldHostDockSite.FDockClients<>nil) then
        OldHostDockSite.FDockClients.Remove(Self);
      if (NewDockSite<>nil) and (NewDockSite.FDockClients<>nil) then
        NewDockSite.FDockClients.Add(Self);
    end;

    //debugln('TControl.Dock A ',DbgSName(Self));

    DoDock(NewDockSite,ARect);
    
    if FHostDockSite<>NewDockSite then
    begin
      // HostDockSite has changed -> commit
      OldHostDockSite := FHostDockSite;
      FHostDockSite := NewDockSite;
      if NewDockSite<>nil then NewDockSite.DoAddDockClient(Self,ARect);
      if OldHostDockSite<>nil then OldHostDockSite.DoRemoveDockClient(Self);
    end;
  finally
    Exclude(FControlState, csDocking);
  end;
end;

{------------------------------------------------------------------------------
  function TControl.ManualDock(NewDockSite: TWinControl; DropControl: TControl;
    ControlSide: TAlign): Boolean;

  Docks this control to DropControl or on NewDockSite.
  If DropControl is not nil, ControlSide defines on which side of DropControl
  this control is docked. (alNone,alClient for stacked in pages). DropControl
  will become part of a TDockManager.
  If DropControl is nil, then DropControl becomes a normal child of NewDockSite
  and ControlSide is ignored.
------------------------------------------------------------------------------}
function TControl.ManualDock(NewDockSite: TWinControl; DropControl: TControl;
  ControlSide: TAlign; KeepDockSiteSize: Boolean): Boolean;
var
  NewBounds: TRect;
  DockObject: TDragDockObject;
  NewPosition: TPoint;
begin
  if (NewDockSite=nil) then begin
    // undock / float this control
    // float the control at the same screen position
    if HostDockSiteManagerAvailable(HostDockSite) then begin
      HostDockSite.DockManager.GetControlBounds(Self,NewBounds);
      NewBounds.TopLeft:=HostDockSite.ClientToScreen(NewBounds.TopLeft);
    end else begin
      NewBounds.TopLeft:=ControlOrigin;
    end;
    NewBounds := Bounds(NewBounds.Left,NewBounds.Top,UndockWidth,UndockHeight);
    DebugLn('TControl.ManualDock ',Name,' NewDockSite=nil HostDockSiteManagerAvailable=',dbgs(HostDockSiteManagerAvailable(HostDockSite)),' NewBounds=',dbgs(NewBounds));
    Result := ManualFloat(NewBounds);
  end
  else
  begin
    // dock / unfloat this control
    CalculateDockSizes;
    
    Result := (HostDockSite=nil);
    if not Result then begin
      // undock from old HostSite
      // - this only undocks from the DockManager
      // - this control still uses the DockSite as parent control
      DebugLn('TControl.ManualDock UNDOCKING ',Name);
      Result:=HostDockSite.DoUndock(NewDockSite,Self);
    end;
    
    if Result then begin
      DebugLn('TControl.ManualDock DOCKING ',Name);
      // create TDragDockObject for docking parameters
      DockObject := TDragDockObject.Create(Self);
      try
        // get current screen coordinates
        NewPosition:=ControlOrigin;
        // initialize DockObject
        with DockObject do begin
          FDragTarget := NewDockSite;
          FDropAlign := ControlSide;
          FDropOnControl := DropControl;
          FIncreaseDockArea := not KeepDockSiteSize;
          DockRect := Bounds(NewPosition.X,NewPosition.Y,Width,Height);
        end;
        // map from screen coordinates to new HostSite coordinates
        NewPosition:=NewDockSite.ScreenToClient(NewPosition);
        // DockDrop
        DebugLn('TControl.ManualDock DOCKDROP ',Name,' DockRect=',dbgs(DockObject.DockRect),' NewPos=',dbgs(NewPosition));
        NewDockSite.DockDrop(DockObject,NewPosition.X,NewPosition.Y);
      finally
        DockObject.Free;
      end;
    end;
  end;
end;

{------------------------------------------------------------------------------
  function TControl.ManualFloat(TheScreenRect: TRect;
    KeepDockSiteSize: Boolean = true): Boolean;

  Undock and float.
  Float means here: create the floating dock site and dock this control into it.
  Exception: Forms do not need float dock sites and float on their own.
------------------------------------------------------------------------------}
function TControl.ManualFloat(TheScreenRect: TRect;
  KeepDockSiteSize: Boolean): Boolean;
var
  FloatHost: TWinControl;
begin
  // undock from old floating host dock site
  Result := (HostDockSite=nil)
            or HostDockSite.DoUndock(nil,Self,KeepDockSiteSize);
  // create new float dock site and dock this control into it.
  if Result then begin
    FloatHost := CreateFloatingDockSite(TheScreenRect);
    //debugln('TControl.ManualFloat A '+Name,':',ClassName,' ',dbgs(TheScreenRect),' FloatHost=',dbgs(FloatHost<>nil));
    if FloatHost<>nil then  begin
      // => dock this control into it.
      FloatHost.Visible := true;
      Dock(FloatHost,Rect(0,0,FloatHost.ClientWidth,FloatHost.ClientHeight))
    end else
      Dock(nil,TheScreenRect);
  end;
end;

{------------------------------------------------------------------------------
  function TControl.ReplaceDockedControl(Control: TControl;
    NewDockSite: TWinControl; DropControl: TControl; ControlSide: TAlign
    ): Boolean;

------------------------------------------------------------------------------}
function TControl.ReplaceDockedControl(Control: TControl;
  NewDockSite: TWinControl; DropControl: TControl; ControlSide: TAlign
  ): Boolean;
var
  OldDockSite: TWinControl;
begin
  Result := False;

  OldDockSite := Control.HostDockSite;
  if (OldDockSite<>nil) and (not HostDockSiteManagerAvailable(OldDockSite)) then
    exit;

  if OldDockSite <> nil then
    OldDockSite.DockManager.SetReplacingControl(Control);
  try
    ManualDock(OldDockSite,nil,alTop);
  finally
    if OldDockSite <> nil then
      OldDockSite.DockManager.SetReplacingControl(nil);
  end;
  Result:=Control.ManualDock(NewDockSite,DropControl,ControlSide);
end;

procedure TControl.AddHandlerOnResize(const OnResizeEvent: TNotifyEvent;
  AsLast: boolean);
begin
  AddHandler(chtOnResize,TMethod(OnResizeEvent),AsLast);
end;

procedure TControl.RemoveHandlerOnResize(const OnResizeEvent: TNotifyEvent);
begin
  RemoveHandler(chtOnResize,TMethod(OnResizeEvent));
end;

procedure TControl.AddHandlerOnChangeBounds(
  const OnChangeBoundsEvent: TNotifyEvent; AsLast: boolean);
begin
  AddHandler(chtOnChangeBounds,TMethod(OnChangeBoundsEvent),AsLast);
end;

procedure TControl.RemoveHandlerOnChangeBounds(
  const OnChangeBoundsEvent: TNotifyEvent);
begin
  RemoveHandler(chtOnChangeBounds,TMethod(OnChangeBoundsEvent));
end;

procedure TControl.AddHandlerOnVisibleChanging(
  const OnVisibleChangingEvent: TNotifyEvent; AsLast: boolean);
begin
  AddHandler(chtOnVisibleChanging,TMethod(OnVisibleChangingEvent));
end;

procedure TControl.RemoveHandlerOnVisibleChanging(
  const OnVisibleChangingEvent: TNotifyEvent);
begin
  RemoveHandler(chtOnVisibleChanging,TMethod(OnVisibleChangingEvent));
end;

procedure TControl.AddHandlerOnVisibleChanged(
  const OnVisibleChangedEvent: TNotifyEvent; AsLast: boolean);
begin
  AddHandler(chtOnVisibleChanged,TMethod(OnVisibleChangedEvent));
end;

procedure TControl.RemoveHandlerOnVisibleChanged(
  const OnVisibleChangedEvent: TNotifyEvent);
begin
  RemoveHandler(chtOnVisibleChanged,TMethod(OnVisibleChangedEvent));
end;

procedure TControl.RemoveAllHandlersOfObject(AnObject: TObject);
var
  HandlerType: TControlHandlerType;
begin
  inherited RemoveAllHandlersOfObject(AnObject);
  for HandlerType:=Low(TControlHandlerType) to High(TControlHandlerType) do
    FControlHandlers[HandlerType].RemoveAllMethodsOfObject(AnObject);
end;

{------------------------------------------------------------------------------
  Method: TControl.GetTextBuf
  Params:  None
  Returns: Nothing

  Copies max bufsize-1 chars to buffer
 ------------------------------------------------------------------------------}
function TControl.GetTextBuf(Buffer: PChar; BufSize: Integer): Integer;
var
  S: string;
begin
  if BufSize <= 0 then Exit;

  S := RealGetText;
  if Length(S) >= BufSize
  then begin
    StrPLCopy(Buffer, S, BufSize - 1);
    Result := BufSize - 1;
  end 
  else begin
    StrPCopy(Buffer, S);
    Result := length(S);
  end;
end;

{------------------------------------------------------------------------------
  Method: TControl.SetTextBuf
  Params:  None
  Returns: Nothing
  
 ------------------------------------------------------------------------------}
procedure TControl.SetTextBuf(Buffer: PChar);
begin
  RealSetText(Buffer);
end;

{------------------------------------------------------------------------------}
{  TControl RealSetText                                                            }
{------------------------------------------------------------------------------}
procedure TControl.RealSetText(const Value: TCaption);
begin
  if FCaption = Value then Exit;
  FCaption := Value;
  TextChanged;
end;

procedure TControl.TextChanged;
begin
end;

function TControl.GetCachedText(var CachedText: TCaption): boolean;
begin
  CachedText := FCaption;
  Result:= true;
end;

{------------------------------------------------------------------------------
  TControl SetText
------------------------------------------------------------------------------}
procedure TControl.SetText(const Value: TCaption);
begin
  //if CompareText(Name,'TextToFindComboBox')=0 then
  //  debugln('TControl.SetText A ',DbgSName(Self),' GetText="',GetText,'" Value="',Value,'" FCaption="',FCaption,'"');
  if GetText = Value then Exit;
  
  // Check if SetTextBuf is overridden, otherwise
  // we can call RealSetText directly
  if TMethod(@Self.SetTextBuf).Code = Pointer(@TControl.SetTextBuf)
  then begin
    RealSetText(Value);
  end
  else begin
    // Bummer, we have to do it the compatible way.
    DebugLn('Note: SetTextBuf is overridden for: ', Classname);
    SetTextBuf(PChar(Value));
  end;
  //if CompareText(ClassName,'TMEMO')=0 then
  //  debugln('TControl.SetText END ',DbgSName(Self),' FCaption="',FCaption,'"');
end;

{------------------------------------------------------------------------------
  TControl Update
------------------------------------------------------------------------------}
procedure TControl.Update;
begin
  if Parent<>nil then Parent.Update;
end;

{------------------------------------------------------------------------------
  Method: TControl.Destroy
  Params:  None
  Returns: Nothing

  Destructor for the class.
 ------------------------------------------------------------------------------}
destructor TControl.Destroy;
var
  HandlerType: TControlHandlerType;
  Side: TAnchorKind;
  i: Integer;
  CurAnchorSide: TAnchorSide;
begin
  //DebugLn('[TControl.Destroy] A ',Name,':',ClassName);
  Application.ControlDestroyed(Self);
  SetParent(nil);
  FreeThenNil(FActionLink);
  for Side:=Low(FAnchorSides) to High(FAnchorSides) do
    FreeThenNil(FAnchorSides[Side]);
  FreeThenNil(FBorderSpacing);
  FreeThenNil(FConstraints);
  if fAnchoredControls<>nil then begin
    for i:=0 to fAnchoredControls.Count-1 do
      for Side:=Low(TAnchorKind) to High(TAnchorKind) do begin
        CurAnchorSide:=AnchoredControls[i].AnchorSide[Side];
        if CurAnchorSide.FControl=Self then
          CurAnchorSide.FControl:=nil;
      end;
    FreeThenNil(fAnchoredControls);
  end;
  FreeThenNil(FFont);
  //DebugLn('[TControl.Destroy] B ',DbgSName(Self));
  inherited Destroy;
  //DebugLn('[TControl.Destroy] END ',DbgSName(Self));
  for HandlerType:=Low(TControlHandlerType) to High(TControlHandlerType) do
    FreeThenNil(FControlHandlers[HandlerType]);
end;

{------------------------------------------------------------------------------
  Method: TControl.Create
  Params:  None
  Returns: Nothing

  Contructor for the class.
 ------------------------------------------------------------------------------}
constructor TControl.Create(TheOwner: TComponent);
var
  Side: TAnchorKind;
begin
  //if AnsiCompareText(ClassName,'TSpeedButton')=0 then
  //  DebugLn('TControl.Create START ',Name,':',ClassName);
  inherited Create(TheOwner);

  // no csOpaque: delphi compatible, win32 themes notebook depend on it
  // csOpaque means entire client area will be drawn 
  // (most controls are semi-transparent)
  FControlStyle := [csCaptureMouse, csClickEvents, csSetCaption, csDoubleClicks];
  FConstraints:= TSizeConstraints.Create(Self);
  FBorderSpacing:=TControlBorderSpacing.Create(Self);
  for Side:=Low(FAnchorSides) to High(FAnchorSides) do
    FAnchorSides[Side]:=TAnchorSide.Create(Self,Side);

  FAnchors := [akLeft,akTop];
  FAlign := alNone;
  FColor := clWindow;
  FVisible := true;
  FParentShowHint := True;
  FParentColor := True;
  FWindowProc := @WndProc;
  FCursor := crDefault;
  FFont := TFont.Create;
  FFont.OnChange := @FontChanged;
  FIsControl := False;
  FEnabled := True;
  FHelpType := htContext;
  FDragCursor := crDrag;
  FFloatingDockSiteClass := TCustomDockForm;
  //DebugLn('TControl.Create END ',Name,':',ClassName);
end;

{------------------------------------------------------------------------------
  Method:  TControl.GetDeviceContext
  Params:  WindowHandle: the windowhandle of this control
  Returns: a Devicecontext

  Get the devicecontext of the parent Wincontrol for this Control.
 ------------------------------------------------------------------------------}
function TControl.GetDeviceContext(var WindowHandle: HWnd): HDC;
begin
  if Parent = nil
  then raise EInvalidOperation.CreateFmt('Control ''%s'' has no parent window', [Name]);

  Result := Parent.GetDeviceContext(WindowHandle);
  MoveWindowOrgEx(Result, Left, Top);
  IntersectClipRect(Result, 0, 0, Width, Height);
end;

{------------------------------------------------------------------------------
  Method:  TControl.HasParent
  Params:
  Returns: True - the item has a parent responsible for streaming

  This function will be called during streaming to decide if a component has
  to be streamed by it's owner or parent.
 ------------------------------------------------------------------------------}
function TControl.HasParent : Boolean;
begin
  Result := (FParent <> nil);
end;

{------------------------------------------------------------------------------
  function TControl.IsParentOf(AControl: TControl): boolean;

 ------------------------------------------------------------------------------}
function TControl.IsParentOf(AControl: TControl): boolean;
begin
  Result:=false;
  while AControl<>nil do begin
    AControl:=AControl.Parent;
    if Self=AControl then begin
      Result:=true;
      exit;
    end;
  end;
end;

{------------------------------------------------------------------------------
  Method:  TControl.SendToBack
  Params:  None
  Returns: Nothing

  Puts a control back in Z-order behind all other controls
 ------------------------------------------------------------------------------}
procedure TControl.SendToBack;
begin
  SetZOrder(false);
end;

{------------------------------------------------------------------------------
  procedure TControl.AnchorToNeighbour(Side: TAnchorKind; Space: integer;
    Sibling: TControl);

  Setup AnchorSide to anchor one side to the side of a neighbour sibling.
  For example Right side to Left side, or Top side to Bottom.
 ------------------------------------------------------------------------------}
procedure TControl.AnchorToNeighbour(Side: TAnchorKind; Space: integer;
  Sibling: TControl);
begin
  case Side of
  akLeft: BorderSpacing.Left:=Space;
  akTop: BorderSpacing.Top:=Space;
  akRight: BorderSpacing.Right:=Space;
  akBottom: BorderSpacing.Bottom:=Space;
  end;
  AnchorSide[Side].Side:=DefaultSideForAnchorKind[Side];
  AnchorSide[Side].Control:=Sibling;
  Anchors:=Anchors+[Side];
end;

procedure TControl.AnchorParallel(Side: TAnchorKind; Space: integer;
  Sibling: TControl);
begin
  case Side of
  akLeft: BorderSpacing.Left:=Space;
  akTop: BorderSpacing.Top:=Space;
  akRight: BorderSpacing.Right:=Space;
  akBottom: BorderSpacing.Bottom:=Space;
  end;
  case Side of
  akLeft: AnchorSide[Side].Side:=asrLeft;
  akTop: AnchorSide[Side].Side:=asrTop;
  akRight: AnchorSide[Side].Side:=asrRight;
  akBottom: AnchorSide[Side].Side:=asrBottom;
  end;
  AnchorSide[Side].Control:=Sibling;
  Anchors:=Anchors+[Side];
end;

{------------------------------------------------------------------------------
  procedure TControl.AnchorHorizontalCenterTo(Sibling: TControl);

  Setup AnchorSide to center the control horizontally relative to a sibling.
 ------------------------------------------------------------------------------}
procedure TControl.AnchorHorizontalCenterTo(Sibling: TControl);
begin
  AnchorSide[akLeft].Side:=asrCenter;
  AnchorSide[akLeft].Control:=Sibling;
  Anchors:=Anchors+[akLeft]-[akRight];
end;

{------------------------------------------------------------------------------
  procedure TControl.AnchorVerticalCenterTo(Sibling: TControl);

  Setup AnchorSide to center the control vertically relative to a sibling.
 ------------------------------------------------------------------------------}
procedure TControl.AnchorVerticalCenterTo(Sibling: TControl);
begin
  AnchorSide[akTop].Side:=asrCenter;
  AnchorSide[akTop].Control:=Sibling;
  Anchors:=Anchors+[akTop]-[akBottom];
end;

procedure TControl.AnchorToCompanion(Side: TAnchorKind; Space: integer;
  Sibling: TControl; FreeCompositeSide: boolean);

  procedure AnchorCompanionSides(
    ResizeSide,// the side of this control, where Sibling is touched and moved
    OppositeResizeSide, // opposite of ResizeSide
    FixedSide1,// the first non moving side
    FixedSide2:// the second non moving side
      TAnchorKind);
  begin
    if not (OppositeAnchor[Side] in Anchors) then
      AnchorSide[OppositeResizeSide].Control:=nil;
    AnchorToNeighbour(ResizeSide,0,Sibling);
    AnchorParallel(FixedSide1,0,Sibling);
    AnchorParallel(FixedSide2,0,Sibling);
    BorderSpacing.SetSpace(ResizeSide,Space);
  end;

var
  NewAnchors: TAnchors;
begin
  // anchor all. Except for the opposite side.
  NewAnchors:=[akLeft,akTop,akRight,akBottom];
  if FreeCompositeSide or (not (OppositeAnchor[Side] in Anchors)) then
    Exclude(NewAnchors,OppositeAnchor[Side]);
  Anchors:=NewAnchors;

  case Side of
  akLeft:   AnchorCompanionSides(akLeft,akRight,akTop,akBottom);
  akRight:  AnchorCompanionSides(akRight,akLeft,akTop,akBottom);
  akTop:    AnchorCompanionSides(akTop,akBottom,akLeft,akRight);
  akBottom: AnchorCompanionSides(akBottom,akTop,akLeft,akRight);
  end;
end;

function TControl.AnchoredControlCount: integer;
begin
  if fAnchoredControls=nil then
    Result:=0
  else
    Result:=fAnchoredControls.Count;
end;

procedure TControl.SetInitialBounds(aLeft, aTop, aWidth, aHeight: integer);
begin
  //DebugLn('TControl.SetInitialBounds A ',Name,':',ClassName,' ',aLeft,',',aTop,',',aWidth,',',aHeight);
  if (csLoading in ComponentState)
  or ((Owner<>nil) and (csLoading in Owner.ComponentState)) then
    exit;
  //DebugLn('TControl.SetInitialBounds B ',Name,':',ClassName,' ',aLeft,',',aTop,',',aWidth,',',aHeight);
  SetBounds(aLeft,aTop,aWidth,aHeight);
end;

procedure TControl.SetBoundsKeepBase(aLeft, aTop, aWidth, aHeight: integer;
  Lock: boolean);
begin
  if Lock then LockBaseBounds;
  try
    SetBounds(aLeft, aTop, aWidth, aHeight);
  finally
    if Lock then UnlockBaseBounds;
  end;
end;

{------------------------------------------------------------------------------
  procedure TControl.GetPreferredSize(
    var PreferredWidth, PreferredHeight: integer; Raw: boolean);
    
  Returns the default/preferred width and height for a control, which is used
  by the LCL autosizing algorithms as default size. Only positive values are
  valid. Negative or 0 are treated as undefined and the LCL uses other sizes
  instead.
  If not Raw then the values will be adjusted by the constraints and undefined
  values will be replaced by the current width and height.
  TWinControl overrides this and asks the interface for theme dependent values.
  See TWinControl.GetPreferredSize for more information.
 ------------------------------------------------------------------------------}
procedure TControl.GetPreferredSize(var PreferredWidth,
  PreferredHeight: integer; Raw: boolean);
begin
  if not (cfPreferredSizeValid in FControlFlags) then begin
    CalculatePreferredSize(FPreferredWidth,FPreferredHeight);
    Include(FControlFlags,cfPreferredSizeValid);
  end;
  PreferredWidth:=FPreferredWidth;
  PreferredHeight:=FPreferredHeight;

  if not Raw then begin
    // use Width and Height for undefined preferred size
    if PreferredWidth<=0 then PreferredWidth:=Width;
    if PreferredHeight<=0 then PreferredHeight:=Height;
    
    // if this control is aligned adjust PreferredWidth and or PreferredHeight
    if Parent<>nil then begin
      if AnchorAlign[Align]*[akLeft,akRight]=[akLeft,akRight] then begin
        // the control will be expanded to maximum width
        // -> use the current width, which is or will be eventually set by the
        //    aligning code
        PreferredWidth:=Width;
      end;
      if AnchorAlign[Align]*[akTop,akBottom]=[akTop,akBottom] then begin
        // the control will be expanded to maximum height
        // -> use the current height, which is or will be eventually set by the
        //    aligning code
        PreferredHeight:=Height;
      end;
    end;
    
    // apply constraints
    PreferredWidth:=Constraints.MinMaxWidth(PreferredWidth);
    PreferredHeight:=Constraints.MinMaxHeight(PreferredHeight);
  end;
end;

procedure TControl.CNPreferredSizeChanged;
begin
  InvalidatePreferredSize;
end;

{------------------------------------------------------------------------------
  procedure TControl.InvalidatePreferredSize;

  Invalidate the cache of the preferred size of this and all parent controls.
 ------------------------------------------------------------------------------}
procedure TControl.InvalidatePreferredSize;
var
  AControl: TControl;
begin
  AControl:=Self;
  while AControl<>nil do begin
    Exclude(AControl.FControlFlags,cfPreferredSizeValid);
    AControl:=AControl.Parent;
  end;
end;

function TControl.GetBoundsDependingOnParent(WithNormalAnchors: Boolean
  ): TAnchors;
var
  a: TAnchorKind;
begin
  Result:=[];
  if Parent=nil then exit;

  if (Anchors*[akLeft,akRight]=[]) then begin
    // center horizontally
    Result:=Result+[akLeft,akRight];
  end;

  for a:=Low(TAnchorKind) to High(TAnchorKind) do begin
    if (a in Anchors) then begin
      if WithNormalAnchors
      or (AnchorSide[a].Control=Parent) then begin
        // side anchored
        Include(Result,a);
      end;
    end;
  end;
end;

procedure TControl.DisableAutoSizing;
begin
  inc(FAutoSizingLockCount);
end;

procedure TControl.EnableAutoSizing;
begin
  if FAutoSizingLockCount<=0 then RaiseGDBException('TControl.EnableAutoSizing');
  dec(FAutoSizingLockCount);
  if FAutoSizingLockCount=0 then begin
    if cfAutoSizeNeeded in FControlFlags then
      AdjustSize;
  end;
end;

{------------------------------------------------------------------------------
  Method: TControl.WMWindowPosChanged
  Params:   Msg: The message
  Returns:  nothing

  event handler.

 ------------------------------------------------------------------------------}
procedure TControl.WMWindowPosChanged(var Message: TLMWindowPosChanged);
begin
  // Do not handle this message and leave it to WMSize and WMMove
  Message.Result:= 0;
end;

{------------------------------------------------------------------------------
  Method: TControl.WMSize
  Params:   Message : TLMSize
  Returns:  nothing

  Event handler for LMSize messages.
  Overriden by TWinControl.WMSize.
 ------------------------------------------------------------------------------}
procedure TControl.WMSize(Var Message : TLMSize);
begin
  {$IFDEF CHECK_POSITION}
  DebugLn('[TControl.WMSize] Name=',Name,':',ClassName,' Message.Width=',DbgS(Message.Width),' Message.Height=',DbgS(Message.Height),' Width=',DbgS(Width),' Height=',DbgS(Height));
  {$ENDIF}
  //Assert(False, Format('Trace:[TWinControl.WMSize] %s', [ClassName]));

  SetBoundsKeepBase(Left,Top,Message.Width,Message.Height,Parent<>nil);
end;

{------------------------------------------------------------------------------
  Method: TControl.WMMove
  Params:   Msg: The message
  Returns:  nothing

  event handler.

  Message.MoveType=0 is the default, all other values will force a RequestAlign.
 ------------------------------------------------------------------------------}
procedure TControl.WMMove(var Message: TLMMove);
begin
  {$IFDEF CHECK_POSITION}
  DebugLn('[TControl.WMMove] Name=',Name,':',ClassName,' Message.XPos=',DbgS(Message.XPos),' Message.YPos=',DbgS(Message.YPos),' OldLeft=',DbgS(Left),' OldTop=',DbgS(Top));
  {$ENDIF}
  { Just sync the coordinates }
  SetBoundsKeepBase(Message.XPos, Message.YPos, Width, Height,Parent<>nil);
end;


{$IFDEF ASSERT_IS_ON}
  {$UNDEF ASSERT_IS_ON}
  {$C-}
{$ENDIF}

// included by controls.pp