Tema: Arrastrar y soltar archivos (Drag and Drop)
Ver Mensaje Individual
  #6
Antiguo 26 de enero de 2024, 10:15
Kuk
Administrador
Última Actividad 21.09.2026 18:24
Posts Posts: 2.500
Likes enviados Enviados: 1037
Likes recibidos Recibidos: 1207
Predeterminado
2
Likes

Josber
Joseg

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

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:

Código COBOL:
  1.  IDENTIFICATION DIVISION.
  2.  PROGRAM-ID. "MyWndProc". 
  3.  ENVIRONMENT DIVISION.
  4.  DATA DIVISION.
  5.  WORKING-STORAGE SECTION.  
  6.  01  OldWndProc     IS  EXTERNAL PIC S9(9) COMP-5. 
  7.  
  8.  
  9.  01  WM_DROPFILES   PIC  S9(9) COMP-5 VALUE H"0233".  
  10.  
  11.  01  P1                   POINTER.
  12.  01  HWND REDEFINES P1    PIC S9(9) COMP-5.
  13.  01  P2                   POINTER.
  14.  01  MSG  REDEFINES P2    PIC  9(9) COMP-5. 
  15.  01  P3                   POINTER.
  16.  01  WPARAM REDEFINES P3  PIC S9(9) COMP-5.
  17.  01  P4                   POINTER.
  18.  01  LPARAM REDEFINES P4  PIC S9(9) COMP-5. 
  19.  
  20.  01  dropFileName         pic x(250).
  21.  01  fileSize             pic 9(4) comp-5.
  22.   
  23.  LINKAGE SECTION.
  24.  77  PARM1                PIC S9(9) COMP-5.
  25.  77  PARM2                PIC  9(9) COMP-5. 
  26.  77  PARM3                PIC S9(9) COMP-5.
  27.  77  PARM4                PIC S9(9) COMP-5.
  28.  
  29.  PROCEDURE DIVISION WITH STDCALL USING PARM1 PARM2 PARM3 PARM4. 
  30.      
  31.      MOVE FUNCTION ADDR(PARM1) TO P1
  32.      MOVE FUNCTION ADDR(PARM2) TO P2
  33.      MOVE FUNCTION ADDR(PARM3) TO P3
  34.      MOVE FUNCTION ADDR(PARM4) TO P4
  35.      
  36.      IF  MSG = WM_DROPFILES
  37.          call "DragQueryFileA" with stdcall using by value WPARAM
  38.                                                   by value 0
  39.                                                   by reference dropFileName
  40.                                                   by reference fileSize
  41.          
  42.          display "Fichero: " dropFileName                                                  
  43.      END-IF
  44.           
  45.      CALL "CallWindowProcA" WITH STDCALL USING BY VALUE OldWndProc
  46.                                                BY VALUE HWND
  47.                                                BY VALUE MSG
  48.                                                BY VALUE WPARAM
  49.                                                BY VALUE LPARAM  
  50.     
  51.      GOBACK
  52.      .

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

Código COBOL:
  1.  ENVIRONMENT     DIVISION.
  2.  DATA            DIVISION.
  3.  WORKING-STORAGE SECTION.
  4.  01  wsHwnd         pic s9(9) comp-5.
  5.  01  ptrMyWndProc   procedure-pointer.
  6.  01  newWndProc redefines ptrMyWndProc pic s9(9) comp-5.
  7.  
  8.  01  OldWndProc     is external pic s9(9) comp-5.
  9.  
  10.  01  GWLP-WNDPROC   pic s9(9) comp-5 value -4. 
  11.   
  12.  PROCEDURE       DIVISION.
  13.      
  14.      set ptrMyWndProc to entry "MyWndProc@16"
  15.      
  16.      move "hwnd" of pow-self to wsHwnd
  17.      
  18.      call "GetWindowLongA" with stdcall using by value wsHwnd
  19.                                               by value GWLP-WNDPROC
  20.                                               returning OldWndProc
  21.                                               
  22.      call "SetWindowLongA" with stdcall using by value wsHwnd
  23.                                               by value GWLP-WNDPROC
  24.                                               by value newWndProc
  25.  
  26.      call "DragAcceptFiles" with stdcall using by value wsHwnd
  27.                                                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
Archivos Adjuntos
Tipo de Archivo: zip shell32.zip (35,3 KB)Descargas: 44


NORMAS DEL FORO - para garantizar el buen funcionamiento del Foro.
¿Te han ayudado? NO TE OLVIDES de darle a
¿Quieres dirigirte a alguien en tu post? Notifícale haciendo clic en su Nick
Kuk is offline   Responder Con Cita