« previous next »
Pages: [1]   Go Down

Author Topic: QuadDraw - Odd little drawing program.  (Read 5106 times)

0 Members and 1 Guest are viewing this topic.

Offline Dav

  • Forum Resident
  • Posts: 792
    • View Profile
QuadDraw - Odd little drawing program.
« on: April 12, 2020, 10:04:52 pm »
Here's a quick little drawing program that draws in 4 sections of the screen at the same time.  After you draw your lines, you can fill the 4 sections (right click in them) at the same time.  Hard for me to explain it, you just have to try it I suppose.  Below is a sample of its limited capabilities, and my limited drawing skills.

- Dav

Note: Jump to latest version here:
https://www.qb64.org/forum/index.php?topic=2467.msg116978#msg116978

Code: QB64: [Select]
  1. '============
  2. 'QuadDraw.bas
  3. '============
  4. 'An odd little drawing program.
  5. 'Draws/paints in 4 sections of the screen at same time.
  6. 'Coded by Dav for QB64 APR/2020
  7.  
  8. 'Left click to draw on screen.
  9. 'Right click to fill enclosed sections with random color.
  10. 'Press space to clear screen and start over fresh.
  11.  
  12. SCREEN _NEWIMAGE(600, 600, 32)
  13.  
  14. cx = _WIDTH / 2: cy = _HEIGHT / 2 'center point of screen
  15.  
  16. w& = _RGB(255, 255, 255) 'used often, so variable it
  17. b& = _RGB(0, 0, 0)
  18.  
  19. PAINT (1, 1), w& 'start with white screen
  20.  
  21. 'show instruction at beginning
  22. PRINT "    Left click to draw, right click to fill color, space clears screen     "
  23.  
  24. size = 5 'size of circle (brush)
  25.  
  27.     t = _MOUSEINPUT
  28.     x = _MOUSEX: y = _MOUSEY
  29.  
  30.     'If left button, draw on screen
  32.         CIRCLE (x, y), size, b&: PAINT (x, y), b&, b&
  33.         CIRCLE (cx - x + cx, cy - y + cy), size, b&
  34.         PAINT (cx - x + cx, cy - y + cy), b&, b&
  35.         CIRCLE (x, cy - y + cy), size, b&
  36.         PAINT (x, cy - y + cy), b&, b&
  37.         CIRCLE (cx - x + cx, y), size, b&
  38.         PAINT (cx - x + cx, y), b&, b&
  39.     END IF
  40.     'if right click, fill sections with color
  42.         c = (RND * 100)
  43.         r = RND * 255: g = RND * 255: b = RND * 255
  44.         PAINT (x, y), _RGB(r, g, b), b&
  45.         PAINT (cx - x + cx, cy - y + cy), _RGB(r, g, b), b&
  46.         PAINT (x, cy - y + cy), _RGB(r, g, b), b&
  47.         PAINT (cx - x + cx, y), _RGB(r, g, b), b&
  48.         WHILE _MOUSEBUTTON(2) <> 0: n = _MOUSEINPUT: WEND
  49.     END IF
  50.     'scpace clears screen again
  51.     IF INKEY$ = CHR$(32) THEN CLS: PAINT (1, 1), w&
  53.  

 
quaddraw.jpg

 
stainedglass.jpg
« Last Edit: April 14, 2020, 09:11:11 pm by Dav »
Logged

Offline TerryRitchie

  • Seasoned Forum Regular
  • Posts: 495
  • Semper Fidelis
    • View Profile
Re: QuadDraw - Odd little drawing program.
« Reply #1 on: April 12, 2020, 10:46:36 pm »
Cool, looks like stained glass.
Logged
In order to understand recursion, one must first understand recursion.

Offline gaslouk

  • Newbie
  • Posts: 29
    • View Profile
Re: QuadDraw - Odd little drawing program.
« Reply #2 on: April 12, 2020, 10:54:35 pm »
It's very good dav, I like it. :)
Untitled 13_4_2020 5_52_53 πμ.png
* Untitled 13_4_2020 5_52_53 πμ.png (Filesize: 36.98 KB, Dimensions: 600x600, Views: 265)
Logged

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: QuadDraw - Odd little drawing program.
« Reply #3 on: April 13, 2020, 07:29:00 am »
With this, I can make some abstract art! :D
Logged
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: QuadDraw - Odd little drawing program.
« Reply #4 on: April 13, 2020, 12:02:37 pm »
The idea is brilliant. Nice work!

I was bothered by the points in the lines, so I adjusted it a bit.


