Programmer 7500/MAX_PROGRAMMERS.iso/VISUAL_B/CODIGO_1/SCRNSAVE/BACKGRND.FRM

Visual Basic Form | 1993-04-16 | 41.4 KB | 1,183 lines

VERSION 2.00
Begin Form BackGround
   BackColor       =   &H00000000&
   BorderStyle     =   0  'None
   ControlBox      =   0   'False
   Height          =   2976
   Icon            =   BACKGRND.FRX:0000
   Left            =   864
   LinkTopic       =   "Form1"
   ScaleHeight     =   213
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   478
   Top             =   1260
   Width           =   5832
   Begin Timer Tick
      Interval        =   50
      Left            =   10
      Top             =   10
   End
' BackGround -- this form expands to fill the whole
'   screen and is used as the back drop for all the
'   drawing
Option Explicit
' variables declared here
Dim lastX, lastY            ' Last position of the moves
Dim LastTime As Long
Dim CurrentTime As Long
Dim LinkTime As Long
Dim PlotType As Integer
Dim PlotInit As Integer
Dim RepeatIndex As Integer
Dim Pointer As Integer
Dim Mirror As Integer
Dim x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer
Dim vx1 As Single, vy1 As Single, vx2 As Single, vy2 As Single
Dim ax1 As Single, ax2 As Single, ay1 As Single, ay2 As Single
Dim l As Long
Dim m As Long
Dim MaxSpeedX As Integer, MaxSpeedY As Integer
Dim TimeInterval As Long
Dim MaxTime As Long
Dim Repeats As Integer
Dim i As Integer
Dim BoxHeight As Integer, BoxWidth As Integer
Dim DC As Integer
Dim Pattern As Long, Locked As Integer
Dim Direction As Integer
'Allocate Memory
Dim x1a() As Integer
Dim x2a() As Integer
Dim y1a() As Integer
Dim y2a() As Integer
Dim x1da() As Integer
Dim x2da() As Integer
Dim y1da() As Integer
Dim y2da() As Integer
Dim x1sa() As Single
Dim x2sa() As Single
Dim y1sa() As Single
Dim y2sa() As Single
Dim vx1sa() As Single
Dim vx2sa() As Single
Dim vy1sa() As Single
Dim vy2sa() As Single
Dim ax1sa() As Single
Dim ax2sa() As Single
Dim ay1sa() As Single
Dim ay2sa() As Single
Dim Colors() As Long
Dim DataPts() As Integer
Dim MaxPlotType As Integer
Sub Circles ()
  ' have a single elipse trace across the
  ' screen with multiple previous copies following
  ' it
  Dim i As Integer, j As Integer, k As Integer, N As Integer
  Dim xRadius As Integer, yRadius As Integer
  ' if first time then initialize
  If PlotInit = False Then
    PlotInit = True
    Cls
    Forecolor = QBColor(15)
    'Set array size and clear the elements
    ReDim x1a(MaxLines) As Integer
    ReDim x2a(MaxLines) As Integer
    ReDim y1a(MaxLines) As Integer
    ReDim y2a(MaxLines) As Integer
    Pointer = 1     ' start with array element 1
    ' set index to count number of times to repeat color
    '   to past maxvalue so that it will be recalculated
    RepeatIndex = MaxLines + 1
    'determine initial position of line
    x1 = Rnd * ScaleWidth
    x2 = Rnd * ScaleWidth
    y1 = Rnd * ScaleHeight
    y2 = Rnd * ScaleHeight
    'set initial velocity
    vx1 = 0
    vx2 = 0
    vy1 = 0
    vy2 = 0
    'set initial acceleration
    ax1 = 0
    ax2 = 0
    ay1 = 0
    ay2 = 0
    'find background color
    m = QBColor(0)
    'Calculate velocity limits
    MaxSpeedX = ScaleWidth * 15! / 800
    MaxSpeedY = ScaleWidth * 15! / 600
  Else  ' put run code here
    ' check if time to get a new color
    If RepeatIndex > RepeatCount Then
        ' use rgb function
        i = Rnd * 255: If i > 255 Then i = 255
        j = Rnd * 255: If j > 255 Then j = 255
        k = Rnd * 255: If k > 255 Then k = 255
        l = RGB(i, j, k)
        RepeatIndex = 1
    Else
        RepeatIndex = RepeatIndex + 1
    End If
        'Delete original circle
        xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
        yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
        If xRadius <> 0 Then
            Circle ((x1a(Pointer) + x2a(Pointer)) / 2, (y1a(Pointer) + y2a(Pointer)) / 2), xRadius, m, , , yRadius / xRadius
        End If
        'Save New Circle
        x1a(Pointer) = x1
        x2a(Pointer) = x2
        y1a(Pointer) = y1
        y2a(Pointer) = y2
        'Draw new Circle
        xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
        yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
        If xRadius <> 0 Then
            Circle ((x1a(Pointer) + x2a(Pointer)) / 2, (y1a(Pointer) + y2a(Pointer)) / 2), xRadius, l, , , yRadius / xRadius
        End If
        'Move pointer to next item
        Pointer = Pointer + 1
        If Pointer > MaxLines Then
            Pointer = 1
        End If
        'determine new acceleration
        ax1 = Rnd - .5
        ax2 = Rnd - .5
        ay1 = Rnd - .5
        ay2 = Rnd - .5
        'calculate new position
        x1 = x1 + vx1
        x2 = x2 + vx2
        y1 = y1 + vy1
        y2 = y2 + vy2
        'calculate new velocity
        vx1 = (vx1 + ax1): If Abs(vx1) > MaxSpeedX Then vx1 = 0: ax1 = 0
        vx2 = (vx2 + ax2): If Abs(vx2) > MaxSpeedX Then vx2 = 0: ax2 = 0
        vy1 = (vy1 + ay1): If Abs(vy1) > MaxSpeedY Then vy1 = 0: ay1 = 0
        vy2 = (vy2 + ay2): If Abs(vy2) > MaxSpeedY Then vy2 = 0: ay2 = 0
        'check if off screen
        If (x1 > ScaleWidth) Then
            'change direction
            vx1 = -Abs(vx1)
        ElseIf (x1 < 0) Then
            'change direction
            vx1 = Abs(vx1)
        End If
        If (y1 > ScaleHeight) Then
            'change direction
            vy1 = -Abs(vy1)
        ElseIf (y1 < 0) Then
            'change direction
            vy1 = Abs(vy1)
        End If
        If (x2 > ScaleWidth) Then
            'change direction
            vx2 = -Abs(vx2)
        ElseIf (x2 < 0) Then
            'change direction
            vx2 = Abs(vx2)
        End If
        If (y2 > ScaleHeight) Then
            'change direction
            vy2 = -Abs(vy2)
        ElseIf (y2 < 0) Then
            'change direction
            vy2 = Abs(vy2)
        End If
  End If
