Curso de programación en Visual - Crear un cuadro de diálogo 33

Curso básico de programación en Visual Basic

Crear un cuadro de diálogo

Realizamos programas para la gestión de empresas. Empresas medianas y pequeñas. Programas de contabilidad, cartera de pedidos clientes proveedores, facturación control de albaranes, tesorería cartera de cobros y pagos y estadísticas.
Nuestro agradecimiento a todos los que por unas causas o por otras visitan nuestra web. Gestión de empresas PYMES. Curso de programación de Visual Basic.

Aunque no es normal que con el calor que hace por estas latitudes en estas fechas me vuelva "trabajador", (seguramente será por el "mono" de no haberme puesto delante del ordenador por culpa del "virus" ese que me atacó hace unos meses), aquí te traigo una nueva entrega de este cursillo que va a ser más largo (en fechas) que... no se me ocurre ahora ningún ejemplo, pero bueno, ya me entiendes, sobre todo teniendo en cuenta que lo empecé en Abril del 97... ¡cuanto tiempo ha pasado ya!

Pero lo importante es que aquí estamos de nuevo con una otra entrega del cursillo básico de Visual Basic, en este caso, vamos a acabar con lo que quedaba pendiente del editor que nos ha servido de ejemplo en las últimas entregas.
Lo que vamos a hacer en este caso es crear nuestro propio diálogo de buscar y reemplazar y también veremos el código que habría que usar para realizar esas operaciones sobre el texto escrito.

Diálogo de Buscar y Reemplazar para el Editor

Antes de empezar a ver el código de este cuadro de diálogo, vamos a hacer unos pequeños cambios en el formulario del editor:

-- Cambia los nombre del menú de edición de mnuEditor a mnuEdicion, (es que es más lógico)

-- El código de mnuEdicion_Click debe quedar así: (después veremos porqué)

Private Sub mnuEdicion_Click(Index As Integer)
    '-----------------------------------------------------------------------
    ' Usando el código del módulo MgsDBR es más cómodo              
    ' ya se encarga de todo...
    '-----------------------------------------------------------------------
    '
    Set LineaEstado = lblStatus
    MgsDBR.menuEdicion Index
    '
End Sub

Si ya tuviésemos el código que ahora veremos, eso sería todo lo que habría que hacer para que funcionasen todas las opciones del menú de Edición... ¿fácil?, no, simple, ya que el código simplemente está escrito en otro sitio... pero escrito está... ¡que conste! y a mi me consta, que lo he escrito yo... je, je.

-- El código de comprobación que hay en el evento mnuFicSalir_Click lo he pasado al del Form_QueryUnload, para que también se pregunte si se pulsa en el botón de cerrar el formulario, (la "x" que hay arriba a la derecha)
Por tanto esos dos eventos quedarían así:

