Membuat Efek Ledakan Kembang Api Dengan kode VB6

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