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 (03/Jul/00)
' 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... (22/Ene/00)
'
' Pero sólo se debería comprobar si (03/Jul/00)
' 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 (03/Jul/00)
' Se necesita el módulo MgsDBR.bas
'
' ©Guillermo 'guille' Som, 1996-2000
'------------------------------------------------------------------------------
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 (03/Jul/00)
'
' (c)Guillermo 'guille' Som, 1997-2000
'------------------------------------------------------------------------------
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 ( 6/Sep/97)
.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 (00.22 23/May/96)
'
' 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 (31/Ago/97)
'
' 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, (si tienes pereza, uedes esperar
a que nos toque la parte de las bases de datos o echarle un vistazo a la cuarta
entrega del Proyecto
Paso a Paso que tengo en mis páginas, no es se usa este diálogo, pero
te puede dar una idea).
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
Guillermo