Private Sub mnuFicSalir_Click()
    ' Terminar el programa
    '
    ' La comprobación de si hay que guardar el fichero está en el
    ' evento Form_QueryUnload, para que también sirva si se pulsa en la "x"
    ' del formulario.
    '
    Unload Me
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    ' Al terminar el programa,
    ' comprobar si se ha modificado el fichero...                   
    '
    ' Pero sólo se debería comprobar si                             
    ' se pulsa en el botón "x" del formulario
    ' o si se cierra por medio de código, (con Unload)
    '
    Dim ret As Long

    ' Sólo si se cierra por medio de nuestro código o por cerrar el
    ' formulario

  If UnloadMode = vbFormCode Or UnloadMode = vbFormControlMenu Then
        If Modificado Then
            ret = MsgBox("El fichero se ha modificado, _
				¿quieres guardarlo?", vbYesNoCancel)
            ' Si hemos contestado "Si"
            If ret = vbYes Then
                ' Guardarlo
                mnuFicGuardar_Click
            ' Si pulsamos el botón Cancelar, salimos del procedimiento
            ' y por tanto no terminamos el programa.
            ElseIf ret = vbCancel Then
                Exit Sub
            End If
        End If
    End If
End Sub

Veamos ahora ese código, aunque antes, una imagen del aspecto del formulario (en tiempo de diseño) que nos servirá para buscar y reemplazar, además de para usarlo como un ImPutBox.

El formulario de Buscar y Reemplazar

Para que este diálogo funcione, necesitamos, además del propio formulario, el código de un módulo BAS, que es realmente el que hace casi todo el trabajo.

Veamos primero el código del formulario:

'---------------------------------------------------------------------------
' Form genérico para diálogo Buscar/Reemplazar                      
' Se necesita el módulo MgsDBR.bas
'
' ©Guillermo 'guille' Som, 1996-2003
'---------------------------------------------------------------------------
Option Explicit

Private Const NumeroMaximoDeItems = 200
Private bBuscandoEnCombo As Boolean


Private Sub cmdCancel_Click()
    ActualizarCombo

    iFFAccion = cFFAc_Cancelar

    Unload Me
End Sub

Private Sub cmdFindNext_Click()
    ActualizarCombo

    sFFBuscar = txtFind.Text
    sFFPoner = ""

    iFFAccion = cFFAc_BuscarSiguiente

    Unload Me
End Sub

Private Sub cmdReplace_Click()
    ActualizarCombo

    sFFBuscar = txtFind.Text
    sFFPoner = txtReplace.Text

    If Len(sFFPoner) = 0 Then
        iFFAccion = cFFAc_Buscar
    Else
        iFFAccion = cFFAc_Reemplazar
    End If

    Unload Me
End Sub

Private Sub cmdReplaceAll_Click()
    ActualizarCombo

    sFFBuscar = txtFind.Text
    sFFPoner = txtReplace.Text

    If Len(sFFPoner) = 0 Then
        iFFAccion = cFFAc_Buscar
    Else
        iFFAccion = cFFAc_ReemplazarTodo
    End If

    Unload Me
End Sub

Private Sub Combo1_Change(Index As Integer)
    Static YaEstoy As Boolean

    If bBuscandoEnCombo Then Exit Sub

    On Local Error Resume Next

    If Index = 0 Then
        txtFind = Combo1(0).Text
    Else
        txtReplace = Combo1(1).Text
    End If

    Err = 0
End Sub

Private Sub Combo1_Click(Index As Integer)

    If bBuscandoEnCombo Then Exit Sub

    If Combo1(Index).ListIndex Then
        Combo1(Index).Text = Combo1(Index).List(Combo1(Index).ListIndex)
    End If
    If Index = 0 Then
        txtFind = Combo1(Index).Text
    Else
        txtReplace = Combo1(Index).Text
    End If
End Sub

Private Sub Form_Load()

    ' Si no se ha especificado ningún nombre de fichero de configuración
    If sFFIni = "" Then
        ' Asignar el nombre del fichero INI.
        '
        ' Se podría hacer así:
        'sFFIni = App.Path & "\BuscReemp.ini"
        ' pero si el programa es el directorio raiz, por ejemplo en C:,
        ' tendríamos esto: 'C:\\BuscReemp.ini' y daría error
        '
        ' Asi que nos creamos una función que devuelva el path pero sin
        ' la barra del final.
        sFFIni = AppPath & "\BuscReemp.ini"
    End If

    ' Posicionar en el centro de la ventana principal
    Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2

    Combo1(0).Clear
    Combo1(1).Clear

    ' En un sub, para que acepte el tag de los combos.
    ' Si se dejaba en el Form_Load, no se actualizaban los valores de inicio
    'IniciarCombo
    Timer1.Interval = 100
    Timer1.Enabled = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    ' Si se cierra por el controlbox o
    ' cualquier forma distinta del propio código, asumir que se ha cancelado.
    If UnloadMode <> vbFormCode Then
        iFFAccion = cFFAc_Cancelar
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim n As Integer
    Dim vTmp As String
    Dim sTmp As String
    Dim i As Integer
    Dim j As Integer
    Dim sTag As String

    ' Si no se ha cancelado...
    If iFFAccion <> cFFAc_Cancelar Then
        ' Guardar el contenido de los combos en el fichero INI
        ActualizarCombo
        For i = 0 To 1
            n = Combo1(i).ListCount
            sTag = Trim$(Combo1(i).Tag)
            If n > NumeroMaximoDeItems Then n = NumeroMaximoDeItems
            GuardarIni sFFIni, sTag, "NumEntradas", CStr(n)
            For j = 0 To n - 1
                vTmp = "Entrada" & CStr(j)
                sTmp = Combo1(i).List(j)
                GuardarIni sFFIni, sTag, vTmp, sTmp
            Next
        Next
    End If

    Set gsDBR = Nothing
End Sub

Private Sub ActualizarCombo()
    '-----------------------------------------------------
    ' Esta rutina actualiza el contenido de los dos combos,
    ' si la entrada en el Combo.Text no está, la incluye.
    ' Se podría usar la llamada al API de Windows.
    '-----------------------------------------------------
    ' Actualizar el contenido del Combo
    Dim sTmp As String
    Static k As Integer
    '
    bBuscandoEnCombo = True
    For k = 0 To 1
        sTmp = Combo1(k).Text
        If Len(Trim$(sTmp)) Then
            ' El valor devuelto no nos interesa
            Call ActualizarLista(sTmp, Combo1(k))
        End If
    Next
    bBuscandoEnCombo = False
End Sub

Private Sub IniciarCombo()
    Dim j As Integer
    Dim i As Integer
    Dim n As Integer
    Dim vTmp As String
    Dim sTmp As String
    Dim sTag As String

    ' Asignar los valores anteriores del combo
    For i = 0 To 1
        sTag = Trim$(Combo1(i).Tag)
        n = 0
        n = LeerIni(sFFIni, sTag, "NumEntradas", n)
        If n > NumeroMaximoDeItems Then n = NumeroMaximoDeItems
        '
        For j = 0 To n - 1
            vTmp = "Entrada" & CStr(j)
            sTmp = LeerIni(sFFIni, sTag, vTmp, "")
            If Len(sTmp) Then
                Combo1(i).AddItem sTmp
            End If
        Next
    Next
End Sub

Private Sub Timer1_Timer()
    ' Asignar los valores anteriores del combo
    Timer1.Enabled = False  ' Ya no necesitaremos más este evento!!!
    '
    IniciarCombo
End Sub

Private Function AppPath() As String
    ' Devolver el path actual sin la barra final de directorio
    '
    ' Si el último caracter es la barra de directorio,
    If Right$(App.Path, 1) = "\" Then
        ' devolver todos los caracteres menos el último.
        AppPath = Left$(App.Path, Len(App.Path) - 1)
    Else
        ' sino, devolver el path normal
        AppPath = App.Path
    End If
End Function

Ahora veamos el contenido del módulo: gsDBR.bas:

'
'---------------------------------------------------------------------------
' gsDBR.bas Módulo para el diálogo de Buscar y Reemplazar           
'
' (c)Guillermo 'guille' Som, 1997-2003
'---------------------------------------------------------------------------
Option Explicit

' Control en el que se mostrará lo que el diálogo está haciendo
' Se tendrá que usar con SET, por ejemplo: Set LineaEstado = Label1
Global LineaEstado As Control

'
' Variables y constantes globales (o públicas) para buscar/reemplazar
'
' Constantes para el menú de Edición
'
' Es recomendable tener un menú de edición con estas opciones
' y en este mismo orden.
'
Public Enum emnuEdicion
    mEdDeshacer = 0
    mEdCortar = 1
    mEdCopiar = 2
    mEdPegar = 3
    ' Const mEdSep1 = 4
    mEdBuscarActual = 5
    mEdBuscarSigActual = 6
    mEdReemplazarActual = 7
    ' Const mEdSep2 = 8
    mEdSeleccionarTodo = 9
End Enum
'
'
Global sFFBuscar As String              ' La cadena a buscar (de los textboxes)
Global sFFPoner As String               ' La cadena a poner
'
Global iFFAccion As Integer             ' Indicará que es lo que hemos hecho
                                        ' para salir del diálogo,
                                        ' ver las siguientes constantes:
'
' Constantes para la acción a realizar
Global Const cFFAc_Cancelar = True
Global Const cFFAc_IDLE = 0
Global Const cFFAc_Buscar = 1
Global Const cFFAc_BuscarSiguiente = 2
Global Const cFFAc_Reemplazar = 3
Global Const cFFAc_ReemplazarTodo = 4
Global Const cFFAc_Aceptar = 5
'
Global sFFIni As String                 ' Archivo de configuración
'
'
'---------------------------
' Funciones Globales del API
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal wMsg As Long, _
     ByVal wParam As Long, lParam As Any) As Long

