Wednesday, December 23, 2020

Happy Holidays !

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


No comments:

Post a Comment