Animasi Salju

- 1 Form
- 1 Module
- 1 Timer, Interval = 500, Enabled = False
-------------------------------------------------------------------------------------------
Ketikan pada Module
-------------------------------------------------------------------------------------------
Type xParticle
X As Integer
Y As Integer
oldX As Integer
oldY As Integer
iStopped As Integer
End Type

Global Const MAXP = 400

Global Const PSIZE = 1

Global Snow(0 To MAXP) As xParticle
-------------------------------------------------------------------------------------------
Ketikan pada Form
-------------------------------------------------------------------------------------------
Dim bRUN As Boolean

Dim fMouseDown_X As Single
Dim fMouseDown_Y As Single
Dim bMOUSE_DOWN As Boolean
-------------------------------------------------------------------------------------------
Private Sub Form_Load()

Randomize

Me.ScaleMode = vbPixels
Me.DrawWidth = PSIZE
Me.BackColor = vbBlack

Dim i As Integer

For i = 0 To MAXP
Snow(i).X = CInt(Int(Me.ScaleWidth * Rnd))
Snow(i).Y = CInt(Int(Me.ScaleHeight * Rnd))
Next i

bRUN = True
Timer1.Enabled = True

Const sTEXT = "R e a l S n o w"
Me.ForeColor = vbRed
Me.CurrentX = Me.ScaleWidth / 2 - TextWidth(sTEXT) / 2
Me.CurrentY = Me.ScaleHeight / 2 - TextHeight(sTEXT) / 2 - 5
Me.Print sTEXT

Const sTEXT2 = "aziel_wika@yahoo.co.id"
Me.CurrentX = Me.ScaleWidth / 2 - TextWidth(sTEXT2) / 2
Me.CurrentY = Me.ScaleHeight / 2 + TextHeight(sTEXT2) + 2
Me.Print sTEXT2

Me.ForeColor = vbWhite

End Sub
-------------------------------------------------------------------------------------------
Sub DrawSnow()
Dim i As Integer

Dim newX As Integer
Dim newY As Integer

Timer1.Enabled = False

Do While bRUN

For i = 0 To MAXP
Me.PSet (Snow(i).oldX, Snow(i).oldY), vbBlack
Me.PSet (Snow(i).X, Snow(i).Y)
Next i

For i = 0 To MAXP
Snow(i).oldX = Snow(i).X
Snow(i).oldY = Snow(i).Y

newX = Snow(i).X + Int(2 * Rnd)
newX = newX - Int(2 * Rnd)

If newX < newx =" 0">= Me.ScaleWidth Then newX = Me.ScaleWidth - 1

newY = Snow(i).Y + 1

If Me.Point(newX, newY) = vbBlack Then
Snow(i).Y = newY
Snow(i).X = newX
Else
If Snow(i).iStopped = 10 Then ' if stopped 10 times, make new!

If Me.Point(Snow(i).X + 1, Snow(i).Y + 1) = vbBlack Then
Snow(i).X = Snow(i).X + 1
Snow(i).Y = Snow(i).Y + 1
Snow(i).iStopped = 0
ElseIf Me.Point(Snow(i).X - 1, Snow(i).Y + 1) = vbBlack Then
Snow(i).X = Snow(i).X - 1
Snow(i).Y = Snow(i).Y + 1
Snow(i).iStopped = 0
Else
newParticle (i)
End If

Else
Snow(i).iStopped = Snow(i).iStopped + 1
End If
End If

If (Snow(i).Y) >= Me.ScaleHeight Then
newParticle (i)
End If

Next i

DoEvents
Loop

End Sub
-------------------------------------------------------------------------------------------
Sub newParticle(i As Integer)
Snow(i).X = CInt(Int(Me.ScaleWidth * Rnd))
Snow(i).Y = 0
Snow(i).oldX = 0
Snow(i).oldY = 0
Snow(i).iStopped = 0
End Sub
-------------------------------------------------------------------------------------------
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Me.PSet (X, Y)
bMOUSE_DOWN = True
fMouseDown_X = X
fMouseDown_Y = Y
End Sub
-------------------------------------------------------------------------------------------
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
If bMOUSE_DOWN Then
Dim oldDW As Long
Dim oldFC As Long
oldDW = Me.DrawWidth
oldFC = Me.ForeColor
Me.DrawWidth = 3
Me.ForeColor = vbRed
Me.Line (fMouseDown_X, fMouseDown_Y)-(X, Y)
fMouseDown_X = X
fMouseDown_Y = Y
Me.DrawWidth = oldDW
Me.ForeColor = oldFC
End If
End Sub
-------------------------------------------------------------------------------------------
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
bMOUSE_DOWN = False
End Sub
-------------------------------------------------------------------------------------------
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
bRUN = False
End Sub
-------------------------------------------------------------------------------------------
Private Sub Timer1_Timer()
DrawSnow
End Sub