Private 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

' 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 EM_CANUNDO = &HC6
Global Const EM_UNDO = &HC7

'--------------------------------------------------
' Profile.bas                           (24/Feb/97)
' Autor:        Guillermo Som Cerezo, 1997
' Fecha inicio: 24/Feb/97 04:05
'
' Módulo genérico para las llamadas al API
' usando xxxPrivateProfileString
'--------------------------------------------------
'
' Declaraciones privadas para guardar y leer ficheros INIs
Private Declare Function GetPrivateProfileString Lib "Kernel32.dll" _
		Alias "GetPrivateProfileStringA" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
     ByVal lpDefault As String, ByVal lpReturnedString As String, _
     ByVal nSize As Long, ByVal lpFileName As String) As Long

Private Declare Function WritePrivateProfileString Lib "Kernel32.dll" _
	Alias "WritePrivateProfileStringA" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
     ByVal lpString As Any, ByVal lpFileName As String) As Long


'----------------------------------------------------------------------------
' Procedimiento equivalente a SaveSetting de VB.
' SaveSetting   En VB/32bits usa el registro.
'               En VB/16bits usa un archivo de texto.
' GuardarIni al usar las llamadas del API, siempre se escriben en archivos de texto.
'----------------------------------------------------------------------------
Public Sub GuardarIni(ByVal lpFileName As String, ByVal lpAppName _ 
		As String, ByVal lpKeyName As String, ByVal lpString As String)
    ' Guarda los datos de configuración
    ' Los parámetros son los mismos que en LeerIni
    ' Siendo lpString el valor a guardar
    '
    Dim LTmp As Long

    LTmp = WritePrivateProfileString(lpAppName, lpKeyName, lpString, lpFileName)
