lblColor = "Color = " & "&&H" & Hex$(RGBColor)

Option Explicit

Private Declare Function WinHelp _
Lib "user32" Alias "WinHelpA" ( _
    ByVal hwnd As Long, _
    ByVal lpHelpFile As String, _
    ByVal wCommand As Long, _
    ByVal dwData As Long _
) As Long

Dim RGBColor
Dim hsvDemo As New HSV
Dim hslDemo As New HSL

Private Sub Form_Load()
    `Set a gray starting color
    With hsvDemo
        .Red = 127
        .Green = 127
        .Blue = 127
    End With
    With hslDemo
        .Red = 127
        .Green = 127
        .Blue = 127
    End With
    Update
End Sub
Private Sub mnuAbout_Click()
    `Set properties
    About.Application = "HSVHSL"
    About.Heading = _
        "Microsoft Visual Basic 6.0 Developer's Workshop"
    About.Copyright = "1998 John Clark Craig and Jeff Webb"


    `Call a method
    About.Display
End Sub

Private Sub mnuContents_Click()
    WinHelp hwnd, App.Path & "\..\..\Help\Mvbdw.hlp", _
        cdlHelpContents, 0
End Sub

Private Sub mnuExit_Click()
    Unload Me
End Sub

Private Sub mnuSearch_Click()
    WinHelp hwnd, App.Path & "\..\..\Help\Mvbdw.hlp", _
        cdlHelpPartialKey, 0
End Sub

Sub Update()
    sliRGB(0).Value = hsvDemo.Red
    sliRGB(1).Value = hsvDemo.Green
    sliRGB(2).Value = hsvDemo.Blue
    sliHSV(0).Value = hsvDemo.Hue
    sliHSV(1).Value = hsvDemo.Saturation
    sliHSV(2).Value = hsvDemo.Value
    sliHSL(0).Value = hslDemo.Hue
    sliHSL(1).Value = hslDemo.Saturation
    sliHSL(2).Value = hslDemo.Luminosity
    `Update RGB color labels
    lblRGB(0).Caption = Format$(hsvDemo.Red, "##0")
    lblRGB(1).Caption = Format$(hsvDemo.Green, "##0")
    lblRGB(2).Caption = Format$(hsvDemo.Blue, "##0")
    `Update HSV color labels
    lblHSV(0).Caption = Format$(hsvDemo.Hue, "##0")

    lblHSV(1).Caption = Format$(hsvDemo.Saturation, "##0")
    lblHSV(2).Caption = Format$(hsvDemo.Value, "##0")
    `Update HSL color labels
    lblHSL(0).Caption = Format$(sliHSL(0).Value, "##0")
    lblHSL(1).Caption = Format$(sliHSL(1).Value, "##0")
    lblHSL(2).Caption = Format$(sliHSL(2).Value, "##0")
    `Update the displayed color
    RGBColor = RGB(hsvDemo.Red, hsvDemo.Green, hsvDemo.Blue)
    picColor.BackColor = RGBColor
    `Update the color's number
    lblColor = "Color = " & "&&H" & Hex$(RGBColor)
End Sub

Private Sub sliHSL_Scroll(Index As Integer)
    hslDemo.Hue = sliHSL(0).Value
    hslDemo.Saturation = sliHSL(1).Value
    hslDemo.Luminosity = sliHSL(2).Value
    hsvDemo.Red = hslDemo.Red
    hsvDemo.Green = hslDemo.Green
    hsvDemo.Blue = hslDemo.Blue
    Update
End Sub

Private Sub sliRGB_Scroll(Index As Integer)
    hsvDemo.Red = sliRGB(0).Value
    hsvDemo.Green = sliRGB(1).Value
    hsvDemo.Blue = sliRGB(2).Value
    hslDemo.Red = hsvDemo.Red
    hslDemo.Green = hsvDemo.Green
    hslDemo.Blue = hsvDemo.Blue
    Update
End Sub