Code: QB64: [Select]
  1. '============
  2. 'QuadDraw.bas
  3. '============
  4. 'An odd little drawing program.
  5. 'Draws/paints in 4 sections of the screen at same time.
  6. 'Coded by Dav for QB64 APR/2020
  7.  
  8. 'Left click to draw on screen.
  9. 'Right click to fill enclosed sections with random color.
  10. 'Press space to clear screen and start over fresh.
  11.  
  12. SCREEN _NEWIMAGE(600, 600, 32)
  13.  
  14. cx = _WIDTH / 2: cy = _HEIGHT / 2 'center point of screen
  15.  
  16. w~& = _RGB32(255, 255, 255) 'used often, so variable it
  17. b~& = _RGB32(0, 0, 0)
  18.  
  19. CLS , w~& 'start with white screen
  20.  
  21. 'show instruction at beginning
  22. PRINT "    Left click to draw, right click to fill color, space clears screen     "
  23.  
  24. size = 5 'size of circle (brush)
  25. NewColoredPen = swapColor(NIB, &HFFFFFFFF, b~&)
  26.  
  28.     t = _MOUSEINPUT
  29.     x = _MOUSEX: y = _MOUSEY
  30.  
  31.     'If left button, draw on screen
  33.  
  34.         _PUTIMAGE (x-11, y-11), NewColoredPen
  35.         _PUTIMAGE (cx - x + cx-11, cy - y + cy-11), NewColoredPen
  36.         _PUTIMAGE (x-11, cy - y + cy-11), NewColoredPen
  37.         _PUTIMAGE (cx - x + cx-11, y-11), NewColoredPen
  38.  
  39.     END IF
  40.     'if right click, fill sections with color
  42.         c = (RND * 100)
  43.         r = RND * 255: g = RND * 255: b = RND * 255
  44.         PAINT (x, y), _RGB32(r, g, b), b~&
  45.         PAINT (cx - x + cx, cy - y + cy), _RGB32(r, g, b), b~&
  46.         PAINT (x, cy - y + cy), _RGB32(r, g, b), b~&
  47.         PAINT (cx - x + cx, y), _RGB32(r, g, b), b~&
  48.         WHILE _MOUSEBUTTON(2) <> 0: n = _MOUSEINPUT: WEND
  49.     END IF
  50.     'scpace clears screen again
  51.     IF INKEY$ = CHR$(32) THEN CLS , w~&
  52.  
  53.     '    IF _MOUSEBUTTON(3) THEN
  54.     '    b~& = _RGB32(1 + RND * 255, 1 + RND * 254, 1 + RND * 255)
  55.     '    _FREEIMAGE NewColoredPen
  56.     '    NewColoredPen = swapColor(NIB, &HFFFFFFFF, b~&)
  57.     '    END IF
  58.  
  60.  
  62.     NIB = _NEWIMAGE(21, 21, 32)
  63.     _DEST NIB
  64.     CLS , &HFFFFFFFF
  65.     CIRCLE (10, 10), 10, &HFF000000
  66.     PAINT (10, 10), &HFF000000, &HFF000000
  67.     _CLEARCOLOR &HFFFFFFFF, NIB
  69.  
  70. FUNCTION swapColor& (oldHandle&, oldcolor~&, newcolor~&)
  71.     DIM m AS _MEM, c AS _UNSIGNED LONG
  72.     swapColor& = _COPYIMAGE(oldHandle&, 32)
  73.     _FREEIMAGE oldHandle&
  74.     m = _MEMIMAGE(swapColor)
  75.     DO UNTIL a& = m.SIZE - 4
  76.         a& = a& + 4
  77.         c~& = _MEMGET(m, m.OFFSET + a&, _UNSIGNED LONG)
  78.         IF c~& = oldcolor~& THEN _MEMPUT m, m.OFFSET + a&, newcolor~&
  79.     LOOP
  80.     _MEMFREE m
  82.  

 
image.JPG

« Last Edit: April 13, 2020, 12:51:37 pm by Petr »
Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: QuadDraw - Odd little drawing program.
« Reply #5 on: April 13, 2020, 02:07:05 pm »
That program example looks like a real pane. A stained glass one.

I'll stick with SCREEN 0, because all I can draw is a conclusion.

Actually, it  reminds me of a cross between an Etch-a-Sketch and synchronized swimming. Very easy to use.

The designs posted took some effort.

Pete

Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: QuadDraw - Odd little drawing program.
« Reply #6 on: April 13, 2020, 02:31:01 pm »
Next version: Use mouse button 3 for pen color change. SUB SPAINT then solve coloring in different color borders.