End Sub

'----------------------------------------------------------------------------
' Función equivalente a GetSetting de VB.
' GetSetting    En VB/32bits usa el registro.
'               En VB/16bits usa un archivo de texto.
' LeerIni al usar las llamadas del API, siempre se escriben en archivos de texto.
'----------------------------------------------------------------------------
Public Function LeerIni(ByVal lpFileName As String, ByVal lpAppName  _
		As String, ByVal lpKeyName As String, Optional ByVal vDefault) As String
    'Los parámetros son:
    'lpFileName:    La Aplicación (fichero INI)
    'lpAppName:     La sección que suele estar entrre corchetes
    'lpKeyName:     Clave
    'vDefault:      Valor opcional que devolverá
    '               si no se encuentra la clave.
    '
    Dim lpString As String
    Dim LTmp As Long
    Dim sRetVal As String

    'Si no se especifica el valor por defecto,
    'asignar incialmente una cadena vacía
    If IsMissing(vDefault) Then
        lpString = ""
    Else
        lpString = vDefault
    End If

    'Longitud máxima permitida                      (25/Ene/98)
    '(antes 255)
    sRetVal = String$(32367, 0)

    LTmp = GetPrivateProfileString(lpAppName, lpKeyName, lpString, _ 
		sRetVal, Len(sRetVal), lpFileName)
    If LTmp = 0 Then
        LeerIni = lpString
    Else
        LeerIni = Left(sRetVal, LTmp)
    End If
    sRetVal = ""
End Function


