Código de fColecciones en sus dos versiones:
Visual Basic 6.0 y Visual Basic .NET

Fecha: 27/Dic/2000

Nota: No se si el código lo publicaré "coloreado", en caso de no hacerlo, espero que no sea un inconveniente.

Si quieres el código completo, aquí lo tienes: para VB6: Colecciones.zip (4.14KB) y para VB.NET: ColeccionesNET.zip (17.8KB)

El código en VB6 (completo, incluyendo las definiciones de los controles, para que se vea la diferencia):

'
VERSION 5.00
Begin VB.Form fColecciones 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Prueba de colecciones"
   ClientHeight    =   4920
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8040
   Icon            =   "fColecciones.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   4920
   ScaleWidth      =   8040
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdLeer 
      Caption         =   "&Leer..."
      Height          =   405
      Left            =   5070
      TabIndex        =   7
      ToolTipText     =   " Leer los mensajes desde un fichero "
      Top             =   4320
      Width           =   1245
   End
   Begin VB.CommandButton cmdGuardar 
      Caption         =   "&Guardar..."
      Height          =   405
      Left            =   3750
      TabIndex        =   6
      ToolTipText     =   " Guardar los mensajes en un fichero "
      Top             =   4320
      Width           =   1245
   End
   Begin VB.CommandButton cmdSalir 
      Cancel          =   -1  'True
      Caption         =   "&Salir"
      Height          =   405
      Left            =   6570
      TabIndex        =   8
      ToolTipText     =   " Terminar el programa (ESC) "
      Top             =   4320
      Width           =   1245
   End
   Begin VB.ListBox List1 
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2580
      Left            =   210
      MultiSelect     =   2  'Extended
      TabIndex        =   5
      Top             =   1590
      Width           =   6105
   End
   Begin VB.CommandButton cmdAdd 
      Caption         =   "&Añadir"
      Default         =   -1  'True
      Height          =   405
      Left            =   5070
      TabIndex        =   4
      ToolTipText     =   " Añadir el mensaje a la colección "
      Top             =   1080
      Width           =   1245
   End
   Begin VB.TextBox Text1 
      Height          =   315
      Index           =   1
      Left            =   1620
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   630
      Width           =   4695
   End
   Begin VB.TextBox Text1 
      Height          =   315
      Index           =   0
      Left            =   1620
      TabIndex        =   1
      Text            =   "Text1"
      Top             =   240
      Width           =   4695
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Caption         =   "&Contenido:"
      Height          =   255
      Index           =   1
      Left            =   270
      TabIndex        =   2
      Top             =   660
      Width           =   1305
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      Caption         =   "&ID:"
      Height          =   255
      Index           =   0
      Left            =   270
      TabIndex        =   0
      Top             =   270
      Width           =   1305
   End
End
Attribute VB_Name = "fColecciones"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'------------------------------------------------------------------------------
' Prueba de colecciones                                             (27/Dic/00)
'
' ©Guillermo 'guille' Som, 2000
'------------------------------------------------------------------------------
Option Explicit

Private m_Mensajes As cMensajes

Private Sub cmdAdd_Click()
    ' Crear un objeto, y añadirlo al ListBox
    Dim sID As String
    Dim tMensaje As cMensaje
    Set tMensaje = New cMensaje
    
    sID = Trim$(Text1(0))
    ' Comprobar si ya existe en la colección
    If m_Mensajes.Exists(sID) Then
        MsgBox "¡ATENCIÓN! Ya existe un elemento con el ID " & sID
        Text1(0).SetFocus
        Exit Sub
    End If
    ' Si llega aquí es que no existe ese ID
    With tMensaje
        .ID = sID
        .Contenido = Trim$(Text1(1))
        ' Añadir este mensaje a la colección
        m_Mensajes.Add tMensaje
        ' Añadirlo a la lista
        List1.AddItem .ID & vbTab & .Contenido
    End With
End Sub

Private Sub cmdGuardar_Click()
    Dim tCD As cComDlg
    Set tCD = New cComDlg
    
    On Error Resume Next
    
    With tCD
        .hWnd = Me.hWnd
        .DialogTitle = "Guardar Mensajes"
        .CancelError = True
        .FileName = App.Path & "\Mensajes.txt"
        .ShowSave
        If Err = 0 Then
            ' Guardar en el fichero indicado
            Guardar .FileName
        End If
    End With
    '
    Set tCD = Nothing
    Err = 0
