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.
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)