File: dragmanager.inc

package info (click to toggle)
lazarus 4.0%2Bdfsg-3
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 275,760 kB
  • sloc: pascal: 2,341,904; xml: 509,420; makefile: 348,726; cpp: 93,608; sh: 3,387; java: 609; perl: 297; sql: 222; ansic: 137
file content (904 lines) | stat: -rw-r--r-- 28,144 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
{%MainUnit ../controls.pp}

{******************************************************************************
                                  TDragManagerDefault
 ******************************************************************************

 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}

type
  TDragManagerDefault = class;

  { TDragDockCommon }

  TDragDockCommon = class
  private
    FManager: TDragManagerDefault;
    FDragImageList: TDragImageList;
    function SendCmDragMsg(ADragObject: TDragObject; ADragMsg: TDragMessage): Boolean;
    function SendDragMessage(AControl: TControl; Msg: TDragMessage; ADragObject: TDragObject; Target: TControl; const Position: TPoint): LRESULT;
  protected
    property Manager: TDragManagerDefault read FManager;
    function Dragging(AControl: TControl): boolean; virtual;abstract;
    procedure DragStarted(APosition: TPoint); virtual;abstract;
    procedure DragMove(APosition: TPoint); virtual;abstract;
    procedure DragStop(ADropped: Boolean); virtual;abstract;
    procedure Notification(AComponent: TComponent; Operation: TOperation); virtual; abstract;
  public
    constructor Create(AManager: TDragManagerDefault; AControl: TControl); virtual;
  end;

  { TDragPerformer }

  TDragPerformer = class(TDragDockCommon)
  private
    FDragObject: TDragObject;
    FDragCursor: TCursor;
    FDragCursorApplied: Boolean;
  protected
    function Dragging(AControl: TControl): boolean; override;
    procedure DragStarted(APosition: TPoint); override;
    procedure DragMove(APosition: TPoint); override;
    procedure DragStop(ADropped: Boolean); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AManager: TDragManagerDefault; AControl: TControl); override;
    destructor Destroy; override;
  end;

  { TDockPerformer }

  TDockPerformer = class(TDragDockCommon)
  private
    FDockObject: TDragDockObject;
  protected
    function Dragging(AControl: TControl): boolean; override;
    procedure DragStarted(APosition: TPoint); override;
    procedure DragMove(APosition: TPoint); override;
    procedure DragStop(ADropped: Boolean); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AManager: TDragManagerDefault; AControl: TControl); override;
    destructor Destroy; override;
  end;

  { TDragManagerDefault }

  TDragManagerDefault = class(TDragManager)
  private
    FDockSites: TFPList;
    FPerformer: TDragDockCommon;
    FStartPosition: TPoint;//mouse position at start of drag or dock
    FThresholdValue: Integer;//treshold before the drag becomes activated
    FWaitForTreshold: boolean;//are we waiting on the treshold activation?
    FInDragStop: Boolean; // semaphore to prevent second execution of dragStop
  protected
    //Support input capture
    procedure KeyUp(var Key: Word; Shift : TShiftState); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
    procedure CaptureChanged(OldCaptureControl: TControl); override;
    procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;

    //Support methods
    function IsDragging: boolean; override;
    function Dragging(AControl: TControl): boolean; override;
    procedure RegisterDockSite(Site: TWinControl; DoRegister: Boolean);override;

    //The Drag and Drop routines
    procedure DragStart(AControl: TControl; AImmediate: Boolean; AThreshold: Integer; StartFromCurrentMouse:Boolean=False); override;
    procedure DragMove(APosition: TPoint); override;
    procedure DragStop(ADropped: Boolean); override;

    function CanStartDragging(Site: TWinControl;  AThreshold: Integer; X,Y:Integer): boolean; override;

    property StartPosition: TPoint read FStartPosition;
  end;


{ TDragDockCommon }

constructor TDragDockCommon.Create(AManager: TDragManagerDefault; AControl: TControl);
begin
  FManager := AManager;
  FDragImageList := nil;
end;

function TDragDockCommon.SendDragMessage(AControl: TControl; Msg: TDragMessage; ADragObject: TDragObject; Target: TControl; const Position: TPoint): LRESULT;
begin
  Result := 0;
  if AControl = nil then exit;
  Result := AControl.DoDragMsg(Msg, Position, ADragObject, Target,
    ADragObject is TDragDockObject);
