Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
drops
#1
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)
Reply


Messages In This Thread
drops - by James D Jarvis - 07-19-2022, 05:12 PM
RE: drops - by dbox - 07-19-2022, 05:18 PM
RE: drops - by James D Jarvis - 07-19-2022, 05:37 PM
RE: drops - by bplus - 07-19-2022, 07:19 PM
RE: drops - by dbox - 07-19-2022, 07:54 PM
RE: drops - by SierraKen - 07-19-2022, 11:38 PM



Users browsing this thread: 1 Guest(s)