End Sub

Private Sub cmdLeer_Click()
    Dim tCD As cComDlg
    Set tCD = New cComDlg
    
    On Error Resume Next
    
    With tCD
        .hWnd = Me.hWnd
        .DialogTitle = "Leer Mensajes"
        .CancelError = True
        .FileName = App.Path & "\Mensajes.txt"
        .ShowOpen
        If Err = 0 Then
            ' Leer el fichero indicado
            Leer .FileName
        End If
    End With
    '
    Set tCD = Nothing
    Err = 0
End Sub

Private Sub cmdSalir_Click()
    ' Terminar el programa
    Unload Me
End Sub

Private Sub Form_Load()
    ' Crear la colección
    Set m_Mensajes = New cMensajes
    
    Text1(0) = ""
    Text1(1) = ""
    List1.Clear
End Sub

Private Sub Guardar(ByVal sFic As String)
    ' Guardar el contenido de la colección
    Dim nFic As Long
    Dim tMensaje As cMensaje
    
    On Error Resume Next
    
    nFic = FreeFile
    Open sFic For Output As nFic
    If Err Then
        Err = 0
        MsgBox "Se ha producido el error: " & vbCrLf & Err.Description
        Exit Sub
    End If
    ' Guardar la identificación de que es un fichero de Mensajes
    Print #nFic, "cMensajes"
    ' Guardar el número de elementos
    Print #nFic, m_Mensajes.Count
    ' Guardar cada uno de los mensajes
    For Each tMensaje In m_Mensajes
        With tMensaje
            Print #nFic, .ID
            Print #nFic, .Contenido
        End With
    Next
    Close nFic
End Sub

Private Sub Leer(ByVal sFic As String)
    ' Leer el contenido de la colección
    Dim nFic As Long
    Dim tMensaje As cMensaje
    Dim s As String
    Dim j As Long
    '
    On Error Resume Next
    
    nFic = FreeFile
    Open sFic For Input As nFic
    If Err Then
        Err = 0
        MsgBox "Se ha producido el error: " & vbCrLf & Err.Description
        Exit Sub
    End If
    ' Leer el primer dato para comprobar si es un fichero de mensajes
    Line Input #nFic, s
    If s <> "cMensajes" Then
        MsgBox "No es un fichero con datos de Mensajes"
        Close nFic
        Exit Sub
    End If
    ' El número de elementos
    Line Input #nFic, s
    j = Val(s)
    ' Eliminar los mensajes de la colección
    m_Mensajes.Clear
    ' Leer cada uno de los mensajes
    Do While Not EOF(nFic)
        Line Input #nFic, s
        s = Trim$(s)
        If Len(s) Then
            Set tMensaje = New cMensaje
            tMensaje.ID = s
            Line Input #nFic, s
            tMensaje.Contenido = s
            m_Mensajes.Add tMensaje
        Else
            ' Si el ID era una cadena vacía, leer el siguiente dato
            Line Input #nFic, s
        End If
    Loop
    Close nFic
    ' Añadir los mensajes al ListBox
    With List1
        .Clear
        For Each tMensaje In m_Mensajes
            .AddItem tMensaje.ID & vbTab & tMensaje.Contenido
        Next
    End With
    If j <> m_Mensajes.Count Then
        MsgBox "Se esperaban " & CStr(j) & " mensajes y se han leido: " & CStr(m_Mensajes.Count)
    End If
End Sub

Private Sub List1_Click()
    ' Al pulsar en un elemento, mostrar el dato
    Dim sID As String
    Dim i As Long
    
    i = List1.ListIndex
    If i > -1 Then
        ' Comprobar si el ID está en la colección
        sID = ListItem2ID(List1.List(i))
        ' Si no está, se devuelve una cadena vacía
        If Len(sID) Then
            Text1(0) = m_Mensajes(sID).ID
            Text1(1) = m_Mensajes(sID).Contenido
        End If
    End If
End Sub

