Un Gran Proyecto, Paso a Paso

 

Novena Entrega (23/Abr/97)
...Esta debería ser la entrega del olvido... y es que esto debería haberlo puesto en la anterior, ¡pero se me olvidó!

Los links para conectar con las entregas anteriores y los archivos comprimidos están al final de la página.


Lo de hoy es muy cortito.
Es sobre soltar un archivo de texto y aceptarlo en el campo de la descripción. Este código está tomado de un ejemplo ya puesto en mis páginas y lo he sacado del libro de Francisco Charte "Programación Profesional con VB4" de Anaya Multimedia.

De lo que se trata es de insertar la clase DragDrop.cls y el formulario frmOcult.frm y añadir un poco de código para "manejar" el tema. Después pondré los listados de esta clase y el form. Primero veremos cómo usarlo en nuestras aplicaciones.

En el form principal, en el que vayamos a "procesar" la "dejada" de archivos, hay que declarar una variable del tipo de la clase, eso se hace con un simple DIM:

' Referencia al objeto de arrastrar y soltar
Dim MiObjeto As DragDrop

En el form_load, al final por ejemplo, hacemos una llamada a la incialización de la clase, para que se encargue de esperar a que se suelte algo sobre nuestro formulario y lo más importante, indicarle a Windows que estamos preparados para recibir archivos "soltados". Así que añade esto al final del Form_Load:

    'Inicializar para Drag & Drop
    ' Creamos el objeto
    Set MiObjeto = New DragDrop
    MiObjeto.Activa Me ' lo activamos

Un olvido, (otro), pero que ya está subsanado, el Form_Unload debe quedar de esta forma:

Private Sub Form_Unload(Cancel As Integer)
    'Sólo si está mostrada de forma normal
    If WindowState = vbNormal Then
        GuardarIni ficIni, "Posición_" & sUsuario, "gsNotas_Left", CStr(Left)
        GuardarIni ficIni, "Posición_" & sUsuario, "gsNotas_Top", CStr(Top)
    End If
    
    MiObjeto.Desactiva ' desactivamos el objeto
    Set MiObjeto = Nothing ' y lo liberamos

    Set gsNotas = Nothing
End Sub

Ahora todo lo que necesitamos es un procedimiento público que se llame Archivo, el que se llame así es porque en la clase se hace referencia a este Método del form "registrado". Así que si no te gusta ese nombre, puedes cambiarlo, pero recuerda que debes cambiarlo también en la clase.
Veamos es código del método Archivo:

' Este procedimiento público será llamado
' por el objeto DragDrop cada vez que se
' reciba un archivo de arrastrar y soltar
Public Sub Archivo(Nombre As String)
    Dim nFic As Integer
    
    On Local Error Resume Next
    
    nFic = FreeFile
    Open Nombre For Input As nFic
    Text1(cDescripcion) = Input$(LOF(nFic), nFic)
    Close nFic
    
    If Err Then
        'LblStatus = "ERROR al insertar : " & Nombre
        Err = 0
    End If
    On Local Error GoTo 0
End Sub

Y eso es todo. En este procedimiento, sólo se acepta en el cuadro de texto de la descripción, aquí se podría "impedir" que se soltara si ese no es el control actual, por ejemplo. Para ello deberías poner al principio de ese procedimiento un chequeo al estilo de esto:

        'Si no estamos en el Text de descripción, salir
        If ControlActual <> cDescripcion Then Exit Sub

Bien, ahora veamos el código de la clase DragDrop:

'----------------------------------------------------------
'cDragDrop.Cls
'
' Esta clase facilitará la creación de aplicaciones
' que acepten archivos de arrastrar-y-soltar desde
' el Explorador
'
'Clase de ejemplo del Capitulo 8 del libro:
'Programación Profesional con Visual Basic 4.0
'de Francisco Charte (Anaya Multimedia)
'
'Adaptada por Guillermo Som, 23/Mar/97
'----------------------------------------------------------
Option Explicit
    
    ' Referencia a la ventana oculta
Private MiVentana As frmOculto
    ' Referencia a la ventana que recibirá los archivos
Private VentanaDragDrop As Form
Private Termina As Boolean ' indicador interno


'Constantes para las funciones del API
'Const PM_NOREMOVE = &H0
Const PM_REMOVE = &H1
'Const PM_NOYIELD = &H2

Const WM_DROPFILES = &H233

'Declaraciones de las funciones del API
Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
'Private Declare Function DragQueryPoint Lib "shell32.dll" (ByVal hDrop As Long, lpPoint As POINTAPI) As Long
Private Declare Sub DragFinish Lib "shell32.dll" (ByVal hDrop As Long)
Private Declare Sub DragAcceptFiles Lib "shell32.dll" (ByVal hwnd As Long, ByVal fAccept As Long)
'
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long