Code: QB64: [Select]
  1. '============
  2. 'QuadDraw.bas
  3. '============
  4. 'An odd little drawing program.
  5. 'Draws/paints in 4 sections of the screen at same time.
  6. 'Coded by Dav for QB64 APR/2020
  7.  
  8. 'Left click to draw on screen.
  9. 'Right click to fill enclosed sections with random color.
  10. 'Press space to clear screen and start over fresh.
  11.  
  12. SCREEN _NEWIMAGE(600, 600, 32)
  13.  
  14. cx = _WIDTH / 2: cy = _HEIGHT / 2 'center point of screen
  15.  
  16. w~& = _RGB32(255, 255, 255) 'used often, so variable it
  17. b~& = _RGB32(0, 0, 0)
  18.  
  19. CLS , w~& 'start with white screen
  20.  
  21. 'show instruction at beginning
  22. PRINT "    Left click to draw, right click to fill color, space clears screen     "
  23.  
  24. size = 5 'size of circle (brush)
  25. NewColoredPen = swapColor(NIB, &HFF000000, b~&)
  26.  
  28.     t = _MOUSEINPUT
  29.     x = _MOUSEX: y = _MOUSEY
  30.  
  31.     'If left button, draw on screen
  33.  
  34.         _PUTIMAGE (x - 11, y - 11), NewColoredPen
  35.         _PUTIMAGE (cx - x + cx - 11, cy - y + cy - 11), NewColoredPen
  36.         _PUTIMAGE (x - 11, cy - y + cy - 11), NewColoredPen
  37.         _PUTIMAGE (cx - x + cx - 11, y - 11), NewColoredPen
  38.  
  39.     END IF
  40.     'if right click, fill sections with color
  42.         c = (RND * 100)
  43.         r = RND * 255: g = RND * 255: b = RND * 255
  44.         SPAINT x, y, _RGB32(r, g, b) '#, b~&
  45.         SPAINT cx - x + cx, cy - y + cy, _RGB32(r, g, b) ', b~&
  46.         SPAINT x, cy - y + cy, _RGB32(r, g, b) ', b~&
  47.         SPAINT cx - x + cx, y, _RGB32(r, g, b) ', b~&
  48.         WHILE _MOUSEBUTTON(2) <> 0: n = _MOUSEINPUT: WEND
  49.     END IF
  50.     'scpace clears screen again
  51.     IF INKEY$ = CHR$(32) THEN CLS , w~&
  52.  
  54.         b~& = _RGB32(1 + RND * 255, 1 + RND * 254, 1 + RND * 255)
  55.         _FREEIMAGE NewColoredPen
  56.         NewColoredPen = swapColor(NIB, &HFF000000, b~&)
  57.     END IF
  58.  
  60.  
  62. NIB = _NEWIMAGE(21, 21, 32)
  63. _DEST NIB
  64. CLS , &HFFFFFFFF
  65. CIRCLE (10, 10), 10, &HFF000000
  66. PAINT (10, 10), &HFF000000, &HFF000000
  67. _CLEARCOLOR &HFFFFFFFF, NIB
  69.  
  70. FUNCTION swapColor& (oldHandle&, oldcolor~&, newcolor~&)
  72. swapColor& = _COPYIMAGE(oldHandle&, 32)
  73. _FREEIMAGE oldHandle&
  74. m = _MEMIMAGE(swapColor)
  75. SELECT CASE _PIXELSIZE(swapColor&)
  76.     CASE 4
  77.         DO UNTIL a& = m.SIZE - 4
  78.             a& = a& + 4
  79.             c~& = _MEMGET(m, m.OFFSET + a&, _UNSIGNED LONG)
  80.             IF c~& = oldcolor~& THEN _MEMPUT m, m.OFFSET + a&, newcolor~&
  81.         LOOP
  82.     CASE 1
  83.         DO UNTIL a& = m.SIZE - 1
  84.             a& = a& + 1
  85.             c~& = _MEMGET(m, m.OFFSET + a&, _UNSIGNED _BYTE)
  86.             IF c~& = oldcolor~& THEN _MEMPUT m, m.OFFSET + a&, newcolor~&
  87.         LOOP
  91.  
  92. SUB SPAINT (x AS INTEGER, y AS INTEGER, clr~&) 'Color everything in the X, Y position regardless of the border color.
  93. DIM m AS _MEM, m2 AS _MEM
  94.  
  99.  
  100.  
  102.     CASE 4 '                             image is 32 bit image
  103.         Virtual = _NEWIMAGE(W, H, 32)
  104.         m2 = _MEMIMAGE(Virtual)
  105.         Back~& = POINT(x, y)
  106.         Back2~& = _RGB32(1, 1, 1)
  107.         Empty~& = _RGBA32(0, 0, 0, 0)
  108.         DO UNTIL a& = m.SIZE - 4
  109.             a& = a& + 4
  110.             IF _MEMGET(m, m.OFFSET + a&, _UNSIGNED LONG) = Back~& THEN _MEMPUT m2, m2.OFFSET + a&, Back~& ELSE _MEMPUT m2, m2.OFFSET + a&, Back2~&
  111.         LOOP
  112.         d = _DEST
  113.         _DEST Virtual
  114.         PAINT (x, y), clr~&, Back2~&
  115.         _DEST d
  116.         a& = 0
  117.         DO UNTIL a& = m.SIZE - 4
  118.             a& = a& + 4
  119.             IF _MEMGET(m2, m2.OFFSET + a&, _UNSIGNED LONG) <> clr~& THEN _MEMPUT m2, m2.OFFSET + a&, Empty~&
  120.         LOOP
  121.         _CLEARCOLOR Back2~&, Virtual
  122.         _PUTIMAGE (0, 0), Virtual
  123.         _MEMFREE m
  124.         _MEMFREE m2
  125.         _FREEIMAGE Virtual
  126.     CASE 1 '                             image is 8 bit image (256 colors)
  127.         Virtual = _NEWIMAGE(W, H, 32)
  128.         m2 = _MEMIMAGE(Virtual)
  129.         Back~& = POINT(x, y)
  130.         Back2~& = _RGB(1, 1, 1)
  131.         Empty~& = _RGBA(0, 0, 0, 0)
  132.         DO UNTIL a& = m.SIZE - 1
  133.             a& = a& + 1
  134.             IF _MEMGET(m, m.OFFSET + a&, _UNSIGNED _BYTE) = Back~& THEN _MEMPUT m2, m2.OFFSET + a&, Back~& ELSE _MEMPUT m2, m2.OFFSET + a&, Back2~&
  135.         LOOP
  136.         d = _DEST
  137.         _DEST Virtual
  138.         PAINT (x, y), clr~&, Back2~&
  139.         _DEST d
  140.         a& = 0
  141.         DO UNTIL a& = m.SIZE - 1
  142.             a& = a& + 1
  143.             IF _MEMGET(m2, m2.OFFSET + a&, _UNSIGNED _BYTE) <> clr~& THEN _MEMPUT m2, m2.OFFSET + a&, Empty~&
  144.         LOOP
  145.         _CLEARCOLOR Back2~&, Virtual
  146.         _PUTIMAGE (0, 0), Virtual
  147.         _MEMFREE m
  148.         _MEMFREE m2
  149.         _FREEIMAGE Virtual
  152.  

 
