05-30-2022, 03:09 AM
Still working on this. Added a couple things, fixed a few things. Used the Text SUB by @bplus to make a menu. Nice SUB bplus - it's faster than my PPRINT SUB. I need to work out the _DISPLAY stuff more, and redo the smooth SUB, it was a quick throw-in.
- Dav
- Dav
Code: (Select All)
'============
'QuadDraw.bas v1.4
'============
'An odd little drawing program.
'Draws/paints in several areas of the screen at same time.
'Coded by Dav for QB64 MAY/2022
'NEW FOR v1.4: Now shows menu of settings on right side.
' (Uses Text SUB by bplus for the menu text)
' Added 'Smooth' SUB (Press S to smooth screen)
' Fixed serious PAINT bug when brushsize is 1.
'CREDITS: SPAINT SUB was made by Petr. Thanks Petr!
' text SUB was made by bplus. thanks bplus!
' (bplus helped me out how to draw lines without gaps too)
'----------
'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 S to smooth the image.
'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(1000, 600, 32) '_DESKTOPWIDTH * .75, _DESKTOPHEIGHT * .85, 32)
centerx = (_WIDTH - 200) / 2
centery = _HEIGHT / 2
wht& = _RGB(255, 255, 255) 'used often, so variable it
blk& = _RGB(0, 0, 0)
brushsize = 3 'size of drawing circle (brush)
quads = 4 'start with 4 drawing sections
CLS , wht& 'start with white screen
_DELAY .25
undo& = _COPYIMAGE(_DISPLAY)
'====
main:
'====
_TITLE "QuadDraw - Quads:" + STR$(quads) + " BrushSize:" + STR$(brushsize)
DrawMenu
DO
WHILE _MOUSEINPUT: WEND
mx = _MOUSEX: my = _MOUSEY
IF mx <= (_WIDTH - 200 - brushsize / 2) THEN
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&
IF brushsize > 1 THEN PAINT (newx, newy), blk&, blk&
IF quads > 1 THEN
CIRCLE (centerx - newx + centerx, centery - newy + centery), d, blk&
IF brushsize > 1 THEN PAINT (centerx - newx + centerx, centery - newy + centery), blk&, blk&
END IF
IF quads > 2 THEN
CIRCLE (newx, centery - newy + centery), d, blk&
IF brushsize > 1 THEN PAINT (newx, centery - newy + centery), blk&, blk&
END IF
IF quads > 3 THEN
CIRCLE (centerx - newx + centerx, newy), d, blk&
IF brushsize > 1 THEN 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
DrawMenu: _DISPLAY
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
_DISPLAY
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
DrawMenu
_AUTODISPLAY
WHILE _MOUSEBUTTON(2) <> 0: N = _MOUSEINPUT: WEND
END IF
END IF
'get keyboard input
key$ = UCASE$(INKEY$)
IF key$ <> "" THEN
SELECT CASE key$
CASE CHR$(32): CLS , wht&: DrawMenu '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 "S": Smooth
CASE CHR$(27): END
END SELECT
DO UNTIL INKEY$ = "": LOOP
_DISPLAY
GOTO main
END IF
_AUTODISPLAY
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
SUB Text (x, y, textHeight, K AS _UNSIGNED LONG, txt$)
'Text SUB by bplus.
DIM fg AS _UNSIGNED LONG, cur&, I&, multi, xlen
fg = _DEFAULTCOLOR
cur& = _DEST
I& = _NEWIMAGE(8 * LEN(txt$), 16, 32)
_DEST I&
COLOR K, _RGBA32(0, 0, 0, 0)
_PRINTSTRING (0, 0), txt$
multi = textHeight / 16
xlen = LEN(txt$) * 8 * multi
_PUTIMAGE (x, y)-STEP(xlen, textHeight), I&, cur&
COLOR fg
_FREEIMAGE I&
END SUB
SUB Smooth
FOR x = 1 TO _WIDTH - 202
FOR y = 1 TO _HEIGHT - 1
p1~& = POINT(x, y)
p2~& = POINT(x + 1, y)
p3~& = POINT(x, y + 1)
p4~& = POINT(x + 1, y + 1)
p5~& = POINT(x - 1, y)
p6~& = POINT(x, y - 1)
p7~& = POINT(x - 1, y - 1)
p8~& = POINT(x - 1, y + 1)
p9~& = POINT(x + 1, y - 1)
r = _RED32(p1~&) + _RED32(p2~&) + _RED32(p3~&) + _RED32(p4~&) + _RED32(p5~&) + _RED32(p6~&) + _RED32(p7~&) + _RED32(p8~&) + _RED32(p9~&)
g = _GREEN32(p1~&) + _GREEN32(p2~&) + _GREEN32(p3~&) + _GREEN32(p4~&) + _GREEN32(p5~&) + _GREEN32(p6~&) + _GREEN32(p7~&) + _GREEN32(p8~&) + _GREEN32(p9~&)
b = _BLUE32(p1~&) + _BLUE32(p2~&) + _BLUE32(p3~&) + _BLUE32(p4~&) + _BLUE32(p5~&) + _BLUE32(p6~&) + _BLUE32(p7~&) + _BLUE32(p8~&) + _BLUE32(p9~&)
PSET (x, y), _RGB(r / 9, g / 9, b / 9)
NEXT
NEXT
END SUB
SUB DrawMenu
LINE (_WIDTH - 200, 0)-(_WIDTH, _HEIGHT), _RGB(96, 96, 96), BF
LINE (_WIDTH - 200, 0)-(_WIDTH - 195, _HEIGHT), _RGB(164, 164, 164), BF
'_PUTIMAGE (_WIDTH - 190, 10), menu&
Text _WIDTH - 177, 12, 38, _RGB(0, 0, 0), "QuadDraw"
Text _WIDTH - 175, 10, 38, _RGB(255, 255, 100), "QuadDraw"
Text _WIDTH - 152, 47, 16, _RGB(0, 0, 0), "By Dav - v1.4"
Text _WIDTH - 150, 45, 16, _RGB(255, 255, 100), "By Dav - v1.4"
Text _WIDTH - 177, 102, 22, _RGB(0, 0, 0), "NUMBER OF QUADS"
Text _WIDTH - 175, 100, 22, _RGB(255, 255, 255), "NUMBER OF QUADS"
Text _WIDTH - 177, 132, 42, _RGB(0, 0, 0), "1 2 3 4"
Text _WIDTH - 175, 130, 42, _RGB(255, 255, 255), "1 2 3 4"
IF quads = 1 THEN
LINE (_WIDTH - 183, 125)-(_WIDTH - 148, 170), _RGBA(255, 255, 255, 100), BF
LINE (_WIDTH - 183, 125)-(_WIDTH - 148, 170), _RGB(255, 255, 255), B
END IF
IF quads = 2 THEN
LINE (_WIDTH - 145, 125)-(_WIDTH - 105, 170), _RGBA(255, 255, 255, 100), BF
LINE (_WIDTH - 145, 125)-(_WIDTH - 105, 170), _RGB(255, 255, 255), B
END IF
IF quads = 3 THEN
LINE (_WIDTH - 103, 125)-(_WIDTH - 62, 170), _RGBA(255, 255, 255, 100), BF
LINE (_WIDTH - 103, 125)-(_WIDTH - 62, 170), _RGB(255, 255, 255), B
END IF
IF quads = 4 THEN
LINE (_WIDTH - 60, 125)-(_WIDTH - 15, 170), _RGBA(255, 255, 255, 100), BF
LINE (_WIDTH - 60, 125)-(_WIDTH - 15, 170), _RGB(255, 255, 255), B
END IF
Text _WIDTH - 179, 202, 22, _RGB(0, 0, 0), "BRUSH SIZE =" + STR$(brushsize)
Text _WIDTH - 177, 200, 22, _RGB(255, 255, 255), "BRUSH SIZE =" + STR$(brushsize)
Text _WIDTH - 179, 228, 22, _RGB(0, 0, 0), "(+/- to change)"
Text _WIDTH - 177, 226, 22, _RGB(255, 255, 255), "(+/- to change)"
LINE (_WIDTH - 160, 260)-(_WIDTH - 40, 380), _RGB(164, 164, 164), BF
LINE (_WIDTH - 160, 260)-(_WIDTH - 40, 380), _RGB(255, 255, 255), B
CIRCLE (_WIDTH - 100, 320), brushsize, _RGB(0, 0, 0)
IF brushsize > 1 THEN PAINT (_WIDTH - 100, 320), _RGB(0, 0, 0)
Text _WIDTH - 179, 412, 22, _RGB(0, 0, 0), "PRESS SPACE TO"
Text _WIDTH - 177, 410, 22, _RGB(255, 255, 255), "PRESS SPACE TO"
Text _WIDTH - 179, 434, 22, _RGB(0, 0, 0), "CLEAR SCREEN."
Text _WIDTH - 177, 432, 22, _RGB(255, 255, 255), "CLEAR SCREEN."
Text _WIDTH - 179, 482, 22, _RGB(0, 0, 0), "S = SMOOTH IT"
Text _WIDTH - 177, 480, 22, _RGB(255, 255, 255), "S = SMOOTH IT"
Text _WIDTH - 179, 522, 22, _RGB(0, 0, 0), "U = WILL UNDO"
Text _WIDTH - 177, 520, 22, _RGB(255, 255, 255), "U = WILL UNDO"
Text _WIDTH - 179, 544, 22, _RGB(0, 0, 0), " LAST CHANGE"
Text _WIDTH - 177, 542, 22, _RGB(255, 255, 255), " LAST CHANGE"
END SUB