[D7] Problème de Drag And Drop dans la FAQ

Version imprimable

04/03/2018, 18h31
Charly910

[D7] Problème de Drag And Drop dans la FAQ

Bonjour,

j'ai essayé de tester le Drag and drop de la FAQ

Comment récupérer le nom d'un fichier de l'explorateur Windows dans un TListBox avec un drag & drop ?

La fenêtre accepte le Drag and drop d'un fichier depuis l'explorateur, mais le nom du fichier ne s'affiche pas dans la ListBox ?

Savez vous pourquoi ? (on ne passe pas dans la fonction WM_DropFiles)

A+
Charly
04/03/2018, 21h06
Andnotor

Essaye ceci.
05/03/2018, 08h36
Charly910
Merci Andornot,

j'ai ajouté
Code:

1 2 ChangeWindowMessageFilterEx(AImage.Handle, WM_COPYGLOBALDATA, MSGFLT_ADD, nil); ChangeWindowMessageFilterEx(AImage.Handle, WM_DROPFILES, MSGFLT_ADD, nil);
dans le create de ma form, mais comme d'habitude je ne trouve pas le uses à ajouter ... (le F1 de D7 ne me donne rien !) je cherche ...

A+
Charly
05/03/2018, 09h39
tourlourou

Si jamais D7 ne le connaît pas (c'est arrivé avec W7), il suffit de l'importer de User32.dll ; le prototype est : sur le msdn.

Merci Tourlourou,

j'ai essayé, mais je n'arrive pas à grand chose ! j'ai ajouté :

Code:

function ChangeWindowMessageFilterEx(hWnd: HWND; Message : Integer ; Action : DWord): Boolean; stdcall; external 'User32.dll';

et dans le Create de la Form :
Code:

1 2 3 4 5 6 7 procedure TForm2.FormCreate(Sender: TObject); begin //la fenêtre accepte le glissement d'objets ChangeWindowMessageFilterEx(Handle, WM_COPYGLOBALDATA, MSGFLT_ADD, nil); ChangeWindowMessageFilterEx(Handle, WM_DROPFILES, MSGFLT_ADD, nil); DragAcceptFiles(Handle, True); end;
WM_COPYGLOBALDATA et MSGFLT_ADD ne sont pas trouvés (et le nil est en trop)

A+
Charly

05/03/2018, 12h17
Andnotor

Il manque un paramètre dans ton prototype "Ex".

Pour ChangeWindowMessageFilter : function(Msg: uint; dwFlag : dword):BOOL; stdcall;.

MSGFLT_ADD = 1
WM_COPYGLOBALDATA = $49

ps: ce n'est pas une bonne solution de déclarer statiquement cette fonction si ton app doit encore supporter XP.

Toujours en pleine panade ...

je fais :

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
unit Unit2;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls, ShellApi  ;
 
Const
     WM_COPYGLOBALDATA = $49  ;
     MSGFLT_ADD = 1  ;
 
 
type
  TForm2 = class(TForm)
    Label1: TLabel;
    ...
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    ...
  private
    { Déclarations privées }
  protected
     procedure WM_DropFiles(var Msg: TMessage); message WM_DROPFILES;
  public
    { Déclarations publiques }
  end;
var
  Form2: TForm2;
  ...
  ChangeWindowMessageFilter : function(Msg: uint; dwFlag : dword):BOOL; stdcall;
implementation
 
{$R *.dfm}
 
{ =========================================================== }
procedure TForm2.FormCreate(Sender: TObject);
begin
  //la fenêtre accepte le glissement d'objets
  ChangeWindowMessageFilter(WM_DROPFILES,1);
//  ChangeWindowMessageFilterEx(Handle, WM_COPYGLOBALDATA, MSGFLT_ADD);
//  ChangeWindowMessageFilterEx(Handle, WM_DROPFILES, MSGFLT_ADD);
  DragAcceptFiles(Handle, True);
end;
 { =========================================================== }
procedure TForm2.WM_DropFiles(var Msg: TMessage);  
// d'après le FAQ
 
var hDeposer: THandle;  
    countFiles, i: integer;  
    FileName: Array[0..255]Of Char;  
begin  
  //Récupérer dans hDeposer le handle envoyé par le message WM_DROPFILES  
  hDeposer := THandle(Msg.wParam);
  //Compter le nombre de fichiers déposés.  
  countFiles := DragQueryFile(hDeposer, UINT(-1), nil, 0);  
  for i := 0 to pred(countFiles) do  
  begin  
    //Déterminer le nom du ième fichier déposé  
    DragQueryFile(hDeposer, i, FileName, 255);  
    //Ajouter le nom du fichier dans le listbox 
    ListBox1.Items.Add(FileName);  
  end;  
  //Indiquer à Windows la fin du déposer  
  DragFinish(hDeposer);  
end;
 { =========================================================== }
 
...
 
end.

j'ai un message pas assez de paramètres originaux sur

Code:

ChangeWindowMessageFilter(WM_DROPFILES,1);

de plus, avec ChangeWindowMessageFilter MSGFLT_ADD et WM_COPYGLOBALDATA ne servent pas ? (sinon il faut utiliser ChangeWindowMessageFilterEx ?)

pour éviter la déclaration statique, comment faire autrement ?

A+
Charly

Bonjour,

peut être comme ceci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
var
  ChangeWindowMessageFilter : function(Msg: uint; dwFlag : dword):BOOL; stdcall;
const
  MSGFLT_ADD = 1;
  WM_COPYGLOBALDATA = $49;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  lbrHandle: THandle;
begin
  lbrHandle := SafeLoadLibrary('User32.dll');
 if lbrHandle <> 0 then
 try
   ChangeWindowMessageFilter := GetProcAddress(lbrHandle, 'ChangeWindowMessageFilter');
   if Assigned(ChangeWindowMessageFilter) then begin
     ChangeWindowMessageFilter(WM_DROPFILES, MSGFLT_ADD);
     ChangeWindowMessageFilter(WM_COPYGLOBALDATA, MSGFLT_ADD);
   end;
 finally
   FreeLibrary(lbrHandle);
 end;
end;

Cordialement,
@+

05/03/2018, 16h04
Charly910

Bonjour Cirec,

j'ai mis ton code dans mon Create, mais à la compil, j'ai toujours 'pas assez de paramètres originaux' sur

Code:

ChangeWindowMessageFilter(WM_DROPFILES, MSGFLT_ADD);

juste après WM_DROPFILES,

il doit y avoir un Pb dans la déclaration de la fonction :

Code:

ChangeWindowMessageFilter : function(Msg: uint; dwFlag : dword):BOOL; stdcall;

A+
Charly

C'est curieux car si je fais
Code:

1 2 // ChangeWindowMessageFilter(WM_DROPFILES, MSGFLT_ADD); ChangeWindowMessageFilter(WM_COPYGLOBALDATA, MSGFLT_ADD);
ça compile. C'est le WM_DropFiles qui ne lui plait pas ?

05/03/2018, 16h18
Cirec

j'ai testé le code avec D7 et W7 et il fonctionne
ce qui me fait penser à ...

as tu retiré toutes les anciennes déclarations du type:

Code:

function ChangeWindowMessageFilterEx(hWnd: HWND; Message : Integer ; Action : DWord): Boolean; stdcall; external 'User32.dll';

de ton code qui pourraient parasiter et peut être mener à ce genre d'erreur !!

sinon je vois pas!

EDIT:
ah ben là encore plus curieux. Toujours est il que chez moi ça fonctionne !
essayes peut être dans un nouveau projet pour voir si ça passe ou pas

Cordialement,
@+
05/03/2018, 16h53
tourlourou

Le problème doit venir de la FAQ : le compilo n'aime pas que le même nom soit utilisé 2 fois :

Code:

procedure WM_DropFiles(var Msg: TMessage); message WM_DROPFILES;
05/03/2018, 16h56
Cirec

Citation:

Envoyé par tourlourou

Le problème doit venir de la FAQ : le compilo n'aime pas que le même nom soit utilisé 2 fois :

Code:

procedure WM_DropFiles(var Msg: TMessage); message WM_DROPFILES;

Effectivement bien vu ;)

