DragOverイベントが発生しない場合がある

解決

take 2021-10-28 00:03:00 No: 149908 IP: 192.*.*.*

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;

編集削除

take 2021-10-28 02:46:55 No: 149909 IP: 192.*.*.*

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;

編集削除

take 2021-11-02 07:06:16 No: 149915 IP: 192.*.*.*

リストのクリックイベントやマウス降下のイベントを監視してみましたが
MouseDown内の処理をタイマーで動かすなどして
すぐにMouseDownイベントを抜け出さないとDragOverイベントは発生しないようです。

Application.ProcesMessageではダメでした

編集削除

Mr.XRAY 2021-11-03 03:20:41 No: 149916 IP: 192.*.*.*

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;

編集削除

take 2021-11-04 01:36:45 No: 149917 IP: 192.*.*.*

レスありがとうございます。
サンプルソースに入れて試したところ
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;

編集削除

Mr.XRAY 2021-11-04 02:07:41 No: 149918 IP: 192.*.*.*

先に提示したコードは，
TListBox.OnDragOver イベントが発生しないということに対するコードです．
他のアプリへの Drag & Drop 処理用のコードではありません．

他のアプリへのデータの Drag & Drop 機能は，
IDropSource インターフェイスを使用して実装します．
Drag & Drop で他のアプリのデータを受け取るには，
IDrogTarget インターフェイスを使用して実装します．

エクスプローラからのファイルの Drag & Drop には，
専用のメッセージ，関数類があります．

編集削除

take 2021-11-04 03:21:01 No: 149919 IP: 192.*.*.*

お気遣いありがとうございます。

他アプリへのDrag&Drop部分は完成していまして
そこにTListBoxのイベントを送って処理させているのですが

選択するファイルの数が増えていくと
内部処理が増えてDrag&Dropに必要なイベントが
発生しなくなる現象が発生していました。

週末に教えて頂いたソースに置き換えて試してみます。

Mr.XRAY様のDrag&Dropのサンプルページも見ておりますが、今回は独自仕様で進めています。

編集削除

take 2021-11-05 07:36:14 No: 149920 IP: 192.*.*.*

本番のプログラムに組み込んでみたところ安定して動作するようになりました。
すでに「解決済み」を押していますが、これで完全解決とさせて頂きます。

編集削除