Public Function ActualizarLista(ByVal sTexto As String, cList _ 
		As Control, Optional vTipoBusqueda, Optional vAddLista) As Long
    'Esta función comprobará si el texto indicado existe en la lista
    'Si no es así, lo añadirá
    'El valor devuelto, será la posición dentro de la lista ó -1 si hay "fallos"
    '
    'Para buscar en el List/combo usaremos una llamada al API
    '(si ya hay una forma de hacerlo, ¿para que re-hacerla?)
    '
    'Constantes para los combos
    Const CB_FINDSTRINGEXACT = &H158
    Const CB_FINDSTRING = &H14C
    Const CB_SELECTSTRING = &H14D
    'Constantes para las Listas
    Const LB_FINDSTRINGEXACT = &H1A2        'Busca la cadena exactamente igual
    Const LB_FINDSTRING = &H18F             'Busca en cualquier parte de la cadena
    Const LB_SELECTSTRING = &H18C           'Busca desde el principio de la cadena
    '
    Dim lTipoBusqueda As Long
    Dim bTipoBusqueda As Integer            '0= Exacta, 1= cualquier parte, 2=desde el principio
    Dim bAddLista As Boolean
    Dim L As Long

    'Si se busca palabra completa o parcial,
    'por defecto COMPLETA
    If IsMissing(vTipoBusqueda) Then
        bTipoBusqueda = False
    Else
        bTipoBusqueda = vTipoBusqueda
    End If
    'Si se debe añadir o no, por defecto SI
    If IsMissing(vAddLista) Then
        bAddLista = True
    Else
        bAddLista = vAddLista
    End If

    'Si el control es un Combo
    If TypeOf cList Is ComboBox Then
        If bTipoBusqueda = 1 Then
            lTipoBusqueda = CB_FINDSTRING
        ElseIf bTipoBusqueda = 2 Then
            lTipoBusqueda = CB_SELECTSTRING
        Else
            lTipoBusqueda = CB_FINDSTRINGEXACT
        End If
    'Si el control es un list
    ElseIf TypeOf cList Is ListBox Then
        If bTipoBusqueda = 1 Then
            lTipoBusqueda = LB_FINDSTRING
        ElseIf bTipoBusqueda = 2 Then
            lTipoBusqueda = LB_SELECTSTRING
        Else
            lTipoBusqueda = LB_FINDSTRINGEXACT
        End If
    Else
        'no es un control List o Combo, salir
        ActualizarLista = -1
        Exit Function
    End If

    If cList.ListCount = 0 Then
        'Seguro que no está, así que añadirla, si viene al caso...
        L = -1
    Else
        L = SendMessage(cList.hWnd, lTipoBusqueda, -1, ByVal sTexto)
    End If

    'Si no está, añadirla
    If L = -1 Then
        If bAddLista Then
            'Con el 0 se añade al principio de la lista
            cList.AddItem sTexto, 0
            L = ActualizarLista(sTexto, cList, bTipoBusqueda, bAddLista)
        End If
    End If
    ActualizarLista = L
End Function

Public Function gsReemplazar(sBuscar As String, sPoner As String, Optional _
		 vModo, Optional vCaption) As Integer
    'Prepara el diálogo de Reemplazar
    Dim iModo As Integer
    Dim sCaption As String

    If IsMissing(vModo) Then
        iModo = cFFAc_Reemplazar
    Else
        iModo = vModo
    End If

    If IsMissing(vCaption) Then
        sCaption = "Reemplazar"
    Else
        sCaption = CStr(vCaption)
    End If

    iFFAccion = cFFAc_IDLE
    With gsDBR
        'Por ahora no se muestra en reemplazar          
        .Caption = sCaption
        .cmdFindNext.Default = False
        .cmdFindNext.Visible = False
        .cmdReplaceAll.Default = True
        .Combo1(0).Text = sBuscar
        .Combo1(1).Text = sPoner
        'Mostrar el form y esperar a que se tome una acción
        .Show vbModal
        'Do
        '    .Show
        '    DoEvents
        'Loop Until iFFAccion
    End With
    'Devolver la cadena a reemplazar y buscar
    sBuscar = sFFBuscar
    sPoner = sFFPoner
    'Si tanto buscar como poner están en blanco, devolver cancelar
    If Len(Trim$(sBuscar)) = 0 Then
        If Len(Trim$(sPoner)) = 0 Then
            iFFAccion = cFFAc_Cancelar
        End If
    End If
    'Devolver la acción
    gsReemplazar = iFFAccion
End Function

Public Function gsBuscar(sBuscar As String, Optional vModo, _
				Optional vCaption) As Integer
    'Prepara el diálogo para buscar
    Dim iModo As Integer
    Dim sCaption As String
    Dim bCompleta As Boolean
    Dim bAtras As Boolean

    If IsMissing(vModo) Then
        iModo = cFFAc_Buscar
        bCompleta = False
        bAtras = False
    End If
    'Sólo permitir buscar y buscar-siguiente
    Select Case iModo
    Case cFFAc_Buscar, cFFAc_BuscarSiguiente
        'está bien, no hay nada que hacer
    Case Else
        iModo = cFFAc_Buscar
    End Select

    If IsMissing(vCaption) Then
        sCaption = "Buscar"
    Else
        sCaption = CStr(vCaption)
    End If

    iFFAccion = cFFAc_IDLE
    With gsDBR
        .Caption = sCaption
        .cmdReplace.Visible = False
        .lblReplace.Visible = False
        .cmdReplaceAll.Visible = False
        .Combo1(1).Visible = False
        .Combo1(1).Enabled = False
        .cmdFindNext.Left = .cmdReplaceAll.Left
        If iModo = cFFAc_BuscarSiguiente Then
            .cmdFindNext.Caption = "Siguiente"
            DoEvents
        End If
        .Combo1(0).Text = sBuscar
        'Mostrar el form y esperar a que se tome una acción
        .Show vbModal
        'Do
        '    .Show
        '    DoEvents
        'Loop Until iFFAccion
    End With
    'Devolver la cadena seleccionada/introducida
    sBuscar = sFFBuscar
    'Devolver la acción
    gsBuscar = iFFAccion