End Sub
Sub ClearArrays ()
        'clear arrays
        ReDim x1a(0) As Integer
        ReDim x2a(0) As Integer
        ReDim y1a(0) As Integer
        ReDim y2a(0) As Integer
        ReDim x1da(0, 0) As Integer
        ReDim x2da(0, 0) As Integer
        ReDim y1da(0, 0) As Integer
        ReDim y2da(0, 0) As Integer
        ReDim x1sa(0) As Single
        ReDim x2sa(0) As Single
        ReDim y1sa(0) As Single
        ReDim y2sa(0) As Single
        ReDim vx1sa(0) As Single
        ReDim vx2sa(0) As Single
        ReDim vy1sa(0) As Single
        ReDim vy2sa(0) As Single
        ReDim ax1sa(0) As Single
        ReDim ax2sa(0) As Single
        ReDim ay1sa(0) As Single
        ReDim ay2sa(0) As Single
        ReDim Colors(0) As Long
End Sub
Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
    EndScrnsave                 ' End screen blanking
End Sub
Sub Form_Load ()
    ' stretch to full screen
    Move 0, 0, Screen.Width, Screen.Height
    DrawWidth = 1
    'For i = 1 To 10: l = Rnd: Next i' clear first values from Rnd
    Randomize
    ' Initialize variables now
    MaxPlotType = 12
    PlotType = Rnd * (MaxPlotType + 1)' choose random start place
    'PlotType = 8 ' fixed start place
    If PlotType > MaxPlotType Then PlotType = 0
    PlotInit = False
    TimeInterval = 0
    MaxTime = MaxChangeMinutes * 60 + Timer ' calculate time in seconds
    HideMouse
    Repeats = 1 ' number of drawings to make before returning
End Sub
Sub Form_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
    If IsEmpty(lastX) Or IsEmpty(lastY) Then
        lastX = x
        lastY = y
    End If
    '
    ' Only unblank the screen if the mouse moves quickly
    ' enough (more than 2 pixels at one time.
    '
    If Abs(lastX - x) > 2 Or Abs(lastY - y) > 2 Then
        EndScrnsave             ' End screen blanking
    End If
    lastX = x                   ' Remember last position
    lastY = y
