FANDOM


El código de control personalizado Rejilla Editar

Option Explicit On

Imports System.ComponentModel

< _
  ToolboxBitmap(GetType(Rejilla), "Rejilla.bmp"), _
  Description("Matriz de casillas.") _
> _
Public Class Rejilla

  Private iColumnas As Byte = 5
  Private iFilas As Byte = 5

  Private iAnchoCasillas As Byte = 20
  Private iAltoCasillas As Byte = 20
  Private colorActiva As Color = Color.Black
  Private colorInactiva As Color = Color.White

  Private iAnchoMinimo As Byte = 5
  Private iAltoMinimo As Byte = 5
  Private iAnchoMaximo As Byte = 50
  Private iAltoMaximo As Byte = 50
  Private iColumnasMinimo As Byte = 1
  Private iFilasMinimo As Byte = 100
  Private iColumnasMaximo As Byte = 1
  Private iFilasMaximo As Byte = 100

  Dim aCasillas(,) As PictureBox

  Event CasillaActivada( _
    ByVal Columna As Byte, _
    ByVal Fila As Byte _
  )

  Event CasillaDesactivada( _
    ByVal Columna As Byte, _
    ByVal Fila As Byte _
  )

  <Description("Número de columnas de la rejilla.")> _
  Property Columnas() As Byte
    Get
      Columnas = iColumnas
    End Get
    Set(ByVal iQueColumnas As Byte)
      iColumnas = iQueColumnas
      Dibujar()
    End Set
  End Property

  <Description("Número de filas de la rejilla.")> _
  Property Filas() As Byte
    Get
      Filas = iFilas
    End Get
    Set(ByVal iQueFilas As Byte)
      iFilas = iQueFilas
      Dibujar()
    End Set
  End Property

  <Description("Ancho de cada casilla de la rejilla.")> _
  Property AnchoCasillas() As Byte
    Get
      AnchoCasillas = iAnchoCasillas
    End Get
    Set(ByVal iQueAnchoCasillas As Byte)
      iAnchoCasillas = iQueAnchoCasillas
      Dibujar()
    End Set
  End Property

  <Description("Alto de cada casilla de la rejilla.")> _
  Property AltoCasillas() As Byte
    Get
      AltoCasillas = iAltoCasillas
    End Get
    Set(ByVal iQueAltoCasillas As Byte)
      iAltoCasillas = iQueAltoCasillas
      Dibujar()
    End Set
  End Property

  <Description("Color de las casillas activas de la rejilla.")> _
  Property ColorCasillaActiva() As Color
    Get
      ColorCasillaActiva = colorActiva
    End Get
    Set(ByVal colorQueColorActiva As Color)
      colorActiva = colorQueColorActiva
    End Set
  End Property

  <Description("Color de las casillas inactivas de la rejilla.")> _
  Property ColorCasillaInactiva() As Color
    Get
      ColorCasillaInactiva = colorInactiva
    End Get
    Set(ByVal colorQueColorInactiva As Color)
      colorInactiva = colorQueColorInactiva
    End Set
  End Property

  <Description("Ancho mínimo de cada casilla de la rejilla.")> _
  Property AnchoMinimo() As Byte
    Get
      AnchoMinimo = iAnchoMinimo
    End Get
    Set(ByVal iQueAnchoMinimo As Byte)
      iAnchoMinimo = iQueAnchoMinimo
    End Set
  End Property

  <Description("Alto mínimo de cada casilla de la rejilla.")> _
  Property AltoMinimo() As Byte
    Get
      AltoMinimo = iAltoMinimo
    End Get
    Set(ByVal iQueAltoMinimo As Byte)
      iAltoMinimo = iQueAltoMinimo
    End Set
  End Property

  <Description("Ancho máximo de cada casilla de la rejilla.")> _
  Property AnchoMaximo() As Byte
    Get
      AnchoMaximo = iAnchoMaximo
    End Get
    Set(ByVal iQueAnchoMaximo As Byte)
      iAnchoMaximo = iQueAnchoMaximo
    End Set
  End Property

  <Description("Alto máximo de cada casilla de la rejilla.")> _
  Property AltoMaximo() As Byte
    Get
      AltoMaximo = iAltoMaximo
    End Get
    Set(ByVal iQueAltoMaximo As Byte)
      iAltoMaximo = iQueAltoMaximo
    End Set
  End Property

  <Description("Número mínimo de columnas de la rejilla.")> _
  Property ColumnasMinimo() As Byte
    Get
      ColumnasMinimo = iColumnasMinimo
    End Get
    Set(ByVal iQueColumnasMinimo As Byte)
      iColumnasMinimo = iQueColumnasMinimo
    End Set
  End Property

  <Description("Número mínimo de filas de la rejilla.")> _
  Property FilasMinimo() As Byte
    Get
      FilasMinimo = iFilasMinimo
    End Get
    Set(ByVal iQueFilasMinimo As Byte)
      iFilasMinimo = iQueFilasMinimo
    End Set
  End Property

  <Description("Número máximo de columnas de la rejilla.")> _
  Property ColumnasMaximo() As Byte
    Get
      ColumnasMaximo = iColumnasMaximo
    End Get
    Set(ByVal iQueColumnasMaximo As Byte)
      iColumnasMaximo = iQueColumnasMaximo
    End Set
  End Property

  <Description("Número máximo de filas de la rejilla.")> _
  Property FilasMaximo() As Byte
    Get
      FilasMaximo = iFilasMaximo
    End Get
    Set(ByVal iQueFilasMaximo As Byte)
      iFilasMaximo = iQueFilasMaximo
    End Set
  End Property

  Sub Dibujar()

    Me.Visible = False

    Dim i As Byte
    Dim j As Byte

    If Not IsNothing(aCasillas) Then

      For j = 1 To UBound(aCasillas, 2)
        For i = 1 To UBound(aCasillas, 1)
          aCasillas(i, j).Dispose()
        Next
      Next

    End If

    ReDim aCasillas(iColumnas, iFilas)

    For j = 1 To iFilas
      For i = 1 To iColumnas
        aCasillas(i, j) = New PictureBox
        aCasillas(i, j).Parent = Me
        aCasillas(i, j).BorderStyle = Windows.Forms.BorderStyle.FixedSingle
        aCasillas(i, j).Top = iAltoCasillas * (j - 1)
        aCasillas(i, j).Left = iAnchoCasillas * (i - 1)
        aCasillas(i, j).Width = iAnchoCasillas
        aCasillas(i, j).Height = iAltoCasillas
        aCasillas(i, j).BackColor = colorInactiva
      Next
    Next

    Me.Visible = True

  End Sub

  Sub ActivarCasilla(ByVal Columna As Byte, ByVal Fila As Byte)
    aCasillas(Columna, Fila).BackColor = colorActiva
    RaiseEvent CasillaActivada(Columna, Fila)
  End Sub

  Sub DesactivarCasilla(ByVal Columna As Byte, ByVal Fila As Byte)
    aCasillas(Columna, Fila).BackColor = colorInactiva
    RaiseEvent CasillaDesactivada(Columna, Fila)
  End Sub

  Public Sub New()
    InitializeComponent()
    Dibujar()
  End Sub

