Resource for Source: C/C++/Resource for Source - C-C++.iso/misc_src/manyth31/manythng.frm

Visual Basic Form | 1995-11-01 | 99.0 KB | 3,069 lines

VERSION 2.00
Begin Form ManyThings
   BackColor       =   &H00000000&
   BorderStyle     =   0  'None
   ClientHeight    =   4605
   ClientLeft      =   1845
   ClientTop       =   1710
   ClientWidth     =   7995
   ControlBox      =   0   'False
   Height          =   5010
   Icon            =   MANYTHNG.FRX:0000
   Left            =   1785
   LinkTopic       =   "Form1"
   ScaleHeight     =   307
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   533
   Top             =   1365
   Width           =   8115
   Begin Timer Tick
      Enabled         =   0   'False
      Interval        =   50
      Left            =   10
      Top             =   10
   End
   Begin Label PasswordLabel
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Need Password    "
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "Times New Roman"
      FontSize        =   24.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   690
      Left            =   2430
      TabIndex        =   0
      Top             =   3510
      Visible         =   0   'False
      Width           =   4470
   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 MouseX, MouseY ' Last position of the mouse moves
Dim LastX As Integer, LastY As Integer
'Dim conv2x As Single, conv2y As Single
Dim LastTime As Long
Dim CurrentTime As Long
Dim LinkTime As Long
Dim PlotType As Integer
Dim PlotInit As Integer
Dim PlotEnd As Integer
Dim RepeatIndex As Integer
Dim Pointer As Integer
Dim Mirror As Integer
Dim RunMode 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
Dim Number As Integer
Dim PicWidth As Integer, PicHeight As Integer
Dim PriorityBreakPoints() As Single
Dim Priorities() As Integer
Dim TotalPriority As Single
Dim MaxPlotType As Integer
' values for GetBrightNonGray:
' minimum magnitude squared of colors
Const MinColor = 3000' was 10000
' minimum difference between colors
Const MinDiff = 30
'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
'for filled polygons
Dim Points() As POINTAPI
Const PI = 3.14159265358979
Const Sin45 = .707106781186547
Const Cos45 = Sin45
Const Sin22_5 = .38268343236509
Const Cos22_5 = .923879532511287
Const Sin11_25 = .195090322016128
Const Cos11_25 = .98078528040323
Const HighMirror = 10
Function CheckIfValidSaver (NeedsMuchMemory As Integer) As Integer
  'when in low memory mode the saver only runs the modules
  'that draw on the screen, not those that manipulate
  'bitmaps, savers that use more memory will pass
  'NeedsMuchMemory as a non-zero value
  If LowMemoryFlag = 0 Then 'if not low memory mode then done
    CheckIfValidSaver = 1
  Else
    If NeedsMuchMemory <> 0 Then
      LogFile ("Saver not valid in low memory: " + Str$(PlotType)), 0
      NextSelection
      CheckIfValidSaver = 0
    Else
      CheckIfValidSaver = 1
    End If
  End If
  If Priorities(PlotType) = 0 Then
    LogFile ("Saver disabled: " + Str$(PlotType)), 0
    NextSelection
    CheckIfValidSaver = 0
  End If
End Function
Sub Circles ()
  ' have a single elipse trace across the
  ' screen with multiple previous copies following
  ' it
  Dim xRadius As Integer, yRadius As Integer
  Dim HighMirror As Integer
  ' if first time then initialize
  If PlotInit = False Then
   'see if we need to reset changes made from previous init
   If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(0) = 0 Then
      Exit Sub
    End If
    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
    'select mirroring method
    HighMirror = 5
    Mirror = Rnd * HighMirror + 1: If Mirror > HighMirror Then Mirror = 1
  Else 'reset changes done by previous init
    ClearScreen
    'zero array sizes
    ReDim x1a(0) As Integer
    ReDim x2a(0) As Integer
    ReDim y1a(0) As Integer
    ReDim y2a(0) As Integer
  End If
  Else  ' put run code here
    Tick.Enabled = False' disable timer until circles completed
    ' check if time to get a new color
    If RepeatIndex > RepeatCount Then
    'set color
    l = GetBrightNonGray()
    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
    DoEvents
    Select Case Mirror
    Case 1: 'mirror on x and y axis

        'Delete original circle mirrored on Y axis
        xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
        yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
        If xRadius <> 0 Then
        Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (y1a(Pointer) + y2a(Pointer)) / 2), xRadius, m, , , yRadius / xRadius
        End If
        DoEvents
        'Delete original circle mirrored on X axis
        xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
        yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
        If xRadius <> 0 Then
        Circle ((x1a(Pointer) + x2a(Pointer)) / 2, (ScaleHeight - y1a(Pointer) + ScaleHeight - y2a(Pointer)) / 2), xRadius, m, , , yRadius / xRadius
        End If
        DoEvents
        'Delete original circle mirrored on origin
        xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
        yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
        If xRadius <> 0 Then
        Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (ScaleHeight - y1a(Pointer) + ScaleHeight - y2a(Pointer)) / 2), xRadius, m, , , yRadius / xRadius
        End If
        DoEvents
    Case 2: 'mirror on Y axis

        'Delete original circle mirrored on Y axis
        xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
        yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
        If xRadius <> 0 Then
        Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (y1a(Pointer) + y2a(Pointer)) / 2), xRadius, m, , , yRadius / xRadius
        End If
        DoEvents
    Case 3: 'mirror around center point
        'Delete original circle mirrored on origin
        xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
        yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
        If xRadius <> 0 Then
        Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (ScaleHeight - y1a(Pointer) + ScaleHeight - y2a(Pointer)) / 2), xRadius, m, , , yRadius / xRadius
        End If
        DoEvents
    Case Else: ' otherwise ignore (i.e. no mirror)
    End Select
    'Save New Circle
    x1a(Pointer) = x1
    x2a(Pointer) = x2
    y1a(Pointer) = y1
    y2a(Pointer) = y2
    Select Case Mirror
    Case 1: 'mirror on x and y axis

        'Delete original circle mirrored on Y axis
        xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
        yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
        If xRadius <> 0 Then
        Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (y1a(Pointer) + y2a(Pointer)) / 2), xRadius, l, , , yRadius / xRadius
        End If
        DoEvents
        'Delete original circle mirrored on X axis
        xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
        yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
        If xRadius <> 0 Then
        Circle ((x1a(Pointer) + x2a(Pointer)) / 2, (ScaleHeight - y1a(Pointer) + ScaleHeight - y2a(Pointer)) / 2), xRadius, l, , , yRadius / xRadius
        End If
        DoEvents
        'Delete original circle mirrored on origin
        xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
        yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
        If xRadius <> 0 Then
        Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (ScaleHeight - y1a(Pointer) + ScaleHeight - y2a(Pointer)) / 2), xRadius, l, , , yRadius / xRadius
        End If
    Case 2: 'mirror on Y axis

        'Delete original circle mirrored on y axis
        xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
        yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
        If xRadius <> 0 Then
        Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (y1a(Pointer) + y2a(Pointer)) / 2), xRadius, l, , , yRadius / xRadius
        End If
    Case 3: 'mirror around center point
        'Delete original circle mirrored on origin
        xRadius = Abs(x1a(Pointer) - x2a(Pointer)) / 2
        yRadius = Abs(y1a(Pointer) - y2a(Pointer)) / 2
        If xRadius <> 0 Then
        Circle ((ScaleWidth - x1a(Pointer) + ScaleWidth - x2a(Pointer)) / 2, (ScaleHeight - y1a(Pointer) + ScaleHeight - y2a(Pointer)) / 2), xRadius, l, , , yRadius / xRadius
        End If
    Case Else: ' otherwise ignore (i.e. no mirror)
    End Select
    DoEvents
    Tick.Enabled = True' re-enable timer
    '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 ClearScreen ()
'goes to extreme efforts to clear the screen
  DC = CreateDC("DISPLAY", 0&, 0&, 0&)
  'clear display
  BitBlt DC, 0, 0, ScrnWidth, ScrnHeight, DC, 0, 0, &H42&
  i = DeleteDC(DC)
  picture = LoadPicture() ' clear picture
  BackColor = QBColor(0)
  Cls
End Sub
Sub Confetti ()
  'put points on screen
  'Dim i As Integer, j As Integer, k As Integer
  Dim x As Integer, y As Integer
  Dim Size As Integer
  Dim UniformBoxes As Integer
  ' if first time then initialize
  If PlotInit = False Then
    'see if we need to reset changes made from previous init
    If PlotEnd = False Then
      'check if saver is permitted to run
      If CheckIfValidSaver(0) = 0 Then
    Exit Sub
      End If
     If LowMemoryFlag = 0 Then 'if not low memory mode then done
       picture = original.Image ' start with original screen
     Else
       Cls
     End If
      PlotInit = True
      Size = Rnd * 5 + 1
    Else 'reset changes done by previous init
      Tick.Enabled = True
      picture = LoadPicture()
    End If
  Else
    Tick.Enabled = False
    Size = Rnd * 5 + 1  ' size to make dots
    If Rnd > .5 Then
       UniformBoxes = True
    Else
       UniformBoxes = False
    End If
    Do
      x = Int(Rnd * ScrnWidth)
      y = Int(Rnd * ScrnHeight)
      Line (x, y)-(x + Size, y + Size), GetNearestColor(hDC, RGB(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))), BF
      If UniformBoxes = False Then
    Size = Rnd ^ 10 * 40 + 2'new size
      End If
      DoEvents
      CurrentTime = Timer
      If (CurrentTime > MaxTime) Or (LastTime > CurrentTime) Then Exit Do
    Loop
    Tick.Enabled = True
    picture = LoadPicture()
  End If
