Animasi ini memunculkan sebuah kembang Api yang meluncur dari bawah keatas kemudian meledak menjadi partikel-partikel kecil yang berwarna-warni.
 |
| ScreenShoot |
Untuk membuat Animasi tersebut diatas sangat mudah, Anda cukup menambahkan Control Tmer pada Form dengan Interval=100, kemudian copy kan kode dibawah ini dijendela kode kosong dibagian (General) - (Declarations) :
Option Explicit
Dim fireworkX As Single
Dim fireworkY As Single
Dim particles(100) As Variant ' Array untuk partikel
Dim colors(100) As Long ' Array untuk warna partikel
Dim angles(100) As Single ' Array untuk sudut partikel
Dim speeds(100) As Single ' Array untuk kecepatan partikel
Dim explosionStage As Integer ' Tahap animasi (naik atau meledak)
Private Sub Form_Load()
' Set ukuran form
Me.ScaleMode = vbPixels
Me.Width = 8000
Me.Height = 6000
Form1.WindowState = 2
Form1.BackColor = vbBlack
Timer1.Interval = 100
' Inisialisasi
Call InitFirework
Timer1.Enabled = True
Timer1.Interval = 10
Me.Caption = "Animasi Kembang Api"
End Sub
Private Sub Timer1_Timer()
' Bersihkan layar
Me.Cls
Select Case explosionStage
Case 0 ' Tahap naik
If fireworkY > Me.ScaleHeight / 2 Then
fireworkY = fireworkY - 20
Me.Circle (fireworkX, fireworkY), 10, RGB(255, 255, 0)
Else
' Mulai tahap ledakan
explosionStage = 1
InitFireworkParticles ' Inisialisasi partikel
End If
Case 1 ' Tahap ledakan
DrawParticles
' Cek apakah partikel telah selesai
If IsExplosionComplete Then
InitFirework ' Reset untuk animasi berikutnya
End If
End Select
End Sub
Private Sub InitFirework()
' Inisialisasi kembang api
fireworkX = Rnd * Me.ScaleWidth
fireworkY = Me.ScaleHeight
explosionStage = 0 ' Mulai dari tahap naik
End Sub
Private Sub InitFireworkParticles()
Dim i As Integer
For i = 0 To 99
' Tentukan posisi awal partikel
particles(i) = Array(fireworkX, fireworkY)
' Warna acak
colors(i) = RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
' Sudut acak (0 hingga 360 derajat, dalam radian)
angles(i) = Rnd * 2 * 3.14159
' Kecepatan acak (antara 2 hingga 7)
speeds(i) = Rnd * 5 + 2
Next i
End Sub
Private Sub DrawParticles()
Dim i As Integer
Dim x As Single
Dim y As Single
Dim particleSize As Single
particleSize = 1.5 ' Ukuran partikel (bisa disesuaikan)
For i = 0 To 99
' Hitung posisi baru partikel
x = particles(i)(0) + Cos(angles(i)) * speeds(i)
y = particles(i)(1) + Sin(angles(i)) * speeds(i)
' Update posisi partikel
particles(i) = Array(x, y)
' Gambar partikel sebagai lingkaran kecil
Me.Circle (x, y), particleSize, colors(i)
Next i
End Sub
Private Function IsExplosionComplete() As Boolean
' Cek apakah semua partikel telah keluar dari layar
Dim i As Integer
Dim allOutOfBounds As Boolean
allOutOfBounds = True
For i = 0 To 99
If particles(i)(0) >= 0 And particles(i)(0) <= Me.ScaleWidth And _
particles(i)(1) >= 0 And particles(i)(1) <= Me.ScaleHeight Then
allOutOfBounds = False
Exit For
End If
Next i
IsExplosionComplete = allOutOfBounds
End Function
Simpan dan jalankan Project Anda
No comments:
Post a Comment