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.
2. Una barra de herramientas (ToolBar) para la versi�n de 32 bits.
3. Un men� (y opci�n) para mostrar el Acerca De...
4. Habilitar/Dehabilitar los botones de la barra de tareas.
5. Las opciones de Copiar, Cortar, Pegar del men� de Edici�n, usando el API, (se me hab�an olvidado, lo siento)
6. La barra de herramientas (ToolBar) para la versi�n de 16 bits.
7. Las clases para la simulaci�n del ToolBar, (me lo he currao, aunque no la vayas a usar, leetelo)

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

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

'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

    Case CMD_Salir
        cmdSalir_Click
    Case CMD_Acerca
        mnuAcercaDe_Click
    Case CMD_Consulta
        mnuConsulta_Click
    Case Else
        cmdAccion_Click Index

Private Sub Toolbar1_ButtonClick(ByVal Button As Button)
    Accion Button.Index
End Sub

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

            '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

'cmdAccion(0).SetFocus

'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

'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

'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

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