Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   Drag Drop (https://www.clubdelphi.com/foros/showthread.php?t=85665)

JuanOrtega 15-04-2014 20:29:53

Drag Drop
 
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 15-04-2014 21:04:18

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

ecfisa 15-04-2014 21:47:36

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 15-04-2014 21:50:41

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

ecfisa 15-04-2014 23:29:40

Hola Lepuke.
Cita:

Empezado por Lepuke (Mensaje 475182)
...¿ si ejecuto como admin en windows seven evito el problema ?

No, tenes que usar el segundo código.

Saludos :)

JuanOrtega 16-04-2014 00:43:59

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 16-04-2014 02:06:15

Lepuke,

Cita:

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.

Cita:

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 16-04-2014 03:11:05

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 16-04-2014 05:32:17

Lepuke,

Cita:

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 16-04-2014 08:00:31

Muchas gracias por el aporte, maestros...

Funciona perfectamente


La franja horaria es GMT +2. Ahora son las 21:08:26.

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi