Arrastrar y soltar archivos (Drag and Drop)

[Joseg]

Hola,

¿Hay alguna forma en Powercobol de arrastrar un archivo a un objeto (por ejemplo, una Listview) y capturar el nombre y/o la ubicación del archivo?
El objetivo sería arrastrar imágenes desde una carpeta de Windows a una aplicación Powercobol. Actualmente uso esta función:

INVOKE Pow-Self "GetFileName" ...

pero para los tiempos que corren no es tan práctico.

Gracias,
Jose

[Kuk]

@Joseg, nunca he investigado el tema, pero tenemos un ejemplo en el foro: https://www.cobolforo.es/showthread.php?1672-Drag-and-drop-de-Objetos&highlight=drag+drop

A ver qué tal. ;)

[Joseg]

@Joseg, nunca he investigado el tema, pero tenemos un ejemplo en el foro: https://www.cobolforo.es/showthread.php?1672-Drag-and-drop-de-Objetos&highlight=drag+drop

A ver qué tal. ;)

Aquí el objetivo es diferente. Arrastre archivos a un contenedor, solo para identificar más fácilmente su origen.

[Kuk]

@Joseg, no lo he probado pero por lo que veo no es tan difícil. Mira esto a ver si te sirve:

https://stackoverflow.com/questions/449872/how-drag-and-drop-of-files-is-done
https://learn.microsoft.com/en-us/cpp/mfc/drag-and-drop-ole?view=msvc-170

[Joseg]

@Joseg, no lo he probado pero por lo que veo no es tan difícil. Mira esto a ver si te sirve:

https://stackoverflow.com/questions/449872/how-drag-and-drop-of-files-is-done
https://learn.microsoft.com/en-us/cpp/mfc/drag-and-drop-ole?view=msvc-170


Eso es exactamente lo que pretendía... ¡pero pasar a Cobol es otra cuestión! Pero voy a intentar.
COPY y PAST puedo hacer (CTR+C / CTRL+V).

Gracias

[Kuk]

@Joseg, lo he probado (la opción de WinAPI) y funciona perfectamente. :bien:

Lo primero, creas un fichero nuevo en el directrio del proyecto y lo llamas MyWndProc.cbl. Luego lo añades en el proyecto (import) y le pegas el siguiente contenido:


IDENTIFICATION DIVISION.
PROGRAM-ID. "MyWndProc".
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 OldWndProc IS EXTERNAL PIC S9(9) COMP-5.


01 WM_DROPFILES PIC S9(9) COMP-5 VALUE H"0233".

01 P1 POINTER.
01 HWND REDEFINES P1 PIC S9(9) COMP-5.
01 P2 POINTER.
01 MSG REDEFINES P2 PIC 9(9) COMP-5.
01 P3 POINTER.
01 WPARAM REDEFINES P3 PIC S9(9) COMP-5.
01 P4 POINTER.
01 LPARAM REDEFINES P4 PIC S9(9) COMP-5.

01 dropFileName pic x(250).
01 fileSize pic 9(4) comp-5.

LINKAGE SECTION.
77 PARM1 PIC S9(9) COMP-5.
77 PARM2 PIC 9(9) COMP-5.
77 PARM3 PIC S9(9) COMP-5.
77 PARM4 PIC S9(9) COMP-5.

PROCEDURE DIVISION WITH STDCALL USING PARM1 PARM2 PARM3 PARM4.

MOVE FUNCTION ADDR(PARM1) TO P1
MOVE FUNCTION ADDR(PARM2) TO P2
MOVE FUNCTION ADDR(PARM3) TO P3
MOVE FUNCTION ADDR(PARM4) TO P4

IF MSG = WM_DROPFILES
call "DragQueryFileA" with stdcall using by value WPARAM
by value 0
by reference dropFileName
by reference fileSize

display "Fichero: " dropFileName
END-IF

CALL "CallWindowProcA" WITH STDCALL USING BY VALUE OldWndProc
BY VALUE HWND
BY VALUE MSG
BY VALUE WPARAM
BY VALUE LPARAM

GOBACK
.


Luego en el evento "Opened" del Form, pones esto:


ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 wsHwnd pic s9(9) comp-5.
01 ptrMyWndProc procedure-pointer.
01 newWndProc redefines ptrMyWndProc pic s9(9) comp-5.

01 OldWndProc is external pic s9(9) comp-5.

01 GWLP-WNDPROC pic s9(9) comp-5 value -4.

PROCEDURE DIVISION.

set ptrMyWndProc to entry "MyWndProc@16"

move "hwnd" of pow-self to wsHwnd

call "GetWindowLongA" with stdcall using by value wsHwnd
by value GWLP-WNDPROC
returning OldWndProc

call "SetWindowLongA" with stdcall using by value wsHwnd
by value GWLP-WNDPROC
by value newWndProc

call "DragAcceptFiles" with stdcall using by value wsHwnd
by value pow-true


No olvides de poner la directiva de compilación ALPHAL(WORD) tanto en las propiedades de los Scripts de Eventos como en las del fichero myWndProc.cbl.

Necesitarás la librería que va en adjuntos. Y listo, a mi me funciona!



P.D. me da que a nuestro amigo @Nitzer le va a gustar también esto :mola:

[Joseg]

¡¡¡Asombroso!!! Muchas gracias
:bien:



@Joseg, lo he probado (la opción de WinAPI) y funciona perfectamente. :bien:

Lo primero, creas un fichero nuevo en el directrio del proyecto y lo llamas MyWndProc.cbl. Luego lo añades en el proyecto (import) y le pegas el siguiente contenido:


IDENTIFICATION DIVISION.
PROGRAM-ID. "MyWndProc".
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 OldWndProc IS EXTERNAL PIC S9(9) COMP-5.


01 WM_DROPFILES PIC S9(9) COMP-5 VALUE H"0233".

01 P1 POINTER.
01 HWND REDEFINES P1 PIC S9(9) COMP-5.
01 P2 POINTER.
01 MSG REDEFINES P2 PIC 9(9) COMP-5.
01 P3 POINTER.
01 WPARAM REDEFINES P3 PIC S9(9) COMP-5.
01 P4 POINTER.
01 LPARAM REDEFINES P4 PIC S9(9) COMP-5.

01 dropFileName pic x(250).
01 fileSize pic 9(4) comp-5.

LINKAGE SECTION.
77 PARM1 PIC S9(9) COMP-5.
77 PARM2 PIC 9(9) COMP-5.
77 PARM3 PIC S9(9) COMP-5.
77 PARM4 PIC S9(9) COMP-5.

PROCEDURE DIVISION WITH STDCALL USING PARM1 PARM2 PARM3 PARM4.

MOVE FUNCTION ADDR(PARM1) TO P1
MOVE FUNCTION ADDR(PARM2) TO P2
MOVE FUNCTION ADDR(PARM3) TO P3
MOVE FUNCTION ADDR(PARM4) TO P4

IF MSG = WM_DROPFILES
call "DragQueryFileA" with stdcall using by value WPARAM
by value 0
by reference dropFileName
by reference fileSize

display "Fichero: " dropFileName
END-IF

CALL "CallWindowProcA" WITH STDCALL USING BY VALUE OldWndProc
BY VALUE HWND
BY VALUE MSG
BY VALUE WPARAM
BY VALUE LPARAM

GOBACK
.


Luego en el evento "Opened" del Form, pones esto:


ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 wsHwnd pic s9(9) comp-5.
01 ptrMyWndProc procedure-pointer.
01 newWndProc redefines ptrMyWndProc pic s9(9) comp-5.

01 OldWndProc is external pic s9(9) comp-5.

01 GWLP-WNDPROC pic s9(9) comp-5 value -4.

PROCEDURE DIVISION.

set ptrMyWndProc to entry "MyWndProc@16"

move "hwnd" of pow-self to wsHwnd

call "GetWindowLongA" with stdcall using by value wsHwnd
by value GWLP-WNDPROC
returning OldWndProc

call "SetWindowLongA" with stdcall using by value wsHwnd
by value GWLP-WNDPROC
by value newWndProc

call "DragAcceptFiles" with stdcall using by value wsHwnd
by value pow-true


No olvides de poner la directiva de compilación ALPHAL(WORD) tanto en las propiedades de los Scripts de Eventos como en las del fichero myWndProc.cbl.

Necesitarás la librería que va en adjuntos. Y listo, a mi me funciona!



P.D. me da que a nuestro amigo @Nitzer le va a gustar también esto :mola:

[Paulo]

Hola.
Está a dar-me um erro na compilação.
Podem ajudar-me?
Gracias

[fastpho]

Hola @Paulo , que error de compilación te da ? :help:

Saludos ...

[Paulo]

Hola @Paulo , que error de compilación te da ? :help:

Saludos ...

Hola fastpho
Em anexo envio imagem com o erro
Gracias

[Kuk]

@Paulo, se te habrá olvidado añadir la librería shell32.lib en tu proyecto, va dentro del ZIP

Veo que has puesto la directiva ALPHAL(WORD) porque el nombre de la función aparece en Camel-Case, pero sin la librería no va a compilar porque no sabe dónde está la función.

Si has añadido la librería y te sigue dando error, tienes que hacer REBUILD ALL para recompilarlo todo y funcionará.

[Paulo]

@Paulo, se te habrá olvidado añadir la librería shell32.lib en tu proyecto, va dentro del ZIP

Veo que has puesto la directiva ALPHAL(WORD) porque el nombre de la función aparece en Camel-Case, pero sin la librería no va a compilar porque no sabe dónde está la función.

Si has añadido la librería y te sigue dando error, tienes que hacer REBUILD ALL para recompilarlo todo y funcionará.


Hola Kuk

Adicionei a livraria shell32.lib, fiz o rebuild all, mas o erro continua...

[Kuk]

@Paulo, es que la función DragAcceptFiles no es así, sólo lleva 2 parámetros, y tú le has añadido un parámetro demás y es por eso que no compila, debe ser así:


call "DragAcceptFiles" with stdcall using by value wsHwnd
by value pow-true


Y tú tienes 2 veces el pow-true:


call "DragAcceptFiles" with stdcall using by value wsHwnd
by value pow-true
by value pow-true.

[Paulo]

Gracias Kuk,
Tanto verifiquei a rotina e não vi esse erro.

[Kuk]

@Paulo, de nada compañero, ya nos cuentas y si puedes enséñanos cómo te ha quedado ;)

[fastpho]

Hola , estoy implementado Arrastrar y soltar archivos (Drag and Drop) sin procedure-pointer
obteniendo la direccion de la funcion , la consulta cual seria la mejor forma de atrapar el nombre del archivo arrastrado , lo estoy haciendo con un cmtimer
pero no se si es la forma correcta :piensa::piensa::piensa:

ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 wsHwnd pic s9(9) comp-5.
01 newWndProc pic s9(9) comp-5.
01 OldWndProc external pic s9(9) comp-5.
01 GWLP-WNDPROC pic s9(9) comp-5 value -4.
01 hModule pic s9(9) comp-5.

PROCEDURE DIVISION.




move "hwnd" of pow-self to wsHwnd.
move wsHwnd to "Text" OF CmText1

call "GetModuleHandleA" with stdcall using by value 0 returning hModule
* DISPLAY "hModule: " , hModule.
call "GetProcAddress" with stdcall using by value hModule
by content "_ProcDragFile@16" & X"00"
returning newWndProc.


y la imagen con

01 EXP-FILE-NAME PIC X(250) GLOBAL EXTERNAL. *> Retorno del Procedimiento
*cmtimer*
IF EXP-FILE-NAME NOT = SPACES THEN
* display "Fichero TIMER: " EXP-FILE-NAME
MOVE EXP-FILE-NAME TO "ImageName" OF CmImage1
END-IF.

Saludos ....

[Kuk]

@fastpho, no sé si he entendido bien tu pregunta, pero en este caso hacemos algo parecido a lo de buscar y traer enfrente un programa. Es decir que le pasamos una función como parámetro, la cual se ejecuta cuando ocurra el evento correspondiente. Con lo cual, no necesitas un Timer, puedes hacer lo que necesitas en la propia función "MyWndProc" que se ejecuta, como decía, automáticamente cuando ocurra el evento.

[fastpho]

@Kuk , no me explicado bien , desde el ProcDragFile.cbl obtengo el archivo arrastrado
con la funcion DragQueryFileA :


IF MSG = WM_DROPFILES
call "DragQueryFileA" with stdcall using by value WPARAM
by value 0
by reference dropFileName
by reference fileSize


string dropFileName
delimited by x"00" into EXP-FILE-NAME
end-string

* display "Fichero: " EXP-FILE-NAME
* display "fileSize: " fileSize *> SIEMPRE ZEROS
END-IF.


en la variable dropFileName tengo el nombre del archivo
ahora como le paso ese dato al formulario que tiene en este caso un control
cmImage , la unica forma que encontre es metiendo un control timer en el formulario,
en la variable que se llama EXP-FILE-NAME que esta declarada como External Global en el
formulario y en el ProcDragFile.cbl como External

Luego en el timer tengo :

IF EXP-FILE-NAME NOT = SPACES THEN
*> display "Fichero TIMER: " EXP-FILE-NAME
MOVE EXP-FILE-NAME TO "ImageName" OF CmImage1
END-IF.


Esta implementacion me esta funcionando , pero tengo el timer consumiendo cpu



Saludos...

[Kuk]

@fastpho, ah vale, ya lo entiendo.

Pues mira, tengo una solución que no vas a entender pero funciona (en mi caso por lo menos).

En "Opened" de tu Form pones esto:


WORKING-STORAGE SECTION.
01 nCMIMAGE1 IS EXTERNAL PIC S9(9) COMP-5.
...
PROCEDURE DIVISION.
...
move CmImage1 to nCMIMAGE1


En "MyWndProc" añades esto en la Working:


*>-------------------
01 POW-0000 PIC S9(18) COMP-5.
01 POW-0001 PIC S9(9) COMP-5.
01 POW-0002 PIC S9(9) COMP-5.
01 POW-0003 PIC S9(9) COMP-5.
01 POW-0004 PIC S9(9) COMP-5.
01 POW-0005 PIC S9(9) COMP-5.
01 POW-0006 PIC X(8192).
01 POW-0007 PIC S9(9) COMP-5.

01 nCMIMAGE1 IS EXTERNAL PIC S9(9) COMP-5.


Y en la procedure, en el IF MSG = WM_DROPFILES le añades este código, no intentes entenderlo, simplemente pégalo tal cual: ;)

...
IF MSG = WM_DROPFILES
call "DragQueryFileA" with stdcall using by value WPARAM
by value 0
by reference dropFileName
by reference fileSize

*> display "Fichero: " dropFileName
*>-------------
MOVE 117440513 TO POW-0000
MOVE 4 TO POW-0001
MOVE 0 TO POW-0002
MOVE 0 TO POW-0003
MOVE 0 TO POW-0004
MOVE 1 TO POW-0005
MOVE dropFileName TO POW-0006
MOVE 33636360 TO POW-0007
CALL "XPOW_INVOKE_BY_ID_2" USING VALUE nCMIMAGE1 REFERENCE POW-0000
VALUE POW-0001 POW-0002 POW-0003 POW-0004 POW-0005 POW-0007
REFERENCE POW-0006 END-CALL
*>-------------
END-IF
...


Rebuild ALL y ejecuta, a ver si funciona. Si no funciona, dime qué error te da.

[fastpho]

@Kuk me anduvo perfecto lo unico que añadi fueron los valores de :



