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)