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.
Fichero con el código de ejemplo, tanto para VB6 como para VB.NET (Nievenet.zip - 382 KB)