DragOverイベントが発生しない場合がある
解決ListBoxの内容を他のDelphiアプリにドラッグアンドドロップする処理を作っているのですが
マウス操作を素早く行うとDragOverイベントが発生しなくなります。
リストボックスを配置して「DragMode」を「dmAutomatic」にして
DragOverとMouseDownに下記の処理で確認します。
普段は問題無いのですが、このリストボックスをフォームの端や全体に広げた状態で
マウス降下とフォーム外へマウスカーソルの移動を素早く行うと
MouseDownのみ発生してDragOverイベントが発生しなくなります。
何か解決方法はありますでしょうか？
環境 32bit VCLフォームアプリケーション Windows10 DephiXE5
procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
ListBox1.Items.Add('DragOver');
ListBox1.ItemIndex := ListBox1.Items.Count-1;
end;
procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ListBox1.Items.Add('MouseDown');
ListBox1.ItemIndex := ListBox1.Items.Count-1;
end;
TListBoxのMouseDownやClickイベント内で行う処理が増えると
処理をしている間にマウスカーソルがDelphiアプリを離れた時には
DragOverイベントは発生しなくなるようです。
送るデータをクリックしたときに準備しているので
そこそこ処理時間が必要なのですが、これは仕様ですかね
procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ListBox1.Items.Add('MouseDown');
ListBox1.ItemIndex := ListBox1.Items.Count-1;
Sleep(500);
end;
リストのクリックイベントやマウス降下のイベントを監視してみましたが
MouseDown内の処理をタイマーで動かすなどして
すぐにMouseDownイベントを抜け出さないとDragOverイベントは発生しないようです。
Application.ProcesMessageではダメでした
TListView.DragMode := dmManual (デフォルト) にして・・・
procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := Sender = Source;
if Accept then begin
//
end;
end;
procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then begin
TListBox(Sender).BeginDrag(True);
end;
end;
レスありがとうございます。
サンプルソースに入れて試したところ
MouseDownイベント内で処理に時間がかかっても
処理終了後にAcceptが Trueの状態でDragOverイベントが発生するという理想通りの動作になりました。
BeginDragも試していたのですがBeginDragがあるならEndDragも必要だろうと色々やっていたのも動作に影響を与えていたようです。
本番の環境にも組み込んで試して見ます。
ありがとうございました。
procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := Sender = Source;
if Accept then begin
ListBox1.Items.Add('Accept');
ListBox1.ItemIndex := ListBox1.Items.Count-1;
end;
end;
procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then begin
TListBox(Sender).BeginDrag(True);
ListBox1.Items.Add('BeginDrag');
ListBox1.ItemIndex := ListBox1.Items.Count-1;
end;
Sleep(500);
end;
procedure TForm1.ListBox1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
// これを加えると動かなくなる
//TListBox(Sender).EndDrag(True);
ListBox1.Items.Add('EndDrag');
ListBox1.ItemIndex := ListBox1.Items.Count-1;
end;
先に提示したコードは，
TListBox.OnDragOver イベントが発生しないということに対するコードです．
他のアプリへの Drag & Drop 処理用のコードではありません．
他のアプリへのデータの Drag & Drop 機能は，
IDropSource インターフェイスを使用して実装します．
Drag & Drop で他のアプリのデータを受け取るには，
IDrogTarget インターフェイスを使用して実装します．
エクスプローラからのファイルの Drag & Drop には，
専用のメッセージ，関数類があります．
お気遣いありがとうございます。
他アプリへのDrag&Drop部分は完成していまして
そこにTListBoxのイベントを送って処理させているのですが
選択するファイルの数が増えていくと
内部処理が増えてDrag&Dropに必要なイベントが
発生しなくなる現象が発生していました。
週末に教えて頂いたソースに置き換えて試してみます。
Mr.XRAY様のDrag&Dropのサンプルページも見ておりますが、今回は独自仕様で進めています。
本番のプログラムに組み込んでみたところ安定して動作するようになりました。
すでに「解決済み」を押していますが、これで完全解決とさせて頂きます。
| ツイート |  |