Chromeのタブドラッグ機能をエミュレートしようとしています。ユーザーがタブストリップ内の新しい場所にタブをドラッグするか、アプリケーションの外にドロップして新しいウィンドウを作成できるようにします。アプリケーション内でドラッグするのは簡単ですが、ユーザーが自分のアプリではなくどこかにドロップしたときはどうすれば検出できますか?アプリケーションの外にドラッグドロップを検出するにはどうすればよいですか?
本質的に私は「引き裂き」タブを実装しようとしています。
Chromeのタブドラッグ機能をエミュレートしようとしています。ユーザーがタブストリップ内の新しい場所にタブをドラッグするか、アプリケーションの外にドロップして新しいウィンドウを作成できるようにします。アプリケーション内でドラッグするのは簡単ですが、ユーザーが自分のアプリではなくどこかにドロップしたときはどうすれば検出できますか?アプリケーションの外にドラッグドロップを検出するにはどうすればよいですか?
本質的に私は「引き裂き」タブを実装しようとしています。
ドラッグ操作中にマウスがキャプチャされるため、アプリケーションの任意のフォーム外にあっても、ドラッグ操作が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。非常にうまくいった! :-) –
すばらしい答えSertac。ありがとう。 – norgepaul
このリンクは、[アプリケーション内のドラッグアンドドロップ](http://stackoverflow.com/q/198488/576719)ですか? –
@LURD:質問を再読み、「新しいウィンドウを作成する」ことがわかるまで、私はあまりにも思っていて、ほとんどそれを複写と呼びました。これは「別のアプリケーション」ではありません。何かが外部にドロップされたときに、自分のアプリケーションに新しいウィンドウを作成しています。私は代わりにupvoted。 :-)それは良い質問であるようです。 –
@KenWhite、あなたは正しいです。 Chromeでこの機能を試しました。 –