Private Sub sliHSV_Scroll(Index As Integer)

    hsvDemo.Hue = sliHSV(0).Value
    hsvDemo.Saturation = sliHSV(1).Value
    hsvDemo.Value = sliHSV(2).Value
    hslDemo.Red = hsvDemo.Red
    hslDemo.Green = hsvDemo.Green
    hslDemo.Blue = hsvDemo.Blue
    Update
End Sub

`HSV.CLS
Option Explicit

`RGB color properties
Private mintRed As Integer
Private mintGreen As Integer
Private mintBlue As Integer

`HSV color properties
Private msngHue As Single
Private msngSaturation As Single
Private msngValue As Single

`Keep track of implied conversion
Private mintCalc As Integer
Private Const RGB2HSV = 1
Private Const HSV2RGB = 2

`~~~ Hue
Property Let Hue(intHue As Integer)
    msngHue = intHue
    mintCalc = HSV2RGB
End Property

Property Get Hue() As Integer
    If mintCalc = RGB2HSV Then CalcHSV
    Hue = msngHue
End Property
`~~~ Saturation
Property Let Saturation(intSaturation As Integer)
    msngSaturation = intSaturation
    mintCalc = HSV2RGB
End Property
Property Get Saturation() As Integer
    If mintCalc = RGB2HSV Then CalcHSV
    Saturation = msngSaturation
End Property

`~~~ Value
Property Let Value(intValue As Integer)
    msngValue = intValue
    mintCalc = HSV2RGB
End Property
Property Get Value() As Integer
    If mintCalc = RGB2HSV Then CalcHSV
    Value = msngValue
End Property

`~~~ Red
Property Let Red(intRed As Integer)
    mintRed = intRed
    mintCalc = RGB2HSV
End Property

Property Get Red() As Integer
    If mintCalc = HSV2RGB Then CalcRGB
    Red = mintRed
End Property

`~~~ Green
Property Let Green(intGreen As Integer)
    mintGreen = intGreen
    mintCalc = RGB2HSV
End Property
Property Get Green() As Integer
    If mintCalc = HSV2RGB Then CalcRGB
    Green = mintGreen
End Property

`~~~ Blue
Property Let Blue(intBlue As Integer)
    mintBlue = intBlue
    mintCalc = RGB2HSV
End Property
Property Get Blue() As Integer
    If mintCalc = HSV2RGB Then CalcRGB
    Blue = mintBlue
End Property