01 POW-0000 PIC S9(18) COMP-5.
01 POW-0001 PIC S9(9) COMP-5.
01 POW-0002 PIC S9(9) COMP-5.
01 POW-0003 PIC S9(9) COMP-5.
01 POW-0004 PIC S9(9) COMP-5.
01 POW-0005 PIC S9(9) COMP-5.
01 POW-0006 PIC X(8192).
01 POW-0007 PIC S9(9) COMP-5.
01 POW-0008 PIC S9(4) COMP-5.



Muchas Gracias
:mola::mola:
Saludos ...

[Kuk]

@fastpho, sí, efectivamente se me han olvidado las variables en la Working de "MyWndProc", acabo de editar el post original :mm:

Me alegro de que te haya funcionado! :beber:

P.S. a @Nitzer le va a gustar todo esto :)

[Kuk]

@fastpho, se me ha ocurrido una manera más elegante de hacerlo.

En "Opened" de tu form pones:

WORKING-STORAGE SECTION.
01 imgControl pic s9(9) comp-5 is external.
PROCEDURE DIVISION.

move CmImage1 to imgControl



En "MyWndProc" haces esto:


IDENTIFICATION DIVISION.
PROGRAM-ID. "MyWndProc".
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
REPOSITORY.
CLASS COM AS "*COM"
.
DATA DIVISION.
WORKING-STORAGE SECTION.
...
01 imgControl pic s9(9) comp-5 is external.
01 comClass object reference COM.
...

IF MSG = WM_DROPFILES
call "DragQueryFileA" with stdcall using by value WPARAM
by value 0
by reference dropFileName
by reference fileSize

if comClass = null
call "POWERCONVTOCOM" USING imgControl RETURNING comClass
end-if

invoke comClass "set-ImageName" using dropFileName
END-IF



A ver qué tal, a mi me funciona. Y el código me gusta más, porque el CALL a "XPOW-..." es un poco chapuza. ;)


El ejemplo limpio queda así:

"Opened" del form:

ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 wsHwnd pic s9(9) comp-5.
01 ptrMyWndProc procedure-pointer.
01 newWndProc redefines ptrMyWndProc pic s9(9) comp-5.

01 OldWndProc is external pic s9(9) comp-5.

01 GWLP-WNDPROC pic s9(9) comp-5 value -4.

01 imgControl pic s9(9) comp-5 is external.
PROCEDURE DIVISION.

move CmImage1 to imgControl

set ptrMyWndProc to entry "MyWndProc@16"

move "hwnd" of pow-self to wsHwnd

call "GetWindowLongA" with stdcall using by value wsHwnd
by value GWLP-WNDPROC
returning OldWndProc

call "SetWindowLongA" with stdcall using by value wsHwnd
by value GWLP-WNDPROC
by value newWndProc

call "DragAcceptFiles" with stdcall using by value wsHwnd
by value pow-true




"MyWndProc":

IDENTIFICATION DIVISION.
PROGRAM-ID. "MyWndProc".
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
REPOSITORY.
CLASS COM AS "*COM"
.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 OldWndProc IS EXTERNAL PIC S9(9) COMP-5.


01 WM_DROPFILES PIC S9(9) COMP-5 VALUE H"0233".

01 P1 POINTER.
01 HWND REDEFINES P1 PIC S9(9) COMP-5.
01 P2 POINTER.
01 MSG REDEFINES P2 PIC 9(9) COMP-5.
01 P3 POINTER.
01 WPARAM REDEFINES P3 PIC S9(9) COMP-5.
01 P4 POINTER.
01 LPARAM REDEFINES P4 PIC S9(9) COMP-5.

01 dropFileName pic x(250).
01 fileSize pic 9(4) comp-5.

01 imgControl pic s9(9) comp-5 is external.
01 comClass object reference COM.

LINKAGE SECTION.
77 PARM1 PIC S9(9) COMP-5.
77 PARM2 PIC 9(9) COMP-5.
77 PARM3 PIC S9(9) COMP-5.
77 PARM4 PIC S9(9) COMP-5.

PROCEDURE DIVISION WITH STDCALL USING PARM1 PARM2 PARM3 PARM4.

