2012-10-18 11 views
6

Chromeのタブドラッグ機能をエミュレートしようとしています。ユーザーがタブストリップ内の新しい場所にタブをドラッグするか、アプリケーションの外にドロップして新しいウィンドウを作成できるようにします。アプリケーション内でドラッグするのは簡単ですが、ユーザーが自分のアプリではなくどこかにドロップしたときはどうすれば検出できますか?アプリケーションの外にドラッグドロップを検出するにはどうすればよいですか?

本質的に私は「引き裂き」タブを実装しようとしています。

+0

このリンクは、[アプリケーション内のドラッグアンドドロップ](http://stackoverflow.com/q/198488/576719)ですか? –

+1

@LURD:質問を再読み、「新しいウィンドウを作成する」ことがわかるまで、私はあまりにも思っていて、ほとんどそれを複写と呼びました。これは「別のアプリケーション」ではありません。何かが外部にドロップされたときに、自分のアプリケーションに新しいウィンドウを作成しています。私は代わりにupvoted。 :-)それは良い質問であるようです。 –

+0

@KenWhite、あなたは正しいです。 Chromeでこの機能を試しました。 –

答えて

7

ドラッグ操作中にマウスがキャプチャされるため、アプリケーションの任意のフォーム外にあっても、ドラッグ操作がOnEndDragハンドラで終了したことを検出することに問題はありません。 'target'オブジェクトをテストすることによってドロップが受け入れられているかどうかを知ることができます。ドロップが受け入れられない場合は、マウスの位置をテストすることで、ドロップがアプリケーション外にあるかどうかを判断できます。

しかし、この方法には依然として問題があります。 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

すばらしい答えSertac。ありがとう。 – norgepaul

関連する問題