[D10.2] Drag and drop depuis explorateur vers TListBox

Bonjour,

Avec Delphi 10.2 et windows 10 je tente d'utiliser le drag and drop depuis l'explorateur vers une listbox, j'utilise ce qui est décrit dans la FAQ mais cela ne fonctionne pas.

Je précise que je fais cela depuis un frame et non pas une form.

J'ai du mettre

Code:

DragAcceptFiles(ListBox1.Handle, true);

en dehors du Create du frame sinon il n'était pas pris en compte
Code:

1 2 3 4 5 6 7 protected procedure WMDropFiles(var Msg: TMessage); message WM_DROPFILES; procedure TFrame1.WMDropFiles(var Msg: TMessage); begin ShowMessage('on drop'); end;
Lorsque je drag un fichier depuis l'explorateur sur la listbox, le curseur change bien d'apparence pour indiquer que l'on va dropper le fichier mais l'événement WMDropFiles n'est jamais éxécuté

Est ce que c'est parce que c'est un frame ?

forcément...tu indiques que c'est ListBox1 qui accepte les fichiers, et tu captures le message sur la Frame

donc soit tu acceptes le drag&drop sur la frame, soit tu dois dériver la ListBox pour qu'elle capture le message WM_DROPFILES

exemple

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
 
unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Winapi.ShellAPI;
 
type
  TDropFilesEvent = procedure(Sender: TObject; const Files: TArray<string>) of object;
 
  TListBox = class(Vcl.stdCtrls.TListBox)
  private
    FOnDropFiles: TDropFilesEvent;
    procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
  public
    procedure CreateWnd; override;
    property OnDropFiles: TDropFilesEvent read FOnDropFiles write FOnDropFiles;
  end;
 
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
    procedure OnDropFiles(Sender: TObject; const Files: TArray<string>);
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
{ TListBox }
 
procedure TListBox.CreateWnd;
begin
  inherited;
  DragAcceptFiles(Handle, true);
end;
 
procedure TListBox.WMDropFiles(var Msg: TWMDropFiles);
var
  Count: Integer;
  Files: TArray<string>;
  Index: Integer;
  Len: Integer;
begin
  Count := DragQueryFile(Msg.Drop, Cardinal(-1), nil, 0);
  SetLength(Files, Count);
  for Index := 0 to Count - 1 do
  begin
    Len := DragQueryFile(Msg.Drop, Index, nil, 0);
    SetLength(Files[Index], Len);
    DragQueryFile(Msg.Drop, Index, PChar(Files[Index]), Len + 1);
  end;
  DragFinish(Msg.Drop);
  if (Count > 0) and Assigned(FOnDropFiles) then
    FOnDropFiles(Self, Files);
end;
 
{ TForm1 }
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  ListBox1.OnDropFiles := OnDropFiles;
end;
 
procedure TForm1.OnDropFiles(Sender: TObject; const Files: TArray<string>);
begin
  for var I := 0 to Length(Files) - 1 do
     ShowMessage(Files[I]);
end;
 
end.

NB: la nouvelle déclaration de TListBox peut être placée dans une unité DropFilesListBox.pas que l'on placera APRES Vcl.StdCtrls dans le uses dans toute unité qui en aura besoin.

attention, toutes les listbox de la fiche accepteront alors les fichiers...mais on peut remédier à cela

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
  TListBox = class(Vcl.stdCtrls.TListBox)
  private
    FAcceptFiles: Boolean;
    FOnDropFiles: TDropFilesEvent;
    procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
    procedure SetAcceptFiles(Value: Boolean);
  public
    procedure CreateWnd; override;
    property OnDropFiles: TDropFilesEvent read FOnDropFiles write FOnDropFiles;
    property AccepFiles: Boolean read FAcceptFiles write SetAcceptFiles;
  end;
...
 
procedure TListBox.CreateWnd;
begin
  inherited;
  if FAcceptFiles then
    DragAcceptFiles(Handle, true);
end;
 
procedure TListBox.SetAcceptFiles(Value: Boolean);
begin
  if Value <> FAcceptFiles then
  begin
    FAcceptFiles := Value;
    if HandleAllocated then
    begin
      DragAcceptFiles(Handle, FAcceptFiles);
    end;
  end;
end;

Merci Paul, ça marche nickel ! :ccool:

curseur du drop

Bonjour,

En utilisant cette unité qui dérive TListBox, est ce qu'il y a un moyen de changer l'apparence du curseur lorsque la souris se déplace au dessus de la ListBox pour faire le drop du fichier ( provenant de l'explorateur windows ) ?

Merci d'avance