added docking properties

git-svn-id: trunk@4316 -

lcl/controls.pp

@@ -159,6 +159,7 @@ const
 type
   TWinControl = class;
   TControl = class;
+  TWinControlClass = class of TWinControl;
 
   TDate = type TDateTime;
   TTime = type TDateTime;
@@ -323,7 +324,9 @@ type
 
   { TDragObject }
           
-  TDragState = (dsDragEnter, dsDragLEave, dsDragMove);
+  TDragObject = class;
+
+  TDragState = (dsDragEnter, dsDragLeave, dsDragMove);
   TDragMode = (dmManual , dmAutomatic);
   TDragKind = (dkDrag, dkDock);
   TDragMessage = (dmDragEnter, dmDragLeave, dmDragMove, dmDragDrop,
@@ -331,8 +334,9 @@ type
   TDragOverEvent = Procedure(Sender, Source: TObject;
                X,Y : Integer; State: TDragState; Var Accept: Boolean) of Object;
   TDragDropEvent = Procedure(Sender, Source: TObject; X,Y: Integer) of Object;
+  TStartDragEvent = Procedure(Sender: TObject; DragObject: TDragObject) of Object;
+  TEndDragEvent = Procedure(Sender, Target: TObject; X,Y: Integer) of Object;
   
-  TDragObject = class;
 
   PDragRec = ^TDragRec;
   TDragRec = record
@@ -357,6 +361,7 @@ type
     FDragHandle: HWND;
     FDragPos: TPoint;
     FDragTargetPos: TPoint;
+    FDropped: Boolean;
     FMouseDeltaX: Double;
     FMouseDeltaY: Double;
     FCancelling: Boolean;
@@ -378,12 +383,15 @@ type
     property DragPos: TPoint read FDragPos write FDragPos;
     property DragTargetPos: TPoint read FDragTargetPos write FDragTargetPos;
     property DragTarget: Pointer read FDragTarget write FDragTarget;
+    property Dropped: Boolean read FDropped;
     property MouseDeltaX: Double read FMouseDeltaX;
     property MouseDeltaY: Double read FMouseDeltaX;
   end;
 
-  TStartDragEvent = Procedure(Sender : TObject; DragObject: TDragObject) of Object;
+  TDragObjectClass = class of TDragObject;
-  TEndDragEvent = Procedure(Sender , Target: TObject; X,Y : Integer) of Object;
+
+
+  { TBaseDragControlObject }
 
   TBaseDragControlObject = class(TDragObject)
   private
@@ -396,7 +404,64 @@ type
     property Control: TControl read FControl write FControl;
   end;
   
+  
+  { TDragControlObject }
+
   TDragControlObject = class(TBaseDragControlObject)
+  protected
+    function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
+    function GetDragImages: TDragImageList; override;
+  public
+    procedure HideDragImage; override;
+    procedure ShowDragImage; override;
+  end;
+  
+  
+  { TDragDockObject }
+  
+  TDragDockObject = class;
+  
+  TDockOrientation = (
+    doNoOrient,   // zone contains a TControl and no child zones.
+    doHorizontal, // zone's children are stacked top-to-bottom.
+    doVertical    // zone's children are arranged left-to-right.
+    );
+  TDockDropEvent = procedure(Sender: TObject; Source: TDragDockObject;
+                             X, Y: Integer) of object;
+  TDockOverEvent = procedure(Sender: TObject; Source: TDragDockObject;
+                             X, Y: Integer; State: TDragState;
+                             var Accept: Boolean) of object;
+  TUnDockEvent = procedure(Sender: TObject; Client: TControl;
+                          NewTarget: TWinControl; var Allow: Boolean) of object;
+  TStartDockEvent = procedure(Sender: TObject;
+                              var DragObject: TDragDockObject) of object;
+
+  TDragDockObject = class(TBaseDragControlObject)
+  private
+    FBrush: TBrush;
+    FDockRect: TRect;
+    FDropAlign: TAlign;
+    FDropOnControl: TControl;
+    //FEraseDockRect: TRect;
+    FFloating: Boolean;
+    procedure SetBrush(Value: TBrush);
+  protected
+    procedure AdjustDockRect(ARect: TRect); virtual;
+    procedure DrawDragDockImage; virtual;
+    procedure EndDrag(Target: TObject; X, Y: Integer); override;
+    procedure EraseDragDockImage; virtual;
+    function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
+    function GetFrameWidth: Integer; virtual;
+  public
+    constructor Create(AControl: TControl); override;
+    destructor Destroy; override;
+    procedure Assign(Source: TDragObject); override;
+    property Brush: TBrush read FBrush write SetBrush;
+    property DockRect: TRect read FDockRect write FDockRect;
+    property DropAlign: TAlign read FDropAlign;
+    property DropOnControl: TControl read FDropOnControl;
+    property Floating: Boolean read FFloating write FFloating;
+    property FrameWidth: Integer read GetFrameWidth;
   end;
 
 
@@ -497,10 +562,12 @@ type
     FControlStyle: TControlStyle;
     FCtl3D : Boolean;
     FCursor : TCursor;
+    FDockOrientation: TDockOrientation;
     FDragCursor : TCursor;
     FDragKind : TDragKind;
     FDragMode : TDragMode;
     FEnabled : Boolean;
+    FFloatingDockSiteClass: TWinControlClass;
     FFont: TFont;
     FHeight: Integer;
     FHelpContext: THelpContext;
@@ -518,6 +585,7 @@ type
     FLastResizeWidth: integer;
     FLeft: Integer;
     FLoadedClientSize: TPoint;
+    FLRDockWidth: Integer;
     FMouseEntered: boolean;
     FOnChangeBounds: TNotifyEvent;
     FOnClick: TNotifyEvent;
@@ -545,16 +613,25 @@ type
     FSizeLock: integer;
     FTabOrder: integer;
     FTabStop : Boolean;
+    FTBDockHeight: Integer;
     FText : TCaption;
     FTop: Integer;
+    FUndockHeight: Integer;
+    FUndockWidth: Integer;
     FVisible: Boolean;
     FWidth: Integer;
     FWindowProc: TWndMethod;
     function GetBoundsRect : TRect;
     function GetClientHeight: Integer;
     function GetClientWidth: Integer;
+    function GetFloating: Boolean;
+    function GetFloatingDockSiteClass: TWinControlClass;
+    function GetLRDockWidth: Integer;
     function GetMouseCapture : Boolean;
+    function GetTBDockHeight: Integer;
     Function GetTabOrder: TTabOrder;
+    function GetUndockHeight: Integer;
+    function GetUndockWidth: Integer;
     function IsAnchorsStored: boolean;
     function IsCaptionStored : Boolean;
     function IsHelpContextStored: boolean;
@@ -576,6 +653,7 @@ type
     procedure SetHeight(Value: Integer);
     procedure SetHelpContext(const AValue: THelpContext);
     procedure SetHelpKeyword(const AValue: String);
+    procedure SetHostDockSite(const AValue: TWinControl);
     procedure SetLeft(Value: Integer);
     procedure SetMouseCapture(Value : Boolean);
     procedure SetParentShowHint(Value : Boolean);
@@ -636,10 +714,11 @@ type
     procedure LockBaseBounds;
     procedure UnlockBaseBounds;
     procedure UpdateAnchorRules;
-    procedure BeginAutoDrag; dynamic;
     procedure ChangeBounds(ALeft, ATop, AWidth, AHeight : integer); virtual;
     procedure DoSetBounds(ALeft, ATop, AWidth, AHeight : integer); virtual;
     procedure ChangeScale(M,D : Integer); dynamic;
+    procedure BeginAutoDrag; dynamic;
+    procedure Dock(NewDockSite: TWinControl; ARect: TRect); dynamic;
     procedure Click; dynamic;
     procedure DblClick; dynamic;
     procedure TripleClick; dynamic;
@@ -766,7 +845,6 @@ type
     property Ctl3D: Boolean read FCtl3D write FCtl3D;//Is this needed for anything other than compatability?
     property Enabled: Boolean read GetEnabled write SetEnabled default True;
     property Font: TFont read FFont write SetFont;
-    property HostDockSite: TWincontrol read FHostDockSite write FHostDockSite;
     property Parent: TWinControl read FParent write SetParent;
     property PopupMenu: TPopupmenu read GetPopupmenu write SetPopupMenu;
     property ShowHint: Boolean read FShowHint write SetShowHint default False;
@@ -774,6 +852,16 @@ type
     property WindowProc: TWndMethod read FWindowProc write FWindowProc;
     property TabStop: Boolean read FTabStop write SetTabStop;
     property TabOrder: TTabOrder read GetTabOrder write SetTaborder default -1;
+  public
+    // docking properties
+    property DockOrientation: TDockOrientation read FDockOrientation write FDockOrientation;
+    property Floating: Boolean read GetFloating;
+    property FloatingDockSiteClass: TWinControlClass read GetFloatingDockSiteClass write FFloatingDockSiteClass;
+    property HostDockSite: TWinControl read FHostDockSite write SetHostDockSite;
+    property LRDockWidth: Integer read GetLRDockWidth write FLRDockWidth;
+    property TBDockHeight: Integer read GetTBDockHeight write FTBDockHeight;
+    property UndockHeight: Integer read GetUndockHeight write FUndockHeight;
+    property UndockWidth: Integer read GetUndockWidth write FUndockWidth;
   public
     property OnResize: TNotifyEvent read FOnResize write FOnResize;
     property OnChangeBounds: TNotifyEvent read FOnChangeBounds write FOnChangeBounds;
@@ -1507,7 +1595,7 @@ end;
 {$ENDIF}
 
 {$I sizeconstraints.inc}
-{$I BaseDragControlObject.inc}
+{$I basedragcontrolobject.inc}
 {$I controlsproc.inc}
 {$I controlcanvas.inc}
 {$I scrolledwindow.inc}
@@ -1536,6 +1624,9 @@ end.
 { =============================================================================
 
   $Log$
+  Revision 1.133  2003/06/25 18:12:32  mattias
+  added docking properties
+
   Revision 1.132  2003/06/23 09:42:09  mattias
   fixes for debugging lazarus
 

lcl/include/control.inc

@@ -81,6 +81,11 @@ begin
   BeginDrag(Mouse.DragImmediate,Mouse.DragThreshold);
 end;
 
+procedure TControl.Dock(NewDockSite: TWinControl; ARect: TRect);
+begin
+
+end;
+
 {------------------------------------------------------------------------------}
 {       TControl.BoundsChanged                                                 
 }
@@ -338,6 +343,28 @@ begin
   Result := ClientRect.Right;
 end;
 
+function TControl.GetFloating: Boolean;
+var
+  CurHostDockSite: TWinControl;
+begin
+  CurHostDockSite:=HostDockSite;
+  Result := (CurHostDockSite <> nil)
+            and (CurHostDockSite is FloatingDockSiteClass);
+end;
+
+function TControl.GetFloatingDockSiteClass: TWinControlClass;
+begin
+  Result := FFloatingDockSiteClass;
+end;
+
+function TControl.GetLRDockWidth: Integer;
+begin
+  if FLRDockWidth>0 then
+    Result := FLRDockWidth
+  else
+    Result := UndockWidth;
+end;
+
 function TControl.IsAnchorsStored: boolean;
 begin
   Result:=Anchors<>[akLeft,akTop];
@@ -376,6 +403,22 @@ Begin
     Result := -1;
 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;
+
 {------------------------------------------------------------------------------}
 {       TControl SetTabOrder                                                   }
 {------------------------------------------------------------------------------}
@@ -894,6 +937,14 @@ Begin
   Result := GetCaptureControl = Self;
 end;
 
+function TControl.GetTBDockHeight: Integer;
+begin
+  if FTBDockHeight>0 then
+    Result := FTBDockHeight
+  else
+    Result := UndockHeight;
+end;
+
 {------------------------------------------------------------------------------}
 {       TControl GetPopupMenu                                 }
 {------------------------------------------------------------------------------}
@@ -1893,6 +1944,12 @@ begin
   FHelpKeyword:=AValue;
 end;
 
+procedure TControl.SetHostDockSite(const AValue: TWinControl);
+begin
+  if AValue=FHostDockSite then exit;
+  Dock(AValue, BoundsRect);
+end;
+
 {------------------------------------------------------------------------------
   Procedure TControl.SetParent(AParent : TWinControl);
 ------------------------------------------------------------------------------}
@@ -2419,6 +2476,9 @@ end;
 
 { =============================================================================
   $Log$
+  Revision 1.138  2003/06/25 18:12:32  mattias
+  added docking properties
+
   Revision 1.137  2003/06/23 09:42:09  mattias
   fixes for debugging lazarus
 

lcl/include/dragobject.inc

@@ -1,3 +1,5 @@
+// included by controls.pp
+
 {******************************************************************************
                                      TDragObject
  ******************************************************************************
@@ -16,6 +18,8 @@
  *****************************************************************************
 }
 
+{ TDragObject }
+
 procedure TDragObject.Assign(Source: TDragObject);
 begin
   FDragTarget := Source.FDragTarget;
@@ -117,3 +121,83 @@ procedure TDragObject.ShowDragImage;
 begin
   // do nothing
 end;
+
+{ TDragControlObject }
+
+function TDragControlObject.GetDragCursor(Accepted: Boolean; X, Y: Integer
+  ): TCursor;
+begin
+  Result:=inherited GetDragCursor(Accepted, X, Y);
+end;
+
+function TDragControlObject.GetDragImages: TDragImageList;
+begin
+  Result:=inherited GetDragImages;
+end;
+
+procedure TDragControlObject.HideDragImage;
+begin
+  inherited HideDragImage;
+end;
+
+procedure TDragControlObject.ShowDragImage;
+begin
+  inherited ShowDragImage;
+end;
+
+{ TDragDockObject }
+
+procedure TDragDockObject.SetBrush(Value: TBrush);
+begin
+
+end;
+
+procedure TDragDockObject.AdjustDockRect(ARect: TRect);
+begin
+
+end;
+
+procedure TDragDockObject.DrawDragDockImage;
+begin
+
+end;
+
+procedure TDragDockObject.EndDrag(Target: TObject; X, Y: Integer);
+begin
+  inherited EndDrag(Target, X, Y);
+end;
+
+procedure TDragDockObject.EraseDragDockImage;
+begin
+
+end;
+
+function TDragDockObject.GetDragCursor(Accepted: Boolean; X, Y: Integer
+  ): TCursor;
+begin
+  Result:=inherited GetDragCursor(Accepted, X, Y);
+end;
+
+function TDragDockObject.GetFrameWidth: Integer;
+begin
+  Result:=4;
+end;
+
+constructor TDragDockObject.Create(AControl: TControl);
+begin
+  inherited Create(AControl);
+end;
+
+destructor TDragDockObject.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TDragDockObject.Assign(Source: TDragObject);
+begin
+  inherited Assign(Source);
+end;
+
+
+// included by controls.pp
+