QB64 Phoenix Edition
drops - Printable Version

+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: drops (/showthread.php?tid=650)



drops - James D Jarvis - 07-19-2022

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)



RE: drops - dbox - 07-19-2022

Nice!  Looks great online too.


RE: drops - James D Jarvis - 07-19-2022

Neato. I didn't know QBJS had moved along so much.


RE: drops - bplus - 07-19-2022

Ha! This reminds me of my mouse chaser program from 7 years ago.
https://staging.qb64phoenix.com/showthread.php?tid=162&pid=4199#pid4199


RE: drops - dbox - 07-19-2022

Yours looks great online too @bplus!


RE: drops - SierraKen - 07-19-2022

Wow good effect. I made a very similar one with circles a few years ago but with no effect, awesome.