End Sub
Sub CyclePalette ()
  Dim Header As Long, DataBits As Long, i As Integer, j As Integer
  Dim l As Long
  Dim Paint As PAINTSTRUCT
  Static Xoffset As Integer, Yoffset As Integer, red As Integer, green As Integer, blue As Integer
  Static Wdth As Integer, Hght As Integer
  Static FastPalRunFlag As Integer, PassFlag As Integer
  Dim FileName As String, File As String
  Static PaletteFlag As Integer
  ' if first time then initialize
  If PlotInit = False Then
    'see if we need to reset changes made from previous init
    If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(1) = 0 Then
      Exit Sub
    End If
     'we only allow to run once since it has problems:
     'if started more than once durring before program stops
     'then resources can disappear drastically, there must
     'be something about the animatepalette function or
     'sendmessage that requires resources to be cleared?
     If FastPalRunFlag Then
       LogFile "Already ran Fast pallete cycle " + File, 1
       NextSelection 'jump to next since there are no bitmap files in directory
       Exit Sub
     End If
      '*****************************************************
      'initialization code here:
      File = GetNextFile(CycleBitmapsDir, 1, "dib", "gif", "")
      If File = "" Then 'check if could not load
    NextSelection 'jump to next since there are no bitmap files in directory
    Exit Sub
      End If
      ' find file
      'FileSpec = RTrim$(BitmapsDir) + "\*.dib"
      j = Rnd * 50 ' pick file at random
      For i = 1 To j
    File = GetNextFile(CycleBitmapsDir, 0, "dib", "gif", "")' get next file
      Next i
      'i = LoadSlide(File, 1)
      'If i = 0 Then 'check if could not load
      '  LogFile "Could not load file " + File, 1
      '  NextSelection 'jump to next since there are no bitmap files in directory
      '  Exit Sub
      'End If
      If InStr(UCase$(File), ".GIF") = 0 Then
    l = ManyDibLoad(File, Wdth, Hght)'load dib

    If l <= 0 Then 'check if could not load
      LogFile "Could not read DIB file " + File, 1
      NextSelection 'jump to next since there are no bitmap files in directory
      Exit Sub
    End If

      Else
    l = ManyGifLoad(File, Wdth, Hght)'load gif

    If l <= 0 Then 'check if could not load
      LogFile "Could not read GIF file " + File, 1
      NextSelection 'jump to next since there are no bitmap files in directory
      Exit Sub
    End If
      End If
      If (TotalNumColors <= 256) And (FastPaletteCycleFlag <> 0) Then
    FastPalRunFlag = 1
    'free up all but 2 system palettes
    i = SetSystemPaletteUse(hDC, SYSPAL_NOSTATIC)
    'show the palettes
    SetWindow2DIBPalette PC_RESERVED
    LogFile "Using Fast Palette Cycling", 0
    PaletteFlag = 1
      Else 'don't mess with palettes
    'picture = LoadPicture() ' clear screen
    LogFile "Changing Palette using screen redraws", 0
    PaletteFlag = 0
      End If
      PassFlag = 2

      PlotInit = True
      'Cls
      'position image
      Xoffset = (ScrnWidth - Wdth) / 2
      Yoffset = (ScrnHeight - Hght) / 2
      'set tick rate
      Tick.Interval = 25
    Else 'reset changes done by previous init
      If PaletteFlag <> 0 Then
    'remove priority on palette entries
    SetWindow2DIBPalette 0
    i = SetSystemPaletteUse(hDC, SYSPAL_STATIC)'restore system palette
      End If
      'try to read last temp file for background
      i = LoadSlideAndTile(RTrim$(BitmapsDir) + "\tmprary.dib")
      'save current screen as new original
      DC = CreateDC("DISPLAY", 0&, 0&, 0&)
      BitBlt original.hDC, 0, 0, ScrnWidth, ScrnHeight, DC, 0, 0, &HCC0020
      i = DeleteDC(DC)
      ClearScreen
      i = ManyDibFree() 'free memory used for dib
      If i <> 0 Then
    LogFile "Could not free memory", 1
      End If
      'set tick rate
      Tick.Interval = 50
    End If
  Else  ' put run code here
    If PassFlag > 1 Then
      Header = ManyDibGet() 'get pointer to header
      DataBits = ManyDibGetData() 'get pointer to data
      If Header <> 0 Then
    i = SetStretchBltMode(hDC, 3)
    i = StretchDIBits(hDC, 0, 0, ScrnWidth, ScrnHeight, 0, 0, Wdth, Hght, DataBits, Header, 0, &HCC0020)'source copy
      Else
    LogFile "Header missing", 1
    NextSelection
    Exit Sub
      End If
      PassFlag = PassFlag - 1
    Else

      Header = ManyDibGet() 'get pointer to header
      DataBits = ManyDibGetData() 'get pointer to data
      If Header <> 0 Then
    If PaletteFlag <> 0 Then
      DoAnimatePalette Pal, 1, 1'shift pallete by one
    Else 'if not palette based, animate screen by
         'changing colors and redrawing

      'draw screen
      i = SetStretchBltMode(hDC, 3)
      ManyDibCyclePalette -1, 1, 255'cycle colors
      'i = StretchDIBits(hDC, 0, 0, ScrnWidth, ScrnHeight, 0, 0, 640, 480, DataBits, Header, 0, &HCC0020)'source copy
      i = SetDIBitsToDevice(hDC, Xoffset, Yoffset, Wdth, Hght, 0, 0, 0, Hght, DataBits, Header, 0)
    End If
      Else
    LogFile "Header missing", 1
    NextSelection
    Exit Sub
      End If
    End If
  End If
  Exit Sub
End Sub
Sub DoAnimatePalette (palette As LOGPALETTE, Start As Integer, StepSize As Integer)
' cycle palete entry and display
    Dim entrynum%, i As Integer
    Dim usepal As Integer
    Dim holdentry As PALETTEENTRY
    Dim temp As Long
    For i = 1 To StepSize'shift n times
      ' The following code simply loops the color values
      LSet holdentry = palette.palPalEntry(Start)
      For entrynum% = Start To PALENTRIES - 2
    LSet palette.palPalEntry(entrynum%) = palette.palPalEntry(entrynum% + 1)
      Next entrynum%
      LSet palette.palPalEntry(PALENTRIES - 1) = holdentry
    Next i
    ' Get a handle to the control's palette
    On Error GoTo DoAnimatePaletteError
    usepal = SendMessageByNum(hWnd, VBM_GETPALETTE, 0, 0)
    On Error GoTo 0
    AnimatePalette usepal, 0, PALENTRIES, palette.palPalEntry(0)
    Exit Sub
DoAnimatePaletteError:
  'overflow on getting palette handle
  On Error GoTo 0
  LogFile "Overflow on getting palette handle", 1
  Exit Sub