End Class

El código de la clase Bacteria Editar

Option Explicit On

Public Class Bacteria

  Private bViva As Boolean
  Private bCreada As Boolean
  Private iColumna As Byte
  Private iFila As Byte

  Event Nacimiento( _
    ByVal Columna As Byte, _
    ByVal Fila As Byte _
  )

  Event Muerte( _
    ByVal Columna As Byte, _
    ByVal Fila As Byte _
  )

  Sub Crear( _
    ByVal Columna As Byte, _
    ByVal Fila As Byte _
  )
    iColumna = Columna
    iFila = Fila
    bCreada = True
  End Sub

  Function Nacer() As Boolean
    Nacer = False
    If Not bCreada Then Exit Function
    bViva = True
    Nacer = True
    RaiseEvent Nacimiento(iColumna, iFila)
  End Function

  Function Morir() As Boolean
    Morir = False
    If Not bCreada Then Exit Function
    bViva = False
    Morir = True
    RaiseEvent Muerte(iColumna, iFila)
  End Function

  ReadOnly Property Viva() As Boolean
    Get
      Viva = bViva
    End Get
  End Property

  ReadOnly Property Creada() As Boolean
    Get
      Creada = bCreada
    End Get
  End Property

  Property Columna() As Byte
    Get
      Columna = iColumna
    End Get
    Set(ByVal iQueColumna As Byte)
      iColumna = iQueColumna
    End Set
  End Property

  Property Fila() As Byte
    Get
      Fila = iFila
    End Get
    Set(ByVal iQueFila As Byte)
      iFila = iQueFila
    End Set
  End Property

  Public Sub New( _
    ByVal Columna As Byte, _
    ByVal Fila As Byte _
  )
    Crear(Columna, Fila)
  End Sub

