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

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

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

' 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

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

'----------------------------------------------------------
'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

    '
    ' 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