il suffit donc de modifier en:

Code:

procedure WMDropFiles(var Msg: TMessage); message WM_DROPFILES;

Cordialement,
@+
05/03/2018, 17h51
Charly910

Super,
ça marche :applo:

je pense qu'il faudrait modifier la FAQ (le WMDropFiles) et aussi pour ceux qui ont W10 ou W8 ajouter le code de Cirec ?

Reste ce que dit Andnotor sur XP ?

Merci à tous les 3

A+
Charly
05/03/2018, 18h12
tourlourou

Oui, la modification de la FAQ a été demandée, enrichie de toutes ces remarques.

Sinon,

une fonction autonome qui marche bien à appeler dans le Create de la fenêtre :

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
 { =========================================================== }
 procedure  TForm2.SetDragAndDropOnSystemsWIthUAC(Wnd : HWND; IsEnabled : boolean);
type
  TChangeWindowMessageFilter = function(Msg : Cardinal; Action : Word) : Bool; stdcall;
const
  Msg_Add = 1;
  WM_COPYGLOBALDATA = $49;
var
  DllHandle : THandle;
  ChangeWindowMessageFilter : TChangeWindowMessageFilter;
begin
  DllHandle := LoadLibrary('user32.dll');
  if DllHandle > 0 then
  begin
    ChangeWindowMessageFilter := GetProcAddress(DllHandle, 'ChangeWindowMessageFilter');
    if Assigned(ChangeWindowMessageFilter) then
    begin
      DragAcceptFiles(Wnd, IsEnabled);
      ChangeWindowMessageFilter(WM_DROPFILES, Msg_Add);
      ChangeWindowMessageFilter(WM_COPYGLOBALDATA, Msg_Add);
    end;
  end;
end;
 { =========================================================== }

appel :

Code:

1
2
3
4
5
6
7
{ =========================================================== }
procedure TForm2.FormCreate(Sender: TObject);
begin
  SetDragAndDropOnSystemsWIthUAC(Handle, True);
  DragAcceptFiles(Handle, True);
end;
{ =========================================================== }

Merci à tous

A+
Charly

05/03/2018, 21h53
Andnotor

Il faut tout de même rappeler que ce problème survient à cause d'une différence de privilèges entre l'application cible et la source.
En gros, ton application est lancée en mode admin (il y a eu élévation de privilèges) ou tu débogues depuis Delphi qui a été lancé en mode admin.
UIAccess=TRUE dans un manifest alloue aussi des privilèges supplémentaires (même s'il n'y a pas de fenêtre de confirmation). Les messages qui lui sont adressés sont également filtrés.

Et pour être plus généraliste, ça concerne une partie des messages en dessous de WM_USER et tous ceux en dessus.
06/03/2018, 13h33
Charly910

Ok, merci Andnotor, je pense qu'il faudra expliquer tout cela dans la FAQ (de façon la plus simple possible, car pour moi ce n'est pas évident !!)

J'ai vu pas mal d'articles sur le net à ce sujet et je ne suis donc pas seul à avoir eu ce Pb.

Je marque résolu, car chez moi tout marche bien maintenant.

A+
Charly