End Sub
Sub Kalied ()
  ' have a line and its mirror images trace across the
  ' screen with multiple previous copies following
  ' it
  Dim i As Integer, j As Integer, k As Integer, N As Integer
  Dim xRadius As Integer, yRadius As Integer
  Dim HighMirror As Integer
  ' if first time then initialize
  If PlotInit = False Then
    PlotInit = True
    Cls
    Forecolor = QBColor(15)
    'select mirroring method
    HighMirror = 3
    Mirror = Rnd * HighMirror + 1: If Mirror > HighMirror Then Mirror = 1
    'Set array size and clear the elements
    ReDim x1a(MaxLines) As Integer
    ReDim x2a(MaxLines) As Integer
    ReDim y1a(MaxLines) As Integer
    ReDim y2a(MaxLines) As Integer
    Pointer = 1     ' start with array element 1
    ' set index to count number of times to repeat color
    '   to past maxvalue so that it will be recalculated
    RepeatIndex = MaxLines + 1
    'determine initial position of line
    x1 = Rnd * ScaleWidth
    x2 = Rnd * ScaleWidth
    y1 = Rnd * ScaleHeight
    y2 = Rnd * ScaleHeight
    'set initial velocity
    vx1 = 0
    vx2 = 0
    vy1 = 0
    vy2 = 0
    'set initial acceleration
    ax1 = 0
    ax2 = 0
    ay1 = 0
    ay2 = 0
    'find background color
    m = QBColor(0)
    'Calculate velocity limits
    MaxSpeedX = ScaleWidth * 15! / 800
    MaxSpeedY = ScaleWidth * 15! / 600
  Else  ' put run code here
    ' check if time to get a new color
    If RepeatIndex > RepeatCount Then
        ' use rgb function
        i = Rnd * 255: If i > 255 Then i = 255
        j = Rnd * 255: If j > 255 Then j = 255
        k = Rnd * 255: If k > 255 Then k = 255
        l = RGB(i, j, k)
        RepeatIndex = 1
    Else
        RepeatIndex = RepeatIndex + 1
    End If
        'Delete original Lines
        Select Case Mirror
        Case 1: 'mirror on x and y axis
            Line (x1a(Pointer), y1a(Pointer))-(x2a(Pointer), y2a(Pointer)), m
            Line (ScaleWidth - x1a(Pointer), y1a(Pointer))-(ScaleWidth - x2a(Pointer), y2a(Pointer)), m
            Line (x1a(Pointer), ScaleHeight - y1a(Pointer))-(x2a(Pointer), ScaleHeight - y2a(Pointer)), m
            Line (ScaleWidth - x1a(Pointer), ScaleHeight - y1a(Pointer))-(ScaleWidth - x2a(Pointer), ScaleHeight - y2a(Pointer)), m
        Case 2: 'mirror on Y axis
            Line (x1a(Pointer), y1a(Pointer))-(x2a(Pointer), y2a(Pointer)), m
            Line (ScaleWidth - x1a(Pointer), y1a(Pointer))-(ScaleWidth - x2a(Pointer), y2a(Pointer)), m
        Case 3: 'mirror around center point
            Line (x1a(Pointer), y1a(Pointer))-(x2a(Pointer), y2a(Pointer)), m
            Line (ScaleWidth - x1a(Pointer), ScaleHeight - y1a(Pointer))-(ScaleWidth - x2a(Pointer), ScaleHeight - y2a(Pointer)), m
        Case Else: Mirror = 1' if invalid value set, then change

        End Select
        'Save New Lines
        x1a(Pointer) = x1
        x2a(Pointer) = x2
        y1a(Pointer) = y1
        y2a(Pointer) = y2
        'Draw New Lines
        Select Case Mirror
        Case 1: 'mirror on x and y axis
            Line (x1a(Pointer), y1a(Pointer))-(x2a(Pointer), y2a(Pointer)), l
            Line (ScaleWidth - x1a(Pointer), y1a(Pointer))-(ScaleWidth - x2a(Pointer), y2a(Pointer)), l
            Line (x1a(Pointer), ScaleHeight - y1a(Pointer))-(x2a(Pointer), ScaleHeight - y2a(Pointer)), l
            Line (ScaleWidth - x1a(Pointer), ScaleHeight - y1a(Pointer))-(ScaleWidth - x2a(Pointer), ScaleHeight - y2a(Pointer)), l
        Case 2: 'mirror on Y axis
            Line (x1a(Pointer), y1a(Pointer))-(x2a(Pointer), y2a(Pointer)), l
            Line (ScaleWidth - x1a(Pointer), y1a(Pointer))-(ScaleWidth - x2a(Pointer), y2a(Pointer)), l
        Case 3: 'mirror around center point
            Line (x1a(Pointer), y1a(Pointer))-(x2a(Pointer), y2a(Pointer)), l
            Line (ScaleWidth - x1a(Pointer), ScaleHeight - y1a(Pointer))-(ScaleWidth - x2a(Pointer), ScaleHeight - y2a(Pointer)), l
        Case Else: Mirror = 1' if invalid value set, then change

        End Select
        'Move pointer to next item
        Pointer = Pointer + 1
        If Pointer > MaxLines Then
            Pointer = 1
        End If
        'determine new acceleration
        ax1 = Rnd - .5
        ax2 = Rnd - .5
        ay1 = Rnd - .5
        ay2 = Rnd - .5
        'calculate new position
        x1 = x1 + vx1
        x2 = x2 + vx2
        y1 = y1 + vy1
        y2 = y2 + vy2
        'calculate new velocity
        vx1 = (vx1 + ax1): If Abs(vx1) > MaxSpeedX Then vx1 = 0: ax1 = 0
        vx2 = (vx2 + ax2): If Abs(vx2) > MaxSpeedX Then vx2 = 0: ax2 = 0
        vy1 = (vy1 + ay1): If Abs(vy1) > MaxSpeedY Then vy1 = 0: ay1 = 0
        vy2 = (vy2 + ay2): If Abs(vy2) > MaxSpeedY Then vy2 = 0: ay2 = 0
        'check if off screen
        If (x1 > ScaleWidth) Then
            'change direction
            vx1 = -Abs(vx1)
        ElseIf (x1 < 0) Then
            'change direction
            vx1 = Abs(vx1)
        End If
        If (y1 > ScaleHeight) Then
            'change direction
            vy1 = -Abs(vy1)
        ElseIf (y1 < 0) Then
            'change direction
            vy1 = Abs(vy1)
        End If
        If (x2 > ScaleWidth) Then
            'change direction
            vx2 = -Abs(vx2)
        ElseIf (x2 < 0) Then
            'change direction
            vx2 = Abs(vx2)
        End If
        If (y2 > ScaleHeight) Then
            'change direction
            vy2 = -Abs(vy2)
        ElseIf (y2 < 0) Then
            'change direction
            vy2 = Abs(vy2)
        End If
    End If