end;


function TDragDockCommon.SendCmDragMsg(ADragObject: TDragObject; ADragMsg: TDragMessage): Boolean;
//Send a CM_DRAG message to the window..
begin
  Result := SendDragMessage(ADragObject.DragTarget, ADragMsg,
    ADragObject, ADragObject.DragTarget, ADragObject.DragPos) <> 0;
end;

{ TDragPerformer }

constructor TDragPerformer.Create(AManager: TDragManagerDefault; AControl: TControl);
//Start a drag operation, if not already running
begin
  inherited Create(AManager, AControl);

  AControl.DoStartDrag(FDragObject);
  if FDragObject = nil then
    FDragObject := TDragControlObject.AutoCreate(AControl);
  FDragObject.DragPos := AManager.StartPosition;
  SetCaptureControl(AControl);
end;

destructor TDragPerformer.Destroy;
begin
  FreeAndNil(FDragObject);
  inherited Destroy;
end;

function TDragPerformer.Dragging(AControl: TControl): boolean;
begin
  Result:= Assigned(FDragObject) and (FDragObject.Control=AControl);
end;

procedure TDragPerformer.DragStarted(APosition: TPoint);
//Imput device has moved beyond tresholt limits (or immediate docking)
begin
  FDragCursorApplied := False;
  if FDragObject = nil then Exit;
  FDragImageList := FDragObject.GetDragImages;
  if FDragImageList <> nil then
    FDragImageList.BeginDrag(0, APosition.X, APosition.Y);
end;

procedure TDragPerformer.DragMove(APosition: TPoint);
var 
  ATarget: TControl;
  DragCursor: TCursor;
begin
  if FDragObject = nil then
    Exit;
  //Inform user of entering and leaving the area
  ATarget := FindControlAtPosition(APosition, False);
  ATarget := TControl(SendDragMessage(ATarget, dmFindTarget, FDragObject, nil, APosition));

  if ATarget <> FDragObject.DragTarget then
  begin
    SendCmDragMsg(FDragObject, dmDragLeave);
    FDragObject.DragTarget := TWinControl(ATarget);
    FDragObject.DragPos := APosition;
    SendCmDragMsg(FDragObject, dmDragEnter);
  end
  else
    FDragObject.DragPos := APosition;

  //TODO: Need to rewrite this(or even delete it, back to the roots)
  if FDragObject.DragTarget <> nil then
    FDragObject.DragTargetPos := FDragObject.DragTarget.ScreenToClient(APosition);
  DragCursor := FDragObject.GetDragCursor(SendCmDragMsg(FDragObject, dmDragMove),APosition.X, APosition.Y);
  if FDragImageList <> nil then
  begin
    if (ATarget = nil) or (csDisplayDragImage in ATarget.ControlStyle) or
       FDragObject.AlwaysShowDragImages then
    begin
      FDragImageList.DragCursor := DragCursor;
      if not FDragImageList.Dragging then
        FDragImageList.BeginDrag(0, APosition.X, APosition.Y)
      else
        FDragImageList.DragMove(APosition.X, APosition.Y);
    end
    else
      FDragImageList.EndDrag;
  end
  else begin
    Screen.BeginTempCursor(DragCursor);
    if FDragCursorApplied then
      Screen.EndTempCursor(FDragCursor);
    FDragCursor := DragCursor;
    FDragCursorApplied := True;
  end;
end;

procedure TDragPerformer.DragStop(ADropped : Boolean);
var 
  ADragObjectCopy: TDragObject;
  DragMsg: TDragMessage;
  Accepted: Boolean;
  TargetPos: TPoint;