`Converts RGB to HSV
Private Sub CalcHSV()
    Dim sngRed As Single
    Dim sngGreen As Single
    Dim sngBlue As Single
    Dim sngMx As Single
    Dim sngMn As Single
    Dim sngDelta As Single
    Dim sngVa As Single
    Dim sngSa As Single
    Dim sngRc As Single
    Dim sngGc As Single

    Dim sngBc As Single
    sngRed = mintRed / 255
    sngGreen = mintGreen / 255
    sngBlue = mintBlue / 255
    sngMx = sngRed
    If sngGreen > sngMx Then sngMx = sngGreen
    If sngBlue > sngMx Then sngMx = sngBlue
    sngMn = sngRed
    If sngGreen < sngMn Then sngMn = sngGreen
    If sngBlue < sngMn Then sngMn = sngBlue
    sngDelta = sngMx - sngMn
    sngVa = sngMx
    If sngMx Then
        sngSa = sngDelta / sngMx
    Else
        sngSa = 0
    End If
    If sngSa = 0 Then
        msngHue = 0
    Else
        sngRc = (sngMx - sngRed) / sngDelta
        sngGc = (sngMx - sngGreen) / sngDelta
        sngBc = (sngMx - sngBlue) / sngDelta
        Select Case sngMx
        Case sngRed
            msngHue = sngBc - sngGc
        Case sngGreen
            msngHue = 2 + sngRc - sngBc
        Case sngBlue
            msngHue = 4 + sngGc - sngRc
        End Select
        msngHue = msngHue * 60
        If msngHue < 0 Then msngHue = msngHue + 360
    End If

    msngSaturation = sngSa * 100
    msngValue = sngVa * 100
    mintCalc = 0
End Sub

`Converts HSV to RGB
Private Sub CalcRGB()
    Dim sngSaturation As Single
    Dim sngValue As Single
    Dim sngHue As Single
    Dim intI As Integer
    Dim sngF As Single
    Dim sngP As Single
    Dim sngQ As Single
    Dim sngT As Single
    Dim sngRed As Single
    Dim sngGreen As Single
    Dim sngBlue As Single
    sngSaturation = msngSaturation / 100
    sngValue = msngValue / 100
    If msngSaturation = 0 Then
        sngRed = sngValue
        sngGreen = sngValue
        sngBlue = sngValue
    Else
        sngHue = msngHue / 60
        If sngHue = 6 Then sngHue = 0
        intI = Int(sngHue)
        sngF = sngHue - intI
        sngP = sngValue * (1! - sngSaturation)
        sngQ = sngValue * (1! - (sngSaturation * sngF))
        sngT = sngValue * (1! - (sngSaturation * (1! - sngF)))
        Select Case intI
        Case 0

            sngRed = sngValue
            sngGreen = sngT
            sngBlue = sngP
        Case 1
            sngRed = sngQ
            sngGreen = sngValue
            sngBlue = sngP
        Case 2
            sngRed = sngP
            sngGreen = sngValue
            sngBlue = sngT
        Case 3
            sngRed = sngP
            sngGreen = sngQ
            sngBlue = sngValue
        Case 4
            sngRed = sngT
            sngGreen = sngP
            sngBlue = sngValue
        Case 5
            sngRed = sngValue
            sngGreen = sngP
            sngBlue = sngQ
        End Select
    End If
    mintRed = Int(255.9999 * sngRed)
    mintGreen = Int(255.9999 * sngGreen)
    mintBlue = Int(255.9999 * sngBlue)
    mintCalc = 0
End Sub

`HSL.CLS
Option Explicit

`RGB color properties
Private mintRed As Integer
Private mintGreen As Integer
Private mintBlue As Integer

`HSL color properties
Private msngHue As Single
Private msngSaturation As Single
Private msngLuminosity As Single

`Keep track of implied conversion
Private mintCalc As Integer
Private Const RGB2HSL = 1
Private Const HSL2RGB = 2

`~~~ Hue
Property Let Hue(intHue As Integer)
    msngHue = (intHue / 240!) * 360!
    mintCalc = HSL2RGB
End Property
Property Get Hue() As Integer
    If mintCalc = RGB2HSL Then CalcHSL
    Hue = (msngHue / 360!) * 240!
End Property

`~~~ Saturation
Property Let Saturation(intSaturation As Integer)
    msngSaturation = intSaturation / 240!
    mintCalc = HSL2RGB
End Property
Property Get Saturation() As Integer
 
    If mintCalc = RGB2HSL Then CalcHSL
    Saturation = msngSaturation * 240!
End Property

`~~~ Luminosity
Property Let Luminosity(intLuminosity As Integer)
    msngLuminosity = intLuminosity / 240!
    mintCalc = HSL2RGB
End Property
Property Get Luminosity() As Integer
    If mintCalc = RGB2HSL Then CalcHSL
    Luminosity = msngLuminosity * 240!
End Property

`~~~ Red
Property Let Red(intRed As Integer)
    mintRed = intRed
    mintCalc = RGB2HSL
End Property

Property Get Red() As Integer
    If mintCalc = HSL2RGB Then CalcRGB
    Red = mintRed
End Property

`~~~ Green
Property Let Green(intGreen As Integer)
    mintGreen = intGreen
    mintCalc = RGB2HSL
End Property
Property Get Green() As Integer
    If mintCalc = HSL2RGB Then CalcRGB
    Green = mintGreen
End Property

`~~~ Blue
Property Let Blue(intBlue As Integer)
    mintBlue = intBlue
    mintCalc = RGB2HSL
