...Drag & Drop mit dem Explorer realisieren?

Autor: Pablo Reyes

Kategorie: Dateien

{
  This way you can drag and drop files to a specific control in a Delphi form.
  Just create a project and add a ListBox component to Form1.}

{ 1. First, a procedure to handle the message but without handling it. }

interface

procedure 
WMDROPFILES(var Msg: TMessage);

implementation

procedure 
TForm1.WMDROPFILES(var Msg: TWMDropFiles);
var
  
pcFileName: PChar;
  i, iSize, iFileCount: integer;
begin
  
pcFileName := ''; // to avoid compiler warning message
  
iFileCount := DragQueryFile(Msg.wParam, $FFFFFFFF, pcFileName, 255);
  for i := 0 to iFileCount - 1 do
  begin
    
iSize := DragQueryFile(Msg.wParam, i, nil, 0) + 1;
    pcFileName := StrAlloc(iSize);
    DragQueryFile(Msg.wParam, i, pcFileName, iSize);
    if FileExists(pcFileName) then
      
AddFile(pcFileName); // method to add each file
    
StrDispose(pcFileName);
  end;
  DragFinish(Msg.wParam);
end;


{
  2. Second, a WindowProc method to replace ListBox1 WindowProc default method
  and a variable to store ListBox1 WindowProc default method.
}

interface

procedure 
LBWindowProc(var Message: TMessage);

implementation

var
  
OldLBWindowProc: TWndMethod;

procedure TForm1.LBWindowProc(var Message: TMessage);
begin
  if Message
.Msg = WM_DROPFILES then
    
WMDROPFILES(Message); // handle WM_DROPFILES message
  
OldLBWindowProc(Message);
  // call default ListBox1 WindowProc method to handle all other messages
end;

{3. In Form1 OnCreate event, initialize all.}

procedure TForm1.FormCreate(Sender: TObject);
begin
  
OldLBWindowProc := ListBox1.WindowProc; // store defualt WindowProc
  
ListBox1.WindowProc := LBWindowProc; // replace default WindowProc
  
DragAcceptFiles(ListBox1.Handle, True); // now ListBox1 accept dropped files
end;


{4. In Form1 OnDestroy event, uninitialize all. Not necesary but a good practice.}

procedure TForm1.FormDestroy(Sender: TObject);
begin
  
ListBox1.WindowProc := OldLBWindowProc;
  DragAcceptFiles(ListBox1.Handle, False);
end;


{5. To complete source code, the AddFile method.}

interface

procedure 
AddFile(sFileName: string);

implementation

procedure 
TForm1.AddFile(sFileName: string);
begin
  
ListBox1.Items.Add(sFilename);
end;

{6. Do not forget to add ShellAPI unit to the uses clause. }

Complete code


unit Unit1;

interface

uses
  
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  
TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    
{ Private declarations }
    
procedure WMDROPFILES(var Msg: TMessage);
    procedure LBWindowProc(var Message: TMessage);
    procedure AddFile(sFileName: string);
  public
    
{ Public declarations }
  
end;

var
  
Form1: TForm1;

implementation

{$R *.DFM}

uses
  
ShellAPI;

var
  
OldLBWindowProc: TWndMethod;

procedure TForm1.AddFile(sFileName: string);
begin
  
ListBox1.Items.Add(sFilename);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  
OldLBWindowProc := ListBox1.WindowProc; // store defualt WindowProc
  
ListBox1.WindowProc := LBWindowProc; // replace default WindowProc
  
DragAcceptFiles(ListBox1.Handle, True); // now ListBox1 accept dropped files
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  
ListBox1.WindowProc := OldLBWindowProc;
  DragAcceptFiles(ListBox1.Handle, False);
end;

procedure TForm1.LBWindowProc(var Message: TMessage);
begin
  if Message
.Msg = WM_DROPFILES then
    
WMDROPFILES(Message); // handle WM_DROPFILES message
  
OldLBWindowProc(Message);
  // call default ListBox1 WindowProc method to handle all other messages
end;

procedure TForm1.WMDROPFILES(var Msg: TMessage);
var
  
pcFileName: PChar;
  i, iSize, iFileCount: integer;
begin
  
pcFileName := ''; // to avoid compiler warning message
  
iFileCount := DragQueryFile(Msg.wParam, $FFFFFFFF, pcFileName, 255);
  for i := 0 to iFileCount - 1 do
  begin
    
iSize := DragQueryFile(Msg.wParam, i, nil, 0) + 1;
    pcFileName := StrAlloc(iSize);
    DragQueryFile(Msg.wParam, i, pcFileName, iSize);
    if FileExists(pcFileName) then
      
AddFile(pcFileName); // method to add each file
    
StrDispose(pcFileName);
  end;
  DragFinish(Msg.wParam);
end;

end.

 

printed from
www.swissdelphicenter.ch
developers knowledge base