End Class

El código de la clase Bacterias Editar

Option Explicit On

Public Class Bacterias

  Inherits System.Collections.CollectionBase

  Private aBacterias(,) As Bacteria
  Private iColumnas As Byte
  Private iFilas As Byte
  Private bCreadas As Boolean

  Event Nacimiento( _
    ByVal Columna As Long, _
    ByVal Fila As Long _
  )

  Event Muerte( _
    ByVal Columna As Long, _
    ByVal Fila As Long _
  )

  Public Sub New()

  End Sub

  Public Sub New( _
    ByVal Columna As Byte, _
    ByVal Fila As Byte _
  )
    Crear(Columna, Fila)
  End Sub

  Public Sub Crear( _
    ByVal Columnas As Long, _
    ByVal Filas As Long _
  )
    If bCreadas Then Destruir()

    iColumnas = Columnas
    iFilas = Filas
    ReDim aBacterias( _
      iColumnas + 2, _
      iFilas + 2 _
    )

    Dim i As Long
    Dim j As Long

    For j = 0 To iFilas + 1
      For i = 0 To iColumnas + 1
        aBacterias(i, j) = New Bacteria(i, j)
        If _
          i <> 0 And _
          j <> 0 And _
          i <> iColumnas + 1 And _
          j <> iFilas + 1 _
        Then
          List.Add(aBacterias(i, j))
        End If
      Next i
    Next j

    bCreadas = True

  End Sub

  Private Sub Destruir()

    Dim i As Long
    Dim j As Long

    For j = 0 To iFilas + 1
      For i = 0 To iColumnas + 1
        aBacterias(i, j) = Nothing
      Next i
    Next j

  End Sub

  ReadOnly Property Creadas() As Boolean
    Get
      Creadas = bCreadas
    End Get
  End Property

  ReadOnly Property Columnas() As Byte
    Get
      Columnas = iColumnas
    End Get
  End Property

  ReadOnly Property Filas() As Byte
    Get
      Filas = iFilas
    End Get
  End Property

  Default ReadOnly Property Bacteria( _
    ByVal Columna As Byte, _
    ByVal Fila As Byte _
  ) As Bacteria
    Get
      If _
        Columna < 1 Or _
        Columna > iColumnas Or _
        Fila < 1 Or _
        Fila > iFilas _
      Then
        Bacteria = Nothing
      Else
        Bacteria = aBacterias(Columna, Fila)
      End If
    End Get
  End Property

  Function Procrear() As Boolean

    Procrear = False
    If Not bCreadas Then Exit Function

    Dim abBacteriasNG(,) As Boolean
    ReDim abBacteriasNG( _
      iColumnas, _
      iFilas _
    )

    Dim i As Byte
    Dim j As Byte
    Dim iVecinas As Byte

    For j = 1 To iFilas
      For i = 1 To iColumnas

        iVecinas = 0

        If aBacterias(i - 1, j - 1).Viva Then
          iVecinas = iVecinas + 1
        End If
        If aBacterias(i - 0, j - 1).Viva Then
          iVecinas = iVecinas + 1
        End If
        If aBacterias(i + 1, j - 1).Viva Then
          iVecinas = iVecinas + 1
        End If

        If aBacterias(i - 1, j - 0).Viva Then
          iVecinas = iVecinas + 1
        End If
        If aBacterias(i + 1, j - 0).Viva Then
          iVecinas = iVecinas + 1
        End If

        If aBacterias(i - 1, j + 1).Viva Then
          iVecinas = iVecinas + 1
        End If
        If aBacterias(i - 0, j + 1).Viva Then
          iVecinas = iVecinas + 1
        End If
        If aBacterias(i + 1, j + 1).Viva Then
          iVecinas = iVecinas + 1
        End If

        Select Case iVecinas
          Case 2
            abBacteriasNG(i, j) = _
              aBacterias(i, j).Viva
          Case 3
            abBacteriasNG(i, j) = True
          Case Else
            abBacteriasNG(i, j) = False
        End Select
      Next i
    Next j

    For j = 1 To iFilas
      For i = 1 To iColumnas
        If abBacteriasNG(i, j) = True And _
          aBacterias(i, j).Viva = False _
        Then
          aBacterias(i, j).Nacer()
          RaiseEvent Nacimiento(i, j)
        ElseIf abBacteriasNG(i, j) = False _
          And aBacterias(i, j).Viva = True _
        Then
          aBacterias(i, j).Morir()
          RaiseEvent Muerte(i, j)
        End If
      Next i
    Next j

    Procrear = True
    Exit Function

  End Function

  Public ReadOnly Property Item( _
    ByVal index As Integer _
  ) As Bacteria
    Get
      Return CType(List.Item(index), Bacteria)
    End Get
  End Property

  Protected Overrides Sub Finalize()
    Destruir()
    MyBase.Finalize()
  End Sub