End Property
Property Get Blue() As Integer
    If mintCalc = HSL2RGB Then CalcRGB
    Blue = mintBlue
End Property

Private Sub CalcHSL()
    Dim sngMx As Single
    Dim sngMn As Single
    Dim sngDelta As Single
    Dim sngPctRed As Single
    Dim sngPctGrn As Single
    Dim sngPctBlu As Single
    sngPctRed = mintRed / 255
    sngPctGrn = mintGreen / 255
    sngPctBlu = mintBlue / 255
    sngMx = sngMaxOf(sngMaxOf(sngPctRed, sngPctGrn), sngPctBlu)
    sngMn = sngMinOf(sngMinOf(sngPctRed, sngPctGrn), sngPctBlu)
    sngDelta = sngMx - sngMn
    msngLuminosity = (sngMx + sngMn) / 2
    If sngMx = sngMn Then
        msngSaturation = 0
    Else
        msngSaturation = 1
    End If
    If msngLuminosity <= 0.5 Then
        If msngSaturation > 0 Then
            msngSaturation = sngDelta / (sngMx + sngMn)
        End If

    Else
        If msngSaturation > 0 Then
            msngSaturation = sngDelta / (2 - sngMx - sngMn)
        End If
    End If
    If msngSaturation Then
        If sngPctRed = sngMx Then
            msngHue = (sngPctGrn - sngPctBlu) / sngDelta
        End If
        If sngPctGrn = sngMx Then
            msngHue = 2 + (sngPctBlu - sngPctRed) / sngDelta
        End If
        If sngPctBlu = sngMx Then
            msngHue = 4 + (sngPctRed - sngPctGrn) / sngDelta
        End If
        msngHue = msngHue * 60
    End If
    If msngHue < 0 Then msngHue = msngHue + 360
    mintCalc = 0
End Sub

Private Sub CalcRGB()
    Dim sngM1 As Single
    Dim sngM2 As Single
    Dim sngPctRed As Single
    Dim sngPctGrn As Single
    Dim sngPctBlu As Single
    If msngLuminosity <= 0.5 Then
        sngM2 = msngLuminosity * (1! + msngSaturation)
    Else
        sngM2 = (msngLuminosity + msngSaturation) _
            - (msngLuminosity * msngSaturation)
    End If
    sngM1 = 2! * msngLuminosity - sngM2

    If msngSaturation = 0! Then
        sngPctRed = msngLuminosity
        sngPctGrn = msngLuminosity
        sngPctBlu = msngLuminosity
    Else
        sngPctRed = rgbVal(sngM1, sngM2, msngHue + 120!)
        sngPctGrn = rgbVal(sngM1, sngM2, msngHue)
        sngPctBlu = rgbVal(sngM1, sngM2, msngHue - 120!)
    End If
    mintRed = Int(255.9999 * sngPctRed)
    mintGreen = Int(255.9999 * sngPctGrn)
    mintBlue = Int(255.9999 * sngPctBlu)
    mintCalc = 0
End Sub

Private Function rgbVal(sngN1 As Single, sngN2 As Single, _
sngHue As Single) As Single
   If sngHue > 360 Then
      sngHue = sngHue - 360
   ElseIf sngHue < 0 Then
      sngHue = sngHue + 360
   End If
   If sngHue < 60 Then
      rgbVal = sngN1 + (sngN2 - sngN1) * sngHue / 60
   ElseIf sngHue < 180 Then
      rgbVal = sngN2
   ElseIf sngHue < 240 Then
      rgbVal = sngN1 + (sngN2 - sngN1) * (240 - sngHue) / 60
   Else
      rgbVal = sngN1
   End If
End Function

Private Function sngMaxOf(sngV1 As Single, sngV2 As Single) As Single
    sngMaxOf = IIf(sngV1 > sngV2, sngV1, sngV2)
End Function

