-
[VB6] - Fireworks.
Code:
Option Explicit
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundW" (ByVal lpszName As Long, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Const SND_ASYNC = &H1
Private Const pi = 3.14
Private Function Draw(v As Long, cc As Long) As Boolean
Dim dh As Single, c As Single, d As Single, x As Single, y As Single, w As Long, i As Long, dx As Single, dy As Single, _
gr As Single, r As Single, g As Single, b As Single, n As String
Rnd v: cc = cc + 2
If cc <= 0 Then
Exit Function
ElseIf cc <= 100 Then
If cc = 2 Then n = App.Path & "\1.wav": PlaySound StrPtr(n), 0, SND_ASYNC
dh = 100 / cc: x = Rnd * 0.75 + 0.125 + (cc * ((v And 2) - 1)) / 1000: y = Sin((cc - 2) / 200 * pi) * 0.75
w = 21 - cc * 0.2: d = 255 / w: c = 0
Do: c = 255 / w: DrawWidth = w: PSet (x, y), RGB(c, c, 0): w = w - 1: Loop While w
ElseIf cc < 300 Then
If cc = 102 Then n = App.Path & "\0.wav": PlaySound StrPtr(n), 0, SND_ASYNC
dh = (cc - 100) / 200: gr = (1 - Cos(dh * pi * 0.25)) * dh: dx = Rnd * 0.75 + 0.125 + ((v And 2) - 1) / 10
dy = 0.75 - gr: i = Rnd * 100 + 200: gr = 1 - 0.2 ^ (dh * 5): dh = 1 - dh
r = Rnd * 0.8 + 0.2: g = Rnd * 0.8 + 0.2: b = Rnd * 0.8 + 0.2
If cc < 150 Then
b = (1 - (cc - 100) / 50) * 3
For w = (cc - 100) * 2 To 1 Step -1
DrawWidth = w * 5: c = cc / w * b: PSet (dx, dy), RGB(c * r, c * g, c * b)
Next
End If
Do While i
c = Rnd * pi * 2: d = gr * (Rnd * 0.8 + 0.2) * 0.5: x = Cos(c) * d + dx: y = Sin(c) * d + dy
w = (dh * 6) * Abs(Sin((cc + i) / 10 * pi)) + 1: c = 0
Do: c = 512 / w * dh: DrawWidth = w: PSet (x, y), RGB(c * r, c * g, c * b): w = w - 1: Loop While w
i = i - 1
Loop
Else: Draw = True: cc = 0: v = v - Rnd * 100
End If
End Function
Private Sub Form_Click()
Unload Me
End Sub
Private Sub Form_Load()
Randomize
End Sub
Private Sub Form_Resize()
Scale (0, 1)-(1, 0)
End Sub
Private Sub tmrTimer_Timer()
Static a1 As Long, a2 As Long, c1 As Long, c2 As Long
If a1 = 0 Then a1 = -(Rnd * 100) - 1: a2 = a1 - 2: c2 = -150
Call Cls: Draw a1, c1: Draw a2, c2
End Sub
Download source code and resources.
