Discussion :

[cincap]

Bonjour à toutes et à tous,

Est t'il possible lors d'un drag and drop depuis un dossier, avant de déposer les fichiers avoir une autre action ?

J'ai un TListBox mais pour le visuel j'ai placé un TImage devant, j'aimerai lorsque j'ai les fichiers en mains en passant sur le TImage le rendre invisible et déposer les fichiers sur le composant récepteur.

J'ai tout testé mais peut-être en interceptant le message.

Si quelqu'un avait une piste merci d'avance.

@+,

cincap

[ShaiLeTroll]

Tu peux faire une indirection, le OnDragOver du TImage cache ce dernier et appelle le OnDragOver du TListBox
Sinon OnMouseMove ..

Sinon, comme un TImage peut être par dessus un TListBox ? un GraphicControl est dessiné sur son parent, donc il n'est pas par dessus le ListBox, sauf si c'est un TImage dans un TPanel mais même en ParentBackground, ce dernier cache le listBox

Pourquoi ne pas poser tes questions dans https://www.developpez.net/forums/f7...omposants-vcl/ ?
Non c'est que depuis que tu traines ici, c'est plus du débutant

[cincap]

@ ShaiLeTroll, bonjour et merci de ta réponse, le TImage est bien sur un TPanel et j'avais testé le onmousemove sans résultat car lors du drag, les fichiers sont dans la main et prêt à être déposé.

Le onmousemove est inactif.

A ta question :

Pourquoi ne pas poser tes questions dans https://www.developpez.net/forums/f7...omposants-vcl/ ?
Non c'est que depuis que tu traines ici, c'est plus du débutant

J'estime que même si je connais beaucoup d'astuces, j'estime être encore débutant et cette manipulation m'est non connue à mon âge et je n'ai trouvé aucune solution sur le net à part comment on code un drag and drop.

Je vais encore tester.

@+,

cincap

[ShaiLeTroll]

c'est genre une image contenant icone "glisser ici" par dessus le ListBox ?

Pour moi, le TImage doit avoir ses OnDragOver et OnDrapDrop comme si il était un proxy pour le receveur
soit les gestionnaires sont les mêmes entre le TImage et le TListBox, et il faut faire attention au Sender
soit les gestionnaires sont différents et dans ce cas le TImage invoque manuellement les gestionnaires du TListBox

C'est comme le OnMouseMove, si un control cache un autre control , il faut mettre les gestionnaires sur les control superposé et dispatcher vers le receveur réel

[blonde]

Hello,


le dossier depuis lequel tu récupères les fichiers est bien l'explorateur de Windows ?
Et du coup, tu utilises l'événement WM_DROPFILES.
Dans ce cas, ta form n'a pas le focus, et donc les événements OnOver, MouseMouse, ... ne s’exécutent pas.

Je pense que tu devrias intercepter les mouvements de la souris, un peu dans cette idée : http://lazplanet.blogspot.com/2016/0...side-your.html
Et tu calcules, si tu passes sur ton image.

N'oublie pas que tu as les fonctions ClientToScreen et ScreenToClient qui te seront bien utiles pour effectuer les changements de coordonnées.

[Paul TOTH]

WM_DROPFILES c'est l'étape finale, pour interagir avant il faut passer par une solution un peu plus sioux avec IDropTarget (dans Winapi.ActiveX) et RegisterDragDrop

si tu ne veux pas tout gérer toi même tu peux utiliser
https://github.com/landrix/The-Drag-...ite-for-Delphi

[Cirec]

Bonjour,

voici un exemple qui fait exactement ce que tu demandes le tout en
restant assez simple.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
unit UDropTest;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, crFileDrops, AppEvnts;
 
type
  Tfrm_DropTest = class(TForm)
    Image1: TImage;
    ListBox1: TListBox;
    Panel1: TPanel;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Drop(Sender: TObject; DropContainer: TWinControl; out FileList: TStrings);
    procedure WndProc(var Message: TMessage); override;
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
    FFileDrop: TcrFileDrop;
  public
    { Déclarations publiques }
  end;
 
var
  frm_DropTest: Tfrm_DropTest;
 
implementation
 
{$R *.dfm}
 
procedure Tfrm_DropTest.Drop(Sender: TObject; DropContainer: TWinControl; out FileList: TStrings);
begin
  ListBox1.Items.Assign(FileList);
  //Caption := Format('X: %d - Y: %d', [FFileDrop.DropPoint.X, FFileDrop.DropPoint.Y]);
end;
 
procedure Tfrm_DropTest.FormCreate(Sender: TObject);
begin
  FFileDrop := TcrFileDrop.Create(Self);
  FFileDrop.DropContainer := ListBox1;
  FFileDrop.OnAfterDrop := Drop;
end;
 
procedure Tfrm_DropTest.WndProc(var Message: TMessage);
begin
  if ((Message.Msg = CM_MOUSEENTER) and (Message.LParam = Integer(Panel1))) and
    ((GetKeyState(VK_LBUTTON) and $8000 )<>  $8000)  then
  begin
    Panel1.Visible := False;
    Button1.Enabled := True;
  end
  else
    inherited WndProc(Message);