Private Sub List1_KeyDown(KeyCode As Integer, Shift As Integer)
    ' Comprobar si se quiere borrar algún elemento
    If KeyCode = vbKeyDelete Then
        Dim i As Long
        Dim sID As String
        '
        With List1
            ' Recorrer todos los elementos de atrás hacia adelante
            For i = .ListCount - 1 To 0 Step -1
                ' Si está seleccionado...
                If .Selected(i) Then
                    ' Comprobar si el ID está en la colección
                    sID = ListItem2ID(.List(i))
                    If Len(sID) Then
                        ' si está, borrarlo de la colección
                        m_Mensajes.Remove sID
                    End If
                    ' ...borrarlo del ListBox
                    .RemoveItem i
                End If
            Next
        End With
    End If
End Sub

Private Function ListItem2ID(ByVal sItem As String) As String
    ' Extraer el ID del elemento pasado,
    ' El formato de sItem será ID & vbTab & Contenido
    ' El valor devuelto será el ID
    '
    Dim s As String, sID As String
    Dim i As Long, j As Long
    
    sID = ""
    ' Añadir un Tab por si no lo tuviese
    s = sItem & vbTab
    ' Buscar el primer TAB para saber cual es el ID
    j = InStr(s, vbTab)
    ' Si tiene un Tab (cosa que siempre debería ser cierta)
    If j Then
        ' Tomar el ID del mensaje
        sID = Trim$(Left$(s, j - 1))
        ' Buscarlo en la colección,
        ' si no existe devolver una cadena vacía
        If m_Mensajes.Exists(sID) = False Then
            sID = ""
        End If
    End If
    ' Devolver el ID o una cadena vacía
    ListItem2ID = sID
End Function

---

El código en VB.NET (completo, incluyendo las definiciones de los controles)

'
'------------------------------------------------------------------------------
' Prueba de colecciones                                             (27/Dic/00)
' 
' ©Guillermo 'guille' Som, 2000
'------------------------------------------------------------------------------

Option Strict On
Option Explicit On
Imports VB = Microsoft.VisualBasic
Namespace tColecciones
	Public  Class fColecciones
		Inherits System.WinForms.Form
		Private Shared  m_vb6FormDefInstance As fColecciones
		Public Shared  Property DefInstance() As fColecciones
			Get
				If m_vb6FormDefInstance Is Nothing Then
					m_vb6FormDefInstance = New fColecciones()
				End If
				DefInstance = m_vb6FormDefInstance
			End Get
			Set
				m_vb6FormDefInstance = Value
			End Set
		End Property