End Function


Public Sub gsPedirUnValor(ByVal spuvTitulo As String, _
                        ByVal spuvMensaje As String, _
                        ByVal spuvPregunta As String, _
                        ByRef spuvValor As String, _
                        ByVal spuvBoton As String)
    '----------------------------------------------------------------------
    ' Rutina de propósito general para pedir un valor         
    '
    ' Los parámetros son:
    '   spuvTitulo      El título de la ventana
    '   spuvMensaje     El texto a mostrar como explicación
    '   spuvPregunta    El texto con la pregunta a realizar
    '   spuvValor       El texto a mostrar en la caja de texto,
    '                   también se usa para devolver la respuesta
    '   spuvBoton       El texto a poner en el botón de aceptar
    '----------------------------------------------------------------------
    With gsDBR
        .Caption = spuvTitulo
        .Combo1(0).Visible = False
        .lblBuscar.Width = .ScaleWidth - 120
        .lblBuscar = spuvMensaje
        .Combo1(0).Visible = False
        .cmdReplace.Visible = False
        .cmdFindNext.Default = False
        .cmdFindNext.Visible = False
        .lblReplace = spuvPregunta
        .cmdReplaceAll.Default = True
        .cmdReplaceAll.Caption = spuvBoton
        If Len(Trim$(spuvValor)) Then
            .Combo1(1).Text = spuvValor
        Else
            If .Combo1(1).ListCount Then
                .Combo1(1).ListIndex = 0
            End If
        End If
        .Show vbModal
    End With
    spuvValor = sFFPoner
End Sub


