2012-10-18 32 views
6

我試圖模擬Chrome的標籤拖動功能。我希望用戶能夠將選項卡拖動到選項卡中的新位置,或將其拖放到應用程序外部以創建新窗口。在應用程序內拖動很容易,但是如何檢測用戶何時掉到不在我的應用程序上的某個位置?如何檢測應用程序外的拖放?

實質上,我正在尋找實施「撕下」選項卡。

+0

此鏈接的任何幫助,[拖放應用程序內和另一個應用程序](http://stackoverflow.com/q/198488/576719)? –

+1

@LURD:我也這麼認爲,幾乎把它稱爲複製品,直到我重新閱讀問題並看到「創建新窗口」。這不是「另一個應用程序」;它會在你的應用程序中創建一個新的窗口,當有東西掉到外面時。我反而提高了。 :-)這似乎是一個很好的問題。 –

+0

@KenWhite,你是對的。只是在Chrome上試用過這個功能。 –

回答

7

由於在拖動操作期間捕獲了鼠標,因此檢測拖動操作在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

+1。非常好地完成! :-) –

+0

偉大的答案塞爾特克。謝謝。 – norgepaul