Programming Tool Box/SIMS_2.iso/vb_tools/manythng/manythng.frm

Text File | 1994-09-28 | 101KB | 4,109 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
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

  Do
    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
    Cls

    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
  Do
    '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

Else
  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