Un Gran Proyecto, Paso a Paso
Octava Entrega (20/Abr/97)
...pero llegó la parienta y lo puso a
rematar la faena... ¡Se acabó el descanso!
(¿por qué siempre tendrán las mujeres la culpa de todo?, me pregunto yo.)
Los links para conectar con las entregas anteriores y los archivos comprimidos están al final de la página.
No ha pasado tanto tiempo, ¿verdad?
Es que creo que sería bueno poner un ToolBar y que se pudiesen soltar archivos de texto
en el cuadro de detalles.
Son chorradillas, pero dan otro "look & feel" al programa, vamos que parece
más "pofecioná"
Nota: A las "marías" que se
crean que es en serio el comentario del "subtítulo"... que sepan que sí!!!
Y sino, que le pregunten a todos los "pepes" que pululan con la informática...
Lo que no sé, es si al revés ocurre lo mismo... ¿Cual es la postura del
"tío" frente a la "tía" que le encanta la informática?
A ver si alguna me lo dice...
Bueno, ya en serio (jé, jé, no caerá esa breva, ¡Guille!). A
partir de este punto, hay que manejar dos proyectos, uno para usarlo con los 32 bits y
otro para aquellos que deben usarlo en 16 bits. Hasta ahora valía para ambos, siempre que
fuese con VB4.
Pero los controles al estilo Win95 (el ToolBar es uno de ellos) no se pueden usar en 16
bits y, que yo sepa, no hay un control equivalente, por lo menos que venga con los discos
del VB4.
Para aquellos que tengan el VB5, que sepan que deben usar la versión de 32 bits.
Para que el código sea el mismo, sólo cambiará el form de gsNotas. El código, salvo pequeños detalles, será el mismo. Lo que voy a plantear, de camino servirá para que le cojas un poca el "gustillo" y el "tranquillo" a las clases, será la creación de una clase para la versión de 16 bits que se encargará de simular al ToolBar de 32 bits, al menos en lo que a las llamadas se refiere. Espero conseguirlo.
1.- Unos ajustes en el form de Entrada, para usar la versión de 16 bits.
Entre otras cosas, al cargar el proyecto en el VB4 de 16
bits, antes no lo había cargado, me he encontrado con que no encontraba el control de
diálogos comunes de 16 bits. Por tanto... he tenido que hacerlo casi manualmente, aunque
después de intentarlo por segunda, o sería la tercera vez? ha aparecido...
Otro detalle, es el nombre del formulario "MostrarConsulta" no lo ha
encontrado!!! Así que le he cambiado el nombre por MostCons.frm, que al tener ocho
caracteres no da problemas.
Resumiendo: para usar el proyecto de 16 bits se usarán los archivos gsNota16.frm y
Entrad16.frm y por supuesto el gsNot16.vbp
Pero vamos a los cambios gordos: Como los nombres de los
archivos pueden ser diferentes, aún refiriendose al mismo, he optado por tener dos
versiones de "almacenamiento" de los datos en el archivo de configuración, por
lo menos en cuanto a lo que el nombre de la base y el path se refiere. Esto sólo lo he
puesto en el archivo de entrada de 16 bits, ya que la versión de 32 bits permanece
"inmutable", al menos en cuanto a este tema se refiere.
Te muestro el código y la "lógica" que he usado, por si te sirve, a ti que
usas la versión de 32 bits, al menos por curiosidad.
Esto estará en Form_load:
'... 'Leer el número de bases creadas #If Win32 Then numBases = Val(LeerIni(ficIni, "General", "NumeroBases")) #Else numBases = Val(LeerIni(ficIni, "General", "NumeroBases16")) #End If 'Comprobar y leer los nombres For i = 1 To numBases 'Si queremos usar más de 99 nombres, añade un cero más #If Win32 Then sNum = "Base" & Format$(i, "00") #Else 'Si es 16 bits, usamos otro formato, 'porque puede ser la misma base, pero con nombre corto sNum = "Base_" & Format$(i, "00") #End If sBase = Trim$(LeerIni(ficIni, "General", sNum)) '...
Esto estará en cmdAceptar:
'... 'Esta base, hay que buscarla en las del usuario especificado 'el formato será usuarioXX=path_de_la_base #If Win32 Then sTmp = sUsuario & Format$(i + 1, "00") #Else sTmp = sUsuario & "_" & Format$(i + 1, "00") #End If '...
2.- Una barra de herramientas (ToolBar) para la versión de 32 bits.
Primero, lo primero... y es la versión de 32 bits...
aunque sea el segundo punto, es lo primero... o no?... no sé!
Ganas de cachondeo que tiene el niño...
Inserta los controles comunes de Windows. Pon un ImageList y un ToolBar. En el ImageList
inserta estos BMP en este orden:
nuevo, grabar, borrar, buscar, buscsig, impres, infow95, salir
En el Toolbar, asigna el ImageList para que apunte al ImageList1. Ahora inserta un botón
para cada uno de los gráficos que has incluido en el control de imagenes. Yo he puesto
unos separadores de esta forma:
Separador-Nuevo-Guardar-Borrar-Separador-Buscar-BuscarSiguiente-Separador-Consulta-Separador-AcercaDe-Separador-Salir
La imagen de la impresora para la consulta, sé que no es la más apropiada, pero...
Bien, ahora hay que hacer una serie de cambios, ya que los valores que teníamos asignados a las constantes CMD_ no son los apropiados para los de los botones de la barra de herramientas. Deberán quedar de esta forma:
'constantes para los botones de acción 'Según el ToolBar Const CMD_Nuevo = 2 Const CMD_Actualizar = 3 Const CMD_Borrar = 4 Const CMD_Buscar = 6 Const CMD_BuscarSiguiente = 7 Const CMD_Consulta = 9 Const CMD_Acerca = 11 Const CMD_Salir = 13 ' Const CMD_Reemplazar = 105
Ahora hay que "actualizar" el tema de cómo
llamar a estas acciones.
Como supongo que habrás borrado el ToolBar con sus botones correspondientes, se habrá
quedado un Sub en la parte General, que se llamará cmdAccion_Click, se puede dejar y lo
usaremos para las acciones que ya teniamos.
Lo que si tendremos que añadir es una opción para Salir y otra para la consulta.
Salir, porque se hacía por medio del cmdSalir, que NO habrá que borrar y consulta porque
sólo se hacía por medio del menú.
Así pues, añade esto en el Sub Accion, al final de los Case, antes del End Select:
Case CMD_Salir cmdSalir_Click Case CMD_Acerca mnuAcercaDe_Click Case CMD_Consulta mnuConsulta_Click Case Else cmdAccion_Click Index
Si, el mnuAcercaDe no existe, ahora lo añadiremos. Y
también sabrás el porqué de el Case Else.
Pero antes vamos a decirle al programa que sepa lo que tiene que hacer cualdo se pulse en
los botones de la barra de tareas.
Añade este código en el ToolBar1_ButtonClick:
Private Sub Toolbar1_ButtonClick(ByVal Button As Button) Accion Button.Index End Sub
Cuando se pulse en un botón, se manda al procedimiento Accion, si no se encuentra la acción indicada, se procederá a buscar en cmd_Accion, por eso está en el Case Else. ¿Lo entiendes ahora?
3.- Un Menú (y opción) para mostrar el Acerca De...
Añade un nuevo menú, al final de los que ya están, que
sea como principal: Ayuda y como sub-menú Acerca De...
Puedes ponerle como short-cut F1 y como nombre para ejecutar la acción: mnuAcercaDe.
El código a usar, será:
Private Sub mnuAcercaDe_Click() 'mostrar información del programa 'mostrar la información del programa, versión, etc. Dim sMsg As String With App sMsg = vbCrLf sMsg = sMsg & .EXEName & " v" & Format$(.Major, "00") & "." & _ Format$(.Minor, "00") & "." & Format$(.Revision, "0000") & vbCrLf & vbCrLf sMsg = sMsg & .FileDescription & vbCrLf sMsg = sMsg & .Comments & vbCrLf & vbCrLf sMsg = sMsg & .LegalCopyright & vbCrLf & vbCrLf sMsg = sMsg & .ProductName End With If MsgConfirm(sMsg, vbInformation, "Acerca de...") Then End If End Sub
4.- Habilitar/Dehabilitar los botones de la barra de tareas.
Ahora hay que hacer que los botones cambien de estado,
según se hacía antes cuando pulsabamos en nuevo, con idea de que no se pueda hacer otra
acción, salvo la de actualizar, Acerca de y Salir.
También se debería hacer lo mismo con los menús, así que... si ves que no está en el
código del programa, hazlo.
Te doy una pista: Deberías ponerlo en un sub-programa, para que sea más fácil,
habilitarlos y deshabilitarlos.
'Deshabilitar los botones, excepto el de guardar For i = CMD_Nuevo To CMD_Consulta Toolbar1.Buttons(i).Enabled = False Next Toolbar1.Buttons(CMD_Actualizar).Enabled = True
Case CMD_Actualizar 'Volver a habilitar los botones y poner la variable a False For i = CMD_Nuevo To CMD_Consulta Toolbar1.Buttons(i).Enabled = True Next
También deberás borrar la línea que hacía el focus en el botón de acción 0, en CargarTabla, cuando no había datos:
'cmdAccion(0).SetFocus
5.- Las opciones de Copiar, Cortar, Pegar del menú de Edición, usando el API (se me habían olvidado, lo siento)
Pues si, se me habian olvidado por completo. Para estas
tareas, vamos a usar el API de Windows y echaremos mano a los trucos que puse para estas
tareas. Así será compatible con el menú desplegable del botón derecho del ratón,
¡espero!
Vamos a usar para estos casos la función PostMessage, que es casi como SendMessage, pero
en teoría, se supone que también en la práctica, es más rápida.
La diferencia entre SendMessage y PostMessage, es que la última simplemente pone el
mensaje enviado en la cola de Windows y el valor devuelto es de si ha podido o no ponerla
satisfactoriamente en la susodicha cola.
SendMessage devolverá, en según que casos, unos valores, una vez que se ha procesado el
mensaje enviado.
En el caso de Deshacer, verás que se usan las dos funciones y cada una tiene su cometido.
Aunque, como también indico, se podría usar en las dos ocasiones SendMessage.
Las declaraciones de las funciones del API y de las constantes son estas: (fijate que han
cambiado los valores de las constantes de edición con respecto a lo que te indicaba en
los trucos del API, estos valores los he probado y van bien, al menos en 32 bits.
He cambiado las opciones del menú de edición, de forma
que ahora sea un array, de esta forma será más rápido, con un simple bucle, el tema de
habilitar o deshabilitar opciones, según se trate o no de un textbox.
Y otras cosillas, para saber si se puede deshacer o pegar texto.
Estas declaraciones debes ponerlas en el módulo global: glbNotas.bas
'Funciones Globales del API #If Win32 Then Declare Function SendMessage Lib "User32" Alias "SendMessageA" _ (ByVal hWnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, lParam As Any) As Long Declare Function PostMessage Lib "User32" Alias "PostMessageA" _ (ByVal hWnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long #Else Declare Function SendMessage Lib "User" _ (ByVal hWnd As Integer, ByVal wMsg As Integer, _ ByVal wParam As Integer, lParam As Any) As Long Declare Function PostMessage Lib "User" _ (ByVal hWnd As Integer, ByVal wMsg As Integer, _ ByVal wParam As Integer, lParam As Any) As Integer #End If 'Declaración de las constantes, para usar con SendMessage/PostMessage Global Const WM_CUT = &H300 Global Const WM_COPY = &H301 Global Const WM_PASTE = &H302 'Global Const WM_CLEAR = &H303 ' Global Const EM_CANUNDO = &HC6 Global Const EM_UNDO = &HC7
Estás son las constantes para las opciones del menú de
Edición, y los procedimientos.
Deberás quitar los que había antes. Fijate en las rutinas de la parte General del form,
averigua cuales quitar!
'Constantes para el menú de Edición Const mEdDeshacer = 0 Const mEdCortar = 1 Const mEdCopiar = 2 Const mEdPegar = 3 Const mEdSep1 = 4 Const mEdBuscar = 5 Const mEdBuscarSiguiente = 6 Const mEdReemplazar = 7 Const mEdSep2 = 8 Const mEdBuscarActual = 9 Const mEdBuscarSigActual = 10 Const mEdReemplazarActual = 11 Const mEdSep3 = 12 Const mEdSeleccionarTodo = 13 Private Sub mnuEd_Click() 'Habilitar las opciones disponibles Dim Habilitada As Boolean Dim i As Integer 'los separadores no se pueden deshabilitar!!! On Local Error Resume Next 'Asegurarnos que es un textbox If TypeOf Screen.ActiveForm.ActiveControl Is TextBox Then 'ok, todo bien... Habilitada = True Else 'no poder hacer estas cosas Habilitada = False End If For i = mEdDeshacer To mEdSeleccionarTodo mnuEdicion(i).Enabled = Habilitada Next 'Algunos chequeos para las opciones de edición: If Habilitada Then 'Si no se puede deshacer, no habilitarlo If SendMessage(Screen.ActiveForm.ActiveControl.hWnd, EM_CANUNDO, 0, ByVal 0&) Then mnuEdicion(mEdDeshacer).Enabled = True Else mnuEdicion(mEdDeshacer).Enabled = False End If 'comprobar si hay algo que pegar... If Clipboard.GetFormat(vbCFText) Then mnuEdicion(mEdPegar).Enabled = True Else mnuEdicion(mEdPegar).Enabled = False End If End If Err = 0 On Local Error GoTo 0 End Sub Private Sub mnuEdicion_Click(Index As Integer) Select Case Index Case mEdDeshacer '------------------------------------------------------------- ' IMPORTANTE: ' En ambos casos se podría usar SendMessage, ' pero en el caso de EM_CANUNDO, NO serviría PostMessage, ' porque esta función sólo devuelve un valor de ' si se ha puesto o no en la cola de mensajes de windows. '------------------------------------------------------------- 'Si se puede deshacer... '(aunque ya no es necesario comprobarlo, se supone que está deshabilitado 'si no se puede deshacer, sólo es a título explicativo, por el comentario anterior) If SendMessage(Screen.ActiveForm.ActiveControl.hWnd, EM_CANUNDO, 0, ByVal 0&) Then 'Deshacerlo! If PostMessage(Screen.ActiveForm.ActiveControl.hWnd, EM_UNDO, 0, ByVal 0&) Then End If End If Case mEdCopiar If PostMessage(Screen.ActiveForm.ActiveControl.hWnd, WM_COPY, 0, ByVal 0&) Then End If Case mEdCortar If PostMessage(Screen.ActiveForm.ActiveControl.hWnd, WM_CUT, 0, ByVal 0&) Then End If Case mEdPegar If PostMessage(Screen.ActiveForm.ActiveControl.hWnd, WM_PASTE, 0, ByVal 0&) Then End If Case mEdBuscar cmdAccion_Click CMD_Buscar Case mEdBuscarSiguiente cmdAccion_Click CMD_BuscarSiguiente Case mEdReemplazar cmdAccion_Click CMD_Reemplazar Case mEdBuscarActual Accion CMD_BuscarActual Case mEdBuscarSigActual Accion CMD_BuscarSigActual Case mEdReemplazarActual Accion CMD_ReemplazarActual Case mEdSeleccionarTodo Accion CMD_SeleccionarTodo End Select End Sub
6.- La barra de herramientas (ToolBar) para la versión de 16 bits.
En la versión de 16 bits no podemos usar los controles de
Windows 95, así que vamos a crearnos una barra de herramientas, esta está más
conseguida que la que puse por ahí en el apartado de Novatos...
Vamos a usar el mismo picture en el que estaban los botones, si ya lo borrastes, sólo
debes incluir un picture box con la propiedad BorderStyle a cero, sin borde y con el Align
a Top, inserta un array de 8 imagenes con Name = ImgTool, los índices de cero a siete.
Inserta un Shape (Shape1), y le asignas el índice a cero, y las demás propiedades se
asignarán en el Form load.
A las imagenes, le asignas los bitmaps siguientes para las siguientes acciones (usa los
que pone ???95up), los otros no tienen la forma del botón. Las imagenes serán: Nuevo,
Grabar, Borrar, Buscar, BuscarSig (o Buscsi~1), Impresora, Info y Salir.
(los nombres no son estos, pero no creo que tengas problemas para reconocer los correctos)
Ahora sólo queda asignar estas rutinas. Las clases la veremos en el siguiente apartado,
ya que se merecen un poco más de atención.
'Para poder usar el recordset en 16 bits, cambia: .Recordset.Terminada por .Recordset!Terminada 'En las declaraciones del Form: 'Para la simulación del ToolBar Dim Toolbar1 As New cToolBar 'En el Form_Load: '... 'Asignar los valores a la colección de Buttons del ToolBar Dim i As Integer 'El Shape, lo usaremos para simular el Enabled=False 'es una chapuza, pero funciona! With Shape1(0) .DrawMode = 9 .BackColor = &HE0E0E0 .BackStyle = 1 End With For i = 0 To 7 If i > 0 Then Load Shape1(i) With imgTool(i) Shape1(i).Move .Left, .Top End With Next With Toolbar1 .Inicializar 1, CMD_Salir .Buttons(CMD_Nuevo).ImgIndex = 0 .Buttons(CMD_Actualizar).ImgIndex = 1 .Buttons(CMD_Borrar).ImgIndex = 2 .Buttons(CMD_Buscar).ImgIndex = 3 .Buttons(CMD_BuscarSiguiente).ImgIndex = 4 .Buttons(CMD_Consulta).ImgIndex = 5 .Buttons(CMD_Acerca).ImgIndex = 6 .Buttons(CMD_Salir).ImgIndex = 7 End With 'Esta es la misma rutina que para 32 bits! Private Sub Toolbar1_ButtonClick(ByVal Button As Button) Accion Button.Index End Sub Private Sub imgTool_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) 'Se ha pulsado... If Button = 1 Then imgTool(Index).BorderStyle = 1 End If End Sub Private Sub imgTool_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then Toolbar1_ButtonClick Toolbar1.Buttons(Toolbar1.Cual(Index)) imgTool(Index).BorderStyle = 0 End If End Sub
Del resto de la tarea, se encargan las dos clases.
7.- Las clases para la simulación del ToolBar, (me lo he currao, aunque no la vayas a usar, leetelo)
Estas son las clases que van a servirnos para simular el
ToolBar, sin tener que cambiar el código usado por la versión de 32 bits, o sea que si
después quieres cambiarte de 16 a 32 bits y le has hecho modificaciones al formulario,
sólo tendrás que quitar lo que se ha añadido en el punto anterior... De nada.
Hay dos clases, una básica que es la que simulará el par´metro Button de los botones
del ToolBar. Y la otra será la que se encargue de manejar una colección de este tipo.
Porque en el listado usamos la colección Buttons para hacerlos disponibles (enabled) o
no.
Aquí están las clases, creo que más o menos bien comentadas, así que no creo que
necesites explicación extra.
'--------------------------------------------------------------- 'Clase para simular el tipo Button (20/Abr/97) ' '(c)Guillermo Som, 1997 '--------------------------------------------------------------- Option Explicit 'Public Enabled As Boolean Public Index As Integer Public ImgIndex As Integer Private sID As String Public Property Get ID() As String ID = sID End Property Public Property Let ID(vNewValue As String) Static YaEstoy As Boolean If YaEstoy Then Exit Property sID = vNewValue YaEstoy = True End Property Public Property Get Enabled() As Boolean If ImgIndex <> -1 Then Enabled = gsNotas.imgTool(ImgIndex).Enabled End If End Property Public Property Let Enabled(vNewValue As Boolean) If ImgIndex <> -1 Then With gsNotas .imgTool(ImgIndex).Enabled = vNewValue .Shape1(ImgIndex).Visible = Not vNewValue .Shape1(ImgIndex).ZOrder End With End If End Property
'-------------------------------------------------------------- 'Clase para simular el ToolBar (20/Abr/97) ' 'Sólo para usarlo con 16bits o para simular el ToolBar en 32bits ' '(c)Guillermo Som, 1997 '-------------------------------------------------------------- Option Explicit Private colButtons As New Collection Public Function Buttons(ByVal Index As Integer) As Button 'Devuelve o asigna un elemento de la colección Dim tButton As New Button Dim sIndex As String On Local Error Resume Next sIndex = "Button" & Format$(Index, "00") Set tButton = colButtons(sIndex) If Err Then Set tButton = Nothing With tButton .ID = sIndex .Index = -1 .Enabled = False End With Err = 0 End If Set Buttons = tButton On Local Error GoTo 0 Set tButton = Nothing End Function Public Function Cual(ByVal Index As Integer) As Integer 'Devolver el índice adecuado Dim tButton As New Button For Each tButton In colButtons If tButton.ImgIndex = Index Then Cual = tButton.Index Exit For End If Next End Function Public Sub Inicializar(ByVal Primero As Integer, Ultimo As Integer) 'inicializa la colección Dim i As Integer Dim tButton As New Button Set colButtons = Nothing For i = Primero To Ultimo Set tButton = Nothing With tButton .ID = "Button" & Format$(i, "00") .Enabled = True .Index = i .ImgIndex = -1 colButtons.Add tButton, .ID End With Next End Sub
Y esto es todo, que no ha sido poco.
Espero que los "forofos" de los 32 bits no se hayan "aburrido" y que
los "pocos" de 16 bits, no se sientan ya desplazados.
De todas formas, si tienes alguna duda... pregunta, pregunta.
¡Feliz programación!
Nos vemos.
Entregas anteriores: Primera,
Segunda, Tercera, Cuarta, Quinta,
Sexta, Septima
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
esta entrega y las posteriores, cuando haya. (gsnotas2_htm.zip 8.97 KB)
Bajate los
listados y los bitmaps para las barras de herramientas. (gsnotas.zip 53.6 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)