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