Private Sub AccionBuscar(Index As Integer)
    '-----------------------------------------------------------------------
    ' Procedimiento genérico para realizar búsquedas            
    '
    ' Valores "externos" necesarios:
    '   LineaEstado     un control para mostrar mensajes temporales
    '                   Hacer un set a una etiqueta en la que se mostrará
    '                   el progreso de la búsqueda:
    '                   Set LineaEstado = lblStatus
    '
    '   Index           El parámetro que apuntará a los índices
    '                   del menú de edición que deberá tener estas opciones:
    '
    '           Deshacer            Ctrl+Z
    '           Cortar              Ctrl+X
    '           Copiar              Ctrl+V
    '           Pegar               Ctrl+P
    '           ---(separador)
    '           Buscar              Ctrl+B o Ctrl+F
    '           Buscar Siguiente    F3
    '           Reemplazar          Ctrl+H
    '           ---(separador)
    '           Seleccionar Todo    Ctrl+A
    '
    '   Estas constantes están declaradas en la enumeración emnuEdicion
    '
    '-----------------------------------------------------------------------
    Static sBuscar As String
    Static lngUltimaPos As Long
    Dim lngPosActual As Long
    Dim sTmp As String
    Dim tText As TextBox 'Control

    On Error Resume Next

    Set tText = Screen.ActiveForm.ActiveControl
    ' Si no es un cuadro de texto, salir
    If Not (TypeOf tText Is TextBox) Then
        Err = 0
        Exit Sub
    End If

    If LineaEstado Is Nothing Then
        ' Poner a cero el número de error, ya que esto nos dará
        ' la "pista" de que todo haya ido bien
        Err = 0
        ' intentarlo con lblStatus, si no existe, salir...
        Set LineaEstado = Screen.ActiveForm.lblStatus
        ' Si se produce un error, es que no podemos usar "LinaEstado"
        If Err Then
            Err = 0
            ' salir del procedimiento
            Exit Sub
        End If
    End If
    ' Guardar el valor mostrado, antes de entrar a esta rutina
    LineaEstado.Tag = LineaEstado

    ' para procesar las otras acciones adicionales   (15/Abr/97)
    Select Case Index
    Case mEdBuscarActual
        ' Si hay texto seleccionado...
        With tText
            If .SelLength > 0 Then
                sBuscar = Trim$(.SelText)
            End If
        End With
        ' Para "personalizar" la sección de búsqueda...
        gsDBR.Combo1(0).Tag = "Buscar_" '& sUsuario
        If gsBuscar(sBuscar, , "Buscar en el campo actual") > cFFAc_IDLE Then
            sBuscar = Trim$(sBuscar)
            If Len(sBuscar) Then
                LineaEstado = "Buscando en el campo actual " & sBuscar & "..."
                DoEvents
                lngUltimaPos = 0&
                lngPosActual = InStr(tText, sBuscar)
                If lngPosActual Then
                    lngUltimaPos = lngPosActual + 1
                    ' posicionarse en esa palabra:
                    With tText
                        .SelStart = lngPosActual - 1
                        .SelLength = Len(sBuscar)
                    End With
                Else
                    Beep
                    MsgBox "No se ha hallado el texto buscado", _
		vbOK + vbInformation, "Buscar en el campo actual"
                End If
                ' posicionarse en ese control
                tText.SetFocus
            End If
        End If
    Case mEdBuscarSigActual
        'Si no hay nada hallado con anterioridad
        'o no se ha procesado la última búsqueda en este control
        If Len(sBuscar) = 0 Or lngUltimaPos = 0& Then
            AccionBuscar mEdBuscarActual
        Else
            LineaEstado = "Buscando " & sBuscar & "..."
            DoEvents
            lngPosActual = InStr(lngUltimaPos, tText, sBuscar)
            If lngPosActual Then
                lngUltimaPos = lngPosActual + Len(sBuscar)
                'posicionarse en esa palabra:
                With tText
                    .SelStart = lngPosActual - 1
                    .SelLength = Len(sBuscar)
                End With
            Else
                lngUltimaPos = 1&
                Beep
                MsgBox "No se ha hallado el texto buscado.", _
			vbOK + vbInformation, "Buscar en el campo actual"
            End If
            ' posicionarse en ese control
            tText.SetFocus
        End If
    Case mEdReemplazarActual
        ' Si hay texto seleccionado...
        With tText
            If .SelLength > 0 Then
                sBuscar = Trim$(.SelText)
            End If
        End With

        sFFBuscar = sBuscar
        sFFPoner = ""
        ' Personalizar las secciones de buscar/reemplazar
        gsDBR.Combo1(0).Tag = "Buscar_" '& sUsuario
        gsDBR.Combo1(1).Tag = "Reemplazar_" '& sUsuario
        iFFAccion = gsReemplazar(sFFBuscar, sFFPoner, , "Reemplazar en el campo actual")
        If iFFAccion <> cFFAc_Cancelar Then
            Screen.ActiveForm.MousePointer = vbHourglass
            DoEvents
            sBuscar = Trim$(sFFBuscar)
            If Len(sFFBuscar) <> 0 And Len(sFFPoner) <> 0 Then
                If iFFAccion = cFFAc_Reemplazar Or iFFAccion = _
			cFFAc_ReemplazarTodo Then
                    LineaEstado = "Reemplazando " & sBuscar & "..."
                    DoEvents
                    lngUltimaPos = 0&
                    lngPosActual = InStr(tText, sBuscar)
                    If lngPosActual Then
                        lngUltimaPos = lngPosActual + Len(sBuscar)
                        sTmp = tText
                        sTmp = Left$(sTmp, lngPosActual - 1) & sFFPoner & _
			Mid$(sTmp, lngPosActual + Len(sFFBuscar))
                        tText = sTmp

                        ' Si sólo es reemplazar uno...
                        If iFFAccion = cFFAc_Reemplazar Then
                            ' posicionarse en la palabra modificada:
                            With tText
                                .SelStart = lngPosActual - 1
                                .SelLength = Len(sFFPoner)
                            End With
                            ' Dejar el puntero del ratón como estaba
                            Screen.ActiveForm.MousePointer = vbDefault
                            ' Salir
                            Exit Sub
                        End If

                        ' Cambiar todas las coincidencias en el mísmo text
                        lngUltimaPos = 1
                        Do
                            lngPosActual = InStr(lngUltimaPos, sTmp, sFFBuscar)
                            If lngPosActual Then
                                lngUltimaPos = lngPosActual + 1
                                sTmp = Left$(sTmp, lngPosActual - 1) & _ 
			sFFPoner & Mid$(sTmp, lngPosActual + Len(sFFBuscar))
                                tText = sTmp
                            End If
                        Loop While lngPosActual
                        '
                        ' posicionarse en la última palabra modificada
                        With tText
                            .SelStart = lngUltimaPos - 2
                            .SelLength = Len(sFFPoner)
                        End With
                        DoEvents
                    Else
                        Beep
                        MsgBox "No se ha hallado el texto buscado.", _
		vbOK + vbInformation, "Buscar en el campo actual"
                    End If
                    ' Si se ha reemplazado todo, no debe estar esta palabra..
                    lngUltimaPos = 0&
                End If
            End If
            Screen.ActiveForm.MousePointer = vbDefault
            DoEvents
        End If
    Case mEdSeleccionarTodo
        With tText
            .SelStart = 0
            .SelLength = Len(.Text)
        End With
    End Select
    LineaEstado = LineaEstado.Tag