image2.JPG
Logged

Offline Dav

  • Forum Resident
  • Posts: 792
    • View Profile
Re: QuadDraw - Odd little drawing program.
« Reply #7 on: April 13, 2020, 09:33:37 pm »
Thanks for trying it out.  Glad you like it.

Nice additions, Petr!  I like them.  I was working up another version today using .png brushes, but I favor your versions better. Feel free to add your name to the code!

Sorry for replying to you all so late, the storms knocked off our power/internet last night and I had to come over to my dads today to check on him, check email, read forums, etc.  May be off for a few days I'm told, Ill be popping in less frequently.

Lol, Pete.  I always enjoy your humor.

- Dav

.
« Last Edit: April 13, 2020, 09:47:52 pm by Dav »
Logged

Offline Dav

  • Forum Resident
  • Posts: 792
    • View Profile
Re: QuadDraw - Odd little drawing program.
« Reply #8 on: April 14, 2020, 10:54:24 am »
Building on the great enhancements added by Petr, I've updated the program with more user control of settings to allow one to make more detailed drawings.

New:
1) You can now change brush size using keys +/-
2) You can specify how many quads to draw on, 1 to 4, by pressing keys 1,2,3,4.
3) Current settings are shown in programs TITLE bar.

With these changes you can make more than stained glass drawings

How about a QuadDraw art show?
 
- Dav

