Delphi 如何检测应用程序外部的拖放？

我试图模仿Chrome的标签拖动功能。我希望用户能够将选项卡拖动到选项卡条中的新位置，或将其放到应用程序外部以创建新窗口。在应用程序中拖动是很容易的，但我如何检测用户何时掉到我的应用程序以外的地方

---

本质上，我希望实现“撕下”选项卡。

因为鼠标是在拖动操作期间捕获的，所以在

onendrag

处理程序中检测拖动操作何时完成没有问题，即使它在任何形式的应用程序之外。您可以通过测试“目标”对象来判断拖放是否被接受，如果拖放不被接受，您可以通过测试鼠标位置来判断它是否在应用程序之外

然而，这种方法仍然存在一个问题。按“Esc”键无法判断是否取消了拖动。还有一个问题是，无法将拖动光标设置为表单外部的“已接受”，因为在那里不会调用任何控件的

OnDragOver

通过使用创建的拖动对象更改拖动操作的行为，可以克服这些问题。以下是一个例子：

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    procedure FormCreate(Sender: TObject);
    procedure PageControl1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PageControl1StartDrag(Sender: TObject;
      var DragObject: TDragObject);
    procedure PageControl1EndDrag(Sender, Target: TObject; X, Y: Integer);
    procedure PageControl1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  PageControl1.DragMode := dmManual;
end;


type
  TDragFloatSheet = class(TDragControlObjectEx)
  private
    class var
      FDragSheet: TTabSheet;
      FDragPos: TPoint;
      FCancelled: Boolean;
  protected
    procedure WndProc(var Msg: TMessage); override;
  end;

procedure TDragFloatSheet.WndProc(var Msg: TMessage);
begin
  if (Msg.Msg = CN_KEYDOWN) and (Msg.WParam = VK_ESCAPE) then
    FCancelled := True;
  FDragPos := DragPos;
  inherited;
  if (Msg.Msg = WM_MOUSEMOVE) and
      (not Assigned(FindVCLWindow(SmallPointToPoint(TWMMouse(Msg).Pos)))) then
    Winapi.Windows.SetCursor(Screen.Cursors[GetDragCursor(True, 0, 0)]);
end;

//-------------------

procedure TForm1.PageControl1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  TDragFloatSheet.FDragSheet :=
      (Sender as TPageControl).Pages[TPageControl(Sender).IndexOfTabAt(X, Y)];
  PageControl1.BeginDrag(False);
end;

procedure TForm1.PageControl1StartDrag(Sender: TObject;
  var DragObject: TDragObject);
begin
  DragObject := TDragFloatSheet.Create(Sender as TPageControl);
end;

procedure TForm1.PageControl1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
  TargetSheet: TTabSheet;
begin
  TargetSheet :=
      (Sender as TPageControl).Pages[TPageControl(Sender).IndexOfTabAt(X, Y)];
  Accept := Assigned(TargetSheet) and (TargetSheet <> TDragFloatSheet.FDragSheet);
end;

procedure TForm1.PageControl1EndDrag(Sender, Target: TObject; X, Y: Integer);
begin
  if Assigned(Target) then begin

    // normal processing, f.i. find the target tab as in OnDragOver
    // and switch positions with TDragFloatSheet.FDragSheet

  end else begin
    if not TDragFloatSheet.FCancelled then begin
      if not Assigned(FindVCLWindow(TDragFloatSheet.FDragPos)) then begin

        // drop TDragFloatSheet.FDragSheet at TDragFloatSheet.FDragPos

      end;
    end;
  end;
end;

end.

单元1；
接口
使用
Winapi.Windows、Winapi.Messages、System.SysUtils、System.Variants、System.Classes、Vcl.Graphics、，
控件、窗体、对话框、控件；
类型
TForm1=类（TForm）
PageControl1:TPageControl；
表1:TTabSheet；
表2:TTabSheet；
表3:TTabSheet；
过程表单创建（发送方：ToObject）；
程序PageControl1MouseDown（发送方：ToObject；按钮：TMouseButton；
移位：t移位状态；X，Y：整数）；
过程页面控制1开始拖动（发送方：ToObject；
变量DragObject:TDragObject）；
过程PageControl1EndDrag（发送方，目标：ToObject；X，Y:整数）；
过程PageControl1DragOver（发送方，源：ToObject；X，Y：整数；
状态：TDragState；变量接受：Boolean）；
结束；
变量
表1:TForm1；
实施
{$R*.dfm}
过程TForm1.FormCreate（发送方：TObject）；
开始
PageControl1.DragMode:=dmManual；
结束；
类型
TDragFloatSheet=类（TDragControlObjectEx）
私有的
类变量
FDragSheet:TTabSheet；
FDragPos:TPoint；
F取消：布尔值；
受保护的
程序WndProc（var Msg:TMessage）；推翻
结束；
程序TDragFloatSheet.WndProc（var Msg:TMessage）；
开始
如果（Msg.Msg=CN\u KEYDOWN）和（Msg.WParam=VK\u ESCAPE），则
f已取消：=真；
FDragPos:=DragPos；
继承；
如果（Msg.Msg=WM_MOUSEMOVE）和
（未分配（FindVCLWindow（SmallPointToPoint（TWMMouse（Msg.Pos）））然后
Winapi.Windows.SetCursor（Screen.Cursors[GetDragCursor（True，0，0）]）；
结束；
//-------------------
程序t用于m1.PageControl1MouseDown（发送方：ToObject；按钮：TMouseButton；
移位：t移位状态；X，Y：整数）；
开始
TDragFloatSheet.FDragSheet：=
（发送方为TPageControl）。页面[TPageControl（发送方）。IndexOfTabAt（X，Y）]；
PageControl1.BeginDrag（假）；
结束；
程序TForm1.PageControl1StartDrag（发送方：ToObject；
变量DragObject:TDragObject）；
开始
DragObject:=TDragFloatSheet.Create（发送方作为TPageControl）；
结束；
过程TForm1.PageControl1DragOver（发送方，源：ToObject；X，Y：整数；
状态：TDragState；变量接受：Boolean）；
变量
目标页：TTabSheet；
开始
目标清单：=
（发送方为TPageControl）。页面[TPageControl（发送方）。IndexOfTabAt（X，Y）]；
接受：=指定（TargetSheet）和（TargetSheet TDragFloatSheet.FDragSheet）；
结束；
过程TForm1.PageControl1EndDrag（发送方，目标：ToObject；X，Y：整数）；
开始
如果已分配（目标），则开始
//正常处理，f.i.查找目标选项卡，如OnDragOver中所示
//并使用TDragFloatSheet.FDragSheet切换位置
结束，否则开始
如果未取消TDragFloatSheet.fc，则开始
如果未分配（FindVCLWindow（TDragFloatSheet.FDragPos）），则开始
//将TDragFloatSheet.FDragSheet放置在TDragFloatSheet.FDragPos处
结束；
结束；
结束；
结束；
结束。

这个链接有什么帮助吗？@LURD：我也这么想，差点说它是重复的，直到我重新阅读这个问题并看到“创建一个新窗口”。这不是“另一个应用程序”；它是在您自己的应用程序中创建一个新窗口，当有东西掉到它外面时。我投了更高的票。：-）这似乎是个好问题。@KenWhite，你说得对。刚刚在Chrome上试用了这个功能。这不只是一个对接问题吗？@RobKennedy:既然你提到了，我想说。。。哦！