'Tipos de datos para las funciones del API
Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type Msg
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type 'MSG


    ' Este método activa la recepción de archivos
    ' en la ventana que se pasa como parámetro
Public Sub Activa(Ventana As Form)
        ' Guardamos la referencia a la ventana
    Set VentanaDragDrop = Ventana
        ' Activamos la recepción de archivos
    DragAcceptFiles VentanaDragDrop.hwnd, True
        ' Creamos una ventana oculta
    Set MiVentana = New frmOculto
        ' y la asociamos con nosotros mismos
    Set MiVentana.MiObjeto = Me
        ' activando el envío de un mensaje en 500 milisegundos
    MiVentana.Timer.Enabled = True
        ' lo cual nos permite devolver el control
        ' al cliente que nos esté utilizando
    Termina = False
End Sub


    ' Esta función será llamada desde el formulario
    ' oculto, y se estará ejecutando mientras Termina
    ' no tome el valor True
Public Sub Proceso()
        ' Para leer mensajes de la cola
    Dim Mensaje As Msg, N As Integer ' contador
        ' Bytes y Cadena para leer nombres de archivo
    Dim Bytes As Integer, Cadena As String
    
        ' Mientras Termina no sea True
    Do While Not Termina
        WaitMessage ' esperamos a que llegue un mensaje
            ' Si ese mensaje es WM_DROPFILES
        If PeekMessage(Mensaje, VentanaDragDrop.hwnd, WM_DROPFILES, WM_DROPFILES, PM_REMOVE) Then ' lo leemos
            With Mensaje ' obtenemos el número total de archivos
                For N = 0 To DragQueryFile(.wParam, -1, Cadena, 0) - 1
                        ' consultamos la longitud del nombre N
                    Bytes = DragQueryFile(.wParam, N, Cadena, 0)
                        ' asignamos el espacio necesario
                    Cadena = String(Bytes + 1, 0)
                        ' y obtenemos el nombre
                    DragQueryFile .wParam, N, Cadena, Bytes + 1
                        ' que pasamos al formulario cliente
                    VentanaDragDrop.Archivo Cadena
                Next
                DragFinish .wParam ' hemos terminado
            End With
        End If
        DoEvents ' permitimos el trabajo de otros procesos
    Loop ' y continuamos
End Sub


    ' Este método será llamado para desactivar
    ' el funcionamiento del objeto
Public Sub Desactiva()
    Termina = True ' Provocamos el fin de la ejecución de Proceso
        ' desactivamos la recepción de archivos
    DragAcceptFiles VentanaDragDrop.hwnd, False
    Unload MiVentana ' descargamos la ventana oculta
    Set VentanaDragDrop = Nothing ' y liberamos referencias
    Set MiVentana = Nothing
End Sub


    ' Al destruir el objeto
Private Sub Class_Terminate()
        ' si no ha sido previamente desactivado
    If Not Termina Then Desactiva ' lo desactivamos
End Sub

Ahora le toca el turno al código del form, este como verás es muy simple y sólo se usa como "activador"

    '
    ' frmOculto.frm
    '
    ' Este formulario oculto tiene como única finalidad
    ' enviar un mensaje al objeto asociado una vez
    ' ha trancurrido un periodo de 500 milisegundos.
    ' Esto permite que el objeto devuelva el control
    ' al formulario que ha llamado al método Activa
    '
Option Explicit

    ' Referencia al objeto
Public MiObjeto As DragDrop


    ' Al descargar el formulario
Private Sub Form_Unload(Cancel As Integer)
    Set MiObjeto = Nothing ' eliminamos la referencia
End Sub


    ' Cuando se produzca el evento
Private Sub Timer_Timer()
    Timer.Enabled = False ' desactivamos el timer
    MiObjeto.Proceso ' y llamamos a Proceso
End Sub

Y esto es todo. Ya advertí que sería breve la cosa.
Una advertencia, las declaraciones del API son sólo para 32 bits. No he encontrado el equivalente, si es que existen, para usarlo con 16 bits. Lo siento.

Hasta la próxima entrega. ¡Feliz programación!
Nos vemos.


ir al índice principal

Entregas anteriores: Primera, Segunda, Tercera, Cuarta, Quinta, Sexta, Septima, Octava
Pues esta vez no te lo digo... No hace falta que eches un vistazo a las entregas anteriores...

Bajate las páginas HTML y los gráficos de las 7 primeras entregas. (gsnotas_htm.zip 84.3 KB)
(si es el mismo archivo, no se incluye esta entrega)
Para bajar las entregas 8ª y posteriores. (gsnotas2_htm.zip 13.2 KB)
Bajate los listados y los bitmaps para las barras de herramientas. (gsnotas.zip 56.4 KB)
(Estos tamaños variarán según el número de entregas; para saber el tamaño actual, deberías ver la última entrega)