begin
  ADragObjectCopy := FDragObject;
  if FDragObject <> nil then
  try
    FDragObject := nil;
    SetCaptureControl(nil);

    if FDragImageList <> nil then
      FDragImageList.EndDrag
    else
    if FDragCursorApplied then
      Screen.EndTempCursor(FDragCursor);
    if (ADragObjectCopy.DragTarget <> nil) and (ADragObjectCopy.DragTarget is TControl) then
      TargetPos := ADragObjectCopy.DragTargetPos //controls can override the position
    else
      TargetPos := ADragObjectCopy.DragPos; //otherwise take the current position
    Accepted := ADropped and SendCmDragMsg(ADragObjectCopy, dmDragLeave);
    ADragObjectCopy.FDropped := Accepted;

    if ADragObjectCopy.DragTarget <> nil then
    begin
      if not Accepted then
      begin
        TargetPos.X := 0;
        TargetPos.Y := 0;
        DragMsg := dmDragCancel;
        ADragObjectCopy.DragPos:=Point(0,0);
        ADragObjectCopy.DragTarget := nil;
      end
      else
        DragMsg := dmDragDrop;
      SendDragMessage(ADragObjectCopy.DragTarget, DragMsg, ADragObjectCopy,
        ADragObjectCopy.DragTarget, ADragObjectCopy.DragPos);
    end;

    if not Accepted then
      ADragObjectCopy.Control.DragCanceled;
    ADragObjectCopy.EndDrag(ADragObjectCopy.DragTarget, TargetPos.X, TargetPos.Y);

  finally
    //erase global variables (dragging stopped)
    if (ADragObjectCopy <>nil) and ADragObjectCopy.AutoFree then
      ADragObjectCopy.Free;
  end;
end;

procedure TDragPerformer.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  if Operation = opRemove then
  begin
    if Assigned(FDragObject) and (AComponent = FDragObject.DragTarget) then
      DragMove(FDragObject.DragPos);
  end;
end;


{ TDockPerformer }

constructor TDockPerformer.Create(AManager: TDragManagerDefault; AControl: TControl);
//Start a drag operation, if not already running
begin
  inherited Create(AManager, AControl);
  AControl.DoStartDock(TDragObject(FDockObject));
  if FDockObject = nil then
    FDockObject := TDragDockObject.AutoCreate(AControl);

  FDockObject.InitDock(AManager.StartPosition);
  // we are tracking capture change to stop drag/dock is happen
  SetCaptureControl(AControl);
end;

destructor TDockPerformer.Destroy;
begin
  FreeAndNil(FDockObject);
  inherited Destroy;
end;

function TDockPerformer.Dragging(AControl: TControl): boolean;
begin
  Result:= Assigned(FDockObject) and (FDockObject.Control=AControl);
end;

procedure TDockPerformer.DragStarted(APosition: TPoint);
// Input device has moved beyond threshold (or immediate docking)
begin
  if FDockObject = nil then
    Exit;
  FDragImageList := FDockObject.GetDragImages;
  if FDragImageList <> nil then
    FDragImageList.BeginDrag(0, APosition.X, APosition.Y);
  FDockObject.ShowDockImage;
end;