Private Function sngMinOf(sngV1 As Single, sngV2 As Single) As Single
   sngMinOf = IIf(sngV1 < sngV2, sngV1, sngV2)
End Function

Option Explicit

Private Sub cmdOK_Click()
    `Cancel About form
    Unload Me
End Sub

Private Sub Form_Load()
    `Center this form
    Left = (Screen.Width - Width) \ 2
    Top = (Screen.Height - Height) \ 2
    `Set defaults
    lblApplication.Caption = "- Application -"
    lblHeading.Caption = "- Heading -"
    lblCopyright.Caption = "- Copyright -"
End Sub

Public Sub Display()
    `Display self as modal
    Show vbModal
End Sub

Property Let Application(Application As String)
    `Define string property for Application
    lblApplication.Caption = Application
End Property
 
Property Let Heading(Heading As String)
    `Define string property for Heading
    lblHeading.Caption = Heading
End Property

Property Let Copyright(Copyright As String)
    `Build complete Copyright string property
    lblCopyright.Caption = "Copyright (c) " & Copyright
End Property

`MySaver.bas
Option Explicit

`Rectangle data structure
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

`Constants for some API functions
Private Const WS_CHILD = &H40000000

Private Const GWL_HWNDPARENT = (-8)
Private Const GWL_STYLE = (-16)
Private Const HWND_TOP = 0&
Private Const SWP_NOZORDER = &H4
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40

   `--- API functions
Private Declare Function GetClientRect _
Lib "user32" ( _
    ByVal hwnd As Long, _
    lpRect As RECT _
) As Long

Private Declare Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As Long _
) As Long

Private Declare Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long _
) As Long

Private Declare Function SetWindowPos _
Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal hWndInsertAfter As Long, _
    ByVal X As Long, _
    ByVal Y As Long, _
    ByVal cx As Long, _

    ByVal cy As Long, _
    ByVal wFlags As Long _
) As Long
Private Declare Function SetParent _
Lib "user32" ( _
    ByVal hWndChild As Long, _
    ByVal hWndNewParent As Long _
) As Long

`Global Show/Preview flag
Public gblnShow As Boolean

`Module level variables
Private mlngDisplayHwnd As Long
Private recDisplay As RECT
    
`Starting point
Public Sub Main()
    Dim strCmd As String
    Dim strTwo As String
    Dim lngStyle As Long
    Dim lngPreviewHandle As Long
    Dim lngParam As Long
    `Process the command line
    strCmd = UCase(Trim(Command))
    strTwo = Left(strCmd, 2)
    Select Case strTwo
    `Preview screen saver in small display window
    Case "/P"
        `Get HWND of display window
        mlngDisplayHwnd = Val(Mid(strCmd, 4))
        `Get display rectangle dimensions
        GetClientRect mlngDisplayHwnd, recDisplay

        `Load form for preview
        gblnShow = False
        Load frmMySaver
        `Get HWND for display form
        lngPreviewHandle = frmMySaver.hwnd
        `Get current window style
        lngStyle = GetWindowLong(lngPreviewHandle, GWL_STYLE)
        `Append "WS_CHILD" style to the current window style
        lngStyle = lngStyle Or WS_CHILD
        `Add new style to display window
        SetWindowLong lngPreviewHandle, GWL_STYLE, lngStyle
        `Set display window as parent window
        SetParent lngPreviewHandle, mlngDisplayHwnd
        `Save the parent hWnd in the display form's window structure.
        SetWindowLong lngPreviewHandle, GWL_HWNDPARENT, _
            mlngDisplayHwnd
        `Preview screensaver in the windowDear John, How Do I... 
        SetWindowPos lngPreviewHandle, _
            HWND_TOP, 0&, 0&, recDisplay.Right, recDisplay.Bottom, _
            SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_SHOWWINDOW
        Exit Sub
    `Allow user to set up screen saver
    Case "/C"
        Load frmMySetup
        Exit Sub
    `Password - not implemented here
    Case "/A"
        MsgBox "No password is necessary for this Screen Saver", _
                vbInformation, "Password Information"
        Exit Sub
    `Show screen saver in normal full screen mode
    Case "/S"
        gblnShow = True
        Load frmMySaver

                frmMySaver.Show
        Exit Sub
    `Unknown command line parameters
    Case Else
        Exit Sub
    End Select
