Snow




'these are global

Dim flake(150) As snow
Dim side As Integer
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim index As Integer
Dim index2 As Integer
Dim floor() As ground
Dim bottom As Integer
Dim size As Integer
'formload event


Private Sub Form_Load()
Randomize
bottom = Screen.Height - 300
side = Screen.Width
ReDim floor(side)
Label1.Top = worldfrm.Top + (worldfrm.Height - 100)
'this will make your flakes

For index = 0 To 150
Call makesnow(index)
Next
'this will track the snow on the ground

For index = 0 To side
floor(index).color = vbBlack
floor(index).gx = index
floor(index).gy = bottom
Next
'this is where the action takes place interval 300

Timer1.Enabled = True
End Sub

'function to make snow


Public Sub makesnow(index As Integer)
Dim xpos As Integer
Dim ypos As Integer
Dim zpos As Integer
'random positions for flakes

xpos = Rnd * side
ypos = (Rnd * (bottom - 20))
zpos = Rnd * 3
flake(index).sx = xpos
flake(index).sy = ypos
flake(index).sz = zpos
If flake(index).sz = 0 Then
flake(index).sv = 30
ElseIf flake(index).sz = 1 Then
flake(index).sv = 20
ElseIf flake(index).sz = 2 Then
flake(index).sv = 10
Else
flake(index).sv = 5
End If
End Sub

'erase old snow flakes


Public Sub oldsnow()
For index = 0 To 150
size = flake(index).sz + 1
worldfrm.DrawWidth = size
PSet (flake(index).sx, flake(index).sy), vbBlack
'Circle (flake(index).sx, flake(index).sy),

'flake(index).sz + 1, vbBlack

Next
End Sub

' draw new flakes


Public Sub newsnow()
For index = 0 To 150
size = flake(index).sz + 1
'Circle (flake(index).sx, flake(index).sy),

'flake(index).sz + 1, vbWhite

worldfrm.DrawWidth = size
PSet (flake(index).sx, flake(index).sy), vbWhite
Next
End Sub

'plot new position of snow


Public Sub movesnow()
Dim wind As Integer
For index = 0 To 150
'determine if there is wind

wind = Rnd * 4
flake(index).sy = flake(index).sy + flake(index).sv
If wind = 1 Then
flake(index).sx = flake(index).sx + flake(index).sv
ElseIf win = 2 Then
flake(index).sx = flake(index).sx - flake(index).sv
ElseIf wind = 3 Then
flake(index).sx = flake(index).sx + (flake(index).sv * 2)
ElseIf wind = 4 Then
flake(index).sx = flake(index).sx - (flake(index).sv * 2)
End If
'if flakes go offsides then wrap around

If flake(index).sx >= side Then
flake(index).sx = 0
End If
If flake(index).sx <= 0 Then
flake(index).sx = side
End If
'flakes on the ground??

index2 = flake(index).sx
If flake(index).sy >= floor(index2).gy Then
PSet (flake(index).sx, flake(index).sy), vbWhite
floor(flake(index).sx).gy = floor(flake(index).sx).gy - 1
Call makesnow(index)
End If
'flakes on label1???

If (flake(index).sy >= Label1.Top) And (flake(index).sx <= Label1.Width) Then
PSet (flake(index).sx, flake(index).sy), vbWhite
Call makesnow(index)
End If
Next
End Sub

' the main event loopp for processing


Private Sub Timer1_Timer()
Call oldsnow
Call movesnow
Call newsnow
End Sub

'this is the module stuff user type snow, holds your snow..


Public Type snow
sx As Integer
sy As Integer
sz As Integer
sv As Integer
End Type

'user type ground, go figure...


Public Type ground
gy As Integer
gx As Integer
color As ColorConstants
End Type
Inputs:
you need just a form set to black background
and a label1 and a timer.
you will also need to place a module in your project.












( snow.html )- by Paolo Puglisi - Modifica del 17/12/2023