procedure TDockPerformer.DragMove(APosition: TPoint);

  function GetDropControl(ADragTarget: TWinControl): TControl;
  //Select a control where the dragged control will be docked
  var
    AControl: TControl;
    i: integer;
  begin
    Result := nil;
    if ADragTarget <> nil then
    begin
      if ADragTarget.UseDockManager then
      begin
        if ADragTarget.DockClientCount > 0 then
        begin
          //Did the user drop it on the same positon?
          AControl := ADragTarget.DockClients[0];
          if (ADragTarget.DockClientCount = 1) and (AControl = FDockObject.Control) then
            Exit;

          AControl := FindDragTarget(FDockObject.DragPos, false);
          while (AControl <> nil) and (AControl <> ADragTarget) do
          begin
            for i := 0 to ADragTarget.DockClientCount-1 do
            begin
              if ADragTarget.DockClients[i]=AControl then
              begin
                Result := ADragTarget.DockClients[i];
                Exit;
              end;
            end;
            AControl := AControl.Parent;
          end;
        end;
      end;
    end;
  end;


  function IsControlChildOfClient(AControl:TWinControl): Boolean;
  begin
    Result := False;
    while Assigned(AControl) do
    begin
      if AControl=FDockObject.Control then
      begin
        Result := True;
        exit;
      end;
      AControl := AControl.Parent;
    end;
  end;

  function IsClientChildOfControl(AControl:TWinControl): Boolean;
  var
    Client:TControl;
  begin
    Result := False;
    Client := FDockObject.Control;
    if Assigned(AControl) then
      while Assigned(Client) do
      begin
        if AControl=Client then
        begin
          Result := True;
          exit;
        end;
        Client := Client.Parent;
      end;
  end;


  function FindDockSiteAtPosition: TWinControl;
  //Replace with lookup in Screen.Zorder(?)
  var
    AControl: TWinControl;
    CanDock: Boolean;
    QualifyingSites: TList;
    ARect: TRect;
    I: Integer;
    j: Integer;

    function HaveMultiplePotentialDockClient(AControl: TWinControl):boolean;
    var
      I,Count:Integer;
    begin
      Count := 0;
      for I := 0 to AControl.ControlCount - 1 do
      begin
        if (AControl.Controls[I].DragKind  = dkDock) and (AControl.Controls[I].DragMode = dmAutomatic) then
          inc(Count);
        if Count > 1 then exit(True);
      end;
      Result:=False;
    end;

    function ItCanBeHostSite:boolean;
    begin
      if FDockObject.Control.HostDockSite <> nil then
        result := (FDockObject.Control.HostDockSite <> AControl) or (AControl.VisibleDockClientCount > 1)
      else
        result := (AControl <> FDockObject.Control.Parent) or HaveMultiplePotentialDockClient(AControl);
    end;

  begin
    Result := nil;
    
    if Manager.FDockSites = nil then
      Exit;
      
    QualifyingSites := TList.Create;
    try
      for i := 0 to Manager.FDockSites.Count - 1 do
      begin
        AControl:=TWinControl(Manager.FDockSites[i]);
        //Sanity checks..
        if not AControl.Showing then continue;
        if not AControl.Enabled then continue;
        if not AControl.IsVisible then continue;
        if AControl=FDockObject.Control then continue;
        if IsControlChildOfClient(AControl) then continue;
        if AControl.DockManager<>nil then
          if not AControl.DockManager.CanBeDoubleDocked then
            if IsClientChildOfControl(AControl) then continue;

        if ItCanBeHostSite then
        begin
          CanDock := True;
          AControl.GetSiteInfo(FDockObject.Control, ARect, APosition, CanDock);
          //debugln(['FindDockSiteAtPosition ',DbgSName(AControl),' CanDock=',CanDock,' PtIn=',PtInRect(ARect, APosition)]);
          if CanDock and PtInRect(ARect, APosition) then
            QualifyingSites.Add(AControl);
        end;
      end;

      if QualifyingSites.Count > 0 then
      begin
        // if a parent and a child has qualified remove the parent
        for i:=QualifyingSites.Count-1 downto 0 do begin
          //debugln(['FindDockSiteAtPosition qualified: ',DbgSName(TWinControl(QualifyingSites[i])),' ',TWinControl(QualifyingSites[i]).Caption]);
          for j:=0 to QualifyingSites.Count-1 do begin
            if TWinControl(QualifyingSites[i]).IsParentOf(TWinControl(QualifyingSites[j]))
            then begin
              //debugln(['FindDockSiteAtPosition isparentof ',DbgSName(TWinControl(QualifyingSites[j])),' ',TWinControl(QualifyingSites[j]).Caption]);
              QualifyingSites.Delete(i);
              break;
            end;
          end;
        end;

        i:=0;
        if QualifyingSites.Count>1 then
        begin
          // there are multiple candidates => use the top level
          for j:=0 to Screen.CustomFormZOrderCount-1 do begin
            i:=QualifyingSites.Count-1;
            while (i>=0)
            and (GetParentForm(TWinControl(QualifyingSites[i]))<>Screen.CustomFormsZOrdered[j])
            do
              dec(i);
            if i>=0 then break;
          end;
          if i<0 then i:=0;
        end;
        Result := TWinControl(QualifyingSites[i]);
      end;
    finally
      QualifyingSites.Free;
    end;
  end;

var
  ATarget: TWinControl;
  DragCursor: TCursor;