End Sub
Sub Kalied2 ()
  ' have a line and its mirror images trace across the
  ' screen with all the previous copies left on the screen
  ' until the maximum is reached and the screen cleared
  Dim i As Integer, j As Integer, k As Integer, N As Integer
  Dim xRadius As Integer, yRadius As Integer
  Dim HighMirror As Integer
  ' if first time then initialize
  If PlotInit = False Then
    PlotInit = True
    Cls
    Forecolor = QBColor(15)
    'select mirroring method
    HighMirror = 3
    Mirror = Rnd * HighMirror + 1: If Mirror > HighMirror Then Mirror = 1
    Pointer = 1     ' set lines on screen to one
    ' set index to count number of times to repeat color
    '   to past maxvalue so that it will be recalculated
    RepeatIndex = MaxLines + 1
    'determine initial position of line
    x1 = Rnd * ScaleWidth
    x2 = Rnd * ScaleWidth
    y1 = Rnd * ScaleHeight
    y2 = Rnd * ScaleHeight
    'set initial velocity
    vx1 = 0
    vx2 = 0
    vy1 = 0
    vy2 = 0
    'set initial acceleration
    ax1 = 0
    ax2 = 0
    ay1 = 0
    ay2 = 0
    'find background color
    m = QBColor(0)
    'Calculate velocity limits
    MaxSpeedX = ScaleWidth * 15! / 800
    MaxSpeedY = ScaleWidth * 15! / 600
  Else  ' put run code here
    ' check if time to get a new color
    If RepeatIndex > RepeatCount Then
        ' use rgb function
        i = Rnd * 255: If i > 255 Then i = 255
        j = Rnd * 255: If j > 255 Then j = 255
        k = Rnd * 255: If k > 255 Then k = 255
        l = RGB(i, j, k)
        RepeatIndex = 1
    Else
        RepeatIndex = RepeatIndex + 1
    End If
        'Draw New Lines
        Select Case Mirror
        Case 1: 'mirror on x and y axis
            Line (x1, y1)-(x2, y2), l
            Line (ScaleWidth - x1, y1)-(ScaleWidth - x2, y2), l
            Line (x1, ScaleHeight - y1)-(x2, ScaleHeight - y2), l
            Line (ScaleWidth - x1, ScaleHeight - y1)-(ScaleWidth - x2, ScaleHeight - y2), l
        Case 2: 'mirror on Y axis
            Line (x1, y1)-(x2, y2), l
            Line (ScaleWidth - x1, y1)-(ScaleWidth - x2, y2), l
        Case 3: 'mirror around center point
            Line (x1, y1)-(x2, y2), l
            Line (ScaleWidth - x1, ScaleHeight - y1)-(ScaleWidth - x2, ScaleHeight - y2), l

        Case Else: Mirror = 1' if invalid value set, then change

        End Select
        ' count total lines on screen
        Pointer = Pointer + 1
        If Pointer > MaxCums Then
            'when maximum reached then clear
            Cls
            Pointer = 1
        End If
        'determine new acceleration
        ax1 = Rnd - .5
        ax2 = Rnd - .5
        ay1 = Rnd - .5
        ay2 = Rnd - .5
        'calculate new position
        x1 = x1 + vx1
        x2 = x2 + vx2
        y1 = y1 + vy1
        y2 = y2 + vy2
        'calculate new velocity
        vx1 = (vx1 + ax1): If Abs(vx1) > MaxSpeedX Then vx1 = 0: ax1 = 0
        vx2 = (vx2 + ax2): If Abs(vx2) > MaxSpeedX Then vx2 = 0: ax2 = 0
        vy1 = (vy1 + ay1): If Abs(vy1) > MaxSpeedY Then vy1 = 0: ay1 = 0
        vy2 = (vy2 + ay2): If Abs(vy2) > MaxSpeedY Then vy2 = 0: ay2 = 0
        'check if off screen
        If (x1 > ScaleWidth) Then
            'change direction
            vx1 = -Abs(vx1)
        ElseIf (x1 < 0) Then
            'change direction
            vx1 = Abs(vx1)
        End If
        If (y1 > ScaleHeight) Then
            'change direction
            vy1 = -Abs(vy1)
        ElseIf (y1 < 0) Then
            'change direction
            vy1 = Abs(vy1)
        End If
        If (x2 > ScaleWidth) Then
            'change direction
            vx2 = -Abs(vx2)
        ElseIf (x2 < 0) Then
            'change direction
            vx2 = Abs(vx2)
        End If
        If (y2 > ScaleHeight) Then
            'change direction
            vy2 = -Abs(vy2)
        ElseIf (y2 < 0) Then
            'change direction
            vy2 = Abs(vy2)
        End If
    End If
End Sub
Sub Lines ()
  ' have a random number of lines trace across the
  ' screen with multiple previous copies following
  ' them
  Dim i As Integer, j As Integer, k As Integer, ii As Integer, N As Integer
  Static Sets As Integer
  ' if first time then initialize
  If PlotInit = False Then
    PlotInit = True
    Cls
    Forecolor = QBColor(15)
    'set number of sets between 1 and 4
    Sets = Rnd * 3 + 1
    'Set array size and clear the elements
    ReDim x1da(MaxLines, Sets) As Integer
    ReDim x2da(MaxLines, Sets) As Integer
    ReDim y1da(MaxLines, Sets) As Integer
    ReDim y2da(MaxLines, Sets) As Integer
    ReDim x1sa(Sets) As Single
    ReDim x2sa(Sets) As Single
    ReDim y1sa(Sets) As Single
    ReDim y2sa(Sets) As Single
    ReDim vx1sa(Sets) As Single
    ReDim vx2sa(Sets) As Single
    ReDim vy1sa(Sets) As Single
    ReDim vy2sa(Sets) As Single
    ReDim ax1sa(Sets) As Single
    ReDim ax2sa(Sets) As Single
    ReDim ay1sa(Sets) As Single
    ReDim ay2sa(Sets) As Single
    ReDim Colors(Sets) As Long
    Pointer = 1     ' start with array element 1
    ' set index to count number of times to repeat color
    '   to past maxvalue so that it will be recalculated
    RepeatIndex = MaxLines + 1
    For j = 1 To Sets
        'determine initial position of line
        x1sa(j) = Rnd * ScaleWidth
        x2sa(j) = Rnd * ScaleWidth
        y1sa(j) = Rnd * ScaleHeight
        y2sa(j) = Rnd * ScaleHeight
    Next j
    'find background color
    m = QBColor(0)
    'Calculate velocity limits
    MaxSpeedX = ScaleWidth * 15! / 800
    MaxSpeedY = ScaleWidth * 15! / 600
  Else  ' put run code here
    ' check if time to get a new color
    If RepeatIndex > RepeatCount Then
        ' use rgb function
        For ii = 1 To Sets
            i = Rnd * 255: If i > 255 Then i = 255
            j = Rnd * 255: If j > 255 Then j = 255
            k = Rnd * 255: If k > 255 Then k = 255
            Colors(ii) = RGB(i, j, k)
        Next ii
        RepeatIndex = 1
    Else
        RepeatIndex = RepeatIndex + 1
    End If
        'Delete original Lines
        For j = 1 To Sets
            Line (x1da(Pointer, j), y1da(Pointer, j))-(x2da(Pointer, j), y2da(Pointer, j)), m
        Next j
        For j = 1 To Sets
            'Save New Lines
            x1da(Pointer, j) = x1sa(j)
            x2da(Pointer, j) = x2sa(j)
            y1da(Pointer, j) = y1sa(j)
            y2da(Pointer, j) = y2sa(j)
            'Draw new Line
            Line (x1da(Pointer, j), y1da(Pointer, j))-(x2da(Pointer, j), y2da(Pointer, j)), Colors(j)
        Next j
        'Move pointer to next item
        Pointer = Pointer + 1
        If Pointer > MaxLines Then
            Pointer = 1
        End If
        For j = 1 To Sets
            'determine new acceleration
            ax1sa(j) = Rnd - .5
            ax2sa(j) = Rnd - .5
            ay1sa(j) = Rnd - .5
            ay2sa(j) = Rnd - .5
            'calculate new position
            x1sa(j) = x1sa(j) + vx1sa(j)
            x2sa(j) = x2sa(j) + vx2sa(j)
            y1sa(j) = y1sa(j) + vy1sa(j)
            y2sa(j) = y2sa(j) + vy2sa(j)
            'calculate new velocity
            vx1sa(j) = (vx1sa(j) + ax1sa(j)): If Abs(vx1sa(j)) > MaxSpeedX Then vx1sa(j) = 0: ax1sa(j) = 0
            vx2sa(j) = (vx2sa(j) + ax2sa(j)): If Abs(vx2sa(j)) > MaxSpeedX Then vx2sa(j) = 0: ax2sa(j) = 0
            vy1sa(j) = (vy1sa(j) + ay1sa(j)): If Abs(vy1sa(j)) > MaxSpeedY Then vy1sa(j) = 0: ay1sa(j) = 0
            vy2sa(j) = (vy2sa(j) + ay2sa(j)): If Abs(vy2sa(j)) > MaxSpeedY Then vy2sa(j) = 0: ay2sa(j) = 0
            'check if off screen
            If (x1sa(j) > ScaleWidth) Then
                'change direction
                vx1sa(j) = -Abs(vx1sa(j))
            ElseIf (x1sa(j) < 0) Then
                'change direction
                vx1sa(j) = Abs(vx1sa(j))
            End If
            If (y1sa(j) > ScaleHeight) Then
                'change direction
                vy1sa(j) = -Abs(vy1sa(j))
            ElseIf (y1sa(j) < 0) Then
                'change direction
                vy1sa(j) = Abs(vy1sa(j))
            End If
            If (x2sa(j) > ScaleWidth) Then
                'change direction
                vx2sa(j) = -Abs(vx2sa(j))
            ElseIf (x2sa(j) < 0) Then
                'change direction
                vx2sa(j) = Abs(vx2sa(j))
            End If
            If (y2sa(j) > ScaleHeight) Then
                'change direction
                vy2sa(j) = -Abs(vy2sa(j))
            ElseIf (y2sa(j) < 0) Then
                'change direction
                vy2sa(j) = Abs(vy2sa(j))
            End If
        Next j
  End If
