Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Snowing

Status
Not open for further replies.
chrissie1

chrissie1

Programmer
Aug 12, 2002
4,517
BE
I now I still have lots of work for school but I got into this on saterday and I couldn't let go.

Its is a snow scene. The original code wasn't very flexible and it was a port from vb6 but I kept the algorithm.

So this is the panel that does all the work (aint very OO but that was more work and I was running out of weekend.
You can place this on any form you like


Code: 
' This program is based on

'=======================================
'"Real Snow" for
'              Visual Basic 6.0
'                 Visual Basic .Net
'                      and JAVA !

'You can find other versions and interesting codes here:
'[URL unfurl="true"]http://www.emu8086.com/vb/[/URL]

'This code is free to use for any purpose,
'you should keep the original copyright:

'Copyright (C) 2004 Free Code
'[URL unfurl="true"]http://www.emu8086.com/vb/[/URL]

'For comments: info@emu8086.com
'=======================================



Public Class Snowing
    Inherits System.Windows.Forms.Panel
    Implements IDisposable

    Private _MaxParticles As Integer
    Private _SnowParticles1x1 As List(Of SnowParticle1X1)
    Private _SnowParticles2x2 As List(Of SnowParticle2x2)
    Private _SnowParticles3x3 As List(Of SnowParticle3x3)
    Private WithEvents _Timer As System.Windows.Forms.Timer
    Private _SnowHeight As Integer = 2
    Dim _CurrentSnowHeight As Integer = 0

    Private _Graphics As Graphics
    Private _graphics1 As Graphics
    Private _Bitmap1x1 As Bitmap
    Private _Bitmap2x2 As Bitmap
    Private _BlackPixel As Color
    Private _Width As Integer
    Private _Height As Integer

    Public Event CurrentSnowheightChanged(ByVal CurrentsnowHeight As Integer)

    Public Property MaximumNumberOfParticles() As Integer
        Get
            Return _MaxParticles
        End Get
        Set(ByVal value As Integer)
            _MaxParticles = value
        End Set
    End Property

    Public Property SnowHeight() As Integer
        Get
            Return _SnowHeight
        End Get
        Set(ByVal value As Integer)
            _SnowHeight = value
        End Set
    End Property

    Public Sub New()
        MyBase.New()
        _MaxParticles = 400
    End Sub

    Public Sub InitSnow()
        Randomize()
        _Timer = New System.Windows.Forms.Timer
        _SnowParticles1x1 = New List(Of SnowParticle1X1)
        _SnowParticles2x2 = New List(Of SnowParticle2x2)
        _SnowParticles3x3 = New List(Of SnowParticle3x3)
        _Bitmap1x1 = New Bitmap(Me.ClientRectangle.Width, Me.ClientRectangle.Height)
        _graphics1 = Graphics.FromImage(_Bitmap1x1)
        _graphics1.Clear(Color.Gray)
        For Each c As Control In Me.Controls
            If TypeOf c Is ISnowable Then
                CType(c, ISnowable).DrawOnBitmap(_Bitmap1x1)
                c.Visible = False
            End If
        Next
        
        ' For some reason "Color.Black" cannot be used, so this used:
        _BlackPixel = _Bitmap1x1.GetPixel(0, 0)

        _Width = _Bitmap1x1.Width - 1
        _Height = _Bitmap1x1.Height - 1

        ' Draw first layer of snow for better look and
        ' snow falling algorithm calculations:
        For inttemp As Integer = 0 To _Width
            _Bitmap1x1.SetPixel(inttemp, _Height, Color.White)
        Next

        For inttemp As Integer = 0 To _MaxParticles - 1
            _SnowParticles1x1.Add(New SnowParticle1X1())
            NewParticle1x1(_SnowParticles1x1(inttemp), False)
        Next

        For inttemp As Integer = 0 To (_MaxParticles / 2) - 1
            _SnowParticles2x2.Add(New SnowParticle2x2())
            NewParticle2x2(_SnowParticles2x2(inttemp), False)
        Next

        For inttemp As Integer = 0 To (_MaxParticles / 2) - 1
            _SnowParticles3x3.Add(New SnowParticle3x3())
            NewParticle3x3(_SnowParticles3x3(inttemp), False)
        Next

        _Graphics = Me.CreateGraphics

        DrawSnow()
        _Timer.Interval = 70
        _Timer.Enabled = True

    End Sub

    Private Sub DrawSnow()
        Dim newX As Integer
        Dim newY As Integer
        For inttemp As Integer = 0 To _SnowParticles1x1.Count - 1
            DrawOldParticle(_SnowParticles1x1(inttemp), _BlackPixel)
            DrawNewParticle(_SnowParticles1x1(inttemp), Color.White)
            If _CurrentSnowHeight < (_Width * _SnowHeight * _MaxParticles) + 1 Then
                _CurrentSnowHeight += 1
            End If
        Next

        _Bitmap2x2 = _Bitmap1x1.Clone(New Rectangle(0, 0, _Bitmap1x1.Width, _Bitmap1x1.Height), _Bitmap1x1.PixelFormat)

        For inttemp As Integer = 0 To _SnowParticles2x2.Count - 1
            DrawParticle2x2(_SnowParticles2x2(inttemp))
        Next
        For inttemp As Integer = 0 To _SnowParticles3x3.Count - 1
            DrawParticle3x3(_SnowParticles3x3(inttemp))
        Next
        _Graphics.DrawImage(_Bitmap2x2, 0, 0)

        For inttemp As Integer = 0 To _SnowParticles1x1.Count - 1
            _SnowParticles1x1(inttemp).OldX = _SnowParticles1x1(inttemp).X
            _SnowParticles1x1(inttemp).OldY = _SnowParticles1x1(inttemp).Y

            ' A trick to get both positive and negative random values:
            newX = _SnowParticles1x1(inttemp).X + Int(2 * Rnd())
            newX = newX - Int(2 * Rnd())

            ' Don't alow our snow to run away:
            If newX < 0 Then newX = 0
            If newX >= _Width Then newX = _Width - 1

            If _SnowParticles1x1(inttemp).Y >= _Height Then
                CheckSnowHeight(_SnowParticles1x1(inttemp))
            Else
                newY = _SnowParticles1x1(inttemp).Y + 1
                If _Bitmap1x1.GetPixel(newX, newY).Equals(_BlackPixel) Then
                    _SnowParticles1x1(inttemp).X = newX
                    _SnowParticles1x1(inttemp).Y = newY
                Else
                    If _SnowParticles1x1(inttemp).Stopped = 10 Then ' if stopped 10 times, make new!
                        If _SnowParticles1x1(inttemp).X >= _Width Then
                            CheckSnowHeight(_SnowParticles1x1(inttemp))
                        ElseIf _SnowParticles1x1(inttemp).Y >= _Height Then
                            CheckSnowHeight(_SnowParticles1x1(inttemp))
                        Else
                            ' Move according to basic SNOW RULE:
                            If _Bitmap1x1.GetPixel(_SnowParticles1x1(inttemp).X + 1, _SnowParticles1x1(inttemp).Y + 1).Equals(_BlackPixel) Then
                                _SnowParticles1x1(inttemp).X = _SnowParticles1x1(inttemp).X + 1
                                _SnowParticles1x1(inttemp).Y = _SnowParticles1x1(inttemp).Y + 1
                                _SnowParticles1x1(inttemp).Stopped = 0
                            ElseIf _SnowParticles1x1(inttemp).X > 0 Then
                                If _Bitmap1x1.GetPixel(_SnowParticles1x1(inttemp).X - 1, _SnowParticles1x1(inttemp).Y + 1).Equals(_BlackPixel) Then
                                    _SnowParticles1x1(inttemp).X = _SnowParticles1x1(inttemp).X - 1
                                    _SnowParticles1x1(inttemp).Y = _SnowParticles1x1(inttemp).Y + 1
                                    _SnowParticles1x1(inttemp).Stopped = 0
                                Else
                                    CheckSnowHeight(_SnowParticles1x1(inttemp))
                                End If
                            Else
                                CheckSnowHeight(_SnowParticles1x1(inttemp))
                            End If
                        End If
                    Else
                        _SnowParticles1x1(inttemp).Stopped = _SnowParticles1x1(inttemp).Stopped + 1
                    End If
                End If
            End If
        Next
        For inttemp As Integer = 0 To _SnowParticles2x2.Count - 1
            ' A trick to get both positive and negative random values:
            newX = _SnowParticles2x2(inttemp).X + Int(2 * Rnd())
            newX = newX - Int(2 * Rnd())

            ' Don't alow our snow to run away:
            If newX < 0 Then newX = 0
            If newX >= _Width - 1 Then newX = _Width - 2

            If _SnowParticles2x2(inttemp).Y + 1 >= _Height Then
                NewParticle2x2(_SnowParticles2x2(inttemp), True)
            Else
                newY = _SnowParticles2x2(inttemp).Y + 1
                _SnowParticles2x2(inttemp).Y = newY
                _SnowParticles2x2(inttemp).X = newX
                'NewParticle2x2(_SnowParticles2x2(inttemp), True)
            End If
        Next
        For inttemp As Integer = 0 To _SnowParticles3x3.Count - 1
            ' A trick to get both positive and negative random values:
            newX = _SnowParticles3x3(inttemp).X + Int(2 * Rnd())
            newX = newX - Int(2 * Rnd())

            ' Don't alow our snow to run away:
            If newX < 0 Then newX = 0
            If newX >= _Width - 2 Then newX = _Width - 3

            If _SnowParticles3x3(inttemp).Y + 2 >= _Height Then
                NewParticle3x3(_SnowParticles3x3(inttemp), True)
            Else
                newY = _SnowParticles3x3(inttemp).Y + 1
                _SnowParticles3x3(inttemp).Y = newY
                _SnowParticles3x3(inttemp).X = newX
                'NewParticle2x2(_SnowParticles2x2(inttemp), True)
            End If
        Next
    End Sub

    Private Sub NewParticle1x1(ByRef SnowParticle As SnowParticle1X1, ByVal FromTop As Boolean)
        SnowParticle = New SnowParticle1X1()
        SnowParticle.X = Int(_Width * Rnd())
        If FromTop Then
            SnowParticle.Y = 2
        Else
            SnowParticle.Y = Int(_Height * Rnd(Now.Millisecond))
            Dim _GoodPixel As Boolean = True
            Do While _GoodPixel = True
                If _Bitmap1x1.GetPixel(SnowParticle.X, SnowParticle.Y).Equals(_BlackPixel) Then
                    _GoodPixel = False
                Else
                    SnowParticle.Y = Int(_Height * Rnd(Now.Millisecond))
                    SnowParticle.X = Int(_Width * Rnd(Now.Millisecond))
                End If
            Loop
        End If
    End Sub

    Private Sub NewParticle2x2(ByRef SnowParticle As SnowParticle2x2, ByVal FromTop As Boolean)
        SnowParticle = New SnowParticle2x2()
        SnowParticle.X = Int(_Width * Rnd())
        If FromTop Then
            SnowParticle.Y = 2
        Else
            SnowParticle.Y = Int(_Height * Rnd(Now.Millisecond))
        End If
    End Sub

    Private Sub NewParticle3x3(ByRef SnowParticle As SnowParticle3x3, ByVal FromTop As Boolean)
        SnowParticle = New SnowParticle3x3()
        SnowParticle.X = Int(_Width * Rnd())
        If FromTop Then
            SnowParticle.Y = 2
        Else
            SnowParticle.Y = Int(_Height * Rnd(Now.Millisecond))
        End If
    End Sub

    Private Sub CheckSnowHeight(ByRef SnowParticle As SnowParticle1X1)
        If _CurrentSnowHeight > (_Width * _SnowHeight * _MaxParticles) Then
            DrawNewParticle(SnowParticle, _BlackPixel)
        End If
        NewParticle1x1(SnowParticle, True)
    End Sub

    Private Sub DrawNewParticle(ByRef SnowParticle As SnowParticle1X1, ByVal Color As Color)
        _Bitmap1x1.SetPixel(SnowParticle.X, SnowParticle.Y, Color)
    End Sub

    Private Sub DrawParticle2x2(ByRef SnowParticle As SnowParticle2x2)
        _Bitmap2x2.SetPixel(SnowParticle.X, SnowParticle.Y, Color.White)
        _Bitmap2x2.SetPixel(SnowParticle.X + 1, SnowParticle.Y, Color.White)
        _Bitmap2x2.SetPixel(SnowParticle.X + 1, SnowParticle.Y + 1, Color.White)
        _Bitmap2x2.SetPixel(SnowParticle.X, SnowParticle.Y + 1, Color.White)
    End Sub

    Private Sub DrawParticle3x3(ByRef SnowParticle As SnowParticle3x3)
        For intheight As Integer = 0 To SnowParticle.Size.Height - 1
            For intwidth As Integer = 0 To SnowParticle.Size.Width - 1
                If SnowParticle.X + intwidth < _Width AndAlso SnowParticle.Y + intheight < _Height Then
                    If (intheight = 0 And intwidth = 0) OrElse (intwidth = SnowParticle.Size.Width - 1 And intheight = SnowParticle.Size.Height - 1) OrElse (intheight = 0 And intwidth = SnowParticle.Size.Width - 1) OrElse (intwidth = 0 And intheight = SnowParticle.Size.Height - 1) Then
                        _Bitmap2x2.SetPixel(SnowParticle.X + intwidth, SnowParticle.Y + intheight, Color.DarkGray)
                    Else
                        _Bitmap2x2.SetPixel(SnowParticle.X + intwidth, SnowParticle.Y + intheight, Color.WhiteSmoke)
                    End If
                End If
            Next
        Next
    End Sub

    Private Sub DrawOldParticle(ByRef SnowParticle As SnowParticle1X1, ByVal Color As Color)
        _Bitmap1x1.SetPixel(SnowParticle.OldX, SnowParticle.OldY, Color)
    End Sub

    Private Sub _Timer_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles _Timer.Tick
        DrawSnow()
    End Sub
End Class

Christiaan Baes
Belgium

"My new site" - Me
 
BTW this is for the 2.0 framwork. Just leave out the generic collection to get it to work in the previous versions of the framework.

Now we have the snow particles. One Abstract class and 3 subclasse that are drawn on the screen.


Code: 
Public MustInherit Class SnowParticle
    Protected _X As Integer
    Protected _Y As Integer
    Protected _OldX As Integer
    Protected _OldY As Integer
    Protected _Stopped As Integer
    Protected _Size As Size
    
    Public Property Size() As Size
        Get
            Return _Size
        End Get
        Set(ByVal value As Size)
            _Size = value
        End Set
    End Property

    Public Property X() As Integer
        Get
            Return _X
        End Get
        Set(ByVal value As Integer)
            _X = value
        End Set
    End Property

    Public Property Y() As Integer
        Get
            Return _Y
        End Get
        Set(ByVal value As Integer)
            _Y = value
        End Set
    End Property

    Public Property OldX() As Integer
        Get
            Return _OldX
        End Get
        Set(ByVal value As Integer)
            _OldX = value
        End Set
    End Property

    Public Property OldY() As Integer
        Get
            Return _OldY
        End Get
        Set(ByVal value As Integer)
            _OldY = value
        End Set
    End Property

    Public Property Stopped() As Integer
        Get
            Return _Stopped
        End Get
        Set(ByVal value As Integer)
            _Stopped = value
        End Set
    End Property

    Public Sub New()

    End Sub

   
End Class

Code: 
Public Class SnowParticle1X1
    Inherits SnowParticle

    Public Sub New()
        _Size = New Size(1, 1)
        _OldX = 0
        _OldY = 0
        _Stopped = 0
    End Sub

End Class

Code: 
Public Class SnowParticle2x2
    Inherits SnowParticle

    Public Sub New()
        _Size = New Size(2, 2)
        _OldX = 0
        _OldY = 0
        _Stopped = 0
    End Sub

End Class

Code: 
Public Class SnowParticle3x3
    Inherits SnowParticle

    Public Sub New()
        _Size = New Size(3, 3)
        _OldX = 0
        _OldY = 0
        _Stopped = 0
    End Sub

End Class

Christiaan Baes
Belgium

"My new site" - Me
 
Considering this is a panel you can add controls to it the snow will just continue falling in the background you can even see it if the control has a transparent background.

But if you want the 1x1 size particles to mass on top of the control you implement the Isnowable interface.
and inherit from any of the other controls or make your owncontrol


Code: 
Public Interface ISnowable
    Sub DrawOnBitmap(ByRef BackgroundBitmap As Bitmap)
End Interface

and this is a label I made to work with it


Code: 
Public Class SnowableLabel
    Inherits System.Windows.Forms.Label
    Implements ISnowable

    Public Sub DrawOnBitmap(ByRef BackgroundBitmap As Bitmap) Implements ISnowable.DrawOnBitmap
        If TypeOf Me.Parent Is Snowing Then
            Dim objGraphics1 As Graphics
            objGraphics1 = Graphics.FromImage(BackgroundBitmap)
            Dim strSize As SizeF = objGraphics1.MeasureString(Text, Font)
            objGraphics1.DrawString(Text, Font, New SolidBrush(ForeColor), Me.Location.X, Me.Location.Y)
            objGraphics1.Dispose()
        End If
    End Sub
End Class

The controls will be made invisible wich would not be advisible in the case of a button so I think the inteface needs another property namely (remainvisible) but that is for the beta release (next year).

and then just add the panel to the form (after a rebiuld it should showup in the toolbox if you are using VS)
and add this to the load event


Code: 
 Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Me.Snowing1.InitSnow()
    End Sub

people who want to play with it go right ahead.

Christiaan Baes
Belgium

"My new site" - Me
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top