Option Explicit

Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Const SWP_NOACTIVATE = &H10
Public Const SWP_NOZORDER = &H4
Public Const SWP_SHOWWINDOW = &H40

Public Const HWND_TOP = 0

Public Const WS_CHILD = &H40000000
Public Const GWL_HWNDPARENT = (-8)
Public Const GWL_STYLE = (-16)

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
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
Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long


Public Const rmConfigure = 1
Public Const rmScreenSaver = 2
Public RunMode As Integer

Public Type Ball
    BallClr As Long
    BallR As Single
    BallX As Single
    BallY As Single
    BallVx As Single
    BallVy As Single
End Type

Public NumBalls As Integer
Public Balls() As Ball


Private Const APP_NAME = "BouncingBalls"


Private Sub CheckShouldRun()
 
    If Not App.PrevInstance Then Exit Sub
    If FindWindow(vbNullString, APP_NAME) Then End
    frmCover.Caption = APP_NAME
End Sub


Public Sub LoadConfig()
    NumBalls = CInt(GetSetting(APP_NAME, "Settings", "NumBalls", "1"))
End Sub


Public Sub InitializeBalls()
Const MIN_CLR = 1
Const MAX_CLR = 15
Const MIN_BALLR = 0.03  
Const MAX_BALLR = 0.05
Const MIN_VX = 0.005    
Const MAX_VX = 0.025
Const MIN_VY = 0.005
Const MAX_VY = 0.025

Dim i As Integer
Dim wid As Single
Dim hgt As Single
Dim minx As Single
Dim maxx As Single
Dim miny As Single
Dim maxy As Single
Dim minr As Single
Dim maxr As Single
Dim minvx As Single
Dim maxvx As Single
Dim minvy As Single
Dim maxvy As Single


    If NumBalls <= 0 Then

        Erase Balls
    Else

        ReDim Balls(1 To NumBalls)

        wid = frmCover.ScaleWidth
        hgt = frmCover.ScaleHeight
        minr = MIN_BALLR * wid
        maxr = MAX_BALLR * wid
        minvx = MIN_VX * wid
        maxvx = MAX_VX * wid
        minvy = MIN_VY * wid
        maxvy = MAX_VY * wid
        Randomize
        For i = 1 To NumBalls
            With Balls(i)
                .BallClr = QBColor(Int((MAX_CLR - MIN_CLR + 1) * Rnd + MIN_CLR))
                .BallR = Int((maxr - minr + 1) * Rnd + minr)
                minx = .BallR
                maxx = wid - .BallR
                miny = .BallR
                maxy = hgt - .BallR
                .BallX = Int((maxx - minx + 1) * Rnd + minx)
                .BallY = Int((maxy - miny + 1) * Rnd + miny)
                .BallVx = Int((maxvx - minvx + 1) * Rnd + minvx)
                .BallVy = Int((maxvy - minvy + 1) * Rnd + minvy)
                If Int(2 * Rnd) = 1 Then .BallVx = -.BallVx
                If Int(2 * Rnd) = 1 Then .BallVy = -.BallVy
            End With
        Next i
    End If

    frmCover.tmrMoveBalls.Enabled = (NumBalls > 0)
End Sub


Public Sub SaveConfig()
    SaveSetting APP_NAME, _
        "Settings", "NumBalls", Format$(NumBalls)
End Sub


Public Sub Main()
Dim args As String
Dim preview_hwnd As Long
Dim preview_rect As RECT
Dim window_style As Long


    args = UCase$(Trim$(Command$))


    Select Case Mid$(args, 1, 2)
        Case "/C"   
            RunMode = rmConfigure
        Case "/R"   
            RunMode = rmScreenSaver
        Case Else     
             Exit Sub

    End Select

    Select Case RunMode
        Case rmConfigure    
            frmConfig.Show
        
        Case rmScreenSaver  
 
            CheckShouldRun
            Load frmCover
            frmCover.Show
            ShowCursor False

    End Select
End Sub

Private Function GetHwndFromCommand(ByVal args As String) As Long
Dim argslen As Integer
Dim i As Integer
Dim ch As String

    args = Trim$(args)
    argslen = Len(args)
    For i = argslen To 1 Step -1
        ch = Mid$(args, i, 1)
        If ch < "0" Or ch > "9" Then Exit For
    Next i

    GetHwndFromCommand = CLng(Mid$(args, i + 1))
End Function