End Sub
Sub Patch ()
  ' copy blocks of original screen to random spots
  ' if first time then initialize
  If PlotInit = False Then
    ' set tick rate down
    Tick.Interval = 250
    ' start with original screen
    Picture = Original.Image
    PlotInit = True
  Else  ' put run code here
    BoxHeight = Rnd * ScaleHeight / 2.5
    BoxWidth = Rnd * ScaleWidth / 2.5 * (8# / 6#)
    ' get random locations
    x1 = Rnd * ScaleWidth
    y1 = Rnd * ScaleHeight
    x2 = Rnd * ScaleWidth
    y2 = Rnd * ScaleHeight
    'make sure room in destination and source blocks
    If x1 + BoxWidth > ScaleWidth Then BoxWidth = ScaleWidth - x1
    If x2 + BoxWidth > ScaleWidth Then BoxWidth = ScaleWidth - x2
    If y1 + BoxHeight > ScaleHeight Then BoxHeight = ScaleHeight - y1
    If y2 + BoxHeight > ScaleHeight Then BoxHeight = ScaleHeight - y2
    'BitBlt Box from x2,y2 to x1,y1
    DC = Original.hDC
    BitBlt hDC, x1, y1, BoxWidth, BoxHeight, DC, x2, y2, &HCC0020

  End If
End Sub
Sub Polygons ()
  ' draw a randomly moving polygon on the screen
  ' with multiple previous copies following it
  Dim i As Integer, j As Integer, k As Integer, ii As Integer, N As Integer
  Static Sets As Integer
  ' if first time then initialize
  If PlotInit = False Then
    PlotInit = True
    Cls
    Forecolor = QBColor(15)
    'set number of sets between 3 and 5
    Sets = Rnd * 2 + 3
    'Set array size and clear the elements
    ReDim x1da(MaxLines, Sets) As Integer
    ReDim y1da(MaxLines, Sets) As Integer
    ReDim x1sa(Sets) As Single
    ReDim y1sa(Sets) As Single
    ReDim vx1sa(Sets) As Single
    ReDim vy1sa(Sets) As Single
    ReDim ax1sa(Sets) As Single
    ReDim ay1sa(Sets) As Single
    Pointer = 1     ' start with array element 1
    ' set index to count number of times to repeat color
    '   to past maxvalue so that it will be recalculated
    RepeatIndex = MaxLines + 1
    For j = 1 To Sets
        'determine initial position of line
        x1sa(j) = Rnd * ScaleWidth
        y1sa(j) = Rnd * ScaleHeight
    Next j
    'find background color
    m = QBColor(0)
    'Calculate velocity limits
    MaxSpeedX = ScaleWidth * 15! / 800
    MaxSpeedY = ScaleWidth * 15! / 600
  Else  ' put run code here
    ' check if time to get a new color
    If RepeatIndex > RepeatCount Then
        i = Rnd * 255: If i > 255 Then i = 255
        j = Rnd * 255: If j > 255 Then j = 255
        k = Rnd * 255: If k > 255 Then k = 255
        l = RGB(i, j, k)

        RepeatIndex = 1
    Else
        RepeatIndex = RepeatIndex + 1
    End If
        'Delete original Lines
        Line (x1da(Pointer, 1), y1da(Pointer, 1))-(x1da(Pointer, 2), y1da(Pointer, 2)), m
        For j = 3 To Sets
            Line -(x1da(Pointer, j), y1da(Pointer, j)), m
        Next j
        Line -(x1da(Pointer, 1), y1da(Pointer, 1)), m
        For j = 1 To Sets
            'Save New Lines
            x1da(Pointer, j) = x1sa(j)
            y1da(Pointer, j) = y1sa(j)
        Next j
        'Draw New Lines
        Line (x1da(Pointer, 1), y1da(Pointer, 1))-(x1da(Pointer, 2), y1da(Pointer, 2)), l
        For j = 3 To Sets
            Line -(x1da(Pointer, j), y1da(Pointer, j)), l
        Next j
        Line -(x1da(Pointer, 1), y1da(Pointer, 1)), l
        'Move pointer to next item
        Pointer = Pointer + 1
        If Pointer > MaxLines Then
            Pointer = 1
        End If
        For j = 1 To Sets
            'determine new acceleration
            ax1sa(j) = Rnd - .5
            ay1sa(j) = Rnd - .5

            'calculate new position
            x1sa(j) = x1sa(j) + vx1sa(j)
            y1sa(j) = y1sa(j) + vy1sa(j)
            'calculate new velocity
            vx1sa(j) = (vx1sa(j) + ax1sa(j)): If Abs(vx1sa(j)) > MaxSpeedX Then vx1sa(j) = 0: ax1sa(j) = 0
            vy1sa(j) = (vy1sa(j) + ay1sa(j)): If Abs(vy1sa(j)) > MaxSpeedY Then vy1sa(j) = 0: ay1sa(j) = 0
            'check if off screen
            If (x1sa(j) > ScaleWidth) Then
                'change direction
                vx1sa(j) = -Abs(vx1sa(j))
            ElseIf (x1sa(j) < 0) Then
                'change direction
                vx1sa(j) = Abs(vx1sa(j))
            End If
            If (y1sa(j) > ScaleHeight) Then
                'change direction
                vy1sa(j) = -Abs(vy1sa(j))
            ElseIf (y1sa(j) < 0) Then
                'change direction
                vy1sa(j) = Abs(vy1sa(j))
            End If
        Next j
    End If
End Sub
Sub Puzzle ()
  'scramble screen by shifting one column or row at a time
  Dim tempx As Integer, tempy As Integer
  Dim x As Integer, y As Integer
  ' if first time then initialize
  If PlotInit = False Then
    ' set tick rate down
    Tick.Interval = 1000
    ' start with original screen
    Picture = Original.Image
    PlotInit = True
    BoxHeight = ScaleHeight / 10
    BoxWidth = ScaleWidth / 10
    'initialize blocks
    ReDim x1da(10, 10) As Integer
    ReDim y1da(10, 10) As Integer
    For x1 = 1 To 10
        For y1 = 1 To 10
            x1da(x1, y1) = (x1 - 1) * BoxWidth
            y1da(x1, y1) = (y1 - 1) * BoxHeight
        Next y1
    Next x1
  Else  ' put run code here
    If Int(Rnd * 2) = 1 Then 'shift column
        x1 = Rnd * 10 + 1: If x1 > 10 Then x1 = 1
        If Int(Rnd * 2) = 1 Then 'shift down
            tempx = x1da(x1, 10)
            tempy = y1da(x1, 10)
            For y1 = 10 To 2 Step -1
                x1da(x1, y1) = x1da(x1, y1 - 1)
                y1da(x1, y1) = y1da(x1, y1 - 1)
                'BitBlt Box to x1,y1
                DC = Original.hDC
                x = (x1 - 1) * BoxWidth
                y = (y1 - 1) * BoxHeight
                BitBlt hDC, x, y, BoxWidth, BoxHeight, DC, x1da(x1, y1), y1da(x1, y1), &HCC0020
            Next y1
            y1 = 1
            x1da(x1, y1) = tempx
            y1da(x1, y1) = tempy
            'BitBlt Box to x1,y1
            DC = Original.hDC
            x = (x1 - 1) * BoxWidth
            y = (y1 - 1) * BoxHeight
            BitBlt hDC, x, y, BoxWidth, BoxHeight, DC, x1da(x1, y1), y1da(x1, y1), &HCC0020
        Else ' shift up
            tempx = x1da(x1, 1)
            tempy = y1da(x1, 1)
            For y1 = 1 To 9
                x1da(x1, y1) = x1da(x1, y1 + 1)
                y1da(x1, y1) = y1da(x1, y1 + 1)
                'BitBlt Box to x1,y1
                DC = Original.hDC
                x = (x1 - 1) * BoxWidth
                y = (y1 - 1) * BoxHeight
                BitBlt hDC, x, y, BoxWidth, BoxHeight, DC, x1da(x1, y1), y1da(x1, y1), &HCC0020
            Next y1
            y1 = 10
            x1da(x1, y1) = tempx
            y1da(x1, y1) = tempy
            'BitBlt Box to x1,y1
            DC = Original.hDC
            x = (x1 - 1) * BoxWidth
            y = (y1 - 1) * BoxHeight
            BitBlt hDC, x, y, BoxWidth, BoxHeight, DC, x1da(x1, y1), y1da(x1, y1), &HCC0020
        End If
    Else ' shift row

        y1 = Rnd * 10 + 1: If y1 > 10 Then y1 = 1
        If Int(Rnd * 2) = 1 Then 'shift right
            tempx = x1da(10, y1)
            tempy = y1da(10, y1)
            For x1 = 10 To 2 Step -1
                x1da(x1, y1) = x1da(x1 - 1, y1)
                y1da(x1, y1) = y1da(x1 - 1, y1)
                'BitBlt Box to x1,y1
                DC = Original.hDC
                x = (x1 - 1) * BoxWidth
                y = (y1 - 1) * BoxHeight
                BitBlt hDC, x, y, BoxWidth, BoxHeight, DC, x1da(x1, y1), y1da(x1, y1), &HCC0020
            Next x1
            x1 = 1
            x1da(x1, y1) = tempx
            y1da(x1, y1) = tempy

            'BitBlt Box to x1,y1
            DC = Original.hDC
            x = (x1 - 1) * BoxWidth
            y = (y1 - 1) * BoxHeight
            BitBlt hDC, x, y, BoxWidth, BoxHeight, DC, x1da(x1, y1), y1da(x1, y1), &HCC0020
        Else 'shift left
            tempx = x1da(1, y1)
            tempy = y1da(1, y1)
            For x1 = 1 To 9
                x1da(x1, y1) = x1da(x1 + 1, y1)
                y1da(x1, y1) = y1da(x1 + 1, y1)
                'BitBlt Box to x1,y1
                DC = Original.hDC
                x = (x1 - 1) * BoxWidth
                y = (y1 - 1) * BoxHeight
                BitBlt hDC, x, y, BoxWidth, BoxHeight, DC, x1da(x1, y1), y1da(x1, y1), &HCC0020
            Next x1
            x1 = 10
            x1da(x1, y1) = tempx
            y1da(x1, y1) = tempy

            'BitBlt Box to x1,y1
            DC = Original.hDC
            x = (x1 - 1) * BoxWidth
            y = (y1 - 1) * BoxHeight
            BitBlt hDC, x, y, BoxWidth, BoxHeight, DC, x1da(x1, y1), y1da(x1, y1), &HCC0020
        End If
    End If
  End If
End Sub
Sub Roll ()
  ' the display rolls both horizontally and vertically
  Dim v As Integer
  ' if first time then initialize
  If PlotInit = False Then
    ' start with original screen
    Picture = Original.Image
    PlotInit = True
    'Calculate velocity limits
    MaxSpeedX = ScaleWidth * 15! / 800
    MaxSpeedY = ScaleWidth * 15! / 600
    ' initial velocities
    vy1 = 0: vx1 = 0
    ' initial offset
    x1 = 0: y1 = 0
    Direction = Rnd * 2: If Direction > 1 Then Direction = 0
  Else  ' put run code here
    DC = Original.hDC
    If Direction Then
        ' do vertical scroll
        BitBlt hDC, 0, y1, ScaleWidth, ScaleHeight - y1, DC, 0, 0, &HCC0020
        BitBlt hDC, 0, 0, ScaleWidth, y1, DC, 0, ScaleHeight - y1, &HCC0020
    Else
        ' do horizontal scroll
        BitBlt hDC, x1, 0, ScaleWidth - x1, ScaleHeight, DC, 0, 0, &HCC0020
        BitBlt hDC, 0, 0, x1, ScaleHeight, DC, ScaleWidth - x1, 0, &HCC0020
    End If
    'determine new acceleration
    ax1 = Rnd - .5
    ay1 = Rnd - .5

    'calculate new velocity
    vx1 = (vx1 + ax1): If Abs(vx1) > MaxSpeedX Then vx1 = 0: ax1 = 0
    vy1 = (vy1 + ay1): If Abs(vy1) > MaxSpeedY Then vy1 = 0: ay1 = 0
    'find new roll amount
    x1 = x1 + vx1
    If x1 > ScaleWidth Then
        x1 = x1 - ScaleWidth
    Else
        If x1 < 0 Then
            x1 = x1 + ScaleWidth
        End If
    End If

    y1 = y1 + vy1
    If y1 > ScaleHeight Then
        y1 = y1 - ScaleHeight
    Else
        If y1 < 0 Then
            y1 = y1 + ScaleHeight
        End If
    End If

  End If
End Sub
Sub Scrape ()
  ' bitblt's with various patterns, dragging them
  ' across the screen randomly
  ' if first time then initialize
  If PlotInit = False Then
    ' start with original screen
    Picture = Original.Image
    PlotInit = True
    'determine initial position of line
    x1 = Rnd * ScaleWidth
    y1 = Rnd * ScaleHeight
    x2 = Rnd * ScaleWidth
    y2 = Rnd * ScaleHeight
    'Calculate velocity limits
    MaxSpeedX = ScaleWidth * 15! / 800
    MaxSpeedY = ScaleWidth * 15! / 600
    BoxHeight = 400 * Rnd ^ 3 + 20
    BoxWidth = (400 * Rnd ^ 3 + 20) * (8# / 6#)
    ' zero initial velocity
    vx1 = 0: vy1 = 0
    ' choose scrape type at random
    i = Rnd * 16
    Select Case i
        Case 0: Pattern = &H42 'Black Out
                Locked = True
        Case 1: Pattern = &HFF0062 'White Out
                Locked = True
        Case 2: Pattern = &HBB0226 'MergePaint
                Locked = False
        Case 3: Pattern = &HCC0020 'Source Copy
                Locked = False
        Case 4: Pattern = &HCC0020 'Source Copy
                Locked = True
                Picture = LoadPicture() ' start with blank screen
        Case 5: Pattern = &H330008 'Not source copy
                Locked = True
        Case 6: Pattern = &H330008 'Not source copy
                Locked = False
        Case 7: Pattern = &H1100A6 'not source erase
                Locked = True
        Case 8: Pattern = &H1100A6 'not source erase
                Locked = False
        Case 9: Pattern = &H440328 'source erase
                Locked = True
        Case 10: Pattern = &H440328 'source erase
                Locked = False
        Case 11: Pattern = &H660046 'source invert
                Locked = True
        Case 12: Pattern = &H660046 'source invert
                Locked = False
        Case 13: Pattern = &H8800C6 'source and
                Locked = False
        Case 14: Pattern = &HEE0086 'source paint
                Locked = False
        Case Else: Pattern = &H550009 'Invert Destination
                Locked = True
    End Select
  Else  ' put run code here
        ' do locking if necessary
        If Locked Then
            x2 = x1: y2 = y1
        Else 'do offset
            x2 = x1 + BoxWidth: If x2 + BoxWidth > ScaleWidth Then x2 = 0
            y2 = y1 + BoxHeight: If y2 + BoxHeight > ScaleHeight Then y2 = 0
        End If
        'BitBlt Box at x1,y1
        DC = Original.hDC
        BitBlt hDC, x1, y1, BoxWidth, BoxHeight, DC, x2, y2, Pattern

        'determine new acceleration
        ax1 = Rnd - .5
        ay1 = Rnd - .5

        'calculate new position
        x1 = x1 + vx1
        y1 = y1 + vy1

        'calculate new velocity
        vx1 = (vx1 + ax1): If Abs(vx1) > MaxSpeedX Then vx1 = 0: ax1 = 0
        vy1 = (vy1 + ay1): If Abs(vy1) > MaxSpeedY Then vy1 = 0: ay1 = 0

        'check if off screen
        If (x1 > ScaleWidth - BoxWidth) Then
            'change direction
            vx1 = -Abs(vx1)
        ElseIf (x1 < 0) Then
            'change direction
            vx1 = Abs(vx1)
        End If
        If (y1 > ScaleHeight - BoxHeight) Then
            'change direction
            vy1 = -Abs(vy1)
        ElseIf (y1 < 0) Then
            'change direction
            vy1 = Abs(vy1)
        End If
  End If
End Sub
Sub Squiggles ()
  ' draw multiple squiggles on the screen.
  ' each squiggle is assign a random color at the
  ' start, then the head travels randomly and the
  ' tail is erased
  Dim i As Integer, j As Integer, k As Integer, ii As Integer, N As Integer
    Static SquigNumb As Integer
    Static SquigLen As Integer
    Static EndPointer As Integer, StartPointer As Integer
  ' if first time then initialize
  If PlotInit = False Then
    PlotInit = True
    Cls
    Forecolor = QBColor(15)
    SquigNumb = Rnd * 10 + 10
    SquigLen = Rnd * 100 + 50
    'Allocate Memory
    ReDim x1da(SquigLen, SquigNumb)  As Integer
    ReDim y1da(SquigLen, SquigNumb)  As Integer
    ReDim x1sa(SquigNumb) As Single
    ReDim y1sa(SquigNumb) As Single
    ReDim vx1sa(SquigNumb) As Single
    ReDim vy1sa(SquigNumb) As Single
    ReDim ax1sa(SquigNumb) As Single
    ReDim ay1sa(SquigNumb) As Single
    ReDim Colors(SquigNumb) As Long
    Pointer = 1
    'Print "Clearing Array"
    For j = 1 To SquigNumb
        'determine initial position of line
        x1sa(j) = Rnd * ScaleWidth
        y1sa(j) = Rnd * ScaleHeight
        For i = 1 To SquigLen
            x1da(i, j) = x1sa(j)
            y1da(i, j) = y1sa(j)
        Next i
    Next j
    'find background color
    m = QBColor(0)
    ' use rgb function to get colors
    For ii = 1 To SquigNumb
        i = Rnd * 255: If i > 255 Then i = 255
        j = Rnd * 255: If j > 255 Then j = 255
        k = Rnd * 255: If k > 255 Then k = 255
        Colors(ii) = RGB(i, j, k)
    Next ii
    'Calculate velocity limits
    MaxSpeedX = ScaleWidth * 15! / 800
    MaxSpeedY = ScaleWidth * 15! / 600
  Else  ' put run code here
        'find where tail line went to
        If Pointer < SquigLen Then
            EndPointer = Pointer + 1
        Else
            EndPointer = 1
        End If
        'find where new line goes
        If Pointer > 1 Then
            StartPointer = Pointer - 1
        Else
            StartPointer = SquigLen
        End If
        For j = 1 To SquigNumb

            'Erase tails of squigles
            Line (x1da(Pointer, j), y1da(Pointer, j))-(x1da(EndPointer, j), y1da(EndPointer, j)), m
            'Save new points
            x1da(Pointer, j) = x1sa(j)
            y1da(Pointer, j) = y1sa(j)
            'Draw front of Squigles
            Line (x1da(StartPointer, j), y1da(StartPointer, j))-(x1da(Pointer, j), y1da(Pointer, j)), Colors(j)
        Next j
        'Move pointer to next item
        Pointer = Pointer + 1
        If Pointer > SquigLen Then
            Pointer = 1
        End If
        For j = 1 To SquigNumb
            'determine new acceleration
            ax1sa(j) = Rnd * 4 - 2
            ay1sa(j) = Rnd * 4 - 2
            'calculate new position
            x1sa(j) = x1sa(j) + vx1sa(j)
            y1sa(j) = y1sa(j) + vy1sa(j)
            'calculate new velocity
            vx1sa(j) = (vx1sa(j) + ax1sa(j)): If Abs(vx1sa(j)) > 20 Then vx1sa(j) = 0: ax1sa(j) = 0
            vy1sa(j) = (vy1sa(j) + ay1sa(j)): If Abs(vy1sa(j)) > 20 Then vy1sa(j) = 0: ay1sa(j) = 0
            'check if off screen
            If (x1sa(j) > ScaleWidth) Then
                x1sa(j) = ScaleWidth
                'change direction
                vx1sa(j) = -Abs(vx1sa(j))
            ElseIf (x1sa(j) < 0) Then
                x1sa(j) = 0
                'change direction
                vx1sa(j) = Abs(vx1sa(j))
            End If
            If (y1sa(j) > ScaleHeight) Then
                y1sa(j) = ScaleHeight
                'change direction
                vy1sa(j) = -Abs(vy1sa(j))
            ElseIf (y1sa(j) < 0) Then
                y1sa(j) = 0
                'change direction
                vy1sa(j) = Abs(vy1sa(j))
            End If
        Next j
  End If
End Sub
Sub Tick_Timer ()
    ' check elapsed time to see if need to change type of plot
    ' also check if past midnight
    CurrentTime = Timer
    If (CurrentTime > MaxTime) Or (LastTime > CurrentTime) Then
        MaxTime = MaxChangeMinutes * 60 + CurrentTime ' calculate time in seconds
        ' get new plottype, but make sure it is not
        ' the same as the current one
        Do
            i = Rnd * (MaxPlotType + 1) 'choose next one at random
            If i > MaxPlotType Then i = 0
        Loop While (i = PlotType)
        PlotType = i
        PlotInit = False

        Picture = LoadPicture()
        BackGround.AutoRedraw = False
        ClearArrays 'set arrays to zero size when not needed
        'reset tick rate
        Tick.Interval = 50
    End If
    LastTime = CurrentTime
    Select Case PlotType
        Case 0: Squiggles
        Case 1: Kalied2
        Case 2: Polygons
        Case 3: Circles
        Case 4: Kalied
        Case 5: Lines
        Case 6: Roll
        Case 7: Patch
        Case 8: Puzzle
        Case 9: Scrape
        Case 10: Scrape ' will be used twice as often
        Case Else: PlotType = 0
    End Select
End Sub