我試圖模擬Chrome的標籤拖動功能。我希望用戶能夠將選項卡拖動到選項卡中的新位置,或將其拖放到應用程序外部以創建新窗口。在應用程序內拖動很容易,但是如何檢測用戶何時掉到不在我的應用程序上的某個位置?如何檢測應用程序外的拖放?
實質上,我正在尋找實施「撕下」選項卡。
我試圖模擬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.
+1。非常好地完成! :-) –
偉大的答案塞爾特克。謝謝。 – norgepaul
此鏈接的任何幫助,[拖放應用程序內和另一個應用程序](http://stackoverflow.com/q/198488/576719)? –
@LURD:我也這麼認爲,幾乎把它稱爲複製品,直到我重新閱讀問題並看到「創建新窗口」。這不是「另一個應用程序」;它會在你的應用程序中創建一個新的窗口,當有東西掉到外面時。我反而提高了。 :-)這似乎是一個很好的問題。 –
@KenWhite,你是對的。只是在Chrome上試用過這個功能。 –