Curso Entrega 7:

En nuestra penúltima entrega vamos a trabajar con un Editor de texto al estilo el NotePad de Windows. Para esta aplicación usamos dos formularios. El primero contiene un TextBox que ocupa la mayor parte del formulario, un CommonDialog traído de Componentes y un menú hecho con el Editor de menú que contiene los siguientes subitems.

Archivo Editar Personalizar

Nuevo Copiar Letra

Abrir Cortar Color Fondo

Grabar Pegar Color Texto

Grabar como

-------

Imprimir

Buscar

----------------

Salir

El segundo formulario más pequeño que el anterior contiene dos labels cuyos caption son: Palabra Buscada y Reemplazar por... Dos cajas de Texto donde se introducen las palabras y cinco botones, cuyos captions sin: Buscar, Buscar Siguiente, Reemplazar, Reemplazar Todas, Cancelar; y un CheckBox para respetar las mayúsculas de la palabra introducida en la caja de texto para ser buscada en el Archivo del Formulario 1.

Los formularios se ven así:

El código del primer formulario es el siguiente:

Option Explicit
Dim abrirarchivo As String 'guarda el camino del archivo

Private Sub mnuAbrir_Click()
Dim numarchivo As Integer 'guarda el numero de archivo, lo numera.
Dim texto As String ' guarda el contenido del texto abierto.

