Download from Yandex
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