The Mother of All Windows Books/CD-MOM.iso/cd_mom/newsletr/vbz/vbz1-3/spyro2.bas

BASIC Source File | 1993-06-19 | 6KB | 221 lines

    DefDbl A-Z
    Dim Ratio, TwoPi, ScrHeight, ScrWidth, CLSFlag%
    Dim Largest, Smallest, ErasePoly, NomSize


Global Const AppName$ = "Spyrograph"

Sub CleanUp ()
    For Z = frmSave!Picture1.Left To -15 Step -180
        If Z > 180 Then
            frmSave!Picture1.Left = Z
        Else
            frmSave!Picture1.Left = -15
        End If
    Next
    Unload frmSave
    End
End Sub

Sub DrawPoly (Order, h, v, Size)

    k2 = TwoPi / Order
    ReDim IAry(0 To Order - 1)
    Shuffle IAry()
    For p = 0 To Order - 1
        i = IAry(p)
        k3 = k2 * i
        X = (Size * Sin(k3) * Ratio) + h
        y = (Size * Cos(k3)) + v
        '
        ' Draw the vertex connections alternately
        ' clockwise and counterclockwise, on a
        ' random basis.
        '
        If Rnd > .5 Then    ' about half the time
            For j = i + 1 To Order - 1
                GoSub InnerLoop
            Next j
        Else
            For j = Order - 1 To i + 1 Step -1
                GoSub InnerLoop
            Next j
        End If
    Next
    Exit Sub

InnerLoop:
    k3 = k2 * j
    x1 = (Size * Sin(k3)) * Ratio + h
    y1 = (Size * Cos(k3)) + v
    frmSave.Line (X, y)-(x1, y1)
    Z = DoEvents()
    Return

End Sub

Sub InitSave ()
    ScreenCapture  'captures the screen into the saver form
    frmSave!Picture1.Picture = frmSave.Image
    frmSave!Picture1.Top = -15
    Select Case Screen.Width \ Screen.TwipsPerPixelX
        Case Is > 800
            frmSave.Picture = frmSave!picSSVGA.Picture
        Case Is > 640
            frmSave.Picture = frmSave!picSVGA.Picture
        Case Else
            frmSave.Picture = frmSave!picVGA.Picture
    End Select
    frmSave.Show
    frmSave!timSave.Enabled = True
    ScrHeight = frmSave.Height
    ScrWidth = frmSave.Width
    Ratio = 1  ' Aspect ratio, =1 for "square" pixels
    ReScale    ' choose appropriate sizes
End Sub

Sub Outer ()
'
' This is where the action takes place.
'

    Randomize
    TwoPi = 6.283185317
    OnScreen% = 0       ' number currently on screen
    Do While DoEvents()
        ' Select a polygon "order" based on the current
        ' lowest and highest allowable values.  See
        ' "ReScale" for how Lowest and Highest are set
        '
        Order = Int(Rnd * (Largest - Smallest + 1)) + Smallest
        '
        ' Choose a random color some distance from the
        ' current color
        '
ReColor:
        Do
            Colr% = Int(Rnd * 16)
        Loop While Abs(Colr% - PrevColr%) < 6
        '
        ' Don't allow BackColor unless the screen
        ' has at least 10 polygons already on it
        '
        If QBColor(Colr%) = BackColor Then
            If OnScreen% < 10 Then
                GoTo ReColor
            End If
        End If
        PrevColr% = Colr%
        frmSave.ForeColor = QBColor(Colr%)
        '
        ' Every so often (maybe 10% of the time)
        ' erase the images by drawing a special
        ' polygon (of order "ErasePoly") in Black
        '
        If Rnd > .9 Then
            '
            ' But only do that if there are at least
            ' 10 polygons already drawn.  Otherwise
            ' just draw a new polygon over the last.
            '
            If OnScreen% > 10 Then
                frmSave.ForeColor = 0
                Order = ErasePoly
                Bigger = ScrWidth
                If ScrHeight > Bigger Then
                    Bigger = ScrHeight
                End If
                Size = Bigger / (1.42 * Ratio)
                h = ScrWidth / 2
                v = ScrHeight / 2
                OnScreen% = 0
            End If
        ElseIf Rnd > .07 Then
            '
            ' Most of the time (roughly 93%), choose
            ' a new size and position for the newest
            ' polygon.
            '
            Size = NomSize / (((Rnd * 2.5) + 2) / 1.2)
            h = (Rnd * ScrWidth)        ' keep the center
            v = (Rnd * ScrHeight)       '   on the screen
            OnScreen% = OnScreen% + 1   ' count this one
        End If
        '
        ' Now draw the polygon
        '
        Call DrawPoly(Order, h, v, Size)
        '
        ' If this was an ErasePoly, clear its rubble
        '
        If OnScreen% = 0 Then
            frmSave.Cls
            Temp& = Timer 'put a little pause in there
            While DoEvents() And ((Timer - Temp&) < 3)
            Wend
        End If
    Loop
End Sub

Sub ReScale ()
    NomSize = Sqr(ScrWidth * ScrHeight)
    If frmSave.WindowState = 1 Then 'if minimized, restrict range
        Smallest = 3
        Largest = 15
        ErasePoly = 30
    Else
        tmp = ScrWidth
        If ScrHeight < NomSize Then
            tmp = ScrHeight
        End If
        tmp = CInt(tmp / 900)
        If tmp < 5 Then
            tmp = 5
        End If
        Largest = tmp * 6
        Smallest = 3
        ErasePoly = CInt(Sqr(NomSize)) And Not 1
    End If
End Sub

Sub Shuffle (IAry())

' Randomize the order in which the vertices are accessed.
' IAry() is an array containing vertex numbers.

    k% = UBound(IAry)
    '
    ' Self-fill the array: I(9)=9, e.g.
    '
    For m% = 0 To k%
        IAry(m%) = m%
    Next
    '
    ' Most of the time (about 90%), randomize the order
    ' in which the points will be accessed, but once
    ' in a while, let it happen in order.
    '
    If Rnd > .1 Then
        LastJ% = -1
        For m% = 0 To k%
            Do
                j% = Int(Rnd * (k% + 1))
            Loop Until (j% <> m%) And (j% <> LastJ%)
            LastJ% = j%
            tmp = IAry(j%)
            IAry(j%) = IAry(m%)
            IAry(m%) = tmp
        Next
    End If
End Sub

Sub TimerProc ()
    TimeToGo = False
    frmSave.Picture1.Left = frmSave.Picture1.Left + 30
    If frmSave.Picture1.Left >= frmSave.ScaleWidth Then
        frmSave!timSave.Enabled = False
        Outer
    End If
End Sub