On Error GoTo archivoerror ' controla un posible error
CommonDialog1.CancelError = True ' devuelve error al activar la tecla cancel.
CommonDialog1.Flags = cdlOFNFileMustExist ' debe existir el archivo a abrir
CommonDialog1.DefaultExt = "TXT" ' por defecto abre archivos de texto
CommonDialog1.Filter = " Archivos de Texto|*.TXT|Todos los Archivos|*.*" ' filtra 'cierto tipo de archivos,txt o todos.
CommonDialog1.ShowOpen ' Muestra la ventana Abrir
numarchivo = FreeFile 'es una función que muestra el numero del siguiente archivo 'disponible para abrir.
Open CommonDialog1.filename For Input As #1' Abre el archivo y le da entrada 'con Input con el numero 1
texto = Input(LOF(numarchivo), #numarchivo) 'LOF Len of file: largo de la cadena 'en este caso del archivo a abrir.
Close 'cierra
Text1.Text = texto ' vuelca la cadena en el control Text1
abrirarchivo = CommonDialog1.filename 'guarda el camino del archivo abierto.
Exit Sub ' sale del procedimiento.
archivoerror:' si se produjo un error se saltea todo lo anterior y con el Goto viene 'hasta esta sentencia.
If Err.Number = cdlCancel Then Exit Sub 'si se activa la tecla cancel devuelve el 'error 32755
MsgBox "Se produjo un Error desconocido al intentar abrir el Archivo" & CommonDialog1.filename
abrirarchivo = "" ' vacia la variable que guardó el camino del archivo.
End Sub

Private Sub mnuBuscar_Click()
Form2.Show ' muestra el formulario de búsqueda.
End Sub

Private Sub mnuColorPag_Click()
CommonDialog1.ShowColor 'muestra la ventana con la paleta de Colores
Text1.BackColor = CommonDialog1.Color ' vuelca el color seleccionado al fondo de 'la caja de texto.
End Sub

Private Sub mnuColorTexto_Click()
CommonDialog1.ShowColor 'muestra la paleta de colores
Text1.ForeColor = CommonDialog1.Color 'cambia el color de la letra del Text1.
End Sub

Private Sub mnuCopiar_Click()
Clipboard.SetText Text1.SelText 'envía al Portapapeles el texto asignado (Seltext) 'que es el seleccionado (Seltext) con el puntero del mouse.
End Sub

Private Sub mnuCortar_Click()
Clipboard.SetText Text1.SelText 'lo mismo que en copiar
Text1.SelText = "" 'pero vacía o borra el texto seleccionado.
End Sub

Private Sub mnuGrabar_Click()
Dim numarchivo As Integer
Dim texto As String

If abrirarchivo = "" Then ' si el nombre de archivo está vacío permanece la ventana de 'grabar abierta hasta que se le asigne un nombre.
mnuGrabarcomo_Click
Exit Sub
End If

On Error GoTo archivoerror
numarchivo = FreeFile 'archivo libre
Open abrirarchivo For Output As #1'Abre y le da salida con un numero
Print #numarchivo, Text1.Text 'le da salida de impresion en el objeto Text1
Close #numarchivo 'cierra el numero
Exit Sub

archivoerror:
If Err.Number = cdlCancel Then Exit Sub
MsgBox "Error desconocido mientras se grabó el archivo" & abrirarchivo
abrirarchivo = ""

End Sub

Private Sub mnuGrabarcomo_Click()
Dim numarchivo As Integer
Dim texto As String

On Error GoTo archivoerror
CommonDialog1.CancelError = True
CommonDialog1.Flags = cdlOFNOverwritePrompt 'sobreescribe el archivo
CommonDialog1.DefaultExt = "TXT" ' por defecto abre textos
CommonDialog1.Filter = "Archivos de Texto|*.TXT|Todos los Archivos|*.*"
CommonDialog1.ShowSave
numarchivo = FreeFile
Open CommonDialog1.filename For Output As #1
Print #numarchivo, Text1.Text
Close #numarchivo
abrirarchivo = CommonDialog1.filename
Exit Sub
archivoerror:
If Err.Number = cdlCancel Then Exit Sub
MsgBox "Se produjo un Error desconocido al intentar abrir el Archivo" & CommonDialog1.filename
abrirarchivo = ""

End Sub

Private Sub mnuImprimir_Click()
CommonDialog1.CancelError = True
On Error GoTo corregirerror
CommonDialog1.Flags = cdlPDNoPageNums ' no numera las páginas
CommonDialog1.Flags = CommonDialog1.Flags + cdlPDAllPages 'le da salida de impresion a todo el texto
CommonDialog1.Flags = CommonDialog1.Flags + cdlPDSelection ' le da salida de 'impresion solo al seleccionado
CommonDialog1.ShowPrinter 'muestra la ventana de configuracion de la impresion. 'deben seleccionarse las opciones deseadas, o confirmar las por defecto sino no 'imprime.
Printer.Print Text1.Text 'le da salida a traves del objeto Printer a la Impresion.
Printer.EndDoc 'termina la impresion.
Exit Sub
corregirerror:
If Not Err = cdlCancel Then Resume Next ' resume next , se salte si hay error a la 'proxima sentencia.
End Sub

Private Sub mnuLetra_Click()
CommonDialog1.Flags = cdlCFBoth 'reconoce las letras con salida para pantalla y 'para impresora.
CommonDialog1.ShowFont ' muestra la ventana de las Fuentes, tipo y tamaño.
Text1.Font = CommonDialog1.FontName 'tipo de letra
Text1.FontBold = CommonDialog1.FontBold ' negrita
Text1.FontItalic = CommonDialog1.FontItalic 'cursiva
Text1.FontSize = CommonDialog1.FontSize 'tamaño de la letra
End Sub

Private Sub mnuNuevo_Click()
Text1.Text = "" 'vacía el texto
abrirarchivo = "" 'vacía la variable que guarda el path del archivo
End Sub

Private Sub mnuPegar_Click()
Text1.SelText = Clipboard.GetText 'pasa los datos del portapapeles a al text1.
End Sub

Private Sub mnuSalir_Click()
End ' cierra la aplicación
End Sub

El código del segundo formulario que realiza la búsqueda de una palabra determinada en el texto completo del formulario 1 es:

Option Explicit
Dim posicion As Integer

Private Sub Command1_Click()
Dim comparar As Integer

posicion = 0
If Check1.Value = 1 Then
comparar = vbBinaryCompare
Else
comparar = vbTextCompare
End If

posicion = InStr(posicion + 1, Form1.Text1.Text, Text1.Text, comparar)
If posicion > 0 Then
Command3.Enabled = True
Command4.Enabled = True
Form1.Text1.SelStart = posicion - 1
Form1.Text1.SelLength = Len(Text1.Text)
Form1.SetFocus
Else
MsgBox " Palabra no encontrada"
Command3.Enabled = False
Command4.Enabled = False
End If
End Sub

Private Sub Command2_Click()
Dim comparar As Integer

If Check1.Value = 1 Then
comparar = vbBinaryCompare 'compara teniendo en cuenta las mayúculas usando la 'opcion compare status.
Else
comparar = vbTextCompare 'no tiene en cuenta las mayúsculas.
End If

posicion = InStr(posicion + 1, Form1.Text1.Text, Text1.Text, comparar) 'usa la 'funcion InStr que cuenta las letras de una cadena pero por su ubicación, devolviendo 'un numero entero por su posicion.
If posicion > 0 Then ' si la posicion es uno o mayor

Form1.Text1.SelStart = posicion - 1 ' empieza con el punto de insercion del puntero
Form1.Text1.SelLength = Len(Text1.Text) 'compara el numero de caracteres 'seleccionados del texto completo con el largo de la cadena de la palabra a buscar
Form1.SetFocus ' ubica el foco en el form1 en el texto
Else
MsgBox " Palabra no encontrada"
Command3.Enabled = False
Command4.Enabled = False
End If
End Sub

Private Sub Command3_Click()
Dim comparar As Integer

Form1.Text1.SelText = Text2.Text
If Check1.Value = 1 Then
comparar = vbBinaryCompare
Else
comparar = vbTextCompare
End If
posicion = InStr(posicion + 1, Form1.Text1.Text, Text1.Text, comparar)
If posicion > 0 Then

Form1.Text1.SelStart = posicion - 1
Form1.Text1.SelLength = Len(Text1.Text)
Form1.SetFocus

Else

Command3.Enabled = False
Command4.Enabled = False
MsgBox " Ya ha sido reemplazada"
End If
End Sub

Private Sub Command4_Click()
Dim comparar As Integer

Form1.Text1.SelText = Text2.Text
If Check1.Value = 1 Then
comparar = vbBinaryCompare
Else
comparar = vbTextCompare
End If
posicion = InStr(posicion + 1, Form1.Text1.Text, Text1.Text, comparar)

'reemplaza una palabra por otra, a traves de un bucle while mientras encuentre un 'caracter a reemplazar.
While posicion > 0
Command3.Enabled = True
Command4.Enabled = True
Form1.Text1.SelStart = posicion - 1
Form1.Text1.SelLength = Len(Text1.Text)
Form1.Text1.SelText = Text2.Text
posicion = posicion + Len(Text2.Text)
posicion = InStr(posicion + 1, Form1.Text1.Text, Text1.Text)
Wend
Command3.Enabled = False
Command4.Enabled = False
MsgBox " Ya ha sido reemplazada"
End Sub

Private Sub Command5_Click()
Form2.Hide

End Sub

Recuerden que si alguna de estas funciones como Sellenght, SelStart, InStr,... les resultan confusa, pueden buscar mas información en la Ayuda de VB5.

Nos vemos

Mirta