Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
QuadDraw revisited - drawing program work in progress
#1
Browsing through the old forum @luke put up temporarily I found a drawing program I forgot about, QuadDraw, and decided to reawaken it.  It would not work in our current QB64 version so I had to rewrite how it draws (it was using a recursive function that worked in QB64 v1.5 but not v2).  Used a drawing method @bplus helped me with with another drawing project (doodle dandy).

I'm going to start working on this again and add more features.  Here's where it's at so far.  Draw on the screen by left clicking the mouse.  Right clicking will fill spaces with a random color.  U will undo last change.  Brush size can be changed with -/+ keys.  You can change how many section to draw at once by pressing numbers 1 to 4.  Current drawing settings are visible in the title bar.  I probably add a menu system and drawing color selector to it next.

Testers and suggestions are welcomed.  Example drawing is attached.

- Dav


Code: (Select All)
'============
'QuadDraw.bas v1.3
'============
'An odd little drawing program.
'Draws/paints in 4 sections of the screen at same time.
'Coded by Dav for QB64 APR/2022

'NEW FOR v1.3:  Fixed it to run in QB64 v2 and higher.
'               (had to remove recursive drawing function)

'               Screen size now adjusts to users desktop resolution.
'               (size not hard coded - should look good on most desktops)

'CREDITS: SPAINT SUB was made by Petr.  Thanks Petr!
'         And bplus helped me figure out a way to draw lines without gaps
'         in another program (doodle dandy). I used that new method here.

'----------
'HOW TO USE:
'----------
'Use the mouse to draw/color on screen.
'Left click = draws on screen.
'Right click = fills areas with color.
'Use the +/- keys to change brush size (1 to 50 allowed)
'Press 1,2,3 or 4 to set how many areas to draw in, default is 4.
'Press U to undo last change.
'Space = clears screen and starts over.
'ESC = Ends program

'Current drawing settings are shown in title bar

DIM SHARED quads, brushsize

SCREEN _NEWIMAGE(_DESKTOPWIDTH * .75, _DESKTOPHEIGHT * .85, 32)
_DELAY .25

centerx = _WIDTH / 2: centery = _HEIGHT / 2 'center point of screen

wht& = _RGB(255, 255, 255) 'used often, so variable it
blk& = _RGB(0, 0, 0)
brushsize = 5 'size of drawing circle (brush)
quads = 4 'start with 4 drawing sections

CLS , wht& 'start with white screen

undo& = _COPYIMAGE(_DISPLAY)

'====
main:
'====

_TITLE "QuadDraw - Quads:" + STR$(quads) + "  BrushSize:" + STR$(brushsize)

DO

    WHILE _MOUSEINPUT: WEND

    mx = _MOUSEX: my = _MOUSEY

    IF _MOUSEBUTTON(1) THEN

        IF stilldown = 0 THEN
            _FREEIMAGE undo&
            undo& = _COPYIMAGE(_DISPLAY)
        END IF

        IF stilldown = 1 THEN
            stepx = lastmx - mx
            stepy = lastmy - my
            length = INT((stepx ^ 2 + stepy ^ 2) ^ .5)
            dx = stepx / length
            dy = stepy / length
            FOR i = 0 TO length
                FOR d = 1 TO brushsize
                    newx = mx + dx * i: newy = my + dy * i
                    CIRCLE (newx, newy), d, blk&: PAINT (newx, newy), blk&, blk&
                    IF quads > 1 THEN
                        CIRCLE (centerx - newx + centerx, centery - newy + centery), d, blk&
                        PAINT (centerx - newx + centerx, centery - newy + centery), blk&, blk&
                    END IF
                    IF quads > 2 THEN
                        CIRCLE (newx, centery - newy + centery), d, blk&
                        PAINT (newx, centery - newy + centery), blk&, blk&
                    END IF
                    IF quads > 3 THEN
                        CIRCLE (centerx - newx + centerx, newy), d, blk&
                        PAINT (centerx - newx + centerx, newy), blk&, blk&
                    END IF
                NEXT
            NEXT
        ELSE
            FOR d = 1 TO brushsize STEP .2
                CIRCLE (mx, my), d, blk&&
            NEXT
        END IF
        lastmx = mx: lastmy = my
        stilldown = 1
    ELSE
        stilldown = 0
    END IF

    'if right click, fill sections with random color
    IF _MOUSEBUTTON(2) THEN

        _FREEIMAGE undo&
        undo& = _COPYIMAGE(_DISPLAY)

        r = RND * 255: g = RND * 255: b = RND * 255

        SPAINT mx, my, _RGB(r, g, b) ', blk&
        IF quads > 1 THEN
            SPAINT centerx - mx + centerx, centery - my + centery, _RGB(r, g, b) ', blk&
        END IF
        IF quads > 2 THEN
            SPAINT mx, centery - my + centery, _RGB(r, g, b) ', blk&
        END IF
        IF quads > 3 THEN
            SPAINT centerx - mx + centerx, my, _RGB(r, g, b) ', blk&
        END IF
        WHILE _MOUSEBUTTON(2) <> 0: n = _MOUSEINPUT: WEND
    END IF

    'get keyboard input
    key$ = UCASE$(INKEY$)
    IF key$ <> "" THEN
        SELECT CASE key$
            CASE CHR$(32): CLS , wht& 'scpace clears screen again
            CASE "1": quads = 1
            CASE "2": quads = 2
            CASE "3": quads = 3
            CASE "4": quads = 4
            CASE "+"
                brushsize = brushsize + 1: IF brushsize > 50 THEN brushsize = 50
            CASE "-"
                brushsize = brushsize - 1: IF brushsize < 1 THEN brushsize = 1
            CASE "U": _PUTIMAGE (0, 0), undo&
            CASE CHR$(27): END
        END SELECT
        DO UNTIL INKEY$ = "": LOOP
        GOTO main
    END IF