#Region " Windows Form Designer generated code "
		' Required by the Win Form Designer
		Private  components As System.ComponentModel.Container
        Private WithEvents cmdShuffle As System.WinForms.Button
        Public ToolTip1 As System.WinForms.ToolTip
		Public  Tag1 As Microsoft.VisualBasic.Compatibility.VB6.Tag
		Private WithEvents  fColecciones As fColecciones
		Public WithEvents  cmdLeer As System.WinForms.Button
		Public WithEvents  cmdGuardar As System.WinForms.Button
		Public WithEvents  cmdSalir As System.WinForms.Button
		Public WithEvents  List1 As System.WinForms.ListBox
		Public WithEvents  cmdAdd As System.WinForms.Button
		Public WithEvents  Text1_1 As System.WinForms.TextBox
		Public WithEvents  Text1_0 As System.WinForms.TextBox
		Public WithEvents  Label1_1 As System.WinForms.Label
		Public WithEvents  Label1_0 As System.WinForms.Label
		Public WithEvents  Label1 As Microsoft.VisualBasic.Compatibility.VB6.LabelArray
		Public WithEvents  Text1 As Microsoft.VisualBasic.Compatibility.VB6.TextBoxArray
		Public Sub New()
			MyBase.New()
			Me.fColecciones = Me
			' This call is required by the Win Form Designer
			If m_vb6FormDefInstance Is Nothing Then
				m_vb6FormDefInstance = Me
			End If
			InitializeComponent()
			Form_Load()
		End Sub
		' Form overrides dispose to clean up the component list.
		Public Overrides Sub Dispose()
			MyBase.Dispose()
			components.Dispose()
		End Sub
		' The main entry point for the application
		Shared Sub Main()
			System.WinForms.Application.Run(New fColecciones())
		End Sub
		' NOTE: The following procedure is required by the Win Form Designer
		' It can be modified using the Win Form Designer.
		' Do not modify it using the code editor.

        Private Sub InitializeComponent()
            Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(fColecciones))
            
            Me.components = New System.ComponentModel.Container()
            Me.ToolTip1 = New System.WinForms.ToolTip(components)
            Me.Label1_1 = New System.WinForms.Label()
            Me.cmdAdd = New System.WinForms.Button()
            Me.Label1 = New Microsoft.VisualBasic.Compatibility.VB6.LabelArray()
            Me.Text1_0 = New System.WinForms.TextBox()
            Me.Text1_1 = New System.WinForms.TextBox()
            Me.Label1_0 = New System.WinForms.Label()
            Me.Text1 = New Microsoft.VisualBasic.Compatibility.VB6.TextBoxArray()
            Me.cmdSalir = New System.WinForms.Button()
            Me.List1 = New System.WinForms.ListBox()
            Me.cmdGuardar = New System.WinForms.Button()
            Me.cmdLeer = New System.WinForms.Button()
            Me.Tag1 = New Microsoft.VisualBasic.Compatibility.VB6.Tag()
            Me.cmdShuffle = New System.WinForms.Button()
            
            '@design Me.TrayHeight = 90
            '@design Me.TrayLargeIcon = False
            '@design Me.TrayAutoArrange = True
            '@design ToolTip1.SetLocation(New System.Drawing.Point(7, 7))
            ToolTip1.Active = True
            
            Label1_1.Location = New System.Drawing.Point(18, 44)
            Label1_1.Text = "&Contenido:"
            Label1_1.Size = New System.Drawing.Size(87, 17)
            Label1_1.RightToLeft = System.WinForms.RightToLeft.No
            Label1_1.ForeColor = System.Drawing.SystemColors.ControlText
            Label1_1.TabIndex = 2
            Label1.SetIndex(Label1_1, 1%)
            Label1_1.BackColor = System.Drawing.SystemColors.Control
            Label1_1.TextAlign = System.WinForms.HorizontalAlignment.Right
            
            cmdAdd.Location = New System.Drawing.Point(338, 72)
            cmdAdd.BackColor = System.Drawing.SystemColors.Control
            ToolTip1.SetToolTip(cmdAdd, " Añadir el mensaje a la colección ")
            cmdAdd.Size = New System.Drawing.Size(83, 27)
            cmdAdd.TabIndex = 4
            cmdAdd.RightToLeft = System.WinForms.RightToLeft.No
            cmdAdd.Text = "&Añadir"
            
            '@design Label1.SetLocation(New System.Drawing.Point(155, 7))
            
            Text1_0.Location = New System.Drawing.Point(108, 16)
            Text1_0.Cursor = System.Drawing.Cursors.Default
            Text1_0.Text = "Text1"
            Text1_0.RightToLeft = System.WinForms.RightToLeft.No
            Text1_0.AutoSize = False
            Text1_0.ForeColor = System.Drawing.SystemColors.WindowText
            Text1_0.TabIndex = 1
            Text1.SetIndex(Text1_0, 0%)
            Text1_0.Size = New System.Drawing.Size(313, 21)
            Text1_0.BackColor = System.Drawing.SystemColors.Window
            
            Text1_1.Location = New System.Drawing.Point(108, 42)
            Text1_1.Cursor = System.Drawing.Cursors.Default
            Text1_1.Text = "Text1"
            Text1_1.RightToLeft = System.WinForms.RightToLeft.No
            Text1_1.AutoSize = False
            Text1_1.ForeColor = System.Drawing.SystemColors.WindowText
            Text1_1.TabIndex = 3
            Text1.SetIndex(Text1_1, 1%)
            Text1_1.Size = New System.Drawing.Size(313, 21)
            Text1_1.BackColor = System.Drawing.SystemColors.Window
            
            Label1_0.Location = New System.Drawing.Point(18, 18)
            Label1_0.Text = "&ID:"
            Label1_0.Size = New System.Drawing.Size(87, 17)
            Label1_0.RightToLeft = System.WinForms.RightToLeft.No
            Label1_0.ForeColor = System.Drawing.SystemColors.ControlText
            Label1_0.TabIndex = 0
            Label1.SetIndex(Label1_0, 0%)
            Label1_0.BackColor = System.Drawing.SystemColors.Control
            Label1_0.TextAlign = System.WinForms.HorizontalAlignment.Right
            
            '@design Text1.SetLocation(New System.Drawing.Point(228, 7))
            
            cmdSalir.Location = New System.Drawing.Point(438, 288)
            cmdSalir.BackColor = System.Drawing.SystemColors.Control
            ToolTip1.SetToolTip(cmdSalir, " Terminar el programa (ESC) ")
            cmdSalir.DialogResult = System.WinForms.DialogResult.Cancel
            cmdSalir.Size = New System.Drawing.Size(83, 27)
            cmdSalir.TabIndex = 9
            cmdSalir.RightToLeft = System.WinForms.RightToLeft.No
            cmdSalir.Text = "&Salir"
            
            List1.Location = New System.Drawing.Point(14, 106)
            List1.SelectionMode = System.WinForms.SelectionMode.MultiExtended
            List1.Size = New System.Drawing.Size(407, 172)
            List1.RightToLeft = System.WinForms.RightToLeft.No
            List1.Font = New System.Drawing.Font("Courier New", 8.25!)
            List1.TabIndex = 5
            
            cmdGuardar.Location = New System.Drawing.Point(250, 288)
            cmdGuardar.BackColor = System.Drawing.SystemColors.Control
            ToolTip1.SetToolTip(cmdGuardar, " Guardar los mensajes en un fichero ")
            cmdGuardar.Size = New System.Drawing.Size(83, 27)
            cmdGuardar.TabIndex = 7
            cmdGuardar.RightToLeft = System.WinForms.RightToLeft.No
            cmdGuardar.Text = "&Guardar..."
            
            cmdLeer.Location = New System.Drawing.Point(338, 288)
            cmdLeer.BackColor = System.Drawing.SystemColors.Control
            ToolTip1.SetToolTip(cmdLeer, " Leer los mensajes desde un fichero ")
            cmdLeer.Size = New System.Drawing.Size(83, 27)
            cmdLeer.TabIndex = 8
            cmdLeer.RightToLeft = System.WinForms.RightToLeft.No
            cmdLeer.Text = "&Leer..."
            
            '@design Tag1.SetLocation(New System.Drawing.Point(90, 7))
            
            cmdShuffle.Location = New System.Drawing.Point(432, 108)
            ToolTip1.SetToolTip(cmdShuffle, " Reordena los contenidos de los mensajes ")
            cmdShuffle.Size = New System.Drawing.Size(83, 27)
            cmdShuffle.TabIndex = 6
            cmdShuffle.Text = "Shuffle"
            Me.Location = New System.Drawing.Point(3, 22)
            Me.Text = "Prueba de colecciones"
            Me.MaximizeBox = False
            Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
            Me.CancelButton = cmdSalir
            Me.BorderStyle = System.WinForms.FormBorderStyle.FixedSingle
            Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
            Me.AcceptButton = cmdAdd
            Me.ClientSize = New System.Drawing.Size(536, 328)
            
            Me.Controls.Add(cmdShuffle)
            Me.Controls.Add(cmdLeer)
            Me.Controls.Add(cmdGuardar)
            Me.Controls.Add(cmdSalir)
            Me.Controls.Add(List1)
            Me.Controls.Add(cmdAdd)
            Me.Controls.Add(Text1_1)
            Me.Controls.Add(Text1_0)
            Me.Controls.Add(Label1_1)
            Me.Controls.Add(Label1_0)
        End Sub
