Nieve en VB.net
[Donde están “Point“ y “PSet”]

Fecha: 21/Abr/2003 (15/Abril/2003)
Autor: Jose Luis Quintero Méndez


Es te código nos muestra como simular nieve en vb.net de una forma un poco tosca. Con este pequeño código lo que se intenta es ver el cambio que han sufrido una serie de sentencias en el nuevo lenguaje vb.net entre estas se encuentran “Point“ y “PSet” las cuales antes utilizábamos directamente desde un formulario.

También se incluye el código para la versión de Visual Basic 6.0 para así poder ver las diferencias mas claras entre los dos lenguajes.

 


'****************************************************************************************
'* Código realizado por José Luis Quintero © (Libre distribución)                       *
'*                                                                                      *
'* Descripción:                                                                         *
'*                                                                                      *
'* Ejemplo de como simular nieve en visualbasic .Net y los cambios que han sufrido varias *
'* de sus sentencias como por ejemplo “Point“ y “PSet”                                  *
'*                                                                                      *
'****************************************************************************************

   'Variables globales
    Dim intlin(110) As Integer ' Array el cual contiene la línea de cada copo de nieve
    Dim intcol(110) As Integer ' Array el cual contiene la columna de cada copo de nieve
    Dim ContNumCopo As Integer ' Contador de Copos
    Dim bm As Bitmap


    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim wid As Integer
        Dim hgt As Integer
        Dim x As Integer

        wid = PictureBox1.ClientRectangle.Width
        hgt = PictureBox1.ClientRectangle.Height


        'Creamos el Bitmap
        bm = New Bitmap("Dibujo1.bmp")

        PictureBox1.Width = bm.Width
        PictureBox1.Height = bm.Height
        Me.Width = bm.Width + 8
        Me.Height = bm.Height + 26
        'Colocamos aleatoria menté un copo en una columna
        For x = 0 To 110 : intcol(x) = Int(Rnd() * PictureBox1.Width) : Next x
        intlin(ContNumCopo) = 0
        Randomize()

    End Sub
    Function ElijeLado()
        Dim clr As System.Drawing.Color
        Dim clr1 As System.Drawing.Color
        Dim Lado(110) As Integer
        ElijeLado = False
        'Ponemos aleatoria menté el lado por el cual rodara el copo
        Lado(ContNumCopo) = Rnd() * 1
        If Lado(ContNumCopo) = 0 Then
            clr = bm.GetPixel(intcol(ContNumCopo) + 1, intlin(ContNumCopo) + 1)
            clr1 = bm.GetPixel(intcol(ContNumCopo) - 1, intlin(ContNumCopo) + 1)
            If clr.ToArgb = 0 Or clr.ToArgb = -16777216 Then
                Call borrar()
                intcol(ContNumCopo) = intcol(ContNumCopo) + 1
                ElijeLado = True

            ElseIf clr1.ToArgb = 0 Or clr1.ToArgb = -16777216 Then
                Call borrar()
                intcol(ContNumCopo) = intcol(ContNumCopo) - 1
                ElijeLado = True
            End If
        Else
            clr = bm.GetPixel(intcol(ContNumCopo) - 1, intlin(ContNumCopo) + 1)
            clr1 = bm.GetPixel(intcol(ContNumCopo) + 1, intlin(ContNumCopo) + 1)
            If clr.ToArgb = -16777216 Or clr.ToArgb = 0 Then
                Call borrar()
                intcol(ContNumCopo) = intcol(ContNumCopo) - 1
                ElijeLado = True
            ElseIf clr1.ToArgb = -16777216 Or clr1.ToArgb = 0 Then
                Call borrar()
                intcol(ContNumCopo) = intcol(ContNumCopo) + 1
                ElijeLado = True
            End If
        End If
    End Function

    Sub borrar()
        'Borramos para dar la sensación de movimiento
        If intlin(ContNumCopo) - 1 > 0 Then bm.SetPixel(intcol(ContNumCopo), intlin(ContNumCopo) - 1, Color.Black)
        bm.SetPixel(intcol(ContNumCopo), intlin(ContNumCopo), Color.Black)
    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Dim x As Integer
        Dim clr As System.Drawing.Color


        For x = 1 To 50 'Le ponemos un bucle para que aumente la velocidad de la caída de copos
            ContNumCopo = ContNumCopo + 1 ' Aumentamos la variable del array para pasar de copo
            If ContNumCopo = 110 Then ContNumCopo = 0
            Try

                intlin(ContNumCopo) = intlin(ContNumCopo) + 1 'Incrementamos la y(Linea) del copo actual
                bm.SetPixel(intcol(ContNumCopo), intlin(ContNumCopo), Color.White) 'Pintamos el copo de blanco
                If intlin(ContNumCopo) >= PictureBox1.ClientRectangle.Height - 1 Then
                    intlin(ContNumCopo) = 0
                    intcol(ContNumCopo) = Int(Rnd() * PictureBox1.Width)
                End If
                clr = bm.GetPixel(intcol(ContNumCopo), intlin(ContNumCopo) + 1) 'Capturamos el color actual
                If clr.ToArgb <> -16777216 And clr.ToArgb <> 0 Then
                    If ElijeLado() = False Then
                        intlin(ContNumCopo) = 0
                        intcol(ContNumCopo) = Int(Rnd() * PictureBox1.ClientRectangle.Width)
                    End If
                Else
                    If intlin(ContNumCopo) - 1 > 0 Then bm.SetPixel(intcol(ContNumCopo), intlin(ContNumCopo) - 1, Color.Black)
                End If

            Catch

            End Try

            ' Mostramos la Imagen.
            PictureBox1.Image = bm
        Next x

    End Sub

End Class

Precisiones :

Para que funcione este código crea una PictureBox con el nombre “PictureBox1” y ponle el fondo en negro luego coloca una imagen en el mismo directorio de la aplicación que se llame “Dibujo1.bmp” y pon le en fondo negro la parte por la que quieres que caiga la nieve.


ir al índice

Fichero con el código de ejemplo, tanto para VB6 como para VB.NET (Nievenet.zip - 382 KB)