End Class

El código del formulario Editar

Option Explicit On

Public Class frmEcosistema

  Private iColumnas As Byte = 20
  Private iFilas As Byte = 10

  Dim WithEvents MisBacterias As New Bacterias(iColumnas, iFilas)

  Private Sub btnSembrar_Click( _
    ByVal sender As System.Object, _
    ByVal e As System.EventArgs _
  ) Handles btnSembrar.Click

    Dim Semilla As New Random

    Dim MiBacteria As Bacteria
    For Each MiBacteria In MisBacterias

      If Semilla.Next Mod 2 = 0 Then
        MiBacteria.Nacer()
        rejBacterias.ActivarCasilla( _
          MiBacteria.Columna, _
          MiBacteria.Fila _
        )
      Else
        MiBacteria.Morir()
        rejBacterias.DesactivarCasilla( _
          MiBacteria.Columna, _
          MiBacteria.Fila _
        )
      End If
    Next

  End Sub

  Private Sub MisBacterias_Muerte( _
    ByVal Columna As Long, _
    ByVal Fila As Long _
  ) Handles MisBacterias.Muerte

    rejBacterias.DesactivarCasilla(Columna, Fila)

  End Sub

  Private Sub MisBacterias_Nacimiento( _
    ByVal Columna As Long, _
    ByVal Fila As Long _
  ) Handles MisBacterias.Nacimiento

    rejBacterias.ActivarCasilla(Columna, Fila)

  End Sub

  Private Sub btnSiguienteGeneracion_Click( _
    ByVal sender As System.Object, _
    ByVal e As System.EventArgs _
  ) Handles btnSiguienteGeneracion.Click

    MisBacterias.Procrear()

  End Sub

End Class

¡Interferencia de bloqueo de anuncios detectada!


Wikia es un sitio libre de uso que hace dinero de la publicidad. Contamos con una experiencia modificada para los visitantes que utilizan el bloqueo de anuncios

Wikia no es accesible si se han hecho aún más modificaciones. Si se quita el bloqueador de anuncios personalizado, la página cargará como se esperaba.