begin
  if FDockObject = nil then
    Exit;

  //Inform user of entering and leaving
  if (GetKeyState(VK_CONTROL) and $8000) <> 0 then
    ATarget := nil
  else
    ATarget := FindDockSiteAtPosition;

  if ATarget <> FDockObject.DragTarget then
  begin
    SendCmDragMsg(FDockObject, dmDragLeave); //using the old values in FDockObject
  end;
  FDockObject.DragPos := APosition;

  if ATarget <> nil then
    with FDockObject do
    begin //determine precise target now, before dmDragMove
      DragTargetPos := ATarget.ScreenToClient(APosition);
      DropOnControl := GetDropControl(ATarget);
      if not ATarget.UseDockManager or
         not ATarget.DockManager.GetDockEdge(FDockObject) then
      begin
        if DropOnControl = nil then
          DropAlign := ATarget.GetDockEdge(DragTargetPos)
        else
          DropAlign := DropOnControl.GetDockEdge(DropOnControl.ScreenToClient(APosition));
      end;
    end;

  if ATarget <> FDockObject.DragTarget then
  begin
    FDockObject.DragTarget := ATarget;
    SendCmDragMsg(FDockObject, dmDragEnter);
  end;

  DragCursor := FDockObject.GetDragCursor(SendCmDragMsg(FDockObject, dmDragMove),APosition.X, APosition.Y);
  if FDragImageList <> nil then
  begin
    if (ATarget = nil) or (csDisplayDragImage in ATarget.ControlStyle) or
       FDockObject.AlwaysShowDragImages then
    begin
      FDragImageList.DragCursor := DragCursor;
      if not FDragImageList.Dragging then
        FDragImageList.BeginDrag(0, APosition.X, APosition.Y)
      else
        FDragImageList.DragMove(APosition.X, APosition.Y);
    end
    else
      FDragImageList.EndDrag;
  end;
  WidgetSet.SetCursor(Screen.Cursors[DragCursor]);

  //Draw borders for the docking section or the boundaries of the dragged form
  with FDockObject do
  begin
    if DragTarget = nil then //show as floating
      FDockObject.Control.DockTrackNoTarget(FDockObject, APosition.X, APosition.Y);

    MoveDockImage;
  end;
end;

procedure TDockPerformer.DragStop(ADropped: Boolean);
var
  ADockObjectCopy: TDragDockObject;
  ParentForm: TCustomForm;
  DragMsg: TDragMessage;
  Accepted: Boolean;
  TargetPos: TPoint;
  Moved: Boolean;
  {$IFDEF EnableDockMove}
  AControl: TControl;
  P: TPoint;
  {$ENDIF}
begin
  ADockObjectCopy := FDockObject;
  if FDockObject <> nil then
  try
    FDockObject := nil;
    SetCaptureControl(nil);

    ADockObjectCopy.HideDockImage;
    ADockObjectCopy.Floating := ADockObjectCopy.DragTarget = nil;

    Moved:=false;
    Accepted := ADockObjectCopy.DragTarget <> nil;

    if ADropped then
    begin
      DebugLn(['TDockPerformer.DragStop Dropped ',ADockObjectCopy.Control.Floating,' ',ADockObjectCopy.Floating,' ',DbgSName(ADockObjectCopy.Control)]);
      if ADockObjectCopy.Control.Floating and ADockObjectCopy.Floating then
      begin
        DebugLn(['TDockPerformer.DragStop SIMPLE MOVE']);
        {$IFDEF EnableDockMove}
        // it works on wine, gtk, qt and carbon

        // just move
        AControl:=ADockObjectCopy.Control;
        if AControl.Parent<>nil then
        begin
          P := AControl.Parent.ClientToScreen(Point(AControl.Left, AControl.Top));
          with ADockObjectCopy.DockRect do
          begin
            AControl.Parent.BoundsRect :=
              Bounds(Left + AControl.Parent.Left - P.X,
                     Top + AControl.Parent.Top - P.Y,
                     Right - Left + AControl.Parent.Width - AControl.Width,
                     Bottom - Top + AControl.Parent.Height - AControl.Height);
          end;
        end else begin
          AControl.BoundsRect:=ADockObjectCopy.DockRect;
        end;
        //DebugLn(['TDockPerformer.DragStop MOVED']);
        Moved:=true;
        Accepted:=true;
        {$ENDIF}
      end;

      // undock
      if not Moved then begin
        if ADockObjectCopy.Control.HostDockSite <> nil then
          Accepted := ADockObjectCopy.Control.HostDockSite.DoUnDock(
               TWinControl(ADockObjectCopy.DragTarget), ADockObjectCopy.Control)
        else
        if ADockObjectCopy.DragTarget = nil then
          Accepted := True
        else
        if ADockObjectCopy.Control.HostDockSite = nil then
          Accepted := True;
      end;
    end;

    if (ADockObjectCopy.DragTarget <> nil) and
       (ADockObjectCopy.DragTarget is TControl) then
      TargetPos := ADockObjectCopy.DragTargetPos //controls can override the position
    else
      TargetPos := ADockObjectCopy.DragPos; //otherwise take the current position
    Accepted := Accepted and (Moved or ADockObjectCopy.Floating or SendCmDragMsg(ADockObjectCopy, dmDragLeave)) and ADropped;
    ADockObjectCopy.FDropped := Accepted;

    // float
    if Accepted and (not Moved) and ADockObjectCopy.Floating then
    begin
      ParentForm := GetParentForm(ADockObjectCopy.Control);
      if (ParentForm <> nil) and
         (ParentForm.ActiveControl = ADockObjectCopy.Control) then
        ParentForm.ActiveControl := nil;
      ADockObjectCopy.Control.DoFloatMsg(ADockObjectCopy);
    end;

    // dock
    if ADockObjectCopy.DragTarget <> nil then
    begin
      if not Accepted then
      begin
        TargetPos.X := 0;
        TargetPos.Y := 0;
        DragMsg := dmDragCancel;
        ADockObjectCopy.DragPos:=Point(0,0);
        ADockObjectCopy.DragTarget:=nil;
      end
      else
        DragMsg := dmDragDrop;
      ADockObjectCopy.Control.Top:=0;
      ADockObjectCopy.Control.Left:=0;
      SendDragMessage(ADockObjectCopy.DragTarget, DragMsg, ADockObjectCopy,
                      ADockObjectCopy.DragTarget, ADockObjectCopy.DragPos);
    end;

    // EndDrag
    if not Accepted then
      ADockObjectCopy.Control.DragCanceled;
    ADockObjectCopy.EndDrag(ADockObjectCopy.DragTarget,TargetPos.X,TargetPos.Y);
  finally
    if ADockObjectCopy.AutoFree then
      ADockObjectCopy.Free
  end;