End Sub

`MySaver.frm
Option Explicit

`API function to hide/show the mouse pointer
Private Declare Function ShowCursor _
Lib "user32" ( _
    ByVal bShow As Long _
) As Long

`API function to signal activity to system
Private Declare Function SystemParametersInfo _
Lib "user32" Alias "SystemParametersInfoA" ( _
    ByVal uAction As Long, _
    ByVal uParam As Long, _
    ByRef lpvParam As Any, _
    ByVal fuWinIni As Long _
) As Long

`Constant for API function

Private Const SPI_SETSCREENSAVEACTIVE = 17

`Declare module-level variables
Dim mlngXai As Long
Dim mlngYai As Long
Dim mlngXbi As Long
Dim mlngYbi As Long
Dim mlngLineCount As Long
Dim mlngLineWidth As Long
Dim mlngActionType As Long
Dim mlngXmax As Long
Dim mlngYmax As Long
Dim mlngInc As Long
Dim mlngColorNum() As Long
Dim mlngDx1() As Double
Dim mlngDx2() As Double
Dim mlngDy1() As Double
Dim mlngDy2() As Double
Dim mlngXa() As Long
Dim mlngXb() As Long
Dim mlngYa() As Long
Dim mlngYb() As Long
Dim mblnQuit As Boolean

Private Sub Form_Load()
    Dim lngRet As Long
    `Tell system that screen saver is active
    lngRet = SystemParametersInfo( _
        SPI_SETSCREENSAVEACTIVE, 0, ByVal 0&, 0)
    `Go full screen if not in preview mode
    If gblnShow = True Then
        Me.WindowState = vbMaximized
    End If
End Sub

Private Sub Form_Paint()
    Dim lngX As Long
    `In preview mode, set AutoRedraw to True
    If gblnShow = False Then
        Me.AutoRedraw = True
    End If
    `Create different display each time
    Randomize
    `Set control values
    mlngInc = 5
    mlngXmax = 300
    mlngYmax = 300
    `Get current user settings from Registry
    mlngActionType = Val(GetSetting("MySaver", "Options", _
        "Action", "1"))
    mlngLineCount = Val(GetSetting("MySaver", "Options", _
        "LineCount", "1"))
    mlngLineWidth = Val(GetSetting("MySaver", "Options", _
        "LineWidth", "1"))
    `Initialize graphics
    With Me
        .BackColor = vbBlack
        .DrawWidth = mlngLineWidth
    End With
    Scale (-mlngXmax, -mlngYmax)-(mlngXmax, mlngYmax)
    `Size arrays
    ReDim mlngColorNum(0 To mlngLineCount)
    ReDim mlngXa(1 To mlngLineCount), mlngXb(1 To mlngLineCount)
    ReDim mlngYa(1 To mlngLineCount), mlngYb(1 To mlngLineCount)
    `Action types above 4 are a little different
    If mlngActionType < 5 Then
        ReDim mlngDx1(1 To mlngLineCount), _
            mlngDx2(1 To mlngLineCount)

        ReDim mlngDy1(1 To mlngLineCount), _
            mlngDy2(1 To mlngLineCount)
    Else
        ReDim mlngDx1(0), mlngDx2(0)
        ReDim mlngDy1(0), mlngDy2(0)
        mlngDx1(0) = Rnd * mlngInc
        mlngDx2(0) = Rnd * mlngInc
        mlngDy1(0) = Rnd * mlngInc
        mlngDy2(0) = Rnd * mlngInc
    End If
    `Hide mouse pointer, unless in preview mode
    If gblnShow = True Then
        lngX = ShowCursor(False)
    End If
    `Do main processing as a loop
    Do
        `Update display
        DoGraphics
        `Yield execution
        DoEvents
    Loop Until mblnQuit = True
    `Show mouse pointer, unless in preview mode
    If gblnShow = True Then
        lngX = ShowCursor(True)
    End If
    `Can't quit in this context; let timer do it
    tmrExitNotify.Enabled = True
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, _
    UnloadMode As Integer)
    `Using End here appears to prevent memory leaks
    End
End Sub

Private Sub Form_Click()
    `Quit if mouse is clicked, unless in preview mode
    If gblnShow = True Then mblnQuit = True
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    `Quit if any key is pressed, unless in preview mode
    If gblnShow = True Then mblnQuit = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
    X As Single, Y As Single)
    Static sngTimer As Single
    `Bail out quickly if in preview mode
    If gblnShow = False Then Exit Sub
    `Quit any time after first .25 seconds
    If sngTimer = 0 Then
        sngTimer = Timer
    ElseIf Timer > sngTimer + 0.25 Then
        mblnQuit = True
    End If
End Sub

Private Sub tmrExitNotify_Timer()
    Dim lngRet As Long
    `Tell system that screen saver is done
    lngRet = SystemParametersInfo( _
        SPI_SETSCREENSAVEACTIVE, 1, ByVal 0&, 0)
    `Time to quit
    End
End Sub

`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

