drops

[James D Jarvis]

Fiddling with the mouse and saw a similar program online so here is  drops.

Code: (Select All)

Screen _NewImage(800, 500, 32)
_Title "drops"
Dim dd(6000, 3)
Color _RGB32(250, 250, 250), _RGB32(0, 0, 255)
dc = 0
Randomize Timer
Do
    Cls
    _Limit 6000
    Do While _MouseInput
        'check for the mouse pointer in the image drawign area

        If _MouseButton(1) Then
            x = _MouseX
            y = _MouseY
            PSet (x, y), _RGB32(100, 100, 100)
            dc = dc + 1
            If dc > 6000 Then dc = 1
            dd(dc, 1) = x
            dd(dc, 2) = y
            dd(dc, 3) = Int(Rnd * 9) + 3

        End If
    Loop
    If dc > 1 Then
        For n = 1 To dc
            If dd(dc, 3) < 255 Then
                Circle (dd(n, 1), dd(n, 2)), dd(n, 3), _RGB32(0, 0, dd(n, 3) * 2)
                If dd(n, 3) < 100 Then Circle (dd(n, 1), dd(n, 2)), dd(n, 3) - Int(Rnd * 3) + 1, _RGB32(200, 200, 255 - Int(dd(n, 3) / 8))
                dd(n, 3) = dd(n, 3) + 3
            Else
                dd(n, 3) = 255
            End If
        Next n

    End If
    Locate 1, 1
    Print dc; " drops, click and drag your mouse,  press <ESC> to quit"
    _Delay 0.05
    _Display

    aa$ = InKey$
Loop Until aa$ = Chr$(27)