end;

procedure TDockPerformer.Notification(AComponent: TComponent;
  Operation: TOperation);
begin

end;


{ TDragManagerDefault }

destructor TDragManagerDefault.Destroy;
begin
  FreeAndNil(FDockSites);
  inherited Destroy;
end;

function TDragManagerDefault.IsDragging: boolean;
//Is something being dragged
begin
  Result := Assigned(FPerformer) and not FInDragStop;
end;

function TDragManagerDefault.Dragging(AControl: TControl): boolean;
//Is the control being dragged
begin
  if FPerformer = nil then
    Result := false
  else
    Result := FPerformer.Dragging(AControl)
end;

procedure TDragManagerDefault.DragStart(AControl: TControl; AImmediate: Boolean; AThreshold: Integer; StartFromCurrentMouse:Boolean=False);
//Start a drag operation
begin
  if FPerformer = nil then
  begin
    if AThreshold >= 0 then
      FThresholdValue := AThreshold
    else
      FThresholdValue := DragThreshold;
    FWaitForTreshold := not AImmediate;
    if StartFromCurrentMouse then
      FStartPosition:=AControl.ClientToScreen(point(0,0))
    else
      GetCursorPos(FStartPosition);

    AControl.BeforeDragStart;

    case AControl.DragKind of
      dkDrag: FPerformer := TDragPerformer.Create(Self, AControl);
      dkDock: FPerformer := TDockPerformer.Create(Self, AControl);
    end;

    if AImmediate then
    begin
      FPerformer.DragStarted(FStartPosition);
      DragMove(FStartPosition);
    end;
  end;
end;

procedure TDragManagerDefault.DragMove(APosition: TPoint);
//The captured input device has moved
begin
  if FPerformer <> nil then
  begin
    //delay until the input device has moved at least x pixels
    if FWaitForTreshold then
    begin
      if Abs(FStartPosition.X - APosition.X) >= FThresholdValue then
        FWaitForTreshold := false
      else
      if Abs(FStartPosition.Y - APosition.Y) >= FThresholdValue then
        FWaitForTreshold := false
      else
        exit;
      FPerformer.DragStarted(APosition);
    end;
    if FPerformer<>nil then
      FPerformer.DragMove(APosition);
  end;
end;