MOVE FUNCTION ADDR(PARM1) TO P1
MOVE FUNCTION ADDR(PARM2) TO P2
MOVE FUNCTION ADDR(PARM3) TO P3
MOVE FUNCTION ADDR(PARM4) TO P4

IF MSG = WM_DROPFILES
call "DragQueryFileA" with stdcall using by value WPARAM
by value 0
by reference dropFileName
by reference fileSize


if comClass = null
call "POWERCONVTOCOM" USING imgControl RETURNING comClass
end-if

invoke comClass "set-ImageName" using dropFileName
END-IF

CALL "CallWindowProcA" WITH STDCALL USING BY VALUE OldWndProc
BY VALUE HWND
BY VALUE MSG
BY VALUE WPARAM
BY VALUE LPARAM

GOBACK
.

[fastpho]

@Kuk me funciona esta opcion tambien sin usar procedure-pointer, y es mas elegante digamos esta opcion,
lo unico es que tuve que modificar algunas lineas por que en la version 5.0 de PowerCobol para acceder
a objetos se debe usar :

REPOSITORY.
CLASS OLE AS "*OLE"
.



y para poder convertir la referencia a la Clase Ole
se debe usar :


CALL "POWERCONVTOOLE" USING ....


Muchas Gracias por tu tiempo
Saludos
:beber:
1010

[Kuk]

@fastpho, declarando "OLE" también fucniona en PowerCOBOL v9 y v10. :bien:


Lo que no me gusta es que el CmImage de Power no funciona con nada salvo *.JPG y en un formato concreto de JPEG, que los hay diferentes y sigue siendo JPEG pero no los muestra todos. De GIF o PNG ya no digo nada... Es muy pobre este control.

[Kuk]

@fastpho, madre mía el tonto que hemos hecho......... :D :D :D

Acabo de fijarme y CmImage tiene una propiedad llamada DropEnabled, que si la marcas, no hace falta ni WinAPI ni COM/OLE, funciona solito :mm: :rofl:
1011

[fastpho]

@Kuk , si lo probe tildando la opcion DropEnabled y tambien funciona sin la
necesidad de OLE/API , y como decis lo malo del cmimage no toma .png por ejemplo
u otros formatos mas modernos

De todas maneras , DragQueryFileA, sirve por ejemplo para arrastrar archivos en general
a un listview u otro objeto , tiene su sentido todo esto, me parece a parte de arrastrar imagenes.


Saludos...

[Kuk]

@fastpho, sí efectivamente sirve para muchas cosas, pero para el propósito inicial, con un solo clic nos valía :D

Pero bueno, así hemos aprendido cosas nuevas también :bien:

[Fito]

Hola Amigos: ahi estuve probando esto y está espectacular, Felicitaciones.

Ahora una pregunta, esto mismo se puede hacer en RMCobol con WOW?

Saludos

Fito...

[Kuk]

@Fito, yo nunca he tenido RM así que no te puedo decir nada al respecto. Habrá que ir probando y a ver, lo mismo lo hacemos funcionar.

No sé si RM permite llamadas a la WinAPI (o cualquier librería C exterior), si es así, lo más seguro es que lo vamos a poder hacer. Es decir, lo principal, que es el SubClassing de la WinAPI.
Luego lo de invocar algo desde la función, será por OLE u otra cosa, es lo de menos. Encontraremos también la manera de hacerlo.

Te propongo que hagas pruebas, si te salta algún error o no funciona de manera esperada, lo tratamos juntos y vamos viendo :beber:
Lo único, si lo hacemos que sea en el apartado de RM, no aquí, para no mezclar las churras con las merinas ;)

[Fito]

Hola Carlitos:

En realidad yo no programo en RM, fue un colega que le mostré esto y como él tiene todo en RM me preguntó y trasladé su inquietud. Te digo más, ni siquiera tengo RM instalado en, mi máquina.

Gracias por responder.

Abrazo...

Fito...

[Kuk]

@Fito, bueno pues tu compi si está en el foro, lo podemos ver con él, o que se registre si no es el caso. Es un tema interesante y ayudaré en lo que pueda. :bien: