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


Monday, December 7, 2020

See matrix content in pure ASCII: Show an array content in the console !

Source: Gagniuc, Paul A. (2017). Markov Chains: From Theory to Implementation and Experimentation. USA, NJ: John Wiley & Sons. pp. 1–235. ISBN 978-1-119-38755-8.

Function MatrixPaint(w, d, ByVal m As Variant, a, n, ByVal msg As String) As String
    
    Dim e() As String
    ReDim e(1 To d) As String
    
    d = Len(a)
    q = "|     "
    h = "|_____|"
    l = vbCrLf
    
    For i = (w - 1) To d
        If i = (w - 1) Then t = t & l & "."
        t = t & "_____."
        If i = d Then t = t & l & "| " & n & " |  "
    Next i

    For i = w To d
        e(i) = Mid(a, i, 1)
        t = t & e(i) & "  |  "
        h = h & "_____|"
    Next i
    
    t = t & l & h & l
    
    For i = w To d
        For j = w To d
            v = Round(m(i, j), 2)
            u = Mid(q, 1, Len(q) - Len(v))
            If j = d Then o = "|" Else o = ""
            For b = w To d
                If j = w And i = b Then
                    t = t & "|  " & e(i) & "  "
                End If
            Next b
            t = t & u & v & o
        Next j
    t = t & l & h & l
    Next i
    
    MatrixPaint = msg & " M[" & Val(d - w + 1) & "," & Val(d - w + 1) & "]" & l & t & l
    
End Function