Code: QB64: [Select]
  1. '============
  2. 'QuadDraw.bas v1.1
  3. '============
  4. 'An odd little drawing program.
  5. 'Draws/paints in 4 sections of the screen at same time.
  6. 'Coded by Dav for QB64, APR/2020
  7.  
  8. 'CREDIT: Many code enhanchments by Petr.  Thanks Petr!
  9.  
  10. 'Follow this programs development here:
  11. 'https://www.qb64.org/forum/index.php?topic=2467.0
  12.  
  13. '----------
  14. 'HOW TO USE:
  15. '----------
  16.  
  17. 'Left click = draws on screen.
  18. 'Right click = fills with color.
  19. 'Middle click = sets new color
  20. 'Use the +/- keys to resize brush size (1 to 50 allowed)
  21. 'Press 1,2,3 or 4 to set how many quads to draw, default is 4.
  22. 'Space = clears screen and starts over.
  23. 'ESC = Ends program
  24.  
  25. SCREEN _NEWIMAGE(600, 600, 32)
  27.  
  28. cx = _WIDTH / 2: cy = _HEIGHT / 2 'center point of screen
  29.  
  30. w~& = _RGB32(255, 255, 255) 'used often, so variable it
  31. b~& = _RGB32(0, 0, 0)
  32.  
  33. CLS , w~& 'start with white screen
  34.  
  35. DIM SHARED size: size = 10 'size of circle (brush)
  36.  
  37. quads = 4 'defaut, use 4 drawing quads
  38.  
  39. '====
  40. main:
  41. '====
  42.  
  43. _TITLE "QuadDraw - Quads:" + STR$(quads) + "  Size:" + STR$(size)
  44.  
  45. NewColoredPen = swapColor(NIB, &HFF000000, b~&)
  46.  
  48.     t = _MOUSEINPUT
  49.     x = _MOUSEX: y = _MOUSEY
  50.  
  51.     'If left button, draw on screen
  53.         _PUTIMAGE (x - (size + 1), y - (size + 1)), NewColoredPen
  54.         IF quads > 1 THEN
  55.             _PUTIMAGE (cx - x + cx - (size + 1), cy - y + cy - (size + 1)), NewColoredPen
  56.         END IF
  57.         IF quads > 2 THEN
  58.             _PUTIMAGE (x - (size + 1), cy - y + cy - (size + 1)), NewColoredPen
  59.         END IF
  60.         IF quads > 3 THEN
  61.             _PUTIMAGE (cx - x + cx - (size + 1), y - (size + 1)), NewColoredPen
  62.         END IF
  63.     END IF
  64.  
  65.     'if right click, fill sections with color
  67.         r = RND * 255: g = RND * 255: b = RND * 255
  68.         SPAINT x, y, _RGB32(r, g, b) '#, b~&
  69.         IF quads > 1 THEN
  70.             SPAINT cx - x + cx, cy - y + cy, _RGB32(r, g, b) ', b~&
  71.         END IF
  72.         IF quads > 2 THEN
  73.             SPAINT x, cy - y + cy, _RGB32(r, g, b) ', b~&
  74.         END IF
  75.         IF quads > 3 THEN
  76.             SPAINT cx - x + cx, y, _RGB32(r, g, b) ', b~&
  77.         END IF
  78.         WHILE _MOUSEBUTTON(2) <> 0: n = _MOUSEINPUT: WEND
  79.     END IF
  80.  
  81.     'Select color
  83.         b~& = _RGB32(1 + RND * 255, 1 + RND * 254, 1 + RND * 255)
  84.         _FREEIMAGE NewColoredPen
  85.         NewColoredPen = swapColor(NIB, &HFF000000, b~&)
  86.     END IF
  87.  
  88.     'get keyboard input
  89.     key$ = INKEY$
  90.     IF key$ <> "" THEN
  91.         SELECT CASE key$
  92.             CASE CHR$(32): CLS , w~& 'scpace clears screen again
  93.             CASE "1": quads = 1
  94.             CASE "2": quads = 2
  95.             CASE "3": quads = 3
  96.             CASE "4": quads = 4
  97.             CASE "+"
  98.                 size = size + 1: IF size > 50 THEN size = 50
  99.             CASE "-"
  100.                 size = size - 1: IF size < 1 THEN size = 1
  101.             CASE CHR$(27): END
  102.         END SELECT
  103.         DO UNTIL INKEY$ = "": LOOP
  104.         GOTO main
  105.     END IF
  107.  
  109.     'FUNCTION by Petr
  110.     NIB = _NEWIMAGE(size * 2 + 1, size * 2 + 1, 32)
  111.     _DEST NIB
  112.     CLS , &HFFFFFFFF
  113.     CIRCLE (size, size), size, &HFF000000
  114.     PAINT (size, size), &HFF000000, &HFF000000
  115.     _CLEARCOLOR &HFFFFFFFF, NIB
  117.  
  118. FUNCTION swapColor& (oldHandle&, oldcolor~&, newcolor~&)
  119.     'FUNCTION by Petr
  120.     DIM m AS _MEM, c AS _UNSIGNED LONG
  121.     swapColor& = _COPYIMAGE(oldHandle&, 32)
  122.     _FREEIMAGE oldHandle&
  123.     m = _MEMIMAGE(swapColor)
  124.     SELECT CASE _PIXELSIZE(swapColor&)
  125.         CASE 4
  126.             DO UNTIL a& = m.SIZE - 4
  127.                 a& = a& + 4
  128.                 c~& = _MEMGET(m, m.OFFSET + a&, _UNSIGNED LONG)
  129.                 IF c~& = oldcolor~& THEN _MEMPUT m, m.OFFSET + a&, newcolor~&
  130.             LOOP
  131.         CASE 1
  132.             DO UNTIL a& = m.SIZE - 1
  133.                 a& = a& + 1
  134.                 c~& = _MEMGET(m, m.OFFSET + a&, _UNSIGNED _BYTE)
  135.                 IF c~& = oldcolor~& THEN _MEMPUT m, m.OFFSET + a&, newcolor~&
  136.             LOOP
  137.     END SELECT
  138.     _MEMFREE m
  140.  
  141. SUB SPAINT (x AS INTEGER, y AS INTEGER, clr~&) 'Color everything in the X, Y position regardless of the border color.
  142.     'SUB by Petr
  143.     DIM m AS _MEM, m2 AS _MEM
  144.  
  145.     m = _MEMIMAGE(_DEST)
  146.     W = _WIDTH(_DEST)
  147.     H = _HEIGHT(_DEST)
  148.     P = _PIXELSIZE(_DEST)
  149.  
  150.  
  151.     SELECT CASE P
  152.         CASE 4 '                             image is 32 bit image
  153.             Virtual = _NEWIMAGE(W, H, 32)
  154.             m2 = _MEMIMAGE(Virtual)
  155.             Back~& = POINT(x, y)
  156.             Back2~& = _RGB32(1, 1, 1)
  157.             Empty~& = _RGBA32(0, 0, 0, 0)
  158.             DO UNTIL a& = m.SIZE - 4
  159.                 a& = a& + 4
  160.                 IF _MEMGET(m, m.OFFSET + a&, _UNSIGNED LONG) = Back~& THEN _MEMPUT m2, m2.OFFSET + a&, Back~& ELSE _MEMPUT m2, m2.OFFSET + a&, Back2~&
  161.             LOOP
  162.             d = _DEST
  163.             _DEST Virtual
  164.             PAINT (x, y), clr~&, Back2~&
  165.             _DEST d
  166.             a& = 0
  167.             DO UNTIL a& = m.SIZE - 4
  168.                 a& = a& + 4
  169.                 IF _MEMGET(m2, m2.OFFSET + a&, _UNSIGNED LONG) <> clr~& THEN _MEMPUT m2, m2.OFFSET + a&, Empty~&
  170.             LOOP
  171.             _CLEARCOLOR Back2~&, Virtual
  172.             _PUTIMAGE (0, 0), Virtual
  173.             _MEMFREE m
  174.             _MEMFREE m2
  175.             _FREEIMAGE Virtual
  176.         CASE 1 '                             image is 8 bit image (256 colors)
  177.             Virtual = _NEWIMAGE(W, H, 32)
  178.             m2 = _MEMIMAGE(Virtual)
  179.             Back~& = POINT(x, y)
  180.             Back2~& = _RGB(1, 1, 1)
  181.             Empty~& = _RGBA(0, 0, 0, 0)
  182.             DO UNTIL a& = m.SIZE - 1
  183.                 a& = a& + 1
  184.                 IF _MEMGET(m, m.OFFSET + a&, _UNSIGNED _BYTE) = Back~& THEN _MEMPUT m2, m2.OFFSET + a&, Back~& ELSE _MEMPUT m2, m2.OFFSET + a&, Back2~&
  185.             LOOP
  186.             d = _DEST
  187.             _DEST Virtual
  188.             PAINT (x, y), clr~&, Back2~&
  189.             _DEST d
  190.             a& = 0
  191.             DO UNTIL a& = m.SIZE - 1
  192.                 a& = a& + 1
  193.                 IF _MEMGET(m2, m2.OFFSET + a&, _UNSIGNED _BYTE) <> clr~& THEN _MEMPUT m2, m2.OFFSET + a&, Empty~&
  194.             LOOP
  195.             _CLEARCOLOR Back2~&, Virtual
  196.             _PUTIMAGE (0, 0), Virtual
  197.             _MEMFREE m
  198.             _MEMFREE m2
  199.             _FREEIMAGE Virtual
  200.     END SELECT
  202.  
