Drag Drop

[JuanOrtega]

Hola , tengo pensado tener un form comun en delphi xe donde pueda arrastrar un archivo (mas bien una imagen) del escritorio al formulario delphi xe y dejar la ruta de la imagen en un edit del formulario , lo eh visto en varios programas y por ahi lei que era drag drop pero no encuentro ejemplos claros de lo que quiero hacer ¿ es realmente drag drop ? ¿ alguien me podria dar documentacion o links de lo que quiero hacer ?

[Casimiro Notevi]

Por favor, recuerda poner títulos descriptivos a tus preguntas, gracias

[ecfisa]

Hola Lepuke.

Ejemplo para versiones anteriores a Windows 7:

Código Delphi [-]
...
type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
     procedure DragDropFile(var Msg: TMessage ); message WM_DROPFILES;
  public
  end;
...
implementation 

uses ShellApi;

procedure TForm1.DragDropFile(var Msg: TMessage);
var
  Cont, i : integer;
  FName : array [0..MAX_COMPUTERNAME_LENGTH+MAX_PATH] of char;
begin
  Cont := DragQueryFile(Msg.WParam, $FFFFFFFF, FName, 255)-1;
  for i := 0 to Cont do
  begin
    DragQueryFile(Msg.WParam, i, FName, 255);
    ListBox1.Items.Add(FName);
  end;
  DragFinish(msg.WParam);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DragAcceptFiles(Handle, True );
  ListBox1.Items.Clear;
end;

A partir de Windows 7,por motivos de seguridad, se filtran los mensajes enviados de una aplicación a otra (entre los que está Drag&Drop), por lo que previamente hay que elevar el privilegio mediante la función ChangeWindowMessageFilter

Código Delphi [-]
type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    procedure DragDropFiles(var Msg: TMessage ); message WM_DROPFILES;
  public
  end;

...

implementation

uses ShellApi;

const
  MSGFLT_ADD = 1;

var
 ChangeWindowMessageFilter: function (msg: Cardinal; dwFlag : Word):BOOL; stdcall;

procedure TForm1.DragDropFiles(var Msg: TMessage);

var
  Cont,i : integer;
  FName : array [0..MAX_COMPUTERNAME_LENGTH+MAX_PATH] of char;
begin
  Cont:= DragQueryFile(Msg.WParam, $FFFFFFFF, FName, 255)-1;
  for i:= 0 to Cont do
    ChangeWindowMessageFilter (i, MSGFLT_ADD);
  for i := 0 to Cont do
  begin
    DragQueryFile(Msg.WParam, i, FName, 255);
    ListBox1.Items.Add(FName);
  end;
  DragFinish(msg.WParam);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  @ChangeWindowMessageFilter:= GetProcAddress(LoadLibrary('user32.dll'),'ChangeWindowMessageFilter');
  if Assigned (ChangeWindowMessageFilter) then
  begin
    ChangeWindowMessageFilter(WM_DROPFILES, MSGFLT_ADD);
    ChangeWindowMessageFilter(WM_COPYDATA, MSGFLT_ADD);
    ChangeWindowMessageFilter($0049, MSGFLT_ADD);
  end;
  DragAcceptFiles(Handle, True);
  ListBox1.Items.Clear;
end;

Saludos

[JuanOrtega]

gracias por la ayuda ecfisa , una pregunta ¿ si ejecuto como admin en windows seven evito el problema ?

[ecfisa]

Hola Lepuke.

Empezado por Lepuke

...¿ si ejecuto como admin en windows seven evito el problema ?

No, tenes que usar el segundo código.

Saludos

[JuanOrtega]

ahora mismo estoy en XP lo probe , no tira ningun error de compilacion pero cuando arrastro el archivo me tira un error de denegacion por parte de windows , despues lo pruebo en mi maquina virtual donde tengo seven , pero ¿ es normal que el segundo codigo me tire ese error en XP ?

[[nlsgarcia]]

Lepuke,

Empezado por ecfisa

...A partir de Windows 7,por motivos de seguridad, se filtran los mensajes enviados de una aplicación a otra (entre los que está Drag&Drop), por lo que previamente hay que elevar el privilegio mediante la función ChangeWindowMessageFilter...

Probé el código sugerido en el Msg #3 en Delphi 7 bajo Windows 7 Professional x32 en una Máquina Virtual con VMWare, tanto el que usa la función ChangeWindowMessageFilter, como el que no la utiliza y en ambos casos funciono correctamente tanto con un usuario con privilegios de administrador, como con un usuario con privilegios estándar.

Empezado por Lepuke

...¿es normal que el segundo código me tire ese error en XP?...

Si es lo que debe suceder, esto se debe a que la función ChangeWindowMessageFilter esta disponible a partir de Windows Vista y Windows Server 2008 en adelante, para Windows XP te sugiero el código que no utiliza la función ChangeWindowMessageFilter del Msg #3.

Espero sea útil

Nelson.

[ecfisa]

Hola Lepuke.

No dispongo de Windows XP para probarlo, pero podrías intentar de este modo:

Código Delphi [-]
...
uses ShellApi;

const
  MSGFLT_ADD = 1;

var
 ChangeWindowMessageFilter: function (msg: Cardinal; dwFlag : Word):BOOL; stdcall;

procedure TForm1.DragDropFiles(var Msg: TMessage);
var
  Cont,i : integer;
  FName : array [0..MAX_COMPUTERNAME_LENGTH+MAX_PATH] of char;
begin
  Cont:= DragQueryFile(Msg.WParam, $FFFFFFFF, FName, 255)-1;
  if (Win32MajorVersion = 6)and(Win32MinorVersion > 0) then
    for i:= 0 to Cont do ChangeWindowMessageFilter (i, MSGFLT_ADD);
  for i := 0 to Cont do
  begin
    DragQueryFile(Msg.WParam, i, FName, 255);
    ListBox1.Items.Add(FName);
  end;
  DragFinish(msg.WParam);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  if (Win32MajorVersion = 6)and(Win32MinorVersion > 0) then
  begin
    @ChangeWindowMessageFilter:= GetProcAddress(LoadLibrary('user32.dll'),'ChangeWindowMessageFilter');
    if Assigned (ChangeWindowMessageFilter) then
    begin
      ChangeWindowMessageFilter (WM_DROPFILES, MSGFLT_ADD);
      ChangeWindowMessageFilter (WM_COPYDATA, MSGFLT_ADD);
      ChangeWindowMessageFilter ($0049, MSGFLT_ADD);
    end;
  end;
  DragAcceptFiles(Handle, True);
  ListBox1.Items.Clear;
end;

Saludos

[[nlsgarcia]]

Lepuke,

Empezado por ecfisa

...No dispongo de Windows XP para probarlo...

El código del Msg #3 que no utiliza la función ChangeWindowMessageFilter y el código del Msg #8 que verifica si la versión de Windows es superior a XP para aplicar la función ChangeWindowMessageFilter, fueron probados en Delphi 7 bajo Windows XP Professional x32 en una Máquina Virtual con VMWare y funcionaron ambos correctamente según lo esperado.

Espero sea útil

Nelson.

[[ElKurgan]]

Muchas gracias por el aporte, maestros...

Funciona perfectamente