procedure TDragManagerDefault.DragStop(ADropped : Boolean);
//End the drag operation
begin
  if Assigned(FPerformer) and not FInDragStop then
  begin
    FInDragStop := True;
    try
      FPerformer.DragStop(ADropped and not FWaitForTreshold);
    finally
      FreeAndNil(FPerformer);
      FInDragStop := False;
    end;
  end;
end;

procedure TDragManagerDefault.RegisterDockSite(Site: TWinControl; DoRegister: Boolean);
begin
  if Assigned(Site) then
  begin
    if FDockSites = nil then
      FDockSites := TFPList.Create;
    if (FDockSites.IndexOf(Site)>=0)=DoRegister then exit;

    //debugln(['TDragManagerDefault.RegisterDockSite Changed ',DbgSName(Site),' DoRegister=',DoRegister]);
    if DoRegister then
    begin
      FDockSites.Add(Site);
      Site.FreeNotification(Self);
    end else
    begin
      FDockSites.Remove(Site);
      Site.RemoveFreeNotification(Self);
    end;
  end;
end;

procedure TDragManagerDefault.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if Key = VK_CONTROL then
    DragMove(Mouse.CursorPos);
end;

procedure TDragManagerDefault.KeyUp(var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_CONTROL:
      DragMove(Mouse.CursorPos);
    VK_ESCAPE:
    begin
      DragStop(False);
      Key := 0;
    end;
  end;
end;

procedure TDragManagerDefault.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  //In TControl.WndProc/LM_LBUTTONDOWN a drag session is started but a few lines
  //later the LM_LBUTTONDOWN is send to the dragmanager which would end dragging.
  //Dragging is only ended by a MouseUp so we can ignore this mesage anywhay.
  //DragStop(true);
end;

procedure TDragManagerDefault.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  // clear performer references
  if Assigned(FPerformer) then
    FPerformer.Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    // remove from dock sites
    if Assigned(FDockSites) then
    begin
      //if FDockSites.IndexOf(AComponent)>=0 then debugln(['TDragManagerDefault.Notification DockSite: ',DbgSName(AComponent)]);
      FDockSites.Remove(AComponent);
      if FDockSites.Count = 0 then
        FreeAndNil(FDockSites);
    end;
    if (AComponent is TControl) and Dragging(TControl(AComponent)) then
      DragStop(False);
  end;
end;

constructor TDragManagerDefault.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  FInDragStop := False;
end;

procedure TDragManagerDefault.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
begin
  P.X := X;
  P.Y := Y;
  DragMove(P);
end;

procedure TDragManagerDefault.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  DragStop(not FWaitForTreshold);
end;

procedure TDragManagerDefault.CaptureChanged(OldCaptureControl: TControl);
var
  i: integer;
  AIsDragging,
  AIsDocking: Boolean;
begin
  // if this is TWinControl, and it have controls (not TWinControls)
  // then we should check Dragging in those controls
  AIsDocking := False;
  AIsDragging := OldCaptureControl.Dragging;
  if AIsDragging then
    AIsDocking := OldCaptureControl.DragKind = dkDock;
  if (not AIsDragging) and (OldCaptureControl is TWinControl) then
  begin
    for i := 0 to TWinControl(OldCaptureControl).ControlCount - 1 do
    begin
      AIsDragging := AIsDragging or TWinControl(OldCaptureControl).Controls[i].Dragging;
      if AIsDragging then
      begin
        AIsDocking := TWinControl(OldCaptureControl).Controls[i].DragKind = dkDock;
        break;
      end;
    end;
  end;
  // when we are start drag/dock in TDockHeader then we should
  // take into account that it doesnot belong to our control - it
  // belongs to parent => we should allow parent to get capture
  if not (AIsDocking and (CaptureControl = OldCaptureControl.Parent)) then
    DragStop(AIsDragging);
end;

function TDragManagerDefault.CanStartDragging(Site: TWinControl;  AThreshold: Integer; X,Y:Integer): boolean;
var
  Threshold:integer;
  aRect:TRect;
begin
  if AThreshold<=0 then
    Threshold:=DragThreshold
  else
    Threshold:=AThreshold;
  aRect := Site.ClientRect;
  InflateRect(aRect, Threshold, Threshold);
  Result := not PtInRect(aRect, Point(X, Y));
end;

//included by controls.pp