`This is where the real graphics drawing takes place
`~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sub DoGraphics()
    Dim intI
    Static dblColorTime As Double
    `Shuffle line colors every so often
    If Timer > dblColorTime Then
        ColorReset
        If mlngLineCount < 5 Then
            dblColorTime = Timer + mlngLineCount * Rnd + 0.3
        Else
            dblColorTime = Timer + 5 * Rnd + 0.3
        End If
    End If
    `Process based on count of lines
    For intI = 1 To mlngLineCount
        `Handle action types below 5 with special procedures
        If mlngActionType < 5 Then
            `Keep ends of lines within bounds
            If mlngXa(intI) <= 0 Then
                mlngDx1(intI) = mlngInc * Rnd
            End If
            If mlngXb(intI) <= 0 Then
                mlngDx2(intI) = mlngInc * Rnd
            End If
            If mlngYa(intI) <= 0 Then
                mlngDy1(intI) = mlngInc * Rnd
            End If
            If mlngYb(intI) <= 0 Then
                mlngDy2(intI) = mlngInc * Rnd
            End If
            If mlngXa(intI) >= mlngXmax Then
                mlngDx1(intI) = -mlngInc * Rnd
            End If

            If mlngXb(intI) >= mlngXmax Then
                mlngDx2(intI) = -mlngInc * Rnd
            End If
            If mlngYa(intI) >= mlngYmax Then
                mlngDy1(intI) = -mlngInc * Rnd
            End If
            If mlngYb(intI) >= mlngYmax Then
                mlngDy2(intI) = -mlngInc * Rnd
            End If
            `Increment the coordinates of the line endpoints
            mlngXa(intI) = mlngXa(intI) + mlngDx1(intI)
            mlngXb(intI) = mlngXb(intI) + mlngDx2(intI)
            mlngYa(intI) = mlngYa(intI) + mlngDy1(intI)
            mlngYb(intI) = mlngYb(intI) + mlngDy2(intI)
            `Draw each line with a unique color
            ForeColor = mlngColorNum(intI)
        Else
            `Set action types 5 and 6 with the same color
            ForeColor = mlngColorNum(0)
        End If
        `Draw lines according to action type
        Select Case mlngActionType
        Case 1
            Line (mlngXa(intI), mlngYa(intI))- _
                (mlngXb(intI), mlngYb(intI))
            Line (-mlngXa(intI), -mlngYa(intI))- _
                (-mlngXb(intI), -mlngYb(intI))
            Line (-mlngXa(intI), mlngYa(intI))- _
                (-mlngXb(intI), mlngYb(intI))
            Line (mlngXa(intI), -mlngYa(intI))- _
                (mlngXb(intI), -mlngYb(intI))
        Case 2
            Line (mlngXa(intI), mlngYa(intI))- _
                (mlngXb(intI), mlngYb(intI)), , B

            Line (-mlngXa(intI), -mlngYa(intI))- _
                (-mlngXb(intI), -mlngYb(intI)), , B
            Line (-mlngXa(intI), mlngYa(intI))- _
                (-mlngXb(intI), mlngYb(intI)), , B
            Line (mlngXa(intI), -mlngYa(intI))- _
                (mlngXb(intI), -mlngYb(intI)), , B
        Case 3
            Circle (mlngXa(intI), mlngYa(intI)), _
                mlngXb(intI)
            Circle (-mlngXa(intI), -mlngYa(intI)), _
                mlngXb(intI)
            Circle (-mlngXa(intI), mlngYa(intI)), _
                mlngXb(intI)
            Circle (mlngXa(intI), -mlngYa(intI)), _
                mlngXb(intI)
        Case 4
            Line (mlngXa(intI), mlngYa(intI))- _
                (mlngXb(intI), -mlngYb(intI))
            Line -(-mlngXa(intI), -mlngYa(intI))
            Line -(-mlngXb(intI), mlngYb(intI))
            Line -(mlngXa(intI), mlngYa(intI))
        `Handle action types above 4 a little differently
        Case 5, 6
            If mlngActionType = 5 Then
                Line (mlngXa(intI), mlngYa(intI))- _
                    (mlngXb(intI), mlngYb(intI)), _
                    BackColor
            Else
                Line (mlngXa(intI), mlngYa(intI))- _
                    (mlngXb(intI), mlngYb(intI)), _
                    BackColor, B
            End If
            If mlngXai <= -mlngXmax Then
                mlngDx1(0) = mlngInc * Rnd + 1

            End If
            If mlngXbi <= -mlngXmax Then
                mlngDx2(0) = mlngInc * Rnd + 1
            End If
            If mlngYai <= -mlngYmax Then
                mlngDy1(0) = mlngInc * Rnd + 1
            End If
            If mlngYbi <= -mlngYmax Then
                mlngDy2(0) = mlngInc * Rnd + 1
            End If
            If mlngXai >= mlngXmax Then
                mlngDx1(0) = -mlngInc * Rnd + 1
            End If
            If mlngXbi >= mlngXmax Then
                mlngDx2(0) = -mlngInc * Rnd + 1
            End If
            If mlngYai >= mlngYmax Then
                mlngDy1(0) = -mlngInc * Rnd + 1
            End If
            If mlngYbi >= mlngYmax Then
                mlngDy2(0) = -mlngInc * Rnd + 1
            End If
            mlngXai = mlngXai + mlngDx1(0)
            mlngXbi = mlngXbi + mlngDx2(0)
            mlngYai = mlngYai + mlngDy1(0)
            mlngYbi = mlngYbi + mlngDy2(0)
            mlngXa(intI) = mlngXai
            mlngXb(intI) = mlngXbi
            mlngYa(intI) = mlngYai
            mlngYb(intI) = mlngYbi
            If mlngActionType = 5 Then
                Line (mlngXa(intI), mlngYa(intI))- _
                    (mlngXb(intI), mlngYb(intI))
            Else

                 Line (mlngXa(intI), mlngYa(intI))- _
                    (mlngXb(intI), mlngYb(intI)), , B
            End If
        End Select
    Next intI
End Sub

Sub ColorReset()
    Dim intI
    `Randomize set of colors
    If mlngActionType <= 4 Then
        For intI = 1 To mlngLineCount
            mlngColorNum(intI) = _
                RGB(Rnd * 256, Rnd * 256, Rnd * 256)
        Next intI
    `Use bright colors for action types 5 or 6
    Else
        mlngColorNum(0) = QBColor(Int(8 * Rnd) + 8)
    End If
End Sub