#End Region
        
        Protected Sub cmdShuffle_Click(ByVal sender As Object, ByVal e As System.EventArgs)
            ' Mezclar los mensajes y mostrarlos                     (27/Dic/00)
            ' Este botón sólo está añadido en la versión de VB.NET
            Dim tMensaje As cMensaje
            
            m_Mensajes.Shuffle()
            With List1
                .Items.Clear()
                For Each tMensaje In m_Mensajes
                    .Items.Add(tMensaje.ID & ControlChars.Tab & tMensaje.Contenido)
                Next
            End With
        End Sub
        
        Private m_Mensajes As cMensajes
        
        Private Sub Guardar(ByVal sFic As String)
            ' Guardar el contenido de la colección
            Dim nFic As Integer
            Dim tMensaje As cMensaje
            
            On Error Resume Next
            
            nFic = VB6.FreeFile
            VB6.Open(nFic, sFic, VB6.OpenMode.Output)
            If CBool(Err.Number) Then
                Err.Clear()
                MsgBox("Se ha producido el error: " & ControlChars.CrLf & Err.Description)
                Exit Sub
            End If
            ' Guardar la identificación de que es un fichero de Mensajes
            VB6.PrintLine(nFic, "cMensajes")
            ' Guardar el número de elementos
            VB6.PrintLine(nFic, m_Mensajes.Count)
            ' Guardar cada uno de los mensajes
            For Each tMensaje In m_Mensajes
                With tMensaje
                    VB6.PrintLine(nFic, .ID)
                    VB6.PrintLine(nFic, .Contenido)
                End With
            Next tMensaje
            VB6.Close(nFic)
        End Sub
        
        Private Sub Leer(ByVal sFic As String)
            ' Leer el contenido de la colección
            Dim nFic As Integer
            Dim tMensaje As cMensaje
            Dim s As String
            Dim j As Integer
            ' 
            On Error Resume Next
            
            nFic = VB6.FreeFile
            VB6.Open(nFic, sFic, VB6.OpenMode.Input)
            If CBool(Err.Number) Then
                Err.Clear()
                MsgBox("Se ha producido el error: " & ControlChars.CrLf & Err.Description)
                Exit Sub
            End If
            ' Leer el primer dato para comprobar si es un fichero de mensajes
            s = VB6.LineInput(nFic)
            If s <> "cMensajes" Then
                MsgBox("No es un fichero con datos de Mensajes")
                VB6.Close(nFic)
                Exit Sub
            End If
            ' El número de elementos
            s = VB6.LineInput(nFic)
            j = CInt(Val(s))
            ' Eliminar los mensajes de la colección
            m_Mensajes.Clear()
            ' Leer cada uno de los mensajes
            Do While Not VB6.EOF(nFic)
                s = VB6.LineInput(nFic)
                s = Trim(s)
                If CBool(Len(s)) Then
                    tMensaje = New cMensaje()
                    tMensaje.ID = s
                    s = VB6.LineInput(nFic)
                    tMensaje.Contenido = s
                    m_Mensajes.Add(tMensaje)
                Else
                    ' Si el ID era una cadena vacía, leer el siguiente dato
                    s = VB6.LineInput(nFic)
                End If
            Loop
            VB6.Close(nFic)
            ' Añadir los mensajes al ListBox
            With List1
                .Items.Clear()
                For Each tMensaje In m_Mensajes
                    .Items.Add(tMensaje.ID & ControlChars.Tab & tMensaje.Contenido)
                Next tMensaje
            End With
            If j <> m_Mensajes.Count Then
                MsgBox("Se esperaban " & CStr(j) & " mensajes y se han leido: " & CStr(m_Mensajes.Count))
            End If
        End Sub
        
        Private Function ListItem2ID(ByVal sItem As String) As String
            ' Extraer el ID del elemento pasado,
            ' El formato de sItem será ID & vbTab & Contenido
            ' El valor devuelto será el ID
            ' 
            Dim s, sID As String
            Dim i, j As Integer
            
            sID = ""
            ' Añadir un Tab por si no lo tuviese
            s = sItem & ControlChars.Tab
            ' Buscar el primer TAB para saber cual es el ID
            j = InStr(s, ControlChars.Tab)
            ' Si tiene un Tab (cosa que siempre debería ser cierta)
            If CBool(j) Then
                ' Tomar el ID del mensaje
                sID = Trim(VB.Left(s, j - 1))
                ' Buscarlo en la colección,
                ' si no existe devolver una cadena vacía
                If m_Mensajes.Exists(sID) = False Then
                    sID = ""
                End If
            End If
            ' Devolver el ID o una cadena vacía
            ListItem2ID = sID
        End Function
        
        Private Sub cmdAdd_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs)
            ' Crear un objeto, y añadirlo al ListBox
            Dim sID As String
            Dim tMensaje As cMensaje
            tMensaje = New cMensaje()
            
            sID = Trim(Text1.Item(0).Text)
            ' Comprobar si ya existe en la colección
            If m_Mensajes.Exists(sID) Then
                MsgBox("¡ATENCIÓN! Ya existe un elemento con el ID " & sID)
                Text1.Item(0).Focus()
                Exit Sub
            End If
            ' Si llega aquí es que no existe ese ID
            With tMensaje
                .ID = sID
                .Contenido = Trim(Text1.Item(1).Text)
                ' Añadir este mensaje a la colección
                m_Mensajes.Add(tMensaje)
                ' Añadirlo a la lista
                List1.Items.Add(.ID & ControlChars.Tab & .Contenido)
            End With
        End Sub
        
        Private Sub cmdGuardar_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs)
            Dim tCD As cComDlg
            tCD = New cComDlg()
            
            On Error Resume Next
            
            With tCD
                .hWnd = Me.Handle
                .DialogTitle = "Guardar Mensajes"
                .CancelError = True
                .FileName = System.WinForms.Application.StartUpPath & "\Mensajes.txt"
                .ShowSave()
                If Err.Number = 0 Then
                    ' Guardar en el fichero indicado
                    Guardar(.FileName)
                End If
            End With
            ' 
            tCD = Nothing
            Err.Clear()
        End Sub
        
        Private Sub cmdLeer_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs)
            Dim tCD As cComDlg
            tCD = New cComDlg()
            
            On Error Resume Next
            
            With tCD
                .hWnd = Me.Handle
                .DialogTitle = "Leer Mensajes"
                .CancelError = True
                .FileName = System.WinForms.Application.StartUpPath & "\Mensajes.txt"
                .ShowOpen()
                If Err.Number = 0 Then
                    ' Leer el fichero indicado
                    Leer(.FileName)
                End If
            End With
            ' 
            tCD = Nothing
            Err.Clear()
        End Sub
        
        Private Sub cmdSalir_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs)
            ' Terminar el programa
            Me.Close()
        End Sub
        
        Private Sub Form_Load()
            ' Crear la colección
            m_Mensajes = New cMensajes()
            
            Text1.Item(0).Text = ""
            Text1.Item(1).Text = ""
            List1.Items.Clear()
        End Sub
        
        Private Sub List1_SelectedIndexChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs)
            ' Al pulsar en un elemento, mostrar el dato
            Dim sID As String
            Dim i As Integer
            
            i = List1.SelectedIndex
            If i > -1 Then
                ' Comprobar si el ID está en la colección
                'sID = ListItem2ID(VB6.GetItemString(List1, i))
                sID = ListItem2ID(List1.GetItemText(i))
                ' Si no está, se devuelve una cadena vacía
                If CBool(Len(sID)) Then
                    Text1.Item(0).Text = m_Mensajes(sID).ID
                    Text1.Item(1).Text = m_Mensajes(sID).Contenido
                End If
            End If
        End Sub
        
        Private Sub List1_KeyDown(ByVal eventSender As System.Object, ByVal eventArgs As System.WinForms.KeyEventArgs)
            Dim KeyCode As Short = CType(eventArgs.KeyCode, Short) ' Convert from Keys to VB6.ShiftConstants
            'Dim Shift As Short = eventArgs.KeyData \ &H10000
            Dim Shift As Integer = eventArgs.KeyData \ &H10000
            ' Comprobar si se quiere borrar algún elemento
            Dim i As Integer
            Dim sID As String
            If KeyCode = System.WinForms.Keys.Delete Then
                ' 
                With List1
                    ' Recorrer todos los elementos de atrás hacia adelante
                    For i = .Items.Count - 1 To 0 Step -1
                        ' Si está seleccionado...
                        If .GetSelected(i) Then
                            ' Comprobar si el ID está en la colección
                            'sID = ListItem2ID(VB6.GetItemString(List1, i))
                            sID = ListItem2ID(List1.GetItemText(i))
                            If CBool(Len(sID)) Then
                                ' si está, borrarlo de la colección
                                m_Mensajes.Remove(sID)
                            End If
                            ' ...borrarlo del ListBox
                            .Items.Remove(i)
                        End If
                    Next
                End With
            End If
        End Sub
    End Class
End NameSpace

Volver a la página explicativa

Ir al índice de vb.net