End Sub
Sub Dribble ()
  'dribbling paint on screen
  Dim i As Integer, j As Integer, k As Integer
  Static MaxHole As Integer
  ' if first time then initialize
  If PlotInit = False Then
    'see if we need to reset changes made from previous init
    If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(1) = 0 Then
      Exit Sub
    End If
    ' start with original screen
    picture = original.Image
    PlotInit = True
    'determine initial position of shot
    x1 = Rnd * ScaleWidth
    y1 = Rnd * ScaleHeight
    'Calculate velocity limits
    MaxSpeedX = ScaleWidth * 20! / 800
    MaxSpeedY = ScaleWidth * 20! / 600
    ' zero initial velocity
    vx1 = 0: vy1 = 0
    'set maximum size of holes
    MaxHole = 4
    ForeColor = RGB(0, 0, 0)' use black box
    FillColor = RGB(0, 0, 0) 'set black fill
    FillStyle = 0 'solid fill
    RunMode = Int(Rnd * 2#)'choose black or color
    'Debug.Print RunMode
    If RunMode > 0 Then ' if random color then use larger spots
    MaxHole = 8
    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
    ForeColor = GetNearestColor(hDC, RGB(i, j, k))
    FillColor = ForeColor
    End If
  Else 'reset changes done by previous init
    ClearScreen
    FillStyle = 1 'transparent fill
  End If
  Else  ' put run code here
    If RunMode > 0 Then ' see if need to change to random color
        If Rnd < .05 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
        ForeColor = GetNearestColor(hDC, RGB(i, j, k))
        FillColor = ForeColor
        End If
    End If
    ' put random hole here
    Circle (x1 + Rnd * 20, y1 + Rnd * 20), MaxHole * Rnd + 2, , , , 1
    'determine new acceleration
    ax1 = 2 * Rnd - 1
    ay1 = 2 * Rnd - 1

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

    'calculate new velocity
    vx1 = (vx1 + ax1): If Abs(vx1) > MaxSpeedX Then vx1 = -vx1 * .9: vy1 = -vy1 * .9: ax1 = 0
    vy1 = (vy1 + ay1): If Abs(vy1) > MaxSpeedY Then vx1 = -vx1 * .9: vy1 = -vy1 * .9: ay1 = 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
  End If
End Sub
Sub Drop ()
  ' bitblt's with various patterns, dragging them
  ' across the screen randomly
  Dim j As Integer
  Static OldY As Integer
  Static NotFoundCount As Integer
  Const MaxCount = 200
  ' if first time then initialize
  If PlotInit = False Then
    'see if we need to reset changes made from previous init
    If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(1) = 0 Then
      Exit Sub
    End If
    'store whether column has dropped
    ReDim x1a(ScaleWidth)
    ' start with original screen
    picture = original.Image
    PlotInit = True
    'flag that no column has been chosen
    x1 = -1
    'Calculate velocity limits
    MaxSpeedY = ScaleWidth * 10! / 600
    MaxSpeedX = ScaleWidth * 10! / 800
    ' zero initial velocity
    vy1 = 0
    'width of column to drop
    BoxWidth = 10 + Rnd * 100
    i = Int(Rnd * 2#)'if i=0 then do jagged drop
    x2 = 0 'used for width change
  Else 'reset changes done by previous init
    'store whether column has dropped
    ReDim x1a(0)
    ClearScreen
  End If
Else  ' put run code here
  If x1 < 0 Then 'see if found valid column
    x1 = Rnd * ScaleWidth / BoxWidth 'choose a column
    If x1a(x1) = 0 Then 'check if not yet dropped
    y1 = 0 'start position
    x1a(x1) = 1 'flag that column has already been used
    x2 = 0: vx2 = 0: OldY = 0' initialize variables
    NotFoundCount = 0
    Else
    x1 = -1 'flag that no column chosen
    ' count column failures
    NotFoundCount = NotFoundCount + 1
    If NotFoundCount > MaxCount Then
        'restart dropping
        'reset whether column has dropped
        ReDim x1a(ScaleWidth)
        ' start with original screen
        picture = original.Image
    End If
    End If
  Else 'if column already found, then drop it
    If i = 0 Then 'check if jagged drop
    'make sure effective width does not get too small
    If x2 >= BoxWidth - 5 Then
    x2 = BoxWidth - 5
    vx2 = -vx2 'reverse direction
    End If
    j = x2 / 2 'get half of change
    'shift column
    DC = original.hDC
    BitBlt hDC, x1 * BoxWidth + j, y1, BoxWidth - x2, ScaleHeight - y1, DC, x1 * BoxWidth + j, 0, &HCC0020'source copy
    'blank top of column
    BitBlt hDC, x1 * BoxWidth + j, OldY, BoxWidth - x2, y1 - OldY + 1, DC, x1 * BoxWidth + j, 0, &H42'blackout
    Else ' not jagged drop
    'shift column
    DC = original.hDC
    BitBlt hDC, x1 * BoxWidth, y1, BoxWidth, ScaleHeight - y1, DC, x1 * BoxWidth, 0, &HCC0020  'source copy
    'blank top of column
    BitBlt hDC, x1 * BoxWidth, OldY, BoxWidth, y1 - OldY + 1, DC, x1 * BoxWidth, 0, &H42'blackout
    End If
    'save current position
    OldY = y1
    'check if off screen
    If (y1 > ScaleHeight) Then
    x1 = -1 'flag done
    vy1 = 0'zero velocity again
    End If
    'determine new acceleration
    ay1 = Rnd * .25
    ax2 = Rnd * .25 - .125
    'calculate new positions
    y1 = y1 + vy1
    x2 = x2 + vx2
    'calculate new velocity
    vy1 = (vy1 + ay1): If Abs(vy1) > MaxSpeedY Then vy1 = vy1 / 2: ay1 = 0
    vx2 = (vx2 + ax2): If Abs(vx2) > MaxSpeedX Then vx2 = vx2 / 2: ax2 = 0
    End If
  End If
End Sub
Sub EndScrnSaveForm ()
  LogFile "EndScrnSaveFrom: before freeing memory", 1
  i = SetSystemPaletteUse(hDC, SYSPAL_STATIC)'restore system palette
  i = ManyDibFree() 'free memory used for dib
  If i <> 0 Then
    LogFile "Could not free memory", 1
  End If
  picture = LoadPicture()
  EndScrnSave 'call global screen saver
End Sub
Sub FilledCircles ()
  ' have a single filled elipse trace across the screen
  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
    'see if we need to reset changes made from previous init
    If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(0) = 0 Then
      Exit Sub
    End If
    PlotInit = True
    Cls
    ForeColor = QBColor(15)
    FillColor = ForeColor
    BackColor = QBColor(0)
    FillStyle = 0' use solid fill
    ' 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
    'Calculate velocity limits
    MaxSpeedX = ScaleWidth * 15! / 800
    MaxSpeedY = ScaleWidth * 15! / 600
  Else 'reset changes done by previous init
    ClearScreen
    FillStyle = 1 'transparent fill
  End If
  Else  ' put run code here
    ' check if time to get a new color
    If RepeatIndex > RepeatCount Then
    ' get random fore ground color
    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
    ForeColor = RGB(i, j, k)
    ' get random fill color
    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
    FillColor = GetNearestColor(hDC, RGB(i, j, k))
    RepeatIndex = 1
    Else
    RepeatIndex = RepeatIndex + 1
    End If
    'Draw new Circle
    xRadius = Abs(x1 - x2) / 2
    yRadius = Abs(y1 - y2) / 2
    If xRadius <> 0 Then
        Circle ((x1 + x2) / 2, (y1 + y2) / 2), xRadius, , , , 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 FilledPolygons ()
  ' draw a randomly moving polygon on the screen
  ' slightly offset from previous polygon
  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
    'see if we need to reset changes made from previous init
    If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(0) = 0 Then
      Exit Sub
    End If
    PlotInit = True
    ForeColor = RGB(255, 255, 255)
    BackColor = RGB(0, 0, 0)
    FillStyle = 0' use solid fill
    DrawWidth = 1' use narrow line
    j = SetPolyFillMode(hDC, 2)' use winding fill mode
    Cls
    'set number of corners between 3 and 5
    Sets = Rnd * 4 + 3
    'Set array size and clear the elements
    ReDim Points(Sets) As POINTAPI
    ReDim vx1sa(Sets) As Single
    ReDim vy1sa(Sets) As Single
    ReDim ax1sa(Sets) As Single
    ReDim ay1sa(Sets) As Single
    'counter for changing colors, set to overflow
    RepeatIndex = RepeatCount + 1
    For j = 1 To Sets
    'determine initial position of line
    Points(j).x = Rnd * ScaleWidth
    Points(j).y = Rnd * ScaleHeight
    Next j
    'Calculate velocity limits
    MaxSpeedX = ScaleWidth * 15! / 800
    MaxSpeedY = ScaleWidth * 15! / 600
  Else 'reset changes done by previous init
    ReDim Points(0) As POINTAPI
    ReDim vx1sa(0) As Single
    ReDim vy1sa(0) As Single
    ReDim ax1sa(0) As Single
    ReDim ay1sa(0) As Single
    FillStyle = 1 'transparent fill
    j = SetPolyFillMode(hDC, 1)' reset to alternate fill mode
    ClearScreen
  End If
  Else  ' put run code here
    ' check if time to get a new color
    If RepeatIndex > RepeatCount Then
    'set fill color
    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
    FillColor = GetNearestColor(hDC, RGB(i, j, k))
    'set foreground color
    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
    ForeColor = RGB(i, j, k)
    RepeatIndex = 1
    Else
    RepeatIndex = RepeatIndex + 1
    End If
    'Draw polygon
    j = Polygon(hDC, Points(0), Sets)
    For j = 1 To Sets
        'determine new acceleration
        ax1sa(j) = Rnd - .5
        ay1sa(j) = Rnd - .5

        'calculate new position
        Points(j).x = Points(j).x + vx1sa(j)
        Points(j).y = Points(j).y + 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 (Points(j).x > ScaleWidth) Then
        'change direction
        vx1sa(j) = -Abs(vx1sa(j))
        ElseIf (Points(j).x < 0) Then
        'change direction
        vx1sa(j) = Abs(vx1sa(j))
        End If
        If (Points(j).y > ScaleHeight) Then
        'change direction
        vy1sa(j) = -Abs(vy1sa(j))
        ElseIf (Points(j).y < 0) Then
        'change direction
        vy1sa(j) = Abs(vy1sa(j))
        End If
    Next j
    End If
End Sub
Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
    Static KeyState As String * 257
    Dim LongChar As Long
    Dim KeyAscii As Integer
    Static temp$    ' Collects characters each time key is pressed.
    If Passwd = "" Then
    LogFile ("KeyDown, Terminating"), 0
    EndScrnSaveForm         ' End screen blanking
    Else
    'refresh system modal in case another process
    'has grabbed it
    If TestMode = 0 Then
        ZOrder 0' make sure form is still on top
        i = SetSysModalWindow(hWnd)
    End If
    'refresh password box
    PasswordLabel.Visible = False
    PasswordLabel.Visible = True
    'convert key to ascii
    'GetKeyboardStateBystring (KeyState)' get kb state
    'i = ToAsciiBystring(KeyCode, 0, KeyState, LongChar, 0)
    'KeyAscii = LongChar Mod 256
    KeyAscii = MapVirtualKey(KeyCode, 2) ' convert virtual key code to ascii
    LogFile ("KeyDown, (" + Str$(KeyCode) + ", " + Str$(Shift) + ") received, translated to '" + Chr$(KeyAscii) + "' (" + Str$(KeyAscii) + ")"), 0
    KeyCode = 0' clear key
    'parse key into password
    If KeyAscii = 13 Then       ' ENTER key pressed.
       KeyAscii = 0            ' Prevents Beep after ENTER Key.
       If temp$ = Passwd Then
         LogFile ("Password entered, Terminating"), 0
         EndScrnSaveForm          ' End screen blanking
       Else
         temp$ = ""
         LogFile ("Invalid Password entered, Continuing"), 0
         PasswordLabel.Caption = "Password Invalid  "
         Beep  ' Signal user that password failed.
         Exit Sub
       End If
    ElseIf KeyAscii = 8 Then    ' Backspace key pressed.
       KeyAscii = 0            'character is not passed on
       If temp$ <> "" Then 'only delete if not empty
         temp$ = Left$(temp$, Len(temp$) - 1) ' Remove one char.
       Else
         Beep
       End If
    ElseIf Len(temp$) = NUMCHARS Then      ' Limit size of password.
       KeyAscii = 0
       Beep                    ' Signal user that field is full.
    ElseIf KeyAscii < 32 Then  ' ignore control keys
       KeyAscii = 0            ' character is not passed on
    Else 'normal character that we can recognize?
       temp$ = temp$ + UCase$(Chr$(KeyAscii))    ' Add a character.
       KeyAscii = 0            'character is not passed on
    End If
    PasswordLabel.Caption = "Password>" + String$(Len(temp$), "*")
    End If
End Sub
Sub Form_KeyPress (KeyAscii As Integer)
    If Passwd <> "" Then
    'refresh system modal in case another process
    'has grabbed it
    If TestMode = 0 Then
       ZOrder 0' make sure form is still on top
       i = SetSysModalWindow(hWnd)
    End If
       'refresh password box
       PasswordLabel.Visible = False
       PasswordLabel.Visible = True
       LogFile ("KeyPress, '" + Chr$(KeyAscii) + "' received, code(" + Str$(KeyAscii) + ")"), 0
       KeyAscii = 0 ' trap characters
    Else
    LogFile ("KeyPress, Terminating"), 0
    EndScrnSaveForm            ' End screen blanking
    End If
End Sub
Sub Form_KeyUp (KeyCode As Integer, Shift As Integer)
LogFile ("KeyUp, (" + Str$(KeyCode) + ", " + Str$(Shift) + ") received"), 0
End Sub
Sub Form_Load ()
    ' stretch to full screen
    Move 0, 0, screen.Width, screen.Height
    TotalNumColors = GetNumberOfColors()'read number colors display can handle
    LogFile "Display supports " + Str$(TotalNumColors) + " colors", 0
    KeyPreview = True 'form takes priority on keys
    'set system modal
    If TestMode = 0 Then
      ZOrder 0' make sure form is still on top
      i = SetSysModalWindow(hWnd) 'make sure can't CTL-ALT-DEL out
    End If
    'make mouse invisible
    If TestMode = 0 Then
      HideMouse
    End If
    'tell windows to disable screen savers
    i = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, False, 0, 0)
    DrawWidth = 1
    Randomize
    MaxPlotType = 21
    ReadPriorities ' call each Plot type to get its priority
    ' Initialize variables now
    'set plot type
    If StartSaver = 0 Then
      PlotType = MaxPlotType * Rnd
    Else
      PlotType = StartSaver
    End If
    If PlotType > MaxPlotType Then PlotType = 1
    LogFile ("First Saver is " + Str$(PlotType)), 1
    PlotInit = False
    PlotEnd = False
    TimeInterval = 0
    MaxTime = MaxChangeMinutes * 60 + Timer ' calculate time in seconds
    'set tick rate
    Tick.Interval = 50
    Repeats = 1 ' number of drawings to make before returning
    Tick.Enabled = True
End Sub
Sub Form_MouseMove (Button As Integer, Shift As Integer, x As Single, y As Single)
    If IsEmpty(MouseX) Or IsEmpty(MouseY) Then
    MouseX = x
    MouseY = y
    LogFile ("First Mouse Movement (" + Str$(x) + "," + Str$(y) + ")"), 0
    End If
    '
    ' Only unblank the screen if the mouse moves quickly
    ' enough (more than 2 pixels at one time.
    '
    If Abs(MouseX - x) > 2 Or Abs(MouseY - y) > 2 Then

      If Passwd = "" Then ' only exit if no password
     LogFile ("Mouse Movement (" + Str$(x) + "," + Str$(y) + "), Terminating"), 0
     LogFile ("Old Pos (" + Str$(MouseX) + "," + Str$(MouseY) + "), Terminating"), 0
     EndScrnSaveForm          ' End screen blanking
      Else
    'refresh system modal in case another process
    'has grabbed it
    If TestMode = 0 Then
        i = SetSysModalWindow(hWnd)
    End If
    PasswordLabel.Visible = False
    PasswordLabel.Visible = True
      End If
    End If
    LogFile ("Mouse Movement (" + Str$(x) + "," + Str$(y) + "), Continuing"), 0
    MouseX = x                   ' Remember last position
    MouseY = y
End Sub
Sub Form_Paint ()
    ' stretch to full screen
    Move 0, 0, screen.Width, screen.Height
End Sub
Function GetBrightNonGray () As Long
' this function is needed because in 256 color mode
' many random colors get mapped to grays
  Dim i As Long, j As Long, k As Long
  Dim NewColor As Long
    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
    'LogFile ("GetBrightNonGray testing color (" + Str$(i) + "," + Str$(j) + "," + Str$(k) + ")")
    'get nearest colors
    NewColor = GetNearestColor(hDC, RGB(i, j, k))
    i = NewColor And &HFF
    j = NewColor \ &H100 And &HFF
    k = NewColor \ &H10000 And &HFF
    'LogFile ("GetBrightNonGray nearest color (" + Str$(i) + "," + Str$(j) + "," + Str$(k) + ")")
    'make sure color is sufficiently bright, and not too gray
    Loop Until ((i * i + j * j + k * k) > MinColor) And ((Abs(i - j) > MinDiff) Or (Abs(j - k) > MinDiff))
  'LogFile ("GetBrightNonGray using color (" + Str$(i) + "," + Str$(j) + "," + Str$(k) + ")")
  GetBrightNonGray = NewColor
End Function
Function GetNumberOfColors () As Single
  Dim i As Integer, j As Integer, k As Integer
  ' get bits per pixel per plane
  i = GetDeviceCaps(hDC, BITSPIXEL)
  ' get number of planes
  j = GetDeviceCaps(hDC, PLANES)
  ' get total bits per pixel
  k = i * j
  GetNumberOfColors = 2# ^ k
End Function
Function GetSize (FileName$) As Integer
    Dim InLine$
    Dim Loaded As Integer
    Open FileName$ For Binary As #1
    '*****************************************************
    'read header
    InLine$ = Input$(26, 1)
    If Asc(Mid$(InLine$, 1, 1)) <> &H42 Then GoTo errorexit
    If Asc(Mid$(InLine$, 2, 1)) <> &H4D Then GoTo errorexit
    PicWidth = Asc(Mid$(InLine$, 19, 1)) + Asc(Mid$(InLine$, 20, 1)) * 256
    PicHeight = Asc(Mid$(InLine$, 23, 1)) + Asc(Mid$(InLine$, 24, 1)) * 256
    'Debug.Print SWidth, SHeight
    Close #1
    Loaded = 1 'flag good read
    GoTo regexit
errorexit: Loaded = 0
regexit: ' no error exit
    GetSize = Loaded'return read state
End Function
Sub Kalied ()
  ' have a line and its mirror images trace across the
  ' screen with multiple previous copies following
  ' it
  Dim xRadius As Integer, yRadius As Integer
  Static OldWidth As Integer, OldHeight As Integer
  Static OldLeft As Integer, OldTop As Integer
  Static Discontinuous As Integer
  ' if first time then initialize
  If PlotInit = False Then
   'see if we need to reset changes made from previous init
   If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(0) = 0 Then
      Exit Sub
    End If
    PlotInit = True
    Cls
    ForeColor = QBColor(15)
    If Rnd > .5 Then
      Discontinuous = False
    Else
      Discontinuous = True
    End If
    'select mirroring method
    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
    'save old
    OldWidth = ScaleWidth: OldHeight = ScaleHeight
    OldLeft = Scaleleft: OldTop = Scaletop
    'change scaleso they are symetrical:
    ScaleHeight = ScaleWidth
    Scaleleft = -ScaleHeight / 2
    Scaletop = Scaleleft
    'Calculate velocity limits
    MaxSpeedX = ScaleWidth * 15! / 800
    MaxSpeedY = ScaleWidth * 15! / 600
    'determine initial position of line
    x1 = (Rnd - .5) * ScaleWidth
    x2 = (Rnd - .5) * ScaleWidth
    y1 = (Rnd - .5) * ScaleHeight
    y2 = (Rnd - .5) * ScaleHeight
    'set initial velocity
    vx1 = (Rnd - .5) * 2 * MaxSpeedX
    vx2 = (Rnd - .5) * 2 * MaxSpeedX
    vy1 = (Rnd - .5) * 2 * MaxSpeedY
    vy2 = (Rnd - .5) * 2 * MaxSpeedY
    'set initial acceleration
    ax1 = 0
    ax2 = 0
    ay1 = 0
    ay2 = 0
    'find background color
    m = QBColor(0)
    'set tick rate
    Tick.Interval = 50
  Else 'reset changes done by previous init
    'reset tick rate
    Tick.Interval = 50
    'zero array sizes
    ReDim x1a(0) As Integer
    ReDim x2a(0) As Integer
    ReDim y1a(0) As Integer
    ReDim y2a(0) As Integer
      'reset screen dimensions
      ScaleWidth = OldWidth
      ScaleHeight = OldHeight
      Scaleleft = OldLeft
      Scaletop = OldTop
    ClearScreen
  End If
  Else  ' put run code here
    ' check if time to get a new color
    If RepeatIndex > RepeatCount Then
    ' get color
    l = GetBrightNonGray()
    If Discontinuous = True Then
      'determine new position of line
      x1 = (Rnd - .5) * ScaleWidth
      x2 = (Rnd - .5) * ScaleWidth
      y1 = (Rnd - .5) * ScaleHeight
      y2 = (Rnd - .5) * ScaleHeight
      'set new velocity
      vx1 = (Rnd - .5) * 2 * MaxSpeedX
      vx2 = (Rnd - .5) * 2 * MaxSpeedX
      vy1 = (Rnd - .5) * 2 * MaxSpeedY
      vy2 = (Rnd - .5) * 2 * MaxSpeedY
      'clear acceleration
      ax1 = 0
      ax2 = 0
      ay1 = 0
      ay2 = 0
    End If
    RepeatIndex = 1
    Else
    RepeatIndex = RepeatIndex + 1
    End If
    'Delete original Lines
    KaliedPlot Mirror, x1a(Pointer), y1a(Pointer), x2a(Pointer), y2a(Pointer), m
    'Save New Lines
    x1a(Pointer) = x1
    x2a(Pointer) = x2
    y1a(Pointer) = y1
    y2a(Pointer) = y2
    DoEvents
    'Draw New Lines
    KaliedPlot Mirror, x1, y1, x2, y2, l
    '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 > -Scaleleft) Then
        'change direction
        vx1 = -Abs(vx1)
    ElseIf (x1 < Scaleleft) Then
        'change direction
        vx1 = Abs(vx1)
    End If
    If (y1 > -Scaletop) Then
        'change direction
        vy1 = -Abs(vy1)
    ElseIf (y1 < Scaletop) Then
        'change direction
        vy1 = Abs(vy1)
    End If
    If (x2 > -Scaleleft) Then
        'change direction
        vx2 = -Abs(vx2)
    ElseIf (x2 < Scaleleft) Then
        'change direction
        vx2 = Abs(vx2)
    End If
    If (y2 > -Scaletop) Then
        'change direction
        vy2 = -Abs(vy2)
    ElseIf (y2 < Scaletop) 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 xRadius As Integer, yRadius As Integer
  Static OldWidth As Integer, OldHeight As Integer
  Static OldLeft As Integer, OldTop As Integer
  Static Discontinuous As Integer
  ' if first time then initialize
  If PlotInit = False Then
    'see if we need to reset changes made from previous init
    If PlotEnd = True Then
      ScaleWidth = OldWidth
      ScaleHeight = OldHeight
      Scaleleft = OldLeft
      Scaletop = OldTop
      ClearScreen
      Exit Sub
    End If
    'check if saver is permitted to run
    If CheckIfValidSaver(0) = 0 Then
      Exit Sub
    End If
    PlotInit = True
    Cls
    ForeColor = QBColor(15)
    If Rnd > .5 Then
      Discontinuous = False
    Else
      Discontinuous = True
    End If
    'select mirroring method
    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
    'save old
    OldWidth = ScaleWidth: OldHeight = ScaleHeight
    OldLeft = Scaleleft: OldTop = Scaletop
    'change scaleso they are symetrical:
    ScaleHeight = ScaleWidth
    Scaleleft = -ScaleHeight / 2
    Scaletop = Scaleleft
    'determine initial position of line
    x1 = (Rnd - .5) * ScaleWidth
    x2 = (Rnd - .5) * ScaleWidth
    y1 = (Rnd - .5) * ScaleHeight
    y2 = (Rnd - .5) * ScaleHeight
    'set initial velocity
    vx1 = (Rnd - .5) * 2 * MaxSpeedX
    vx2 = (Rnd - .5) * 2 * MaxSpeedX
    vy1 = (Rnd - .5) * 2 * MaxSpeedY
    vy2 = (Rnd - .5) * 2 * MaxSpeedY
    '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
    ' get color
    l = GetBrightNonGray()
    If Discontinuous = True Then
      'determine new position of line
      x1 = (Rnd - .5) * ScaleWidth
      x2 = (Rnd - .5) * ScaleWidth
      y1 = (Rnd - .5) * ScaleHeight
      y2 = (Rnd - .5) * ScaleHeight
      'set new velocity
      vx1 = (Rnd - .5) * 2 * MaxSpeedX
      vx2 = (Rnd - .5) * 2 * MaxSpeedX
      vy1 = (Rnd - .5) * 2 * MaxSpeedY
      vy2 = (Rnd - .5) * 2 * MaxSpeedY
      'clear acceleration
      ax1 = 0
      ax2 = 0
      ay1 = 0
      ay2 = 0
    End If
    RepeatIndex = 1
    Else
    RepeatIndex = RepeatIndex + 1
    End If
    'Draw New Lines
    KaliedPlot Mirror, x1, y1, x2, y2, l
    ' 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 > -Scaleleft) Then
        'change direction
        vx1 = -Abs(vx1)
    ElseIf (x1 < Scaleleft) Then
        'change direction
        vx1 = Abs(vx1)
    End If
    If (y1 > -Scaletop) Then
        'change direction
        vy1 = -Abs(vy1)
    ElseIf (y1 < Scaletop) Then
        'change direction
        vy1 = Abs(vy1)
    End If
    If (x2 > -Scaleleft) Then
        'change direction
        vx2 = -Abs(vx2)
    ElseIf (x2 < Scaleleft) Then
        'change direction
        vx2 = Abs(vx2)
    End If
    If (y2 > -Scaletop) Then
        'change direction
        vy2 = -Abs(vy2)
    ElseIf (y2 < Scaletop) Then
        'change direction
        vy2 = Abs(vy2)
    End If
    End If
End Sub
Sub KaliedPlot (MirrorMode As Integer, x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, Color As Long)
'warning -- recursive subroutine
  Dim xm1 As Integer, ym1 As Integer, xm2 As Integer, ym2 As Integer
    Select Case MirrorMode
    Case 1: 'mirror on x and y axis
        Line (x1, y1)-(x2, y2), Color
        Line (-x1, y1)-(-x2, y2), Color
        Line (x1, -y1)-(x2, -y2), Color
        Line (-x1, -y1)-(-x2, -y2), Color
    Case 2: 'mirror on Y axis
        Line (x1, y1)-(x2, y2), Color
        Line (-x1, y1)-(-x2, y2), Color
    Case 3: 'mirror around center point
        Line (x1, y1)-(x2, y2), Color
        Line (-x1, -y1)-(-x2, -y2), Color
    Case 4: 'mirror around center point and diagonally
        Line (x1, y1)-(x2, y2), Color
        Line (-x1, -y1)-(-x2, -y2), Color
        'mirror diagonally
        xm1 = y1
        ym1 = x1
        xm2 = y2
        ym2 = x2
        Line (-xm1, ym1)-(-xm2, ym2), Color
        Line (xm1, -ym1)-(xm2, -ym2), Color
    Case 5: 'mirror on x and y axis and diagonally
        Line (x1, y1)-(x2, y2), Color
        Line (-x1, y1)-(-x2, y2), Color
        Line (x1, -y1)-(x2, -y2), Color
        Line (-x1, -y1)-(-x2, -y2), Color
        'mirror diagonally
        xm1 = y1
        ym1 = x1
        xm2 = y2
        ym2 = x2
        Line (xm1, ym1)-(xm2, ym2), Color
        Line (-xm1, ym1)-(-xm2, ym2), Color
        Line (xm1, -ym1)-(xm2, -ym2), Color
        Line (-xm1, -ym1)-(-xm2, -ym2), Color
    Case 6: 'mirror around center point and diagonally
        'and then shift 45 degrees and repeat
        KaliedPlot 4, x1, y1, x2, y2, Color
        'shift 45 degrees, formula
        'r*sin(a+b) = y*cos(b) + x*sin(b)
        'r*cos(a+b) = x*cos(b) - y*sin(b)
        xm1 = x1 * Cos45 - y1 * Sin45
        ym1 = y1 * Cos45 + x1 * Sin45
        xm2 = x2 * Cos45 - y2 * Sin45
        ym2 = y2 * Cos45 + x2 * Sin45
        KaliedPlot 4, xm1, ym1, xm2, ym2, Color
    Case 7: 'mirror on x and y axis and diagonally
        'and then shift 45 degrees and repeat
        KaliedPlot 5, x1, y1, x2, y2, Color
        'shift 45 degrees, formula
        'r*sin(a+b) = y*cos(b) + x*sin(b)
        'r*cos(a+b) = x*cos(b) - y*sin(b)
        xm1 = x1 * Cos45 - y1 * Sin45
        ym1 = y1 * Cos45 + x1 * Sin45
        xm2 = x2 * Cos45 - y2 * Sin45
        ym2 = y2 * Cos45 + x2 * Sin45
        KaliedPlot 5, xm1, ym1, xm2, ym2, Color
    Case 8: 'mirror around center point and diagonally
        'and then shift 45 degrees and repeat
        'and then shift 22.5 and repeat the above
        KaliedPlot 6, x1, y1, x2, y2, Color
        'shift 22.5 degrees, formula
        'r*sin(a+b) = y*cos(b) + x*sin(b)
        'r*cos(a+b) = x*cos(b) - y*sin(b)
        xm1 = x1 * Cos22_5 - y1 * Sin22_5
        ym1 = y1 * Cos22_5 + x1 * Sin22_5
        xm2 = x2 * Cos22_5 - y2 * Sin22_5
        ym2 = y2 * Cos22_5 + x2 * Sin22_5
        KaliedPlot 6, xm1, ym1, xm2, ym2, Color
    Case 9: 'mirror on x and y axis and diagonally
        'and then shift 45 degrees and repeat
        'and then shift 22.5 and repeat the above
        KaliedPlot 7, x1, y1, x2, y2, Color
        'shift 22.5 degrees, formula
        'r*sin(a+b) = y*cos(b) + x*sin(b)
        'r*cos(a+b) = x*cos(b) - y*sin(b)
        xm1 = x1 * Cos22_5 - y1 * Sin22_5
        ym1 = y1 * Cos22_5 + x1 * Sin22_5
        xm2 = x2 * Cos22_5 - y2 * Sin22_5
        ym2 = y2 * Cos22_5 + x2 * Sin22_5
        KaliedPlot 7, xm1, ym1, xm2, ym2, Color
    Case 10: 'mirror around center point and diagonally
        'and then shift 45 degrees and repeat
        'and then shift 22.5 and repeat the above
        'and then shift 11.25 and repeat the above
        KaliedPlot 8, x1, y1, x2, y2, Color
        'shift 22.5 degrees, formula
        'r*sin(a+b) = y*cos(b) + x*sin(b)
        'r*cos(a+b) = x*cos(b) - y*sin(b)
        xm1 = x1 * Cos11_25 - y1 * Sin11_25
        ym1 = y1 * Cos11_25 + x1 * Sin11_25
        xm2 = x2 * Cos11_25 - y2 * Sin11_25
        ym2 = y2 * Cos11_25 + x2 * Sin11_25
        KaliedPlot 8, xm1, ym1, xm2, ym2, Color
    Case 11: 'mirror on x and y axis and diagonally
        'and then shift 45 degrees and repeat
        'and then shift 22.5 and repeat the above
        'and then shift 11.25 and repeat the above
        KaliedPlot 9, x1, y1, x2, y2, Color
        'shift 22.5 degrees, formula
        'r*sin(a+b) = y*cos(b) + x*sin(b)
        'r*cos(a+b) = x*cos(b) - y*sin(b)
        xm1 = x1 * Cos11_25 - y1 * Sin11_25
        ym1 = y1 * Cos11_25 + x1 * Sin11_25
        xm2 = x2 * Cos11_25 - y2 * Sin11_25
        ym2 = y2 * Cos11_25 + x2 * Sin11_25
        KaliedPlot 9, xm1, ym1, xm2, ym2, Color
    Case Else: MirrorMode = 1' if invalid value set, then change
    End Select
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
  Dim il As Long, jl As Long, kl As Long
  Static Sets As Integer
  ' if first time then initialize
  If PlotInit = False Then
   'see if we need to reset changes made from previous init
   If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(0) = 0 Then
      Exit Sub
    End If
    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 'reset changes done by previous init
    'Set array size and clear the elements
    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
    ClearScreen
  End If
  Else  ' put run code here
    ' check if time to get a new color
    If RepeatIndex > RepeatCount Then
    ' get colors
    For ii = 1 To Sets
      Colors(ii) = GetBrightNonGray()
    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
Function LoadSlide (File As String, ShowPic As Integer) As Integer
 'loads picture to screen, if gif file extension, then
 'save to dib bitmap, returns zero on failure
  Dim RetVal As Integer, i As Integer, l As Long
  Dim Header As Long, DataBits As Long
  Dim TempName As String
  RetVal = 1
  LogFile "Showing file " + File, 1
  If InStr(UCase$(File), ".GIF") = 0 Then
    ' if not gif file, then bitmap
    If ShowPic Then
      On Error GoTo LoadSlide_Error
      picture = LoadPicture(File)
      On Error GoTo 0
    End If
    'get dimensions of bitmap
    If GetSize(File) = 0 Then RetVal = 0
  Else ' convert gif to DIB
    l = ManyGifLoad(File, PicWidth, PicHeight)'load gif
    If l <= 0 Then
      LogFile "Could not read GIF file " + File, 1
      RetVal = 0
    Else
      'where to store converted file
      TempName = RTrim$(BitmapsDir) + "\tmprary.dib"
      i = ManyDIBWrite(TempName)
      If i <> 0 Then 'check for error
    LogFile "Could not write GIF file " + TempName, 1
    RetVal = 0
      Else
    If ShowPic Then
      On Error GoTo LoadSlide_Error
      picture = LoadPicture(TempName)
      On Error GoTo 0
    End If
      End If
    End If
  End If
  LoadSlide = RetVal
  Exit Function
LoadSlide_Error:
  'could not load file, out of memory?
  On Error GoTo 0
  RetVal = 0
  LogFile ("Could not load file " + File), 1
  Resume Next
End Function
Function LoadSlideAndTile (File As String) As Integer
' returns zero on error
  Dim i As Integer, RetVal As Integer
  If File = "" Then
    RetVal = 0
  Else
    i = LoadSlide(File, 1)'put file on display
    If i = 0 Then 'check if could not load
      RetVal = 0
    Else
      Replicate
      RetVal = 1
    End If
  End If
  LoadSlideAndTile = RetVal
End Function
Sub MultiSpiros ()
  'Do spirograph like figures
  'reserve memory
  Const Deg2Pi = PI / 180
  Static MaxRad As Integer'maximum radius for circles
  Const MaxNodes = 35'maximum number of nodes on spiro
  Dim Nodes As Integer
  Const MaxRpts = 7'max times to go around circle
  Dim Rpts As Integer
  Const PlotPoints = 1'number of points to plot each time
  Const ClearCount = 3'number on screen before clearing
  Static PlotAngleIncr As Single
  Static PlotEndAngle As Single
  Static PlotAngle As Single
  Static SinIncr As Single
  Static SinAngle As Single
  Static Xcenter As Integer
  Static Ycenter As Integer
  Static Xincr As Integer
  Static Yincr As Integer
  Const MaxSpiro = 8' maximum number of simultaneous spiros
  Static SpiroCnt As Integer
  Static Rad1 As Integer
  Static Rad2 As Integer
  Dim r As Single
  Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, n As Integer
  Dim il As Long, jl As Long, kl As Long
  ' if first time then initialize
  If PlotInit = False Then
    'see if we need to reset changes made from previous init
    If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(0) = 0 Then
      Exit Sub
    End If
      PlotInit = True
      ForeColor = RGB(255, 255, 255)
      BackColor = RGB(0, 0, 0)
      Cls
     'initialize variables used
     PlotEndAngle = 0
     PlotAngle = 10
     MaxRad = ScaleHeight / 3'maximum radius for circles
     Pointer = 0
    Else 'reset changes done by previous init
      DrawWidth = 1' use narrow line
      ClearScreen
    End If
  Else  ' put run code here
   Do
    ' check if time to do new spiro
    If PlotAngle > PlotEndAngle Then
    'set foreground color
    ForeColor = GetBrightNonGray()
    PlotAngle = Rnd * 180 * Deg2Pi'initial offset
    Rpts = Rnd * MaxRpts + .5
    PlotAngleIncr = .125 * Rpts * Deg2Pi
    PlotEndAngle = 360 * Rpts * Deg2Pi + PlotAngle + PlotAngleIncr
    Nodes = Rnd * MaxNodes + .5
    SinIncr = PlotAngleIncr * Nodes / Rpts
    SinAngle = 0
    Rad1 = MaxRad * Rnd + ScaleHeight / 80
    Rad2 = MaxRad * Rnd + ScaleHeight / 80
    'get location of first
    Xcenter = Rnd * ScaleWidth * 3 / 4 + ScaleWidth / 8
    Ycenter = Rnd * ScaleHeight * 3 / 4 + ScaleHeight / 8
    'get location of last
    i = Rnd * ScaleWidth * 3 / 4 + ScaleWidth / 8
    j = Rnd * ScaleHeight * 3 / 4 + ScaleHeight / 8
    'get number
    SpiroCnt = (MaxSpiro - 2) * Rnd + 2' maximum number of simultaneous spiros
    'calculate increment
    Xincr = (i - Xcenter) / (SpiroCnt - 1)
    Yincr = (j - Ycenter) / (SpiroCnt - 1)
    DrawWidth = 1 + 2 * Rnd ' set line width
    GoSub 3000 'calculate x1 and y1
    Delay 2'pause before clearing screen
    End If
    For i = 1 To PlotPoints
      GoSub 3000 'calculate x1 and y1
      k = x1: l = y1: m = LastX: n = LastY
      'plot each spiro
      For j = 1 To SpiroCnt
    'draw line
    Line (m, n)-(k, l)
    'get location for next
    k = k + Xincr: l = l + Yincr
    m = m + Xincr: n = n + Yincr
      Next j
    Next i
    DoEvents
    CurrentTime = Timer
    If (CurrentTime > MaxTime) Or (LastTime > CurrentTime) Then Exit Sub
   Loop
  End If
  Exit Sub
3000 'calculate new point on screen
  LastX = x1: LastY = y1
  r = Rad1 + Rad2 * Sin(SinAngle)
  x1 = r * Cos(PlotAngle) + Xcenter
  y1 = r * Sin(PlotAngle) + Ycenter
  SinAngle = SinAngle + SinIncr
  PlotAngle = PlotAngle + PlotAngleIncr
  Return
End Sub
Sub NextSelection ()
Dim i As Integer
Dim Level As Single
If RandomFlag <> 0 Then
  ' pick a new selection but not the same as the last
    'i = Int(Rnd * MaxPlotType) + 1'choose next one at random
    Level = Rnd * TotalPriority' get random proportion of TP
    'now search array to see which saver this prop. falls into
    i = 1
    While (PriorityBreakPoints(i) <= Level)
      i = i + 1
    Wend
    'Debug.Print i, Level, TotalPriority
    If (i > MaxPlotType) Or (i < 1) Then i = PlotType'flag to try again
  Loop While (i = PlotType)
  PlotType = i
  PlotType = PlotType + 1
End If
LogFile ("Next Saver is" + Str$(PlotType)), 1
End Sub
Sub Patch ()
  ' copy blocks of original screen to random spots
  ' if first time then initialize
  If PlotInit = False Then
   'see if we need to reset changes made from previous init
   If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(1) = 0 Then
      Exit Sub
    End If
    ' set tick rate down
    Tick.Interval = 250
    ' start with original screen
    picture = original.Image
    PlotInit = True
    i = Int(Rnd * 2#) 'if i=0 then alternate reverse copy
  Else 'reset changes done by previous init
    ClearScreen
    'reset tick rate
    Tick.Interval = 50
  End If
  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
    If i = 0 And Rnd < .5 Then
    BitBlt hDC, x1, y1, BoxWidth, BoxHeight, DC, x2, y2, &H330008 'not source copy
    Else
    BitBlt hDC, x1, y1, BoxWidth, BoxHeight, DC, x2, y2, &HCC0020 'source copy
    End If
  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
  Dim il As Long, jl As Long, kl As Long
  Static Sets As Integer
  ' if first time then initialize
  If PlotInit = False Then
    'see if we need to reset changes made from previous init
    If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(0) = 0 Then
      Exit Sub
    End If
    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 'reset changes done by previous init
    'Set array size and clear the elements
    ReDim x1da(0, 0) As Integer
    ReDim y1da(0, 0) As Integer
    ReDim x1sa(0) As Single
    ReDim y1sa(0) As Single
    ReDim vx1sa(0) As Single
    ReDim vy1sa(0) As Single
    ReDim ax1sa(0) As Single
    ReDim ay1sa(0) As Single
    ClearScreen
  End If
  Else  ' put run code here
    ' check if time to get a new color
    If RepeatIndex > RepeatCount Then
    ' get colors
    l = GetBrightNonGray()
    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
    'see if we need to reset changes made from previous init
    If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(1) = 0 Then
      Exit Sub
    End If
    ' set tick rate down
    Tick.Interval = 1000
    ' start with original screen
    picture = original.Image
    'find background color
    m = QBColor(0)
    PlotInit = True
    Number = Rnd * 16 + 4
    'Number = 20
    BoxHeight = ScaleHeight / Number
    BoxWidth = ScaleWidth / Number
    'initialize blocks
    ReDim x1da(Number, Number) As Integer
    ReDim y1da(Number, Number) As Integer
    For x1 = 1 To Number
    For y1 = 1 To Number
        x1da(x1, y1) = (x1 - 1) * BoxWidth
        y1da(x1, y1) = (y1 - 1) * BoxHeight
    Next y1
    Next x1
  Else 'reset changes done by previous init
    ReDim x1da(0, 0) As Integer
    ReDim y1da(0, 0) As Integer
    'reset tick rate
    Tick.Interval = 50
    ClearScreen
  End If
  Else  ' put run code here
    If Int(Rnd * 2) = 1 Then 'shift column
    x1 = Rnd * Number + 1: If x1 > Number Then x1 = 1
    If Int(Rnd * 2) = 1 Then 'shift down
        tempx = x1da(x1, Number)
        tempy = y1da(x1, Number)
        For y1 = Number 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
        Line (x, y)-Step(BoxWidth, BoxHeight), m, B
        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
        Line (x, y)-Step(BoxWidth, BoxHeight), m, B
    Else ' shift up
        tempx = x1da(x1, 1)
        tempy = y1da(x1, 1)
        For y1 = 1 To (Number - 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
        Line (x, y)-Step(BoxWidth, BoxHeight), m, B

        Next y1
        y1 = Number
        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
        Line (x, y)-Step(BoxWidth, BoxHeight), m, B
    End If
    Else ' shift row
    y1 = Rnd * Number + 1: If y1 > Number Then y1 = 1
    If Int(Rnd * 2) = 1 Then 'shift right
        tempx = x1da(Number, y1)
        tempy = y1da(Number, y1)
        For x1 = Number 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
        Line (x, y)-Step(BoxWidth, BoxHeight), m, B
        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
        Line (x, y)-Step(BoxWidth, BoxHeight), m, B
    Else 'shift left
        tempx = x1da(1, y1)
        tempy = y1da(1, y1)
        For x1 = 1 To (Number - 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
        Line (x, y)-Step(BoxWidth, BoxHeight), m, B
        Next x1
        x1 = Number
        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
        Line (x, y)-Step(BoxWidth, BoxHeight), m, B
    End If
    End If
  End If
End Sub
Sub ReadPriorities ()
  Dim i As Integer, j As Integer
  Dim temp As String * 30, Out  As String
  Dim Priority As Single
  ReDim PriorityBreakPoints(MaxPlotType + 1) As Single
  ReDim Priorities(MaxPlotType) As Integer
  TotalPriority = 0
  For i = 1 To MaxPlotType
    j = GetPrivateProfileString(secName, PriorityBaseName + Int2Str(i), "1", temp, 28, iniName)
    Priority = Val(temp)
    Out = Out + Str$(Priority)
    If Priority < 0# Then Priority = 0#
    If Priority = 0# Then
      Priorities(i) = 0
    Else
      Priorities(i) = 1
    End If
    TotalPriority = TotalPriority + Priority
    PriorityBreakPoints(i) = TotalPriority
  Next
  LogFile "Priorites set to " + Out, 0
  PriorityBreakPoints(MaxPlotType + 1) = TotalPriority + 3.402E+38
End Sub
Sub Replicate ()
  Dim x As Integer, y As Integer, x1 As Integer, y1 As Integer
  DoEvents
  DC = CreateDC("DISPLAY", 0&, 0&, 0&)
  'limit sizes
  If PicWidth > ScrnWidth Then PicWidth = ScrnWidth
  If PicHeight > ScrnHeight Then PicHeight = ScrnHeight
  If (PicWidth < ScrnWidth) Or (PicHeight < ScrnHeight) Then
    'need to center picture
    'first backup picture
    BitBlt original.hDC, 0, 0, PicWidth, PicHeight, DC, 0, 0, &HCC0020
    'clear original
    'Picture = LoadPicture()
    ' now copy back centered
    x = ScrnWidth / 2 - PicWidth / 2
    y = ScrnHeight / 2 - PicHeight / 2
    BitBlt hDC, x, y, PicWidth, PicHeight, original.hDC, 0, 0, &HCC0020
  End If
  If (PicWidth < ScrnWidth) Then 'fill row
    '1st copy left
    x1 = x
    While x1 > 0
      BitBlt hDC, x1 - PicWidth, 0, PicWidth, ScrnHeight, hDC, x, 0, &HCC0020
      x1 = x1 - PicWidth
    Wend
    'next copy right
    x1 = x
    While x1 < ScrnWidth
      BitBlt hDC, x1 + PicWidth, 0, PicWidth, ScrnHeight, hDC, x, 0, &HCC0020
      x1 = x1 + PicWidth
    Wend
  End If
  If (PicHeight < ScrnHeight) Then
    '1st copy up
    y1 = y
    While y1 > 0
      BitBlt hDC, 0, y1 - PicHeight, ScrnWidth, PicHeight, hDC, 0, y, &HCC0020
      y1 = y1 - PicHeight
    Wend
    'next copy down
    y1 = y
    While y1 < ScrnHeight
      BitBlt hDC, 0, y1 + PicHeight, ScrnWidth, PicHeight, hDC, 0, y, &HCC0020
      y1 = y1 + PicHeight
    Wend
  End If
  i = DeleteDC(DC)
End Sub
Sub Roll ()
  ' the display rolls both horizontally and vertically
  Dim v As Integer
  ' if first time then initialize
  If PlotInit = False Then
    'see if we need to reset changes made from previous init
    If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(1) = 0 Then
      Exit Sub
    End If
    ' 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 'reset changes done by previous init
    ClearScreen
  End If
  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 RunSelection ()
    ' execute the appropriate selection
    Select Case PlotType
    Case 1: Squiggles
    Case 2: Kalied2
    Case 3: Polygons
    Case 4: Circles
    Case 5: Kalied
    Case 6: Lines
    Case 7: Roll
    Case 8: FilledCircles
    Case 9: Patch
    Case 10: Spiro
    Case 11: Scrape
    Case 12: Stretch
    Case 13: Dribble
    Case 14: Drop
    Case 15: Slides
    Case 16: FilledPolygons
    Case 17: MultiSpiros
    Case 18: Puzzle
    Case 19: ShootHoles
    Case 20: CyclePalette
    Case 21: Confetti
    Case Else: PlotType = 1
           RunSelection ' try again
    End Select
End Sub
Sub Scrape ()
  Static smear As Integer
  ' bitblt's with various patterns, dragging them
  ' across the screen randomly
  ' if first time then initialize
  If PlotInit = False Then
    'see if we need to reset changes made from previous init
    If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(1) = 0 Then
      Exit Sub
    End If
    ' start with original screen
    picture = original.Image
    PlotInit = True
    'determine initial position of line
    x1 = Rnd * ScaleWidth
    y1 = 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
    'default for smear
    smear = False
    ' choose scrape type at random
    i = Rnd * 14 + 1
    'i = 12
    Select Case i
    Case 1: Pattern = &H42 'Black Out
        Locked = True
    Case 2: Pattern = &HFF0062 'White Out
        Locked = True
    Case 3: Pattern = &HBB0226 'MergePaint
        Locked = False
    Case 4: Pattern = &H330008 'Not source copy
        Locked = True
    Case 5: Pattern = &H330008 'Not source copy
        Locked = False
    Case 6: Pattern = &H330008 'Not source copy
        Locked = False
        picture = LoadPicture() ' start with blank screen
    Case 7: Pattern = &H330008 'Not source copy
        smear = True
        'set random source location
        x2 = Rnd * (ScaleWidth - BoxWidth)
        y2 = Rnd * (ScaleHeight - BoxHeight)
    Case 8: Pattern = &H660046 'source invert
        Locked = True
    Case 9: Pattern = &H8800C6 'source and
        Locked = False
    Case 10: Pattern = &HEE0086 'source paint (or)
        Locked = False
    Case 11: Pattern = &H550009 'Invert Destination
        Locked = True
    Case 12: Pattern = &HCC0020 'Source Copy
        Locked = False
    Case 13: Pattern = &HCC0020 'Source Copy
        Locked = True
        picture = LoadPicture() ' start with blank screen
    Case Else: Pattern = &HCC0020 'Source Copy
        smear = True
        'set random source location
        x2 = Rnd * (ScaleWidth - BoxWidth)
        y2 = Rnd * (ScaleHeight - BoxHeight)
    End Select
  Else 'reset changes done by previous init
    ClearScreen
  End If
  Else  ' put run code here
    If smear Then
      'do nothing
    ' do locking if necessary
    ElseIf 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 SetWindow2DIBPalette (State As Integer)
  Dim i As Integer, j As Integer, k As Integer, l As Integer
  Dim usepal%
  'read dib palette into logical palette for cycling
  ManyLoadLogPal Pal, 0, 256, State
  usepal% = SendMessageByNum(hWnd, VBM_GETPALETTE, 0, 0)
  'this has problems:
  'i = SetPaletteEntries%(usepal%, 0, PALENTRIES, Pal.palPalEntry(0))
  'Pal.palNumEntries
  'try to set windows palette to logical palette using clipboard
  If PaletteHandle <> 0 Then
    i = DeleteObject(PaletteHandle)
  End If
  PaletteHandle = CreatePalette(Pal)
  j = OpenClipboard(hWnd)
  k = SetClipboardData(CF_PALETTE, PaletteHandle)
  l = CloseClipboard()
  picture = Clipboard.GetData(CF_PALETTE)
  Clipboard.Clear
End Sub
Sub ShootHoles ()
  ' shoots small holes approximately at the same place
  Dim i As Integer, j As Integer, k As Integer
  Dim r As Long, x As Long, y As Long
  Static Radius As Integer, HoleSize  As Integer
  Dim temp As Single
  Const pi2 = PI * 2
  ' if first time then initialize
  If PlotInit = False Then
    'see if we need to reset changes made from previous init
    If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(1) = 0 Then
      Exit Sub
    End If
    ' start with original screen
    picture = original.Image
    PlotInit = True
    'determine initial position of shot
    x1 = Rnd * ScaleWidth
    y1 = Rnd * ScaleHeight
    'determine maximum radius of shot
    Radius = (ScaleHeight - 100) * Rnd + 100
    'set size of holes
    HoleSize = 20 * Rnd ^ 2 + 2
    RunMode = Int(Rnd * 3)'choose color mode to show
    FillStyle = 0 'solid fill
    If RunMode > 0 Then ' if random color then use larger spots
    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
    ForeColor = GetNearestColor(hDC, RGB(i, j, k))
    FillColor = ForeColor
    Else
      ForeColor = RGB(0, 0, 0)' use black box
      FillColor = RGB(0, 0, 0) 'set black fill
    End If
  Else 'reset changes done by previous init
    ClearScreen
    FillStyle = 1 'transparent fill
  End If
Else  ' put run code here
    If RunMode > 1 Then ' if random color then use larger spots
    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
    ForeColor = GetNearestColor(hDC, RGB(i, j, k))
    FillColor = ForeColor
    End If
    'get distance from center
    r = Rnd * Radius
    'get random angle
    temp = Rnd * pi2
    'get x portion
    x = r * Cos(temp)
    'get y portion
    y = r * Sin(temp)
    ' randomly change sign of x offset
    If Rnd > .5 Then
      x = -x
    End If
    ' randomly change sign of y offset
    If Rnd > .5 Then
      y = -y
    End If
    ' put random hole here
    Circle (x1 + x, y1 + y), HoleSize, , , , 1
  End If
End Sub
Sub ShowPal (palette As LOGPALETTE)
'displays the current palette
    Dim usepal%
    ' Get a handle to the control's palette
    usepal% = SendMessageByNum(hWnd, VBM_GETPALETTE, 0, 0)
    AnimatePalette usepal%, 0, PALENTRIES, palette.palPalEntry(0)
End Sub
Sub Slides ()
  'cycle between different bitmaps
  Dim j As Integer
  Static File As String
  Static OldTime As Long
  Static running As Integer
  Dim CurTime As Long
  Dim FileName As String
  ' if first time then initialize
  If PlotInit = False Then
   'see if we need to reset changes made from previous init
   If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(1) = 0 Then
      Exit Sub
    End If
    File = GetNextFile(BitmapsDir, 1, "gif", "bmp", "")
    If File = "" Then 'check if could not find bitmap
      NextSelection 'jump to next since there are no bitmap files in directory
      Exit Sub
    End If
    ' find file
    j = Rnd * 50 ' pick file at random
    For i = 1 To j
      File = GetNextFile(BitmapsDir, 0, "gif", "bmp", "")' get next file
    Next i
    i = LoadSlideAndTile(File)
    If i = 0 Then 'check if could not load
      NextSelection 'jump to next since there are no bitmap files in directory
      Exit Sub
    End If
    OldTime = Timer
    running = False
    PlotInit = True
  Else 'reset changes done by previous init
    ' save screen in place of original for latter use
    ' we do this because on palette based systems
    ' the slide procedure messes up the color
    ' palette and the Clipboard.setData 9 and
    ' Clipboard.GetData(9) sequence does not restore
    ' it, so we just use the new picture with the
    ' new palette from now on
    DC = CreateDC("DISPLAY", 0&, 0&, 0&)
    BitBlt original.hDC, 0, 0, ScrnWidth, ScrnHeight, DC, 0, 0, &HCC0020
    i = DeleteDC(DC)
    i = ManyDibFree() 'free memory used for dib
    If i <> 0 Then
      LogFile "Could not free memory", 1
    End If
    ClearScreen
  End If
Else  ' put run code here
    If running Then Exit Sub ' no recursive calls
    If File = "" Then Exit Sub
    CurTime = Timer
    If (CurTime >= OldTime) And ((OldTime + BmpSeconds) > CurTime) Then Exit Sub
    OldTime = Timer
    running = True
    j = Rnd * 20
    For i = 1 To j
      File = GetNextFile(BitmapsDir, 0, "gif", "bmp", "")' get next file
    Next i
    i = LoadSlideAndTile(File)
    If i = 0 Then 'check if could not load
      NextSelection 'jump to next since there are no bitmap files in directory
      Exit Sub
    End If
  End If
  running = False
  Exit Sub
End Sub
Sub Spiro ()
  'Do spirograph like figures
  'reserve memory
  Const Deg2Pi = PI / 180
  Static MaxRad As Integer'maximum radius for circles
  Const MaxNodes = 35'maximum number of nodes on spiro
  Dim Nodes As Integer
  Const MaxRpts = 7'max times to go around circle
  Dim Rpts As Integer
  Const PlotPoints = 1'number of points to plot each time
  Const ClearCount = 3'number on screen before clearing
  Static PlotAngleIncr As Single
  Static PlotEndAngle As Single
  Static PlotAngle As Single
  Static SinIncr As Single
  Static SinAngle As Single
  Static Xcenter As Integer
  Static Ycenter As Integer
  Static Rad1 As Integer
  Static Rad2 As Integer
  Dim r As Single
  Dim l As Integer
  ' if first time then initialize
  If PlotInit = False Then
   'see if we need to reset changes made from previous init
   If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(0) = 0 Then
      Exit Sub
    End If
      PlotInit = True
      ForeColor = RGB(255, 255, 255)
      BackColor = RGB(0, 0, 0)
      Cls
     'initialize variables used
     PlotEndAngle = 0
     PlotAngle = 10
     MaxRad = ScaleHeight / 3'maximum radius for circles
     Pointer = 0
    Else 'reset changes done by previous init
      DrawWidth = 1' use narrow line
      ClearScreen
    End If
  Else  ' put run code here
   Do
    ' check if time to do new spiro
    If PlotAngle > PlotEndAngle Then
    'set foreground color
    ForeColor = GetBrightNonGray()
    PlotAngle = Rnd * 180 * Deg2Pi'initial offset
    Rpts = Rnd * MaxRpts + .5
    PlotAngleIncr = .125 * Rpts * Deg2Pi
    PlotEndAngle = 360 * Rpts * Deg2Pi + PlotAngle + PlotAngleIncr
    Nodes = Rnd * MaxNodes + .5
    SinIncr = PlotAngleIncr * Nodes / Rpts
    SinAngle = 0
    Rad1 = MaxRad * Rnd + ScaleHeight / 80
    Rad2 = MaxRad * Rnd + ScaleHeight / 80
    Xcenter = Rnd * ScaleWidth * 3 / 4 + ScaleWidth / 8
    Ycenter = Rnd * ScaleHeight * 3 / 4 + ScaleHeight / 8
    DrawWidth = 1 + 2 * Rnd' use narrow line
    GoSub 2000 'calculate x1 and y1
    Pointer = Pointer + 1
    If Pointer >= ClearCount Then
      Delay 3'pause before clearing screen
      Cls
      Pointer = 0
    End If
    currentx = x1
    currenty = y1
    End If
    For l = 1 To PlotPoints
      GoSub 2000 'calculate x1 and y1
      'draw line
      'Line (LastX, LastY)-(x1, y1)
      Line -(x1, y1)
    Next l
    DoEvents
    CurrentTime = Timer
    If (CurrentTime > MaxTime) Or (LastTime > CurrentTime) Then Exit Sub
   Loop
  End If
  Exit Sub
2000 'calculate new point on screen
  'LastX = x1: LastY = y1
  r = Rad1 + Rad2 * Sin(SinAngle)
  x1 = r * Cos(PlotAngle) + Xcenter
  y1 = r * Sin(PlotAngle) + Ycenter
  SinAngle = SinAngle + SinIncr
  PlotAngle = PlotAngle + PlotAngleIncr
  Return
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
  Dim il As Long, jl As Long, kl As Long
  Static SquigNumb As Integer
  Static SquigLen As Integer
  Static EndPointer As Integer, StartPointer As Integer
  ' if first time then initialize
  If PlotInit = False Then
   'see if we need to reset changes made from previous init
   If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(0) = 0 Then
      Exit Sub
    End If
    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)
    ' get colors
    For ii = 1 To SquigNumb
    Colors(ii) = GetBrightNonGray()
    Next ii
    'Calculate velocity limits
    MaxSpeedX = ScaleWidth * 15! / 800
    MaxSpeedY = ScaleWidth * 15! / 600
  Else 'reset changes done by previous init
    ReDim x1da(0, 0)  As Integer
    ReDim y1da(0, 0)  As Integer
    ReDim x1sa(0) As Single
    ReDim y1sa(0) As Single
    ReDim vx1sa(0) As Single
    ReDim vy1sa(0) As Single
    ReDim ax1sa(0) As Single
    ReDim ay1sa(0) As Single
    ReDim Colors(0) As Long
    ClearScreen
  End If
  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
    If Rnd < .1 Then 'change a color 10% of the time
      ii = Int(Rnd * SquigNumb + 1)' get random squiggle to change
      If ii > SquigNumb Then ii = 1
      Colors(ii) = GetBrightNonGray()
    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 Stretch ()
    Dim x As Integer, y As Integer
    Static ShadowDC As Integer
    Static oldBM As Integer
  ' does a StretchBlt from a random box within the Original
  ' image and then displays it on the screen
  ' if first time then initialize
  If PlotInit = False Then
    'see if we need to reset changes made from previous init
    If PlotEnd = False Then
    'check if saver is permitted to run
    If CheckIfValidSaver(1) = 0 Then
      Exit Sub
    End If
    'see how many colors display can handle
    If TotalNumColors <= 256 Then 'see if palette based
      LogFile ("Saver does not work in palette display mode: " + Str$(PlotType)), 0
      NextSelection 'jump to next since this does not work
            'well with palettes
      Exit Sub
    End If
    ' set tick rate down
    Tick.Interval = 300
    ' start with original screen
    picture = original.Image
    ' start temp form same as original
    DC = original.hDC
    BitBlt hDC, 0, 0, ScaleWidth, ScaleHeight, DC, 0, 0, &HCC0020
    'BitBlt Temp.hDC, 0, 0, ScaleWidth, ScaleHeight, hDC, 0, 0, &HCC0020
    'create hidden DC
    'ShadowDC = CreateCompatibleDC(hDC)
    'oldBM = SelectObject(ShadowDC, Original.Image)
    PlotInit = True
    'initial position is 1:1 copy
    x1 = 0
    y1 = 0
    x2 = ScaleWidth
    y2 = ScaleHeight
    'Calculate velocity limits
    MaxSpeedX = ScaleWidth * 15! / 800
    MaxSpeedY = ScaleWidth * 15! / 600
    ' zero initial velocity
    vx1 = MaxSpeedX * Rnd
    vy1 = MaxSpeedY * Rnd
    vx2 = -MaxSpeedX * Rnd
    vy2 = -MaxSpeedY * Rnd
    Pattern = &HCC0020 'Source Copy
  Else 'reset changes done by previous init
    ClearScreen
    'reset tick rate
    Tick.Interval = 50
    'destroy Device context
    'i = SelectObject(ShadowDC, oldBM)
    'i = DeleteDC(ShadowDC)
  End If
  Else  ' put run code here
    'make sure x1,y1 less than x2,y2 or swap
    If x1 > x2 Then x = x1: x1 = x2: x2 = x
    If y1 > y2 Then y = y1: y1 = y2: y2 = y
    'make sure that source box size does not
    'go below a minimum
    If x2 - x1 < 40 Then x2 = x1 + 40
    If y2 - y1 < 40 Then y2 = y1 + 40
    'Stretch Box from x1,y1 to x2,y2 onto display
    ' direct route does not work right:
    'DC = Original.hDC
    'i = StretchBlt(hDC, ByVal 0, ByVal 0, ScaleWidth, ScaleHeight, DC, x1, y1, x, y, &HCC0020)
    'indirect route does not work on pallete display modes:
    DC = original.hDC
    x = x2 - x1: y = y2 - y1
    i = StretchBlt(temp.hDC, ByVal 0, ByVal 0, ScaleWidth, ScaleHeight, DC, x1, y1, x, y, &HCC0020)
    ' now that it has been stretched, write to display
    DC = temp.hDC
    BitBlt hDC, 0, 0, ScaleWidth, ScaleHeight, DC, 0, 0, &HCC0020
    'try this method:
    'i = StretchBlt(hDC, ByVal 0, ByVal 0, ScaleWidth, ScaleHeight, ShadowDC, x1, y1, x, y, &HCC0020)
    'determine new acceleration
    ax1 = Rnd - .5
    ay1 = Rnd - .5
    ax2 = Rnd - .5
    ay2 = Rnd - .5

    'calculate new position
    x1 = x1 + vx1
    y1 = y1 + vy1
    x2 = x2 + vx2
    y2 = y2 + vy2
    '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
    vx2 = (vx2 + ax2): If Abs(vx2) > MaxSpeedX Then vx2 = 0: ax2 = 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)
        x1 = ScaleWidth - 1
    ElseIf (x1 < 0) Then
        'change direction
        vx1 = Abs(vx1)
        x1 = 0
    End If
    If (y1 >= ScaleHeight) Then
        'change direction
        vy1 = -Abs(vy1)
        y1 = ScaleHeight - 1
    ElseIf (y1 < 0) Then
        'change direction
        vy1 = Abs(vy1)
        y1 = 0
    End If
    'check if off screen
    If (x2 >= ScaleWidth) Then
        'change direction
        vx2 = -Abs(vx2)
        x2 = ScaleWidth - 1
    ElseIf (x2 < 0) Then
        'change direction
        vx2 = Abs(vx2)
        x2 = 0
    End If
    If (y2 >= ScaleHeight) Then
        'change direction
        vy2 = -Abs(vy2)
        y2 = ScaleHeight - 1
    ElseIf (y2 < 0) Then
        'change direction
        vy2 = Abs(vy2)
        y2 = 0
    End If
  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
    ZOrder 0' make sure form is still on top
    'clear old saver
    PlotInit = False: PlotEnd = True
    LogFile ("Cleanup of" + Str$(PlotType)), 1
    RunSelection 'just clean up after running
    'LogFile ("After Cleanup of " + Str$(PlotType)), 1
    'see if we want random selection
    NextSelection 'get new PlotType
    PlotInit = False: PlotEnd = False
    'remove password prompt
    PasswordLabel.Visible = False
    End If
    LastTime = CurrentTime
    RunSelection
End Sub