Logged

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: QuadDraw - Odd little drawing program.
« Reply #9 on: April 14, 2020, 11:42:43 am »
Nice work, Dav!

 
image3.JPG
Logged

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: QuadDraw - Odd little drawing program.
« Reply #10 on: April 14, 2020, 11:50:59 am »
Hi
I think to observe the thread to see how far this demo will grow up.

I remember a similar paint game on android. Well done and good enanchments for now.
Go on great Dav and Petr.
Logged
Programming isn't difficult, only it's  consuming time and coffee

Offline Dav

  • Forum Resident
  • Posts: 792
    • View Profile
Re: QuadDraw - Odd little drawing program.
« Reply #11 on: April 14, 2020, 09:10:11 pm »
Small update...Added an UNDO last change - Press U to do an UNDO.  A little needed function (for me at least).

- Dav

Code: QB64: [Select]
  1. '============
  2. 'QuadDraw.bas v1.2
  3. '============
  4. 'An odd little drawing program.
  5. 'Draws/paints in 4 sections of the screen at same time.
  6. 'Coded by Dav for QB64, APR/2020
  7.  
  8. 'CREDIT: Many code enhanchments by Petr.  Thanks Petr!
  9.  
  10. 'Follow this programs development here:
  11. 'https://www.qb64.org/forum/index.php?topic=2467.0
  12.  
  13. 'Added: UNDO last change by pressing U
  14.  
  15. '----------
  16. 'HOW TO USE:
  17. '----------
  18.  
  19. 'Left click = draws on screen.
  20. 'Right click = fills with color.
  21. 'Middle click = sets new color
  22. 'Use the +/- keys to resize brush size (1 to 50 allowed)
  23. 'Press 1,2,3 or 4 to set how many quads to draw, default is 4.
  24. 'Press U to undo last change
  25. 'Space = clears screen and starts over.
  26. 'ESC = Ends program
  27.  
  28. SCREEN _NEWIMAGE(600, 600, 32)
  30.  
  31. cx = _WIDTH / 2: cy = _HEIGHT / 2 'center point of screen
  32.  
  33. w~& = _RGB32(255, 255, 255) 'used often, so variable it
  34. b~& = _RGB32(0, 0, 0)
  35.  
  36. CLS , w~& 'start with white screen
  37.  
  39.  
  40. DIM SHARED size: size = 10 'size of circle (brush)
  41.  
  42. quads = 4 'defaut, use 4 drawing quads
  43.  
  44. '====
  45. main:
  46. '====
  47.  
  48. _TITLE "QuadDraw - Quads:" + STR$(quads) + "  Size:" + STR$(size)
  49.  
  50. NewColoredPen = swapColor(NIB, &HFF000000, b~&)
  51.  
  53.     t = _MOUSEINPUT
  54.     x = _MOUSEX: y = _MOUSEY
  55.  
  56.     'If left button, draw on screen
  58.  
  59.         undo& = _COPYIMAGE(_DISPLAY)
  60.  
  61.         DO
  62.             t = _MOUSEINPUT
  63.             x = _MOUSEX: y = _MOUSEY
  64.  
  65.             _PUTIMAGE (x - (size + 1), y - (size + 1)), NewColoredPen
  66.             IF quads > 1 THEN
  67.                 _PUTIMAGE (cx - x + cx - (size + 1), cy - y + cy - (size + 1)), NewColoredPen
  68.             END IF
  69.             IF quads > 2 THEN
  70.                 _PUTIMAGE (x - (size + 1), cy - y + cy - (size + 1)), NewColoredPen
  71.             END IF
  72.             IF quads > 3 THEN
  73.                 _PUTIMAGE (cx - x + cx - (size + 1), y - (size + 1)), NewColoredPen
  74.             END IF
  75.         LOOP UNTIL _MOUSEBUTTON(1) = 0
  76.  
  77.     END IF
  78.  
  79.     'if right click, fill sections with color
  81.  
  82.         undo& = _COPYIMAGE(_DISPLAY)
  83.  
  84.         r = RND * 255: g = RND * 255: b = RND * 255
  85.         SPAINT x, y, _RGB32(r, g, b) '#, b~&
  86.         IF quads > 1 THEN
  87.             SPAINT cx - x + cx, cy - y + cy, _RGB32(r, g, b) ', b~&
  88.         END IF
  89.         IF quads > 2 THEN
  90.             SPAINT x, cy - y + cy, _RGB32(r, g, b) ', b~&
  91.         END IF
  92.         IF quads > 3 THEN
  93.             SPAINT cx - x + cx, y, _RGB32(r, g, b) ', b~&
  94.         END IF
  95.         WHILE _MOUSEBUTTON(2) <> 0: n = _MOUSEINPUT: WEND
  96.     END IF
  97.  
  98.     'Select color
  100.         b~& = _RGB32(1 + RND * 255, 1 + RND * 254, 1 + RND * 255)
  101.         _FREEIMAGE NewColoredPen
  102.         NewColoredPen = swapColor(NIB, &HFF000000, b~&)
  103.     END IF
  104.  
  105.     'get keyboard input
  106.     key$ = UCASE$(INKEY$)
  107.     IF key$ <> "" THEN
  108.         SELECT CASE key$
  109.             CASE CHR$(32): CLS , w~& 'scpace clears screen again
  110.             CASE "1": quads = 1
  111.             CASE "2": quads = 2
  112.             CASE "3": quads = 3
  113.             CASE "4": quads = 4
  114.             CASE "+"
  115.                 size = size + 1: IF size > 50 THEN size = 50
  116.             CASE "-"
  117.                 size = size - 1: IF size < 1 THEN size = 1
  118.             CASE "U": _PUTIMAGE (0, 0), undo&
  119.             CASE CHR$(27): END
  120.         END SELECT
  121.         DO UNTIL INKEY$ = "": LOOP
  122.         GOTO main
  123.     END IF
  125.  
  126.  
  127.  
  129.     'FUNCTION by Petr
  130.     NIB = _NEWIMAGE(size * 2 + 1, size * 2 + 1, 32)
  131.     _DEST NIB
  132.     CLS , &HFFFFFFFF
  133.     CIRCLE (size, size), size, &HFF000000
  134.     PAINT (size, size), &HFF000000, &HFF000000
  135.     _CLEARCOLOR &HFFFFFFFF, NIB
  137.  
  138. FUNCTION swapColor& (oldHandle&, oldcolor~&, newcolor~&)
  139.     'FUNCTION by Petr
  140.     DIM m AS _MEM, c AS _UNSIGNED LONG
  141.     swapColor& = _COPYIMAGE(oldHandle&, 32)
  142.     _FREEIMAGE oldHandle&
  143.     m = _MEMIMAGE(swapColor)
  144.     SELECT CASE _PIXELSIZE(swapColor&)
  145.         CASE 4
  146.             DO UNTIL a& = m.SIZE - 4
  147.                 a& = a& + 4
  148.                 c~& = _MEMGET(m, m.OFFSET + a&, _UNSIGNED LONG)
  149.                 IF c~& = oldcolor~& THEN _MEMPUT m, m.OFFSET + a&, newcolor~&
  150.             LOOP
  151.         CASE 1
  152.             DO UNTIL a& = m.SIZE - 1
  153.                 a& = a& + 1
  154.                 c~& = _MEMGET(m, m.OFFSET + a&, _UNSIGNED _BYTE)
  155.                 IF c~& = oldcolor~& THEN _MEMPUT m, m.OFFSET + a&, newcolor~&
  156.             LOOP
  157.     END SELECT
  158.     _MEMFREE m
  160.  
  161. SUB SPAINT (x AS INTEGER, y AS INTEGER, clr~&) 'Color everything in the X, Y position regardless of the border color.
  162.     'SUB by Petr
  163.     DIM m AS _MEM, m2 AS _MEM
  164.  
  165.     m = _MEMIMAGE(_DEST)
  166.     W = _WIDTH(_DEST)
  167.     H = _HEIGHT(_DEST)
  168.     P = _PIXELSIZE(_DEST)
  169.  
  170.  
  171.     SELECT CASE P
  172.         CASE 4 '                             image is 32 bit image
  173.             Virtual = _NEWIMAGE(W, H, 32)
  174.             m2 = _MEMIMAGE(Virtual)
  175.             Back~& = POINT(x, y)
  176.             Back2~& = _RGB32(1, 1, 1)
  177.             Empty~& = _RGBA32(0, 0, 0, 0)
  178.             DO UNTIL a& = m.SIZE - 4
  179.                 a& = a& + 4
  180.                 IF _MEMGET(m, m.OFFSET + a&, _UNSIGNED LONG) = Back~& THEN _MEMPUT m2, m2.OFFSET + a&, Back~& ELSE _MEMPUT m2, m2.OFFSET + a&, Back2~&
  181.             LOOP
  182.             d = _DEST
  183.             _DEST Virtual
  184.             PAINT (x, y), clr~&, Back2~&
  185.             _DEST d
  186.             a& = 0
  187.             DO UNTIL a& = m.SIZE - 4
  188.                 a& = a& + 4
  189.                 IF _MEMGET(m2, m2.OFFSET + a&, _UNSIGNED LONG) <> clr~& THEN _MEMPUT m2, m2.OFFSET + a&, Empty~&
  190.             LOOP
  191.             _CLEARCOLOR Back2~&, Virtual
  192.             _PUTIMAGE (0, 0), Virtual
  193.             _MEMFREE m
  194.             _MEMFREE m2
  195.             _FREEIMAGE Virtual
  196.         CASE 1 '                             image is 8 bit image (256 colors)
  197.             Virtual = _NEWIMAGE(W, H, 32)
  198.             m2 = _MEMIMAGE(Virtual)
  199.             Back~& = POINT(x, y)
  200.             Back2~& = _RGB(1, 1, 1)
  201.             Empty~& = _RGBA(0, 0, 0, 0)
  202.             DO UNTIL a& = m.SIZE - 1
  203.                 a& = a& + 1
  204.                 IF _MEMGET(m, m.OFFSET + a&, _UNSIGNED _BYTE) = Back~& THEN _MEMPUT m2, m2.OFFSET + a&, Back~& ELSE _MEMPUT m2, m2.OFFSET + a&, Back2~&
  205.             LOOP
  206.             d = _DEST
  207.             _DEST Virtual
  208.             PAINT (x, y), clr~&, Back2~&
  209.             _DEST d
  210.             a& = 0
  211.             DO UNTIL a& = m.SIZE - 1
  212.                 a& = a& + 1
  213.                 IF _MEMGET(m2, m2.OFFSET + a&, _UNSIGNED _BYTE) <> clr~& THEN _MEMPUT m2, m2.OFFSET + a&, Empty~&
  214.             LOOP
  215.             _CLEARCOLOR Back2~&, Virtual
  216.             _PUTIMAGE (0, 0), Virtual
  217.             _MEMFREE m
  218.             _MEMFREE m2
  219.             _FREEIMAGE Virtual
  220.     END SELECT
  222.  
  223.  
Logged

Offline OldMoses

  • Seasoned Forum Regular
  • Posts: 469
    • View Profile
Re: QuadDraw - Odd little drawing program.
« Reply #12 on: April 15, 2020, 06:20:27 pm »
You come up with some of the neatest, fun ideas for programs. They're always worth a look see.
Logged

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: QuadDraw - Odd little drawing program.
« Reply #13 on: April 15, 2020, 07:05:00 pm »
Logged
Programming isn't difficult, only it's  consuming time and coffee
Pages: [1]   Go Up
« previous next »