LOOP

END

SUB SPAINT (x AS INTEGER, y AS INTEGER, clr~&) 'Color everything in the X, Y position regardless of the border color.
    'SUB by Petr
    DIM m AS _MEM, m2 AS _MEM

    m = _MEMIMAGE(_DEST)
    W = _WIDTH(_DEST)
    H = _HEIGHT(_DEST)
    P = _PIXELSIZE(_DEST)

    SELECT CASE P
        CASE 4 '                             image is 32 bit image
            Virtual = _NEWIMAGE(W, H, 32)
            m2 = _MEMIMAGE(Virtual)
            Back~& = POINT(x, y)
            Back2~& = _RGB32(1, 1, 1)
            Empty~& = _RGBA32(0, 0, 0, 0)
            DO UNTIL a& = m.SIZE - 4
                a& = a& + 4
                IF _MEMGET(m, m.OFFSET + a&, _UNSIGNED LONG) = Back~& THEN _MEMPUT m2, m2.OFFSET + a&, Back~& ELSE _MEMPUT m2, m2.OFFSET + a&, Back2~&
            LOOP
            d = _DEST
            _DEST Virtual
            PAINT (x, y), clr~&, Back2~&
            _DEST d
            a& = 0
            DO UNTIL a& = m.SIZE - 4
                a& = a& + 4
                IF _MEMGET(m2, m2.OFFSET + a&, _UNSIGNED LONG) <> clr~& THEN _MEMPUT m2, m2.OFFSET + a&, Empty~&
            LOOP
            _CLEARCOLOR Back2~&, Virtual
            _PUTIMAGE (0, 0), Virtual
            _MEMFREE m
            _MEMFREE m2
            _FREEIMAGE Virtual
        CASE 1 '                             image is 8 bit image (256 colors)
            Virtual = _NEWIMAGE(W, H, 32)
            m2 = _MEMIMAGE(Virtual)
            Back~& = POINT(x, y)
            Back2~& = _RGB(1, 1, 1)
            Empty~& = _RGBA(0, 0, 0, 0)
            DO UNTIL a& = m.SIZE - 1
                a& = a& + 1
                IF _MEMGET(m, m.OFFSET + a&, _UNSIGNED _BYTE) = Back~& THEN _MEMPUT m2, m2.OFFSET + a&, Back~& ELSE _MEMPUT m2, m2.OFFSET + a&, Back2~&
            LOOP
            d = _DEST
            _DEST Virtual
            PAINT (x, y), clr~&, Back2~&
            _DEST d
            a& = 0
            DO UNTIL a& = m.SIZE - 1
                a& = a& + 1
                IF _MEMGET(m2, m2.OFFSET + a&, _UNSIGNED _BYTE) <> clr~& THEN _MEMPUT m2, m2.OFFSET + a&, Empty~&
            LOOP
            _CLEARCOLOR Back2~&, Virtual
            _PUTIMAGE (0, 0), Virtual
            _MEMFREE m
            _MEMFREE m2
            _FREEIMAGE Virtual
    END SELECT
END SUB


   

Find my programs here in Dav's QB64 Corner
Reply


Messages In This Thread
QuadDraw revisited - drawing program work in progress - by Dav - 04-24-2022, 05:57 PM



Users browsing this thread: 2 Guest(s)