end;
procedure Tfrm_DropTest.Button1Click(Sender: TObject);
begin
  Panel1.visible := True;
  Button1.Enabled := False;
end;
 
end.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
{—————————————————————————————————————————————————————————————————————————}
{ Project : crDrop.dpk                                                    }
{ Comment :                                                               }
{                                                                         }
{    Date : 08/12/2008 20:33:02                                           }
{  Author : Cirec                                                         }
{—————————————————————————————————————————————————————————————————————————}
{ Last modified                                                           }
{    Date : 09/12/2008 01:25:18                                           }
{  Author : Cirec                                                         }
{—————————————————————————————————————————————————————————————————————————}
unit crFileDrops;
 
interface
 
uses
  Windows, SysUtils, Classes, Messages, Controls, ShellApi;
 
type
 
 
  TBeforeDrop = procedure(Sender: TObject; out DropPoint: TPoint) of Object;
  TAfterDrop = procedure(Sender: TObject; DropContainer: TWinControl; out FileList: TStrings) of Object;
 
 
  TcrFileDrop = class(TComponent)
  private
    { Déclarations privées }
    DefWndProc: TWndMethod;
    FDropContainer: TWinControl;
    FFileList: TStrings;
    FOnAfterDrop: TAfterDrop;
    FDropPoint: TPoint;
    FOnBeforeDrop: TBeforeDrop;
    procedure SetDropContainer(const Value: TWinControl);
  protected
    { Déclarations protégées }
    procedure DropWndProc(var Message: TMessage);
    procedure RemoveDropContainer;
    procedure SetHackWndProc;
  public
    { Déclarations publiques }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property DropPoint: TPoint read FDropPoint {write FDropPoint};
  published
    { Déclarations publiées }
    property DropContainer: TWinControl read FDropContainer write SetDropContainer;
    property OnBeforeDrop: TBeforeDrop read FOnBeforeDrop write FOnBeforeDrop;
    property OnAfterDrop: TAfterDrop read FOnAfterDrop write FOnAfterDrop;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Cirec DelphiFr', [TcrFileDrop]);
end;
 
{ TcrFileDrop }
 
constructor TcrFileDrop.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDropContainer := nil;
  DefWndProc := nil;
  FFileList := TStringList.Create;
end;
 
destructor TcrFileDrop.Destroy;
begin
  RemoveDropContainer;
  FFileList.Free;
  inherited Destroy;
end;
 
 
procedure TcrFileDrop.DropWndProc(var Message: TMessage);
const
  DQF_COUNTFILES = $FFFFFFFF;
var FileCount, FileNameLen, I: integer;
    FileName : string;
begin
  if message.Msg = WM_DropFiles  then
  begin
    FFileList.Clear;
    //nombre de fichiers dans la queue
    FileCount := DragQueryFile(message.wParam, DQF_COUNTFILES, nil, 0);
    // récupère la position de la souris lors du Drop si besoin
    DragQueryPoint(message.wParam, FDropPoint);
    for I := 0 to pred(FileCount) do
    begin
      // Longueur du nom du fichier
      FileNameLen := DragQueryFile(message.wParam, I, Nil, 0) + 1;
      // ajuste la taille
      SetLength(FileName, FileNameLen);
      // récupère les données
      DragQueryFile(message.wParam, I, PChar(FileName), FileNameLen);
      // ajout à la Liste
      FFileList.Add(FileName);
    end;
    // fin du drop
    DragFinish(message.wParam);
 
    if Assigned(FOnBeforeDrop) then
      FOnBeforeDrop(Self, FDropPoint);
    // si l'évènement OnAfterDrop est assigné et si il y a au moins
    // un fichier dans la liste on le déclanche
    if Assigned(FOnAfterDrop) and (FileCount > 0) then
      FOnAfterDrop(Self, FDropContainer, FFileList);
  end
  else
  // traitement par défaut
    DefWndProc(message);
end;
 
 
procedure TcrFileDrop.RemoveDropContainer;
begin
  if not (csDesigning in ComponentState) and Assigned(FDropContainer)
    and Assigned(DefWndProc) then
  begin
    FDropContainer.WindowProc := DefWndProc;
    if not (csDestroying in ComponentState) then
      DragAcceptFiles(FDropContainer.Handle, False);
    FDropContainer := nil;
    DefWndProc := nil;
  end;
end;
 
procedure TcrFileDrop.SetDropContainer(const Value: TWinControl);
begin
  if Value <> FDropContainer then
  begin
    RemoveDropContainer;
    FDropContainer := Value;
    SetHackWndProc;
  end;
 
end;
 
procedure TcrFileDrop.SetHackWndProc;
begin
  if Assigned(FDropContainer) and not (csDesigning in ComponentState) then
  begin
    DefWndProc := FDropContainer.WindowProc;
    FDropContainer.WindowProc := DropWndProc;
    DragAcceptFiles(FDropContainer.Handle, true);
  end;
end;
 
 
end.

Le zip testé avec D6:DropFiles.zip

Cordialement,

@+

[cincap]

Bonjour à toutes et à tous,

@ tous merci pour les suggestions.

@ Cirec, merci de ton exemple que je lis un peu tard à cause de mes problèmes de santé mais toujours présent.

Après test cela fonctionne je garde en réserve.

@+,

cincap