End Sub


Public Sub menuEdi()
    ' Habilitar las opciones disponibles
    Dim Habilitada As Boolean
    Dim i As Integer
    '
    Dim elForm As Form

    ' Los separadores no se pueden deshabilitar!!!
    On Local Error Resume Next

    Set elForm = Screen.ActiveForm

    ' 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
        elForm!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
            elForm!mnuEdicion(mEdDeshacer).Enabled = True
        Else
            elForm!mnuEdicion(mEdDeshacer).Enabled = False
        End If

        ' Comprobar si hay algo que pegar...
        If Clipboard.GetFormat(vbCFText) Then
            elForm!mnuEdicion(mEdPegar).Enabled = True
        Else
            elForm!mnuEdicion(mEdPegar).Enabled = False
        End If

        ' Si hay texto seleccionado, habilitamos Cortar y Copiar
        If Screen.ActiveForm.ActiveControl.SelLength Then
            elForm!mnuEdicion(mEdCortar).Enabled = True
            elForm!mnuEdicion(mEdCopiar).Enabled = True
        Else
            elForm!mnuEdicion(mEdCortar).Enabled = False
            elForm!mnuEdicion(mEdCopiar).Enabled = False
        End If
    End If

    Err = 0
End Sub


Public Sub menuEdicion(Index As Integer)
    Dim sTmp As String

    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...
        If SendMessage(Screen.ActiveForm.ActiveControl.hWnd, EM_CANUNDO, 0, ByVal 0&) Then
            'Deshacerlo!
            Call PostMessage(Screen.ActiveForm.ActiveControl.hWnd, EM_UNDO, 0, ByVal 0&)
        End If
    Case mEdCopiar
        Call PostMessage(Screen.ActiveForm.ActiveControl.hWnd, WM_COPY, 0, ByVal 0&)
    Case mEdCortar
        Call PostMessage(Screen.ActiveForm.ActiveControl.hWnd, WM_CUT, 0, ByVal 0&)
    Case mEdPegar
        Call PostMessage(Screen.ActiveForm.ActiveControl.hWnd, WM_PASTE, 0, ByVal 0&)
    Case mEdBuscarActual
        AccionBuscar mEdBuscarActual
    Case mEdBuscarSigActual
        AccionBuscar mEdBuscarSigActual
    Case mEdReemplazarActual
        AccionBuscar mEdReemplazarActual
    Case mEdSeleccionarTodo
        AccionBuscar mEdSeleccionarTodo
    End Select
End Sub

Como te dije al principio, para usar el cuadro de diálogo, solamente hay que llamar al procedimiento menuEdicion con el índice de la acción que queremos realizar, para el caso de Buscar sería un valor de 5 o usar la constante mEdBuscarActual.
Pero esto está bien para buscar texto dentro del TextBox que tiene actualmente el foco, si quieres usarla para otras cosas, por ejemplo buscar en una base de datos, tendrás que crearte tu propio código.
En el procedimiento AccionBuscar tienes la forma en que se puede llamar a este formulario para que muestre el cuadro de diálogo y usar los valores elegidos por el usuario.

Hasta aquí hemos llegado, a ver que preparo para la próxima entrega, ya que estoy un poco "liado" (entiéndase por liado: confundido, sin claridad mental... ¡jo!), sobre que es lo que pondré, ya que no me decido entre "algo" básico de tratamiento de bases de datos y empezar con el "escabroso" tema de los módulos de clases (para crear objetos en Visual Basic).
En fin... ya veremos que es lo que te encuentras. Mientras tanto, disfruta con lo que hay y espero que te sea provechoso.

Nos vemos