Actualizado: 11/Abr/2001 (11/Oct/2004)
Nota del 15/Nov/2002: Sigue este link para ver las últimas modificaciones (en
código para VB6)
15/Nov/2002:
Sigue este link para
ver las últimas actualizaciones
11/Oct/2004:
La última revisión a la
utilidad de colorear código (versión .NET 1.1)
A continuación te muestro el código completo de la utilidad para colorear el código de vb.Net, (también vale para c# y otros ficheros de Visual Basic), y generar el código HTML para pegar en un fichero HTM.
La utilidad permite seleccionar el fichero a "colorear" y guardar el código generado en un fichero HTML.
También permite generar el código HTML del trozo de código que queramos, (el contenido en ListBox; en el ListBox se puede pegar lo que tengamos copiado en el portapapeles), y una vez "coloreado" el código, se muestra en dicho ListBox, además de pegarlo en el portapapeles.Estas son capturas de la utilidad en ejecución:
Solapa de colorear el código.
Solapa de las palabras clave y selección del lenguaje a usar.
Espero que te pueda ser de utilidad... para mi lo es, ya que me ahorra un montón de trabajo y queda mejor ver el código coloreado que sin colorear.
Sigue este link si quieres ver esta misma utilidad en la versión adaptada a VB6.
Te relaciono a continuación las otras cosillas que podrás ver en el código de ejemplo:
Al final de esta página encontrás un link con el código completo.
- Implemetar interfaces en nuestras clases.
- Copiar un array en otro, dejando un elemento libre al principio.
- Copiar un array en otro, dejando un elemento libre al final.
- Cómo recorrer los elementos de una clase/colección heredada.
- Cómo usar métodos de una clase sin crear un nuevo objeto (usando Shared).
¡Espero que disfrutes de lo que hay en esta página!Nos vemos.
Guillermo
Implemetar interfaces en nuestras clases:
Ya sabes que en VB5 y VB6, la única forma de "simular" herencia era usando Implements, en esta nueva versión de Visual Basic, ésta palabra funciona "casi" igual, con la ventaja de que ahora se pueden implementar cualquier interface que exista en cualquier librería (o assembly).
En la colección de cPalabras, he añadido un método para clasificar el contenido de la colección, y aunque he usado el método Sort del ArrayList usado, el código no funcionaba ya que necesitaba implementar la interface IComparable, que tiene el método CompareTo que devuelve un valor según el resultado de comparar dos elementos de dicha colección. Ésta interface no es necesario implementarla en colecciones que contienen tipos básicos, pero en este caso, el tipo de datos almacenado en la colección es cPalabra, por tanto, esa clase debe implementar esa interface.
Veamos parte del código, el resto del código puedes verlo más abajo.
Public Sub Sort() ' Clasificar el contenido de la colección (30/Mar/01) ' Esto necesita que la clase usada en la colección ' implemente el interface IComparable, cosa que se hace en cID m_col.Sort() 'El lugar en el que he implementado esa interface ha sido en la clase cID, (que es heredada por cPalabra), ya que el orden de la clasificación se hace por el ID de cada objeto.
Public MustInherits Class cID ' Implenta la interfaz para hacer comparaciones (30/Mar/01) Implements IComparable ' Public Function CompareTo(ByVal [object] As Object) As Integer Implements System.IComparable.CompareTo If Me.ID < CType([object], cID).ID Then Return -1 ElseIf CType([object], cID).ID = Me.ID Then Return 0 ElseIf Me.ID > CType([object], cID).ID Then Return 1 End If End Function ' Private sID As String Private bYaEstoy As Boolean ' Public Property ID() As String Get Return sID End Get Set(ByVal Value As String) If Not bYaEstoy Then bYaEstoy = True sID = Value End If End Set End Property End Class
Copiar un array en otro, dejando un elemento libre al principio:
Hay ocasiones en las que necesitamos insertar un elemento en un array.
Existe un método en todos los arrays que es: CopyTo, el cual nos permite indicar el array de destino y a partir de que posición queremos que se copie el contenido del array original.
En este caso, queremos dejar un hueco al principio, por tanto le indicamos que la copia la haga a partir de la segunda posición, (recuerda que todos los arrays en vb.Net empiezan por el índice 0, por tanto la posición 1, indicará que es la segunda posición...Fíjate que el array que se pasa a la función se hace por referencia, es decir, cualquier cambio que se haga en este método, se reflejará en el array que se usó en la llamada para insertar el nuevo elemento; también se devuelve el array, de esta forma se puede usar esta función de dos formas, usando el valor devuelto y también modificando directamente el array pasado como parámetro. Aunque el efecto "colateral" es que, si se usa el valor devuelto, también se modifica el parámetro... pero... en fin, si se sabe que esto ocurre... tampoco es tan grave... je!
' Insertar la cadena indicada en el array Public Function InsertAtStart(ByRef StrArray() As String, ByVal sLine As String) As String() ' Insertar la cadena indicada al principio del array Dim j As Integer Dim tmpArray() As String ' Array temporal ' j = StrArray.Length ReDim tmpArray(j + 1) StrArray.CopyTo(tmpArray, 1) tmpArray(0) = sLine ' Copiar el array en el indicado, por si quiere usar como Sub StrArray = tmpArray ' Devolver el array generado Return tmpArray End Function
Copiar un array en otro, dejando un elemento libre al final:
Para insertar un elemento al final del array, haremos lo mismo que hemos visto en el punto anterior, pero en esta ocasión la copia se hace desde el primer elemento (el cero), lo único es que el array de destino debe tener un elemento más, que será el que se usará para asignar el nuevo elemento a insertar.
Al igual que en el procedimiento mostrado anteriormente, esta función devuelve un array con los nuevos valores y también se modifica el array que se pasa como parámetro.
Public Function InsertAtEnd(ByRef StrArray() As String, ByVal sLine As String) As String() ' Insertar la cadena indicada al final del array Dim j As Integer Dim tmpArray() As String ' j = StrArray.Length ReDim tmpArray(j + 1) StrArray.CopyTo(tmpArray, 0) tmpArray(j) = sLine ' Copiar el array en el indicado, por si quiere usar como Sub StrArray = tmpArray ' Devolver el array generado Return tmpArray End Function
Cómo recorrer los elementos de una clase/colección heredada:
La clase cPalabrasFile hereda la clase cPalabras y le añade acceso a datos, tanto para leer las palabras de dicha colección de un fichero, como para guardar dichas palabras en un fichero. Para guardar las palabras, hay que recorrer cada una de las palabras de dicha colección para poder guardarlas, (en este caso sólo se guarda el contenido de la propiedad ID), para ello se recorre de esta forma:
For Each tPalabra In MeLa nueva clase añade dos nuevos métodos: ReadFromFile y SaveToFile, además de sobrecargar el procedimiento New que permite crear un nuevo objeto colección. La nueva colección permite crear la clase vacia o bien indicar el nombre del fichero del que se leerán las palabras y leerlas.
Veamos el código usado:Para leer el contenido de un fichero y asignarlo a la colección:
Public Sub ReadFromFile(ByVal FileName As String) ' Leer el fichero de palabras Dim tPalabra As cPalabra Dim sr As System.IO.StreamReader = New System.IO.StreamReader(FileName, System.Text.Encoding.Default) Do While Not sr.Peek = -1 Dim s As String = sr.ReadLine.Trim() If s <> "" Then If Me.Exists(s) = False Then tPalabra = New cPalabra() tPalabra.ID = s Me.Add(tPalabra) End If End If Loop sr.Close() ' End SubPara guardar el contenido de la colección en un fichero:
Public Sub SaveToFile(ByVal FileName As String) ' Guardar el contenido de mPalabras en el fichero Dim tPalabra As cPalabra ' Borrarlo si ya existe If System.IO.File.Exists(FileName) Then System.IO.File.Delete(FileName) End If ' Guardar en formato ANSI Dim sw As New System.IO.StreamWriter(System.IO.File.OpenWrite(FileName), System.Text.Encoding.Default) For Each tPalabra In Me sw.WriteLine(tPalabra.ID) Next sw.Close() End SubLas dos nuevas formas de crear un objeto de este tipo: leyendo el contenido de un fichero y otro normal, como el original de la clase heredada, pero que hay que implementar para que esta clase pueda usar las dos formas de creación.
Lo que no hay que hacer es llamar al método Inicializar de la clase base, ya que esa llamada se hace de forma automáticamente al crear la clase base, lo mismo ocurre al finalizar, las colecciones se destruyen en el método Finalize de cPalabras.' Al crear la instancia de la colección se puede indicar ' el fichero de dónde se leerán las palabras. Public Overloads Sub New(ByVal FileName As String) ' Crear la clase leyendo el contenido de un fichero MyBase.New() ReadFromFile(FileName) End Sub ' Public Overloads Sub New() MyBase.New() End Sub ' Protected Overrides Sub Finalize() ' Las colecciones se destruyen en la clase base (cPalabras) MyBase.Finalize() End Sub
El código del proyecto de colorear el código y convertirlo en HTML (HTMCodeColor):
Links a los distintos ficheros del código:
- El formulario
- Clase para manipular ficheros y guardar el contenido en array de cadenas
- La clase/colección para almacenar las palabras
- La colección de palabras con acceso a ficheros
- La clase gsListBox (heredada de ListBox)
El código de la aplicación HTMLCodeColor (HTMLCodeColor.zip 22.5KB)
Recuerda que es para la Beta1 de Visual Studio.NET
'------------------------------------------------------------------------------ ' Procesar un fichero de código (28/Mar/01) ' y generar el código HTML coloreado para pegar en una página. ' ' Se pueden procesar ficheros de vb.Net y c# ' ' ©Guillermo 'guille' Som, 2001 '------------------------------------------------------------------------------ Option Strict On Option Compare Text ' Public Class fHTMColorCode Inherits Form Private m_lstCode As Guille.Clases.gsListBox ' Private mPalabras As New Guille.Clases.cPalabrasFile() Private mFile As New Guille.Clases.cFileToArray() ' Private mPalabrasModificadas As Boolean ' Si se modifican las palabras Private sFileTo As String ' Fichero de destino ' ' Array para almacenar cada línea del fichero de origen Private sFileFrom() As String ' ' Variable para procesar cada palabra Private LineaCompleta As String ' ' Array para contener los botones de examinar (02/Abr/01) Private abtnLenguaje As ArrayList Private Enum eLenguaje esVB '= 0 esCS '= 1 esHTM '= 2 End Enum ' ' Constantes para los tags a añadir ' ' Color verde para los comentarios. Const sTagFontGreen As String = "<font color = #008000>" ' Color azul de las palabras reservadas. Const sTagFontBlue As String = "<font color = #0000FF>" ' Color cian para las cadenas de texto, no es estándard, pero queda bien. Const sTagFontText As String = "<font color = #408080>" Const sEndFontTag As String = "</font>" ' Líneas a añadir al código Const sTagFontTipo As String = "<pre><font face=" & ControlChars.Quote & "Courier New" & ControlChars.Quote & " size=2>" Const sEndFontTipo As String = "</font></pre>" '& ControlChars.CrLf ' Constantes de algunos caracteres especiales: (31/Mar/01) ' Nota: no uso los caracteres que se pondrán, ya que de otra forma, ' si este código se convierte, no mostraría el código correcto. Const sTagQuote As String = "quot;" ' comillas dobles Const sTagLT As String = "lt;" ' signo menor que Const sTagGT As String = "gt;" ' signo mayor que ' ' #Region " Windows Form Designer generated code " ' Public Sub New() MyBase.New() fHTMColorCode() = Me 'This call is required by the Win Form Designer. InitializeComponent() ' Add any initialization after the InitializeComponent() call ' ' Asignar los botones de examinar al array abtnLenguaje = New ArrayList() With abtnLenguaje .Add(btnExaminarVB()) .Add(btnExaminarCS()) .Add(btnExaminarHTM()) End With ' txtFileFrom.Text = "" txtFileTo.Text = "" txtWord.Text = "" lstWords.Items.Clear() ' ' Estas propiedades hay que asignarlas en el listbox normal lstCode.SelectionMode = SelectionMode.MultiExtended lstCode.HorizontalScrollbar = True ' Asignar el listbox que contendrá el código m_lstCode = New Guille.Clases.gsListBox(lstCode()) m_lstCode.HorizontalScrollbar = True m_lstCode.SelectionMode = SelectionMode.MultiExtended m_lstCode.Items.Clear() ' chkFP.Checked = CBool(GetSetting("HTMColorCode", "Ficheros", "Cargar al iniciar", "0")) Dim FileName As String = GetSetting("HTMColorCode", "Ficheros", "Palabras", "") ' If chkFP.Checked And File.Exists(FileName) Then ' Leer el fichero de palabras mPalabras.Clear() mPalabras.ReadFromFile(FileName) ' Añadir al ListBox Palabras2List() End If ' ' Deshabilitar los valores de HTML rbHTM.Enabled = False txtHTM.Enabled = False btnExaminarHTM.Enabled = False ' rbVB.Checked = CBool(GetSetting("HTMColorCode", "Ficheros", "rbVB", "1")) rbCS.Checked = CBool(GetSetting("HTMColorCode", "Ficheros", "rbCS", "0")) rbHTM.Checked = CBool(GetSetting("HTMColorCode", "Ficheros", "rbHTM", "0")) ' txtVB.Text = GetSetting("HTMColorCode", "Ficheros", "vb", "vbdotnet.txt") txtCS.Text = GetSetting("HTMColorCode", "Ficheros", "cs", "csharp.txt") txtHTM.Text = GetSetting("HTMColorCode", "Ficheros", "HTM", "html.txt") ' ' Hacer que se vean los controles de cada Tab ' no se porqué, pero algunas veces no se ven los que están ' en la solapa de palabras... Dim tObj As Control tabPage1.Visible = True For Each tObj In tabPage1.Controls tObj.Visible = True Next ' tabPage2.Visible = True For Each tObj In tabPage2.Controls tObj.Visible = True Next ' For Each tObj In groupBox1.Controls tObj.Visible = True Next End Sub ' ' ' Private Function CadaPalabra(Optional ByVal sLinea As String = "") As String ' Desglosar la línea en palabras ' Si se indica el parámetro, se devolverá la primera palabra ' si no se indica el parámetro se devolverán las siguientes. ' Si no hay más palabras, devuelve una cadena vacia. ' ' Estos signos se considerarán separadores de palabras Const sSep As String = " .,;:()<>[]{}'/*" & ControlChars.Quote & ControlChars.Tab Dim i, j, k As Integer Dim s, c, sID As String ' If sLinea <> "" Then LineaCompleta = sLinea End If If LineaCompleta = "" Then Return "" End If s = LineaCompleta ' Desglosar en palabras sID = "" j = s.Length - 1 For i = 0 To j c = s.Substring(i, 1) If c = "" Then k = 0 Else k = InStr(sSep, c) End If If k = 0 And i = j Then k = 1 sID &= c End If If k > 0 Or i = j Then ' Se ha encontrado una palabra If i < j Then If i = 0 Then LineaCompleta = s.Substring(i + 1) Else LineaCompleta = s.Substring(i) End If Else If LineaCompleta = c Then LineaCompleta = "" ElseIf LineaCompleta <> sID Then LineaCompleta = s.Substring(i) Else LineaCompleta = "" End If End If If sID = "" Then ' Comprobar si es' y cambiarlo por el tag correspondiente If c = "<" Then c = "&" & sTagLT ElseIf c = ">" Then c = "&" & sTagGT End If sID = c End If Exit For Else sID &= c End If Next Return sID End Function ' Private Sub ProcesarFichero(ByRef saCodigo() As String) ' Procesar el contenido del array y convertirlo a HTM Dim i, j As Integer Dim s, s2, sID As String Dim HayComillas As Boolean = False Dim HayRem As Boolean = False ' Dim HayMultipleRem As Boolean = False Dim k As Integer ' If mPalabras.Count = 0 Then MessageBox.Show("¡ATENCION! debes seleccionar el fichero de palabras clave.") cmdOpen.Select() Exit Sub End If ' lblStatus.Text = " Procesando código..." lblStatus.Refresh() ' j = saCodigo.Length - 1 For i = 0 To j s = saCodigo(i) s2 = Trim(s) ' Si es una línea vacia If s2 = "" Then saCodigo(i) = s ElseIf s2.Substring(0, 1) = "'" Then ' Si es una línea con comentarios saCodigo(i) = sTagFontGreen & s & sEndFontTag Else ' Tomar la primera palabra s2 = s sID = CadaPalabra(s2) s = "" ' Mientras no sea una cadena vacía Do While sID <> "" If sID = ControlChars.Quote Then ' Convertirlo en el tag de comillas (31/Mar/01) sID = "&" & sTagQuote If HayComillas Then If chkTextColor.Checked = True Then s = s & sID & sEndFontTag Else s = s & sID End If HayComillas = False Else HayComillas = True If chkTextColor.Checked = True Then s = s & sTagFontText & sID Else s = s & sID End If End If ElseIf HayComillas = True Or HayRem = True Then ' No interpretar lo que haya entre comillas (31/Mar/01) ' Ni lo que esté en un comentario (03/Abr/01) s = s & sID ElseIf rbVB.Checked = True And (sID = "'" And HayRem = False) Then s = s & sTagFontGreen & sID HayRem = True ElseIf mPalabras.Exists(sID) And HayComillas = False Then ' Si está en la colección de palabras clave s = s & sTagFontBlue & sID & sEndFontTag Else s = s & sID End If sID = CadaPalabra() Loop If HayComillas Then If chkTextColor.Checked = True Then s = s & ControlChars.Quote & sEndFontTag Else s = s & ControlChars.Quote End If HayComillas = False End If ' ' Si se está procesando un fichero de C (c#, C/C++) If rbCS.Checked Then ' Comprobar si hay comentarios de c# o C/C++ ' ' Comprobar si hay un comentario múltiple k = s.IndexOf("/*") If k > -1 Then HayMultipleRem = True s = s.Substring(0, k) & sTagFontGreen & s.Substring(k) End If ' Comprobar si hay un final de comentario mútiple k = s.IndexOf("*/") If k > -1 Then HayMultipleRem = False s = s.Substring(0, k) & sEndFontTag & s.Substring(k) End If ' Comprobar si hay un comentario de línea completa k = s.IndexOf("//") If k > -1 Then s = s.Substring(0, k) & sTagFontGreen & s.Substring(k) & sEndFontTag End If ' If HayMultipleRem Then s = sTagFontGreen & s & sEndFontTag End If ' End If ' If HayRem Then s = s & sEndFontTag HayRem = False End If ' saCodigo(i) = s End If Next ' Añadir los Tags del tipo de letra mFile.InsertAtStart(saCodigo, sTagFontTipo) mFile.InsertAtEnd(saCodigo, sEndFontTipo) ' lblStatus.Text = " Código convertido." lblStatus.Refresh() End Sub ' Private Sub cmdCreate_Click(ByVal sender As Object, ByVal e As EventArgs) Handles cmdCreate.Click ' Procesar el fichero ' Try ' Comprobar si ya está procesado, para leerlo de nuevo If sFileFrom(0).Substring(0, 5) = "<pre>" Then sFileFrom = mFile.StringArrayFromFile(txtFileFrom.Text) End If Catch ' End Try ProcesarFichero(sFileFrom) ' Guardar el contenido en el fichero indicado (sFileTo) mFile.WriteToFile(sFileTo, sFileFrom) End Sub ' Private Sub cmdBrowseTo_Click(ByVal sender As Object, ByVal e As EventArgs) Handles cmdBrowseTo.Click ' Seleccionar el fichero de destino With SFD() .Filter = "Fichero HTML|*.htm;*.html|Todos los ficheros (*.*)|*.*" If .ShowDialog = DialogResult.OK Then txtFileTo.Text = .FileName ' Este será el fichero en el que se guardará sFileTo = .FileName End If End With End Sub ' Private Sub cmdBrowseFrom_Click(ByVal sender As Object, ByVal e As EventArgs) Handles cmdBrowseFrom.Click ' Seleccionar el fichero de origen With OFD() .Filter = "Ficheros .NET|*.vb;*.cs|Visual Basic|*.vb;*.bas;*.frm;*.cls;*.ctl|Ficheros de c# y C/C++|*.cs;*.c;*.h;*.cpp;*.hpp|Ficheros HTML|*.ht*|Todos los ficheros (*.*)|*.*" ' If rbVB.Checked Then .FilterIndex = 2 ElseIf rbCS.Checked Then .FilterIndex = 3 ElseIf rbHTM.Checked Then .FilterIndex = 4 End If ' If .ShowDialog = DialogResult.OK Then txtFileFrom.Text = .FileName ' Leer el fichero y guardarlo en memoria sFileFrom = mFile.StringArrayFromFile(.FileName) ' m_lstCode.Lines = sFileFrom End If End With End Sub ' Private Sub cmdOpen_Click(ByVal sender As Object, ByVal e As EventArgs) Handles cmdOpen.Click ' Leer el fichero con las palabras With OFD() ' Asignar el fichero según el lenguaje seleccionado If rbVB.Checked Then .FileName = txtVB.Text ElseIf rbCS.Checked Then .FileName = txtCS.Text ElseIf rbHTM.Checked Then .FileName = txtHTM.Text End If ' .Filter = "Ficheros de texto (*.txt)|*.txt|Todos los ficheros (*.*)|*.*" If .ShowDialog = DialogResult.OK Then ' Leer el fichero de palabras mPalabras.Clear() mPalabras.ReadFromFile(.FileName) ' ' Añadir al ListBox Palabras2List() End If End With End Sub ' Private Sub cmdSave_Click(ByVal sender As Object, ByVal e As EventArgs) Handles cmdSave.Click ' Guardar las palabras en el fichero indicado With SFD() .Filter = "Ficheros de texto (*.txt)|*.txt|Todos los ficheros (*.*)|*.*" If .ShowDialog = DialogResult.OK Then ' ' Clasificar las palabras (30/Mar/01) mPalabras.Sort() ' Guardar el contenido de mPalabras en el fichero mPalabras.SaveToFile(.FileName) ' mPalabrasModificadas = False End If End With End Sub ' Private Sub lstWords_KeyDown(ByVal sender As Object, ByVal e As KeyEventArgs) Handles lstWords.KeyDown If e.KeyCode = Keys.Delete Then ' Si se pulsa la tecla Del, borrar los elementos seleccionados cmdDel_Click(sender, Nothing) End If End Sub ' Private Sub cmdDel_Click(ByVal sender As Object, ByVal e As EventArgs) Handles cmdDel.Click ' Eliminar los elementos seleccionados del ListBox Dim i, j As Integer Dim sID As String Dim n As Integer = lstWords.SelectedIndex ' ' Recorrer todos los elementos seleccionados For i = lstWords.SelectedIndices.Count - 1 To 0 Step -1 ' Necesitamos el índice j = lstWords.SelectedIndices.Item(i) ' Obtener el ID de la colección de palabras sID = lstWords.Items(j).ToString mPalabras.Remove(sID) ' borrar este índice del ListBox lstWords.Items.RemoveAt(j) Next mPalabrasModificadas = True ' ' Seleccionar el índice que antes estaba seleccionado ' comprobar el error, por si ya no está If n > lstWords.Items.Count - 1 Then n = lstWords.Items.Count - 1 End If Try lstWords.SelectedIndex = n Catch 'lstWords.SelectedIndex = 0 End Try End Sub ' Private Sub cmdAdd_Click(ByVal sender As Object, ByVal e As EventArgs) Handles cmdAdd.Click ' Añadir la palabra al ListBox, si es que no está Dim sID As String = Me.txtWord.Text If mPalabras.Exists(sID) = False Then Dim tPalabra As New Guille.Clases.cPalabra() tPalabra.ID = sID mPalabras.Add(tPalabra) lstWords.Items.Add(sID) mPalabrasModificadas = True End If End Sub ' Private Sub cmdExit_Click(ByVal sender As Object, ByVal e As EventArgs) Handles cmdExit.Click Me.Close() End Sub ' Private Sub fHTMColorCode_Closing(ByVal sender As Object, ByVal e As CancelEventArgs) Handles fHTMColorCode.Closing ' Cuando se vaya a cerrar, comprobar si hay que guardar las palabras If mPalabrasModificadas = True Then ' Preguntar si se quiere guardar If MessageBox.Show("Se ha modificado la lista de palabras" & Chr(13) & "¿Quieres guardarlas?", "Palabras modificadas", MessageBoxButtons.YesNo) = DialogResult.Yes Then cmdSave_Click(sender, Nothing) End If End If ' Guardar el fichero a usar para las palabras SaveSetting("HTMColorCode", "Ficheros", "Cargar al iniciar", chkFP.Checked.ToString) ' If rbVB.Checked = True Then SaveSetting("HTMColorCode", "Ficheros", "Palabras", txtVB.Text) ElseIf rbCS.Checked = True Then SaveSetting("HTMColorCode", "Ficheros", "Palabras", txtCS.Text) ElseIf rbHTM.Checked = True Then SaveSetting("HTMColorCode", "Ficheros", "Palabras", txtHTM.Text) End If SaveSetting("HTMColorCode", "Ficheros", "rbVB", rbVB.Checked.ToString) SaveSetting("HTMColorCode", "Ficheros", "rbCS", rbCS.Checked.ToString) SaveSetting("HTMColorCode", "Ficheros", "rbHTM", rbHTM.Checked.ToString) ' SaveSetting("HTMColorCode", "Ficheros", "vb", txtVB.Text) SaveSetting("HTMColorCode", "Ficheros", "cs", txtCS.Text) SaveSetting("HTMColorCode", "Ficheros", "HTM", txtHTM.Text) ' End Sub ' Private Sub Palabras2List() Dim tPalabra As Guille.Clases.cPalabra ' Añadir al ListBox With lstWords.Items .Clear() For Each tPalabra In mPalabras .Add(tPalabra.ID) Next End With mPalabrasModificadas = False End Sub ' Private Sub btnExaminar_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btnExaminarVB.Click, btnExaminarCS.Click, btnExaminarHTM.Click ' Este evento será el mismo para los tres botones de examinar With OFD() ' Asignar el fichero y nombre del lenguaje seleccionado ' según el botón pulsado If abtnLenguaje(eLenguaje.esVB).Equals(sender) Then .FileName = txtVB.Text rbVB.Checked = True ElseIf abtnLenguaje(eLenguaje.esCS).Equals(sender) Then .FileName = txtCS.Text rbCS.Checked = True ElseIf abtnLenguaje(eLenguaje.esHTM).Equals(sender) Then .FileName = txtHTM.Text rbHTM.Checked = True End If .Filter = "Ficheros de texto (*.txt)|*.txt|Todos los ficheros (*.*)|*.*" If .ShowDialog = DialogResult.OK Then If rbVB.Checked Then txtVB.Text = .FileName ElseIf rbCS.Checked Then txtCS.Text = .FileName ElseIf rbHTM.Checked Then txtHTM.Text = .FileName End If End If End With End Sub ' Private Sub cmdProcesarTexto_Click(ByVal sender As Object, ByVal e As EventArgs) Handles cmdProcesarTexto.Click ' Procesar el contenido del ListBox, (antes un TextBox) ' ProcesarFichero(m_lstCode.Lines) ' Copiarlo en el portapapeles ClipBoard.SetDataObject(m_lstCode.ItemsToText) End Sub ' Private Sub lstWords_SelectedIndexChanged(ByVal sender As Object, ByVal e As EventArgs) Handles lstWords.SelectedIndexChanged ' Mostrar la palabra seleccionada Me.txtWord.Text = lstWords.SelectedItem.ToString End Sub Private Sub lstCode_KeyDown(ByVal sender As Object, ByVal e As KeyEventArgs) Handles lstCode.KeyDown Dim i, j As Integer Dim s As String = "" ' If e.Control = True And (e.KeyCode = Keys.Insert Or e.KeyCode = Keys.C) Then ' Si se pulsa Ctrl+C o Ctrl+Insert ' Copiar en la memoria los elementos seleccionados For i = 0 To lstCode.SelectedIndices.Count - 1 s &= lstCode.Items(lstCode.SelectedIndices(i)).ToString & Microsoft.VisualBasic.ControlChars.CrLf Next Clipboard.SetDataObject(s) ElseIf (e.Control = True And e.KeyCode = Keys.V) Or (e.Shift = True And e.KeyCode = Keys.Insert) Then ' Si se pulsa Ctrl+V o Shift+Insert ' Pegar el contenido del portapales s = CStr(Clipboard.GetDataObject.GetData(DataFormats.Text)) If s = "" Then Exit Sub End If lstCode.Items.Clear() ' Añade cada línea en un elemento diferente j = 0 i = 0 Do i = s.IndexOf(Microsoft.VisualBasic.ControlChars.CrLf, j) If i > -1 Then lstCode.Items.Add(s.Substring(j, i - j)) j = i + 2 If j > s.Length Then Exit Do End If End If Loop While i > -1 ElseIf e.KeyCode = Keys.Delete Then ' Borrar todos los elementos seleccionados ' ' Recorrer todos los elementos seleccionados For i = lstCode.SelectedIndices.Count - 1 To 0 Step -1 ' Necesitamos el índice j = lstCode.SelectedIndices(i) ' borrar este índice del ListBox lstCode.Items.RemoveAt(j) Next End If End Sub ' End Class Código de la clase cFileToArray:
clase para leer ficheros y asignarlo a un array de cadenas y otras cosas:'------------------------------------------------------------------------------ ' Clase para leer de un fichero y convertirlo en un array (29/Mar/01) ' ' He usado un array de bytes para leer el fichero, porque de esta forma ' se leen los caracteres especiales como eñes y acentos. ' ' Esta clase permite leer de un fichero y devolver: ' una cadena con el contenido del fichero (usando CrLf para cada línea). ' un array de cadenas con cada línea del fichero. ' un array de Bytes con el contenido del fichero. ' Permite guardar el contenido del fichero previamente leido, ' o el indicado en un array de cadenas. ' Insertar una cadena en un array, tanto al principio como al final. ' ' ©Guillermo 'guille' Som, 2001 '------------------------------------------------------------------------------ ' Option Strict On Option Compare Text Imports System.IO ' Namespace Guille.Clases Public Class cFileToArray ' ' Array de Bytes para almacenar el fichero 'Private abFile() As Byte ' Array para almacenar cada línea del fichero Private asFile() As String ' ' Procedimientos públicos ' ' Insertar la cadena indicada en el array Public Function InsertAtStart(ByRef StrArray() As String, ByVal sLine As String) As String() ' Insertar la cadena indicada al principio del array Dim j As Integer Dim tmpArray() As String ' Array temporal ' j = StrArray.Length ReDim tmpArray(j + 1) StrArray.CopyTo(tmpArray, 1) tmpArray(0) = sLine ' Copiar el array en el indicado, por si quiere usar como Sub StrArray = tmpArray ' Devolver el array generado Return tmpArray End Function ' Public Function InsertAtEnd(ByRef StrArray() As String, ByVal sLine As String) As String() ' Insertar la cadena indicada al final del array Dim j As Integer Dim tmpArray() As String ' j = StrArray.Length ReDim tmpArray(j + 1) StrArray.CopyTo(tmpArray, 0) tmpArray(j) = sLine ' Copiar el array en el indicado, por si quiere usar como Sub StrArray = tmpArray ' Devolver el array generado Return tmpArray End Function ' Public Function StringFromFile(ByVal FileName As String) As String ' Leer el fichero indicado y devolver una cadena con el contenido Dim i As Integer Dim s As String = "" ' LeerFichero(FileName) For i = 0 To asFile.Length - 1 s &= asFile(i) & ControlChars.CrLf Next Return s End Function ' Public Function StringArrayFromFile(ByVal FileName As String) As String() ' Leer el fichero indicado y devolver un array con cada línea LeerFichero(FileName) Return asFile End Function ' Public Overloads Sub WriteToFile(ByVal FileName As String) ' Guardar el contenido del array leido en el fichero indicado Try Dim i As Integer = asFile.Length Catch 'CreaStringArray() Exit Sub End Try GuardarFichero(FileName, asFile) End Sub ' Public Overloads Sub WriteToFile(ByVal FileName As String, ByVal sFileArray() As String) ' Guarda en FileName el contenido del array indicado GuardarFichero(FileName, sFileArray) End Sub ' ' Dos formas de crear una nueva instancia de esta clase (30/Mar/01) ' Public Overloads Sub New(ByVal FileName As String) ' Leer el fichero y crear el array de cadenas. MyBase.New() LeerFichero(FileName) End Sub ' Public Overloads Sub New() MyBase.New() ' End Sub ' ' ' Procedimientos privados ' Protected Sub GuardarFichero(ByVal FileName As String, ByVal sFileArray() As String) ' Guarda el contenido del array indicado en FileName Dim i As Integer ' Si existe, borrarlo If File.Exists(FileName) Then File.Delete(FileName) End If Dim sw As New StreamWriter(File.OpenWrite(FileName), System.Text.Encoding.Default) 'Dim sw As StreamWriter = File.CreateText(FileName) For i = 0 To sFileArray.Length - 1 sw.WriteLine(sFileArray(i)) Next sw.Close() End Sub ' Protected Sub LeerFichero(ByVal FileName As String) Dim sr As StreamReader = New StreamReader(FileName, System.Text.Encoding.Default) Dim n As Integer = -1 Do While Not sr.Peek = -1 n = n + 1 ReDim Preserve asFile(n + 1) asFile(n) = sr.ReadLine() Loop sr.Close() End Sub ' End Class End NamespaceCódigo de la clase cPalabra y cPalabras:
'------------------------------------------------------------------------------ ' cPalabra y cPalabras (02/Ene/01) ' Clase y colección para almacenar las palabras ' ' Revisado con procedimientos NO Overridable (27/Mar/01) ' ' ©Guillermo 'guille' Som, 1997-2001 '------------------------------------------------------------------------------ ' Restringe la conversión implícita de datos a tipos relacionados ' además de obligar a declarar todas las variables a usar ' e impedir compilación tardía (late-binding) Option Strict On ' Esto obliga a declarar todas las variables... ' ¿Aún hay gente que no declara las variables? ' Si se usa Option Strict On no es necesario usar Option Explicit On 'Option Explicit On Option Compare Text ' ' Este Imports es para tener acceso a opciones de colecciones ' para GetEnumerator Imports System.Collections Namespace Guille.Clases '-------------------------------------------------------------------------- ' cID (05/Ene/01) ' Esta clase se usará como base para crear IDs en las clases ' No se puede usar como clase por separado, debe ser heredada (02/Abr/01) ' ' ©Guillermo 'guille' Som, 2001 '-------------------------------------------------------------------------- Public MustInherit Class cID ' Implenta la interfaz para hacer comparaciones (30/Mar/01) Implements IComparable ' Public Function CompareTo(ByVal [object] As Object) As Integer Implements System.IComparable.CompareTo If Me.ID < CType([object], cID).ID Then Return -1 ElseIf CType([object], cID).ID = Me.ID Then Return 0 ElseIf Me.ID > CType([object], cID).ID Then Return 1 End If End Function ' Private sID As String Private bYaEstoy As Boolean ' Public Property ID() As String Get Return sID End Get Set(ByVal Value As String) If Not bYaEstoy Then bYaEstoy = True sID = Value End If End Set End Property End Class ' '-------------------------------------------------------------------------- ' cContenido (05/Ene/01) ' Esta clase se usará como base para crear Contenidos e IDs en las clases ' No se puede heredar más de una clase ' ' ©Guillermo 'guille' Som, 2001 '-------------------------------------------------------------------------- Public Class cContenido ' ' Hereda la clase cID, desde este momento todas las propiedades y ' métodos de la clase heredada pueden usarse como si se hubiesen ' escrito en esta, (en este caso sólo es ID). Inherits cID ' Private sContenido As String ' Public Property Contenido() As String Get Return sContenido End Get Set(ByVal Value As String) sContenido = Value End Set End Property End Class ' '-------------------------------------------------------------------------- ' cPalabra (02/Ene/01) ' ' ©Guillermo 'guille' Som, 1997-2001 '-------------------------------------------------------------------------- Public Class cPalabra ' Hereda las propiedades ID y Contenido ' (incluidas en la clase cContenido) Inherits cContenido ' ' Public Mostrar As Boolean ' Si hay que mostrarla Public Veces As Integer ' El número de veces que está ' ' Esta propiedad simplemente almacena el valor en la propiedad Contenido ' heredada de cContenido Public Property Descripción() As String Get Return Contenido() End Get Set(ByVal Value As String) ' Asignar el nuevo valor Contenido() = Value End Set End Property ' ' Incrementa el valor de Veces con el número indicado, (24/Mar/01) ' por defecto es 1 Public Sub IncVeces(Optional ByVal CuantasVeces As Integer = 1) Me.Veces += CuantasVeces End Sub ' Public ReadOnly Property Clone(Optional ByVal sNuevoID As String = "") As cPalabra Get ' Hacer una copia de este objeto (06/Oct/00) ' ' Esta copia no se puede añadir a una colección ' que previamente contenga este objeto, salvo que se cambie ' el ID de la copia. Dim tPalabra As New cPalabra() ' With tPalabra ' Si se especifica un nuevo ID, asignarlo (11/Oct/00) If CBool(Len(sNuevoID)) Then .ID = sNuevoID Else ' sino, usar el que tenía .ID = Me.ID End If .Descripción = Me.Descripción .Veces = Me.Veces .Mostrar = Me.Mostrar End With ' Return tPalabra End Get End Property End Class ' '-------------------------------------------------------------------------- ' cPalabras, colección de cPalabra (02/Ene/01) ' ' Con métodos para leer y guardar en un fichero. (30/Mar/01) ' ' ©Guillermo 'guille' Som, 1997-2001 '-------------------------------------------------------------------------- Public Class cPalabras ' ' El valor de Contador, al ser Shared, se mantiene entre ' distintas instancias de la colección, Shared Contador As Integer ' ' m_col almacenará los objetos de la colección Private m_col As ArrayList ' m_ht almacenará los IDs de la colección, uso un Hashtable ' ya que permite comprobar si existe el ID en la colección que es ' un valor de tipo cadena, mientras que los ArrayList sólo comprueba ' si existe un objeto de los incluidos en el array. Private m_ht As Hashtable Private m_Index As Integer ' ' Public Sub New() MyBase.New() Inicializar() End Sub ' Protected Sub Inicializar() m_col = New ArrayList() m_ht = New Hashtable() End Sub ' Protected Overrides Sub Finalize() ' Destruimos las colecciones m_ht = Nothing m_col = Nothing MyBase.Finalize() End Sub ' Public Function Exists(ByVal sID As String) As Boolean ' Comprueba si el ID indicado existe en la colección (11/Oct/00) ' Devuelve verdadero o falso, según sea el caso Return m_ht.ContainsKey(sID) End Function ' Public Sub Clear() ' Borrar el contenido de la colección m_col.Clear() m_ht.Clear() Contador = 0 End Sub ' Public Function GetEnumerator() As IEnumerator Return m_col.GetEnumerator End Function ' Public Sub Remove(ByVal sIndex As String) ' Método Remove de una colección ' ' Comprobar si existe el elemento If m_ht.ContainsKey(sIndex) Then ' Obtener el índice dentro de m_col m_Index = CType(m_ht.Item(sIndex), Integer) ' eliminarlo de m_col m_col.RemoveAt(m_Index) ' ' eliminarlo del hashtable m_ht.Remove(sIndex) ' ' reasignar en m_ht el índice dentro de m_col ' a partir del elemento que se acaba de eliminar Dim i As Integer Dim sID As String For i = m_Index To m_col.Count - 1 ' Asignar en m_ht el nuevo índice dentro de m_col sID = CType(m_col.Item(i), cPalabra).ID m_ht.Item(sID) = i Next ' End If End Sub ' Default Public ReadOnly Property Item(ByVal sIndex As String) As cPalabra Get ' Método predeterminado Dim tPalabra As cPalabra ' If m_ht.ContainsKey(sIndex) Then m_Index = CType(m_ht.Item(sIndex), Integer) Return CType(m_col.Item(m_Index), cPalabra) Else ' Creamos una nuevo objeto tPalabra = New cPalabra() tPalabra.ID = sIndex ' Incrementamos el contador de elementos Contador += 1 ' lo añadimos a la colección m_Index = m_col.Add(tPalabra) m_ht.Add(sIndex, m_Index) Return tPalabra ' Eliminamos el objeto tPalabra = Nothing End If End Get End Property ' Public Function Count() As Integer ' Método Count de las colección Return m_col.Count End Function ' Public Sub Add(ByVal tPalabra As cPalabra) ' Añadir un nuevo elemento a la colección ' If m_ht.ContainsKey(tPalabra.ID) = False Then m_Index = m_col.Add(tPalabra) m_ht.Add(tPalabra.ID, m_Index) ' incrementamos el contador de elementos Contador += 1 End If End Sub ' Public Function Clone() As cPalabras ' Hacer una copia de este objeto (06/Oct/00) ' ' Esta copia no se puede añadir a una colección que previamente contenga este objeto Dim tPalabras As New cPalabras() Dim tPalabra As cPalabra ' ' Añadir a la nueva colección los elementos de la contenida en este objeto For Each tPalabra In m_col tPalabras.Add(tPalabra.Clone()) Next tPalabra ' Return tPalabras End Function ' Public Sub Sort() ' Clasificar el contenido de la colección (30/Mar/01) ' Esto necesita que la clase usada en la colección ' implemente el interface IComparable, cosa que se hace en cID m_col.Sort() ' m_ht.Clear() ' ' reasignar en m_ht el índice dentro de m_col Dim i As Integer Dim sID As String For i = 0 To m_col.Count - 1 ' Asignar en m_ht el nuevo índice dentro de m_col sID = CType(m_col.Item(i), cPalabra).ID m_ht.Item(sID) = i Next Contador = m_col.Count End Sub ' Public Sub Nuevo(ByVal unaPalabra As cPalabra) ' Añadir una nueva Palabra (17/Nov/00) Dim sID As String Dim tPalabra As New cPalabra() ' Incrementamos el contador de elementos ' Este valor puede que no coincida con el número de elementos actuales Contador += 1 ' Comprobar si ya existe... If m_ht.ContainsKey(unaPalabra.ID) Then ' existe un elemento con ese ID ' por tanto, crear un nuevo ID sID = "m" & FormatNumber(Contador, , Microsoft.VisualBasic.TriState.True) Else sID = unaPalabra.ID End If ' tPalabra = unaPalabra.Clone(sID) m_Index = m_col.Add(tPalabra) m_ht.Add(sID, m_Index) End Sub End Class End NamespaceCódigo de la clase cPalabrasFile:
(cPalabras con acceso a disco)
'------------------------------------------------------------------------------ ' cPalabrasFile (30/Mar/01) ' Colección del tipo cPalabra con acceso a Ficheros ' ' ©Guillermo 'guille' Som, 2001 '------------------------------------------------------------------------------ Option Strict On Option Compare Text Namespace Guille.Clases Public Class cPalabrasFile ' Hereda la clase cPalabras Inherits Guille.Clases.cPalabras ' ' Al crear la instancia de la colección se puede indicar ' el fichero de dónde se leerán las palabras. Public Overloads Sub New(ByVal FileName As String) ' Crear la clase leyendo el contenido de un fichero MyBase.New() ReadFromFile(FileName) End Sub ' Public Overloads Sub New() MyBase.New() End Sub ' Protected Overrides Sub Finalize() ' Las colecciones se destruyen en la clase base (cPalabras) MyBase.Finalize() End Sub ' Public Sub ReadFromFile(ByVal FileName As String) ' Leer el fichero de palabras Dim tPalabra As cPalabra Dim sr As System.IO.StreamReader = New System.IO.StreamReader(FileName, System.Text.Encoding.Default) Do While Not sr.Peek = -1 Dim s As String = sr.ReadLine.Trim() If s <> "" Then If Me.Exists(s) = False Then tPalabra = New cPalabra() tPalabra.ID = s Me.Add(tPalabra) End If End If Loop sr.Close() ' End Sub ' Public Sub SaveToFile(ByVal FileName As String) ' Guardar el contenido de mPalabras en el fichero Dim tPalabra As cPalabra ' Borrarlo si ya existe If System.IO.File.Exists(FileName) Then System.IO.File.Delete(FileName) End If ' Guardar en formato ANSI Dim sw As New System.IO.StreamWriter(System.IO.File.OpenWrite(FileName), System.Text.Encoding.Default) For Each tPalabra In Me sw.WriteLine(tPalabra.ID) Next sw.Close() End Sub End Class End NamespaceCódigo de la clase gsListBox:
(Una clase basada en ListBox)
'------------------------------------------------------------------------------ ' Clase para implementar nuevas propiedades a un ListBox ' ' Autor: Guillermo 'guille' Som ' Fecha: 02/Abr/2001 ' ' Nuevas propiedades y métodos: ' Lines Implementa un array de cadenas, para manipular los Items ' ItemsToText Devuelve una cadena con el contenido de los Items ' Clear Borra los elementos del listbox ' ' Métodos Shared, se pueden usar sin necesidad de crear una nueva instancia ' ArrayToItems Asigna un array a los elementos del ListBox ' ItemsToArray Devuelve un array con los Items del ListBox ' ItemsToText Devuelve una cadena con el contenido de los Items '------------------------------------------------------------------------------ Option Strict On Namespace Guille.Clases ' Public Class gsListBox ' Inherits ListBox ' ' El listbox que contendrá la información Private m_lb As ListBox ' '---------------------------------------------------------------------- ' Los procedimientos Shared permiten usar los objetos sin crear ' una instancia de esta clase. '---------------------------------------------------------------------- Public Shared Sub ArrayToItems(ByVal aListBox As ListBox, ByVal StringArray() As String) ' Añade el contenido de un array a los Items de un ListBox Dim i As Integer ' aListBox.Items.Clear() For i = 0 To StringArray.Length - 1 aListBox.Items.Add(StringArray(i)) Next End Sub ' Public Shared Function ItemsToArray(ByVal aListBox As ListBox) As String() ' Devolver un array con todos los items del ListBox indicado Dim aString() As String Dim i As Integer ' ReDim aString(aListBox.Items.Count) For i = 0 To aListBox.Items.Count - 1 aString(i) = aListBox.Items(i).ToString Next Return aString End Function ' Public Overloads Shared Function ItemsToText(ByVal aListBox As ListBox) As String ' Devolver una cadena con todo el contenido de los Items Dim s As String = "" Dim i As Integer ' For i = 0 To aListBox.Items.Count - 1 s &= aListBox.Items(i).ToString & Microsoft.VisualBasic.ControlChars.CrLf Next Return s End Function '---------------------------------------------------------------------- ' Public Sub Clear() m_lb.Items.Clear() End Sub ' Public Overloads Function ItemsToText() As String ' Devolver una cadena con todo el contenido de los Items ' (se llama al método compartido) Return ItemsToText(m_lb) End Function ' ' Implementar la propiedad Lines Public Overloads Property Lines(ByVal Index As Integer) As String ' Devolver sólo la línea indicada ' ' Esto daria error si el elemento no existe, ' pero se devuelve una cadena vacia o se asigna a un nuevo elemento Get Try Return m_lb.Items(Index).ToString Catch Return "" End Try End Get ' Set(ByVal Value As String) Try m_lb.Items(Index) = Value Catch m_lb.Items.Add(Value) End Try End Set End Property ' Public Overloads Property Lines() As String() ' Si no se especifica parámetro, devolver todas las líneas Get ' Convertir los elementos en un array Dim aString() As String Dim i As Integer ' ReDim aString(m_lb.Items.Count) For i = 0 To m_lb.Items.Count - 1 aString(i) = m_lb.Items(i).ToString Next Return aString End Get ' Set(ByVal Value As String()) ' Se asigna un array de cadenas y se guarda en los items Dim i As Integer m_lb.Items.Clear() For i = 0 To Value.Length - 1 m_lb.Items.Add(Value(i)) Next End Set End Property ' ' Al crear la clase, hay que especificar el ListBox que manipulará Public Sub New(ByVal aListBox As ListBox) MyBase.New() m_lb = aListBox End Sub End Class End Namespace
El código de la
aplicación HTMLCodeColor (HTMLCodeColor.zip 22.5KB)
Recuerda que es para la Beta1 de Visual
Studio.NET