04-24-2022, 05:57 PM
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
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