delphi - 如何检测应用程序外部的拖放?

标签 delphi drag-and-drop delphi-xe2

我正在尝试模拟 Chrome 的选项卡拖动功能。我希望用户能够将选项卡拖动到选项卡栏中的新位置或将其放在应用程序之外以创建新窗口。在应用程序内拖动很容易,但如何检测用户何时将其拖放到应用程序以外的某个位置?

本质上,我希望实现“撕下”标签。

最佳答案

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

但是这种方法仍然存在问题。您无法通过按“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.

关于delphi - 如何检测应用程序外部的拖放?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/12959880/

相关文章:

java - 有没有办法在拖放中达到下降时刻?

c - 如何在 Delphi 中表示以空字符结尾的字符串数组?

javascript - Javascript 中图像的可拖动克隆

javascript - 用拖放替换图像

delphi - 验证真实日期

delphi - 如何动态创建与顶部对齐但在其他对齐控件之后的控件?

delphi - 如何将预先存在的函数分配给 TComparison<T>?

delphi - 在 ADO 数据集过滤器中使用 LIKE 和 '%'

objective-c - firemonkey + xcode,混合代码