Paint Pixels 6

[SierraKen]

I think it was b+ that told me months ago that: "A program is never finished!"
I decided to update my Paint Pixels paint program with some new knowledge I gained recently with my recent programs. There is no changes for when you actually draw, but there are 4 big changes in it to make it worth keeping this one and tossing out the old version(s).
Here are the changes, I will copy/paste from the comments I have at the start of the code:

'This program was finished on December 17, 2019.
'Technical Notes:
'This version lets people save their .bmp files with spaces in their filenames.
'This version doesn't use the temp.bmp when saving anymore.
'This version jumps right to Draw mode when starting and also after Saving and Loading.
'This version lets you continue to draw on the same picture after Saving.

Edit: I just added a picture of a jet that was made with this if you wish to see.

Code: QB64: [Select]

1. 'This program was finished on December 17, 2019.
2. 'Technical Notes:
3. 'This version lets people save their .bmp files with spaces in their filenames.
4. 'This version doesn't use the temp.bmp when saving anymore.
5. 'This version jumps right to Draw mode when starting and also after Saving and Loading.
6. 'This version lets you continue to draw on the same picture after Saving.
7. '
8. 'This program uses around 55 MB RAM and 1% of the CPU on my semi-new computer.
9. 'Use at your own risk. I hold no responsibility for any problems whatsoever.
10. '
11. 'Thank you to B+ from the QB64.org forum for the color picker, the picture rotation code,
12. 'the ray line making code, and general help in making this program.
13. '-------------------------------------------------------------------------------------------
14. _LIMIT 100
15. start:
16. picture& = _NEWIMAGE(800, 600, 32)
17. CLS
18. SCREEN 0
19. _FULLSCREEN _OFF
20. _TITLE "Paint Pixels 6"
21. WIDTH 40, 43
22. _FONT 16
23. COLOR 15, 0
24. _SCREENMOVE 400, 200
25. PRINT
26. PRINT "        Paint Pixels 6"
27. PRINT
28. PRINT "       By Ken G. and B+"
29. PRINT
30. PRINT "     Use your Mouse for:"
31. PRINT "     (R)ays, (B)oxes, (O)rbits,"
32. PRINT "     (D)raw, (E)rase, (C)olors,"
33. PRINT "     (S)ave, (L)oad."
34. PRINT "     (P)rint to your Printer."
35. PRINT "     (I)nstructions - which will"
36. PRINT "     cause your picture to be lost."
37. PRINT
38. PRINT "     Space Bar to erase picture."
39. PRINT
40. PRINT
41. PRINT "     Press the Space Bar to"
42. PRINT "     skip instructions."
43. PRINT
44. PRINT "     Press Esc to end."
45. PRINT
46. PRINT "   * Any other key to continue. *"
47. gggo:
48. _LIMIT 100
49. ecc$ = INKEY$
50. IF ecc$ = " " THEN GOTO start2:
51. IF ecc$ = CHR$(27) THEN END
52. IF ecc$ = "" THEN GOTO gggo:
53. CLS
54. PRINT
55. PRINT "               Page 2"
56. PRINT
57. PRINT "     Commands are self-explanatory"
58. PRINT "     on Title Bar of Paint Window."
59. PRINT "     Here are some others:"
60. PRINT "     * Space Bar clears the screen."
61. PRINT "     * A color choosing window"
62. PRINT "       will come up right before"
63. PRINT "       you start painting. It also"
64. PRINT "       comes up when you press Space"
65. PRINT "       Bar to clear the screen."
66. PRINT "       Move the slides to the color"
67. PRINT "       you wish to use."
68. PRINT "     * Esc to end program."
69. PRINT "     * Use Left Mouse Button"
70. PRINT "     * (I)nstructions"
71. PRINT "     - There is no Undo feature."
72. PRINT
73. PRINT " It saves under .bmp files which can"
74. PRINT " be used with most other programs."
75. PRINT " It saves as 800 x 600 pixels."
76. PRINT
77. PRINT "       Press Esc to end."
78. PRINT
79. PRINT "    *  Any other key to start. *"
80. ggggo:
81. _LIMIT 100
82. ecc2$ = INKEY$
83. IF ecc2$ = CHR$(27) THEN END
84. IF ecc2$ = "" THEN GOTO ggggo:
85. CLS
86. start2:
87. CLS
88. begin = 1
89. PRINT "         Background Color"
90. PRINT
91. PRINT "         (B)lack (W)hite"
92. PRINT
93. PRINT "         Or Esc to end program."
94. start3:
95. _LIMIT 1000
96. bcolor$ = INKEY$
97. IF bcolor$ = CHR$(27) THEN END
98. IF bcolor$ = "" THEN GOTO start3:
99. IF bcolor$ = "w" OR bcolor$ = "W" THEN
100.     s& = _NEWIMAGE(800, 600, 32)
101.     picture& = _NEWIMAGE(800, 600, 32)
102.     bcol = 1
103.     SCREEN s&
104.     LINE (0, 0)-(800, 600), _RGB32(255, 255, 255), BF
105.     _PUTIMAGE , s&, picture&
106.     GOTO more2:
107. END IF
108. IF bcolor$ = "B" OR bcolor$ = "b" THEN
109.     s& = _NEWIMAGE(800, 600, 32)
110.     picture& = _NEWIMAGE(800, 600, 32)
111.     bcol = 2
112.     SCREEN s&
113.     CLS
114.     GOTO more2:
115. END IF
116. GOTO start3:
117. more2:
118. begin = 1
119. dMode = 1
120. m = 1
121.  
122. GOSUB chosencolor:
123. _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
124. '---------------------------------------------------
125. 'Here is the main loop of the program when painting.
126. '---------------------------------------------------
127. DO
128.     _LIMIT 1000
129.     _PUTIMAGE , picture&, s&
130.     SCREEN s&
131.     a$ = INKEY$
132.     DO WHILE _MOUSEINPUT
133.         mouseX = _MOUSEX
134.         mouseY = _MOUSEY
135.         mouseLeftButton = _MOUSEBUTTON(1)
136.         mouseRightButton = _MOUSEBUTTON(2)
137.         mouseMiddleButton = _MOUSEBUTTON(3)
138.     LOOP
139.     IF a$ = "d" OR a$ = "D" THEN
140.         dMode = 1 - dMode
141.         m = 1
142.     END IF
143.     IF dMode AND m = 1 THEN
144.         _TITLE "Mode: (D)raw | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
145.         IF mouseLeftButton THEN
146.             LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), clr~&, BF
147.             _PUTIMAGE , s&, picture&
148.         END IF
149.     END IF
150.     IF m = 1 AND dMode = 0 THEN
151.         _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
152.     END IF
153.     IF a$ = "e" OR a$ = "E" THEN
154.         eMode = 1 - eMode
155.         m = 2
156.     END IF
157.     IF eMode AND m = 2 THEN
158.         _TITLE "Mode: (E)raser | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
159.         IF mouseLeftButton AND bcol = 1 THEN
160.             LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), _RGB32(255, 255, 255), BF
161.             _PUTIMAGE , s&, picture&
162.         END IF
163.         IF mouseLeftButton AND bcol = 2 THEN
164.             LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), _RGB32(0, 0, 0), BF
165.             _PUTIMAGE , s&, picture&
166.         END IF
167.     END IF
168.     IF m = 2 AND eMode = 0 THEN
169.         _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
170.     END IF
171.     'Here is when someone whipes the screen blank with the space bar.
172.     IF a$ = " " THEN GOTO start2:
173.     IF a$ = CHR$(27) THEN END
174.     IF a$ = "s" OR a$ = "S" THEN GOTO saving:
175.     IF a$ = "l" OR a$ = "L" THEN GOSUB loading:
176.     IF a$ = "i" OR a$ = "I" THEN m = 0: GOTO start:
177.     'Here is code needed to call up the Windows Color Picker.
178.     'It also uses the code on top of this program and the Function at the end
179.     'of this program.
180.     IF a$ = "c" OR a$ = "C" THEN
181.         chosencolor:
182.         check$ = colorDialog$
183.         IF check$ <> "" THEN clr~& = VAL(check$) ELSE clr~& = &HFF0000FF '<<< I am blue if colorDialog does not work
184.         IF begin = 1 THEN begin = 0: RETURN
185.     END IF
186.     'Here is the Ray Lines code.
187.     IF a$ = "r" OR a$ = "R" THEN
188.         rMode = 1 - rMode
189.         m = 3
190.         IF rMode THEN lastx = mouseX: lastY = mouseY 'set first lastx, lasty
191.     END IF
192.     IF rMode AND m = 3 THEN
193.         _TITLE "Mode: (R)ays | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
194.         LINE (lastx, lastY)-(mouseX, mouseY), clr~&
195.         IF mouseLeftButton THEN
196.             lastx = mouseX: lastY = mouseY
197.             _PUTIMAGE , s&, picture&
198.         END IF
199.     END IF
200.     IF m = 3 AND rMode = 0 THEN
201.         _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
202.     END IF
203.     'Here is the Orbit Circles code.
204.     IF a$ = "o" OR a$ = "O" THEN
205.         oMode = 1 - oMode
206.         m = 4
207.         IF oMode THEN lastx = mouseX: lastY = mouseY
208.     END IF
209.     IF oMode AND m = 4 THEN
210.         _TITLE "Mode: (O)rbits | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
211.         IF mouseX < lastx THEN size = lastx - mouseX
212.         IF mouseX > lastx THEN size = mouseX - lastx
213.         IF mouseY < lastY THEN size2 = lastY - mouseY
214.         IF mouseY > lastY THEN size2 = mouseY - lastY
215.         one:
216.         seconds = seconds + .01
217.         s = (60 - seconds) * 6 + size
218.         x = INT(SIN(s / 180 * 3.141592) * size) + lastx
219.         Y = INT(COS(s / 180 * 3.141592) * size2) + lastY
220.         CIRCLE (x, Y), 1, clr~&
221.         IF seconds > 60 THEN
222.             seconds = 0
223.             GOTO two:
224.         END IF
225.         GOTO one:
226.         two:
227.         size = 0: size2 = 0
228.         IF mouseLeftButton THEN
229.             lastx = mouseX
230.             lastY = mouseY
231.             _PUTIMAGE , s&, picture&
232.         END IF
233.     END IF
234.     IF m = 4 AND oMode = 0 THEN
235.         _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
236.     END IF
237.     'Here is the Boxes code.
238.     IF a$ = "b" OR a$ = "B" THEN
239.         bMode = 1 - bMode
240.         m = 5
241.         IF bMode THEN lastx = mouseX: lastY = mouseY
242.     END IF
243.     IF bMode AND m = 5 THEN
244.         _TITLE "Mode: (B)oxes | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
245.         LINE (lastx, lastY)-(mouseX, mouseY), clr~&, BF
246.         IF mouseLeftButton THEN
247.             lastx = mouseX:
248.             lastY = mouseY
249.             _PUTIMAGE , s&, picture&
250.         END IF
251.     END IF
252.     IF m = 5 AND bMode = 0 THEN
253.         _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
254.     END IF
255.     'Here is the Printing of the picture.
256.     IF a$ = "p" OR a$ = "P" THEN
257.         _TITLE "Mode: (P)rint | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
258.         m = 0
259.         IF bcolor$ = "w" OR bcolor$ = "W" THEN
260.             j& = _COPYIMAGE(0)
261.             _DELAY .25
262.             INPUT "Print on printer (Y/N)?", i$ 'print screen page on printer
263.             CLS
264.             SCREEN j&
265.             _DELAY .25
266.             IF LEFT$(i$, 1) = "y" OR LEFT$(i$, 1) = "Y" THEN
267.                 'printer prep (code copied and pasted from bplus Free Calendar Program)
268.                 YMAX = _HEIGHT: XMAX = _WIDTH
269.                 landscape& = _NEWIMAGE(YMAX, XMAX, 32)
270.                 _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
271.                 _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
272.                 _PRINTIMAGE landscape&
273.                 _DELAY 2
274.                 landscape& = 0
275.                 s& = j&
276.                 _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
277.             END IF
278.         END IF
279.     END IF
280. LOOP
281.  
282. 'Saving
283. 'This section first saves your picture as temp.bmp and then
284. 'asks you a name for your picture and then renames temp.bmp to your name.
285. saving:
286. _TITLE "Mode: (S)ave | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
287. CLS
288. PRINT "                       Saving"
289. PRINT
290. PRINT "         Your bmp file will be saved in the"
291. PRINT "         same directory as this program is."
292. PRINT "         It can be used with almost any"
293. PRINT "         other graphics program or website."
294. PRINT "         It is saved using:"
295. PRINT "         width: 800  height: 600 pixels."
296. PRINT
297. PRINT "         Type a name to save your picture"
298. PRINT "         and press the Enter key. Do not"
299. PRINT "         add .bmp at the end, the program"
300. PRINT "         will do it automatically."
301. PRINT
302. PRINT "         Example: MyPic"
303. PRINT "         Quit and Enter key ends program."
304. PRINT
305. INPUT "         ->"; nm$
306. IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
307. nm$ = nm$ + ".bmp"
308. 'Checking to see if the file already exists on your computer.
309. theFileExists = _FILEEXISTS(nm$)
310. IF theFileExists = -1 THEN
311.     PRINT
312.     PRINT "       File Already Exists"
313.     PRINT "       Saving will delete your old"
314.     PRINT "       bmp picture."
315.     PRINT "       Would you like to still do it?"
316.     PRINT "      (Y/N)."
317.     PRINT "      Esc goes to start screen."
318.     llloop:
319.     _LIMIT 100
320.     ag2$ = INKEY$
321.     IF ag2$ = CHR$(27) THEN GOTO start:
322.     IF ag2$ = "" THEN GOTO llloop:
323.     IF ag2$ = "y" OR ag$ = "Y" THEN
324.         SHELL _HIDE "DEL " + nm$
325.         GOTO saving2:
326.     END IF
327.     GOTO llloop:
328. END IF
329. saving2:
330. CLS
331. _PUTIMAGE , picture&, s&
332. SaveImage 0, nm$
333. nm$ = ""
334. FOR snd = 100 TO 700 STEP 100
335.     SOUND snd, 2
336. NEXT snd
337. CLS
338. GOTO more2:
339.  
340. 'This section loads your picture from your computer.
341. loading:
342. _TITLE "Mode: (L)oad | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
343. CLS
344. PRINT
345. PRINT "                       Loading"
346. PRINT
347. PRINT "           Do not add .bmp at the end."
348. PRINT "           The bmp picture must be in the same"
349. PRINT "           directory as this program is."
350. PRINT "           You will not be able to edit your"
351. PRINT "           picture file with this program."
352. PRINT "           Type the name of your picture file"
353. PRINT "           here and press the Enter key."
354. PRINT "           Example: MyPic"
355. PRINT "           Quit and Enter key ends program."
356. PRINT
357. INPUT "           ->"; nm$
358. IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
359. nm$ = nm$ + ".bmp"
360. theFileExists = _FILEEXISTS(nm$)
361. IF theFileExists = 0 THEN
362.     PRINT
363.     PRINT "           File Does Not Exist."
364.     PRINT "           Would you like to try again (Y/N)"
365.     PRINT "           Esc goes to start screen."
366.     _LIMIT 100
367.     llloop2:
368.     ag$ = INKEY$
369.     IF ag$ = "" THEN GOTO llloop2:
370.     IF ag$ = "y" OR ag$ = "Y" THEN GOTO loading:
371.     IF ag$ = CHR$(27) THEN GOTO start:
372.     GOTO start:
373. END IF
374. CLS
375. l = 0
376. i& = _LOADIMAGE(nm$, 32)
377. SCREEN i&
378. FOR snd2 = 100 TO 700 STEP 100
379.     SOUND snd2, 2
380. NEXT snd2
381. s& = i&
382. i& = 0
383. picture& = _NEWIMAGE(800, 600, 32)
384. SCREEN s&
385. dMode = 1
386. m = 1
387. RETURN
388.  
389. 'Here is the SUB needed to save the image to BMP.
390. SUB SaveImage (image AS LONG, filename AS STRING)
391.     bytesperpixel& = _PIXELSIZE(image&)
392.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
393.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
394.     x& = _WIDTH(image&)
395.     y& = _HEIGHT(image&)
396.     b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + STRING$(16, 0) 'partial BMP header info(???? to be filled later)
397.     IF bytesperpixel& = 1 THEN
398.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
399.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
400.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
401.         NEXT
402.     END IF
403.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
404.     lastsource& = _SOURCE
405.     _SOURCE image&
406.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
407.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
408.         r$ = ""
409.         FOR px& = 0 TO x& - 1
410.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
411.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
412.         NEXT px&
413.         d$ = d$ + r$ + padder$
414.     NEXT py&
415.     _SOURCE lastsource&
416.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
417.     b$ = b$ + d$ ' total file data bytes to create file
418.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
419.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
420.     f& = FREEFILE
421.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
422.     OPEN filename$ + ext$ FOR BINARY AS #f&
423.     PUT #f&, , b$
424.     CLOSE #f&
425. END SUB
426.  
427. FUNCTION colorDialog$
428.  
429.     'first screen dimensions items to restore at exit
430.     DIM curRow AS INTEGER, curCol AS INTEGER, autoDisplay AS INTEGER
431.     DIM sw AS INTEGER, sh AS INTEGER, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG
432.     DIM curScrn AS LONG, backScrn AS LONG 'some handles
433.  
434.     DIM cd AS LONG
435.     DIM r AS INTEGER, g AS INTEGER, b AS INTEGER, a AS INTEGER, mb AS INTEGER, mx AS INTEGER, my AS INTEGER, i AS INTEGER
436.     DIM makeConst$, k$
437.     DIM f AS SINGLE
438.  
439.     'save old settings to restore at end ofsub
440.     curRow = CSRLIN
441.     curCol = POS(0)
442.     autoDisplay = _AUTODISPLAY
443.     sw = _WIDTH
444.     sh = _HEIGHT
445.     fg = _DEFAULTCOLOR
446.     bg = _BACKGROUNDCOLOR
447.     _KEYCLEAR
448.     'screen snapshot
449.     curScrn = _DEST
450.     backScrn = _NEWIMAGE(sw, sh, 32)
451.     _PUTIMAGE , curScrn, backScrn
452.  
453.     cd = _NEWIMAGE(800, 600, 32)
454.     SCREEN cd
455.     r = 128: g = 128: b = 128: a = 128
456.     COLOR &HFFDDDDDD, 0
457.     DO
458.         CLS
459.         makeConst$ = "&H" + RIGHT$(STRING$(8, "0") + HEX$(_RGBA32(r, g, b, a)), 8)
460.         slider 16, 10, r, "Red"
461.         slider 16, 60, g, "Green"
462.         slider 16, 110, b, "Blue"
463.         slider 16, 160, a, "Alpha"
464.         _PRINTSTRING (150, 260), "Press Enter or Spacebar, if you want to use the color: " + makeConst$
465.         _PRINTSTRING (210, 280), "Press Escape or Q to not use any color, returns 0."
466.         LINE (90, 300)-(710, 590), , B
467.         FOR i = 100 TO 700
468.             f = 255 * (i - 100) / 600
469.             LINE (i, 310)-STEP(0, 30), _RGB32(f, 0, 0): LINE (i, 310)-STEP(0, 20), VAL(makeConst$)
470.             LINE (i, 340)-STEP(0, 30), _RGB32(0, f, 0): LINE (i, 340)-STEP(0, 20), VAL(makeConst$)
471.             LINE (i, 370)-STEP(0, 30), _RGB32(0, 0, f): LINE (i, 370)-STEP(0, 20), VAL(makeConst$)
472.             LINE (i, 400)-STEP(0, 30), _RGB32(f, f, 0): LINE (i, 400)-STEP(0, 20), VAL(makeConst$)
473.             LINE (i, 430)-STEP(0, 30), _RGB32(0, f, f): LINE (i, 430)-STEP(0, 20), VAL(makeConst$)
474.             LINE (i, 460)-STEP(0, 30), _RGB32(f, 0, f): LINE (i, 460)-STEP(0, 20), VAL(makeConst$)
475.             LINE (i, 490)-STEP(0, 30), _RGB32(f, f, f): LINE (i, 490)-STEP(0, 20), VAL(makeConst$)
476.             LINE (i, 520)-STEP(0, 30), _RGB32(0, 0, 0): LINE (i, 520)-STEP(0, 20), VAL(makeConst$)
477.             LINE (i, 550)-STEP(0, 30), _RGB32(255, 255, 255): LINE (i, 550)-STEP(0, 20), VAL(makeConst$)
478.         NEXT
479.         WHILE _MOUSEINPUT: WEND
480.         mb = _MOUSEBUTTON(1)
481.         IF mb THEN 'clear it
482.             mx = _MOUSEX: my = _MOUSEY
483.             IF mx >= 16 AND mx <= 781 THEN
484.                 IF my >= 10 AND my <= 50 THEN
485.                     r = INT((mx - 16) / 3)
486.                 ELSEIF my >= 60 AND my <= 100 THEN
487.                     g = INT((mx - 16) / 3)
488.                 ELSEIF my >= 110 AND my <= 150 THEN
489.                     b = INT((mx - 16) / 3)
490.                 ELSEIF my >= 160 AND my <= 200 THEN
491.                     a = INT((mx - 16) / 3)
492.                 END IF
493.             END IF
494.         END IF
495.         k$ = INKEY$
496.         IF LEN(k$) THEN
497.             IF ASC(k$) = 27 OR k$ = "q" THEN EXIT DO
498.             IF ASC(k$) = 13 OR k$ = " " THEN colorDialog$ = makeConst$: EXIT DO
499.         END IF
500.         _DISPLAY
501.         _LIMIT 60
502.     LOOP
503.  
504.     'put things back
505.     SCREEN curScrn
506.     COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0): CLS
507.     _PUTIMAGE , backScrn
508.     _DISPLAY
509.     COLOR fg, bg
510.     _FREEIMAGE backScrn
511.     _FREEIMAGE cd
512.     IF autoDisplay THEN _AUTODISPLAY
513.     'clear key presses
514.     _KEYCLEAR
515.     'clear mouse clicks
516.     WHILE _MOUSEINPUT: WEND
517.     mb = _MOUSEBUTTON(1)
518.     IF mb THEN 'clear it
519.         WHILE mb 'OK!
520.             IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
521.             _LIMIT 10
522.         WEND
523.     END IF
524.     LOCATE curRow, curCol
525.  
526. END FUNCTION
527.  
528. SUB slider (x, y, value, label$)
529.     DIM c~&, s$
530.     SELECT CASE label$
531.         CASE "Red": c~& = &HFFFF0000
532.         CASE "Green": c~& = &HFF008800
533.         CASE "Blue": c~& = &HFF0000FF
534.         CASE "Alpha": c~& = &H88FFFFFF
535.     END SELECT
536.     LINE (x, y)-STEP(765, 40), c~&, B
537.     LINE (x, y)-STEP(3 * value, 40), c~&, BF
538.     s2$ = STR$(value)
539.     s3$ = LTRIM$(RTRIM$(s2$))
540.     s$ = label$ + " = " + s3$
541.     _PRINTSTRING (x + 384 - 4 * LEN(s$), y + 12), s$
542. END SUB
543.  

[bplus]

Hi Ken,

A comment about deciding to cancel or escape from ColorDialog:

Code: [Select]

    IF a$ = "c" OR a$ = "C" THEN
        chosencolor:
        check$ = colorDialog$
        IF check$ <> "" THEN clr~& = VAL(check$) ELSE clr~& = &HFF0000FF '<<< I am blue if colorDialog does not work
        IF begin = 1 THEN begin = 0: RETURN
    END IF

Like this:

Code: [Select]

    IF a$ = "c" OR a$ = "C" THEN
        chosencolor:
        check$ = colorDialog$
        IF check$ <> "" THEN clr~& = VAL(check$) 'ELSE <<< don't change drawing color
        IF begin = 1 THEN begin = 0: RETURN
    END IF


[SierraKen]

Thanks bplus. I wondered about that months ago but just left it in there. Since I have people choose a color to start out with, this makes sense to me. Here is the updated code, I will also update my website today.

Code: QB64: [Select]

1. 'This program was finished on December 17, 2019.
2. 'Technical Notes:
3. 'This version lets people save their .bmp files with spaces in their filenames.
4. 'This version doesn't use the temp.bmp when saving anymore.
5. 'This version jumps right to Draw mode when starting and also after Saving and Loading.
6. 'This version lets you continue to draw on the same picture after Saving.
7. '
8. 'This program uses around 55 MB RAM and 1% of the CPU on my semi-new computer.
9. 'Use at your own risk. I hold no responsibility for any problems whatsoever.
10. '
11. 'Thank you to B+ from the QB64.org forum for the color picker, the picture rotation code,
12. 'the ray line making code, and general help in making this program.
13. '-------------------------------------------------------------------------------------------
14. _LIMIT 100
15. start:
16. picture& = _NEWIMAGE(800, 600, 32)
17. CLS
18. SCREEN 0
19. _FULLSCREEN _OFF
20. _TITLE "Paint Pixels 6"
21. WIDTH 40, 43
22. _FONT 16
23. COLOR 15, 0
24. _SCREENMOVE 400, 200
25. PRINT
26. PRINT "        Paint Pixels 6"
27. PRINT
28. PRINT "       By Ken G. and B+"
29. PRINT
30. PRINT "     Use your Mouse for:"
31. PRINT "     (R)ays, (B)oxes, (O)rbits,"
32. PRINT "     (D)raw, (E)rase, (C)olors,"
33. PRINT "     (S)ave, (L)oad."
34. PRINT "     (P)rint to your Printer."
35. PRINT "     (I)nstructions - which will"
36. PRINT "     cause your picture to be lost."
37. PRINT
38. PRINT "     Space Bar to erase picture."
39. PRINT
40. PRINT
41. PRINT "     Press the Space Bar to"
42. PRINT "     skip instructions."
43. PRINT
44. PRINT "     Press Esc to end."
45. PRINT
46. PRINT "   * Any other key to continue. *"
47. gggo:
48. _LIMIT 100
49. ecc$ = INKEY$
50. IF ecc$ = " " THEN GOTO start2:
51. IF ecc$ = CHR$(27) THEN END
52. IF ecc$ = "" THEN GOTO gggo:
53. CLS
54. PRINT
55. PRINT "               Page 2"
56. PRINT
57. PRINT "     Commands are self-explanatory"
58. PRINT "     on Title Bar of Paint Window."
59. PRINT "     Here are some others:"
60. PRINT "     * Space Bar clears the screen."
61. PRINT "     * A color choosing window"
62. PRINT "       will come up right before"
63. PRINT "       you start painting. It also"
64. PRINT "       comes up when you press Space"
65. PRINT "       Bar to clear the screen."
66. PRINT "       Move the slides to the color"
67. PRINT "       you wish to use."
68. PRINT "     * Esc to end program."
69. PRINT "     * Use Left Mouse Button"
70. PRINT "     * (I)nstructions"
71. PRINT "     - There is no Undo feature."
72. PRINT
73. PRINT " It saves under .bmp files which can"
74. PRINT " be used with most other programs."
75. PRINT " It saves as 800 x 600 pixels."
76. PRINT
77. PRINT "       Press Esc to end."
78. PRINT
79. PRINT "    *  Any other key to start. *"
80. ggggo:
81. _LIMIT 100
82. ecc2$ = INKEY$
83. IF ecc2$ = CHR$(27) THEN END
84. IF ecc2$ = "" THEN GOTO ggggo:
85. CLS
86. start2:
87. CLS
88. begin = 1
89. PRINT "         Background Color"
90. PRINT
91. PRINT "         (B)lack (W)hite"
92. PRINT
93. PRINT "         Or Esc to end program."
94. start3:
95. _LIMIT 1000
96. bcolor$ = INKEY$
97. IF bcolor$ = CHR$(27) THEN END
98. IF bcolor$ = "" THEN GOTO start3:
99. IF bcolor$ = "w" OR bcolor$ = "W" THEN
100.     s& = _NEWIMAGE(800, 600, 32)
101.     picture& = _NEWIMAGE(800, 600, 32)
102.     bcol = 1
103.     SCREEN s&
104.     LINE (0, 0)-(800, 600), _RGB32(255, 255, 255), BF
105.     _PUTIMAGE , s&, picture&
106.     GOTO more2:
107. END IF
108. IF bcolor$ = "B" OR bcolor$ = "b" THEN
109.     s& = _NEWIMAGE(800, 600, 32)
110.     picture& = _NEWIMAGE(800, 600, 32)
111.     bcol = 2
112.     SCREEN s&
113.     CLS
114.     GOTO more2:
115. END IF
116. GOTO start3:
117. more2:
118. begin = 1
119. dMode = 1
120. m = 1
121.  
122. GOSUB chosencolor:
123. _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
124. '---------------------------------------------------
125. 'Here is the main loop of the program when painting.
126. '---------------------------------------------------
127. DO
128.     _LIMIT 1000
129.     _PUTIMAGE , picture&, s&
130.     SCREEN s&
131.     a$ = INKEY$
132.     DO WHILE _MOUSEINPUT
133.         mouseX = _MOUSEX
134.         mouseY = _MOUSEY
135.         mouseLeftButton = _MOUSEBUTTON(1)
136.         mouseRightButton = _MOUSEBUTTON(2)
137.         mouseMiddleButton = _MOUSEBUTTON(3)
138.     LOOP
139.     IF a$ = "d" OR a$ = "D" THEN
140.         dMode = 1 - dMode
141.         m = 1
142.     END IF
143.     IF dMode AND m = 1 THEN
144.         _TITLE "Mode: (D)raw | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
145.         IF mouseLeftButton THEN
146.             LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), clr~&, BF
147.             _PUTIMAGE , s&, picture&
148.         END IF
149.     END IF
150.     IF m = 1 AND dMode = 0 THEN
151.         _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
152.     END IF
153.     IF a$ = "e" OR a$ = "E" THEN
154.         eMode = 1 - eMode
155.         m = 2
156.     END IF
157.     IF eMode AND m = 2 THEN
158.         _TITLE "Mode: (E)raser | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
159.         IF mouseLeftButton AND bcol = 1 THEN
160.             LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), _RGB32(255, 255, 255), BF
161.             _PUTIMAGE , s&, picture&
162.         END IF
163.         IF mouseLeftButton AND bcol = 2 THEN
164.             LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), _RGB32(0, 0, 0), BF
165.             _PUTIMAGE , s&, picture&
166.         END IF
167.     END IF
168.     IF m = 2 AND eMode = 0 THEN
169.         _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
170.     END IF
171.     'Here is when someone whipes the screen blank with the space bar.
172.     IF a$ = " " THEN GOTO start2:
173.     IF a$ = CHR$(27) THEN END
174.     IF a$ = "s" OR a$ = "S" THEN GOTO saving:
175.     IF a$ = "l" OR a$ = "L" THEN GOSUB loading:
176.     IF a$ = "i" OR a$ = "I" THEN m = 0: GOTO start:
177.     'Here is code needed to call up the Windows Color Picker.
178.     'It also uses the code on top of this program and the Function at the end
179.     'of this program.
180.     IF a$ = "c" OR a$ = "C" THEN
181.         chosencolor:
182.         check$ = colorDialog$
183.         IF check$ <> "" THEN clr~& = VAL(check$) 'ELSE <<< don't change drawing color
184.         IF begin = 1 THEN begin = 0: RETURN
185.     END IF
186.     'Here is the Ray Lines code.
187.     IF a$ = "r" OR a$ = "R" THEN
188.         rMode = 1 - rMode
189.         m = 3
190.         IF rMode THEN lastx = mouseX: lastY = mouseY 'set first lastx, lasty
191.     END IF
192.     IF rMode AND m = 3 THEN
193.         _TITLE "Mode: (R)ays | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
194.         LINE (lastx, lastY)-(mouseX, mouseY), clr~&
195.         IF mouseLeftButton THEN
196.             lastx = mouseX: lastY = mouseY
197.             _PUTIMAGE , s&, picture&
198.         END IF
199.     END IF
200.     IF m = 3 AND rMode = 0 THEN
201.         _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
202.     END IF
203.     'Here is the Orbit Circles code.
204.     IF a$ = "o" OR a$ = "O" THEN
205.         oMode = 1 - oMode
206.         m = 4
207.         IF oMode THEN lastx = mouseX: lastY = mouseY
208.     END IF
209.     IF oMode AND m = 4 THEN
210.         _TITLE "Mode: (O)rbits | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
211.         IF mouseX < lastx THEN size = lastx - mouseX
212.         IF mouseX > lastx THEN size = mouseX - lastx
213.         IF mouseY < lastY THEN size2 = lastY - mouseY
214.         IF mouseY > lastY THEN size2 = mouseY - lastY
215.         one:
216.         seconds = seconds + .01
217.         s = (60 - seconds) * 6 + size
218.         x = INT(SIN(s / 180 * 3.141592) * size) + lastx
219.         Y = INT(COS(s / 180 * 3.141592) * size2) + lastY
220.         CIRCLE (x, Y), 1, clr~&
221.         IF seconds > 60 THEN
222.             seconds = 0
223.             GOTO two:
224.         END IF
225.         GOTO one:
226.         two:
227.         size = 0: size2 = 0
228.         IF mouseLeftButton THEN
229.             lastx = mouseX
230.             lastY = mouseY
231.             _PUTIMAGE , s&, picture&
232.         END IF
233.     END IF
234.     IF m = 4 AND oMode = 0 THEN
235.         _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
236.     END IF
237.     'Here is the Boxes code.
238.     IF a$ = "b" OR a$ = "B" THEN
239.         bMode = 1 - bMode
240.         m = 5
241.         IF bMode THEN lastx = mouseX: lastY = mouseY
242.     END IF
243.     IF bMode AND m = 5 THEN
244.         _TITLE "Mode: (B)oxes | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
245.         LINE (lastx, lastY)-(mouseX, mouseY), clr~&, BF
246.         IF mouseLeftButton THEN
247.             lastx = mouseX:
248.             lastY = mouseY
249.             _PUTIMAGE , s&, picture&
250.         END IF
251.     END IF
252.     IF m = 5 AND bMode = 0 THEN
253.         _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
254.     END IF
255.     'Here is the Printing of the picture.
256.     IF a$ = "p" OR a$ = "P" THEN
257.         _TITLE "Mode: (P)rint | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
258.         m = 0
259.         IF bcolor$ = "w" OR bcolor$ = "W" THEN
260.             j& = _COPYIMAGE(0)
261.             _DELAY .25
262.             INPUT "Print on printer (Y/N)?", i$ 'print screen page on printer
263.             CLS
264.             SCREEN j&
265.             _DELAY .25
266.             IF LEFT$(i$, 1) = "y" OR LEFT$(i$, 1) = "Y" THEN
267.                 'printer prep (code copied and pasted from bplus Free Calendar Program)
268.                 YMAX = _HEIGHT: XMAX = _WIDTH
269.                 landscape& = _NEWIMAGE(YMAX, XMAX, 32)
270.                 _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
271.                 _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
272.                 _PRINTIMAGE landscape&
273.                 _DELAY 2
274.                 landscape& = 0
275.                 s& = j&
276.                 _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
277.             END IF
278.         END IF
279.     END IF
280. LOOP
281.  
282. 'Saving
283. 'This section first saves your picture as temp.bmp and then
284. 'asks you a name for your picture and then renames temp.bmp to your name.
285. saving:
286. _TITLE "Mode: (S)ave | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
287. CLS
288. PRINT "                       Saving"
289. PRINT
290. PRINT "         Your bmp file will be saved in the"
291. PRINT "         same directory as this program is."
292. PRINT "         It can be used with almost any"
293. PRINT "         other graphics program or website."
294. PRINT "         It is saved using:"
295. PRINT "         width: 800  height: 600 pixels."
296. PRINT
297. PRINT "         Type a name to save your picture"
298. PRINT "         and press the Enter key. Do not"
299. PRINT "         add .bmp at the end, the program"
300. PRINT "         will do it automatically."
301. PRINT
302. PRINT "         Example: MyPic"
303. PRINT "         Quit and Enter key ends program."
304. PRINT
305. INPUT "         ->"; nm$
306. IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
307. nm$ = nm$ + ".bmp"
308. 'Checking to see if the file already exists on your computer.
309. theFileExists = _FILEEXISTS(nm$)
310. IF theFileExists = -1 THEN
311.     PRINT
312.     PRINT "       File Already Exists"
313.     PRINT "       Saving will delete your old"
314.     PRINT "       bmp picture."
315.     PRINT "       Would you like to still do it?"
316.     PRINT "      (Y/N)."
317.     PRINT "      Esc goes to start screen."
318.     llloop:
319.     _LIMIT 100
320.     ag2$ = INKEY$
321.     IF ag2$ = CHR$(27) THEN GOTO start:
322.     IF ag2$ = "" THEN GOTO llloop:
323.     IF ag2$ = "y" OR ag$ = "Y" THEN
324.         SHELL _HIDE "DEL " + nm$
325.         GOTO saving2:
326.     END IF
327.     GOTO llloop:
328. END IF
329. saving2:
330. CLS
331. _PUTIMAGE , picture&, s&
332. SaveImage 0, nm$
333. nm$ = ""
334. FOR snd = 100 TO 700 STEP 100
335.     SOUND snd, 2
336. NEXT snd
337. CLS
338. GOTO more2:
339.  
340. 'This section loads your picture from your computer.
341. loading:
342. _TITLE "Mode: (L)oad | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
343. CLS
344. PRINT
345. PRINT "                       Loading"
346. PRINT
347. PRINT "           Do not add .bmp at the end."
348. PRINT "           The bmp picture must be in the same"
349. PRINT "           directory as this program is."
350. PRINT "           You will not be able to edit your"
351. PRINT "           picture file with this program."
352. PRINT "           Type the name of your picture file"
353. PRINT "           here and press the Enter key."
354. PRINT "           Example: MyPic"
355. PRINT "           Quit and Enter key ends program."
356. PRINT
357. INPUT "           ->"; nm$
358. IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
359. nm$ = nm$ + ".bmp"
360. theFileExists = _FILEEXISTS(nm$)
361. IF theFileExists = 0 THEN
362.     PRINT
363.     PRINT "           File Does Not Exist."
364.     PRINT "           Would you like to try again (Y/N)"
365.     PRINT "           Esc goes to start screen."
366.     _LIMIT 100
367.     llloop2:
368.     ag$ = INKEY$
369.     IF ag$ = "" THEN GOTO llloop2:
370.     IF ag$ = "y" OR ag$ = "Y" THEN GOTO loading:
371.     IF ag$ = CHR$(27) THEN GOTO start:
372.     GOTO start:
373. END IF
374. CLS
375. l = 0
376. i& = _LOADIMAGE(nm$, 32)
377. SCREEN i&
378. FOR snd2 = 100 TO 700 STEP 100
379.     SOUND snd2, 2
380. NEXT snd2
381. s& = i&
382. i& = 0
383. picture& = _NEWIMAGE(800, 600, 32)
384. SCREEN s&
385. dMode = 1
386. m = 1
387. RETURN
388.  
389. 'Here is the SUB needed to save the image to BMP.
390. SUB SaveImage (image AS LONG, filename AS STRING)
391.     bytesperpixel& = _PIXELSIZE(image&)
392.     IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
393.     IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
394.     x& = _WIDTH(image&)
395.     y& = _HEIGHT(image&)
396.     b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + STRING$(16, 0) 'partial BMP header info(???? to be filled later)
397.     IF bytesperpixel& = 1 THEN
398.         FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
399.             cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
400.             b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
401.         NEXT
402.     END IF
403.     MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
404.     lastsource& = _SOURCE
405.     _SOURCE image&
406.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
407.     FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
408.         r$ = ""
409.         FOR px& = 0 TO x& - 1
410.             c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
411.             IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
412.         NEXT px&
413.         d$ = d$ + r$ + padder$
414.     NEXT py&
415.     _SOURCE lastsource&
416.     MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
417.     b$ = b$ + d$ ' total file data bytes to create file
418.     MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
419.     IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
420.     f& = FREEFILE
421.     OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
422.     OPEN filename$ + ext$ FOR BINARY AS #f&
423.     PUT #f&, , b$
424.     CLOSE #f&
425. END SUB
426.  
427. FUNCTION colorDialog$
428.  
429.     'first screen dimensions items to restore at exit
430.     DIM curRow AS INTEGER, curCol AS INTEGER, autoDisplay AS INTEGER
431.     DIM sw AS INTEGER, sh AS INTEGER, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG
432.     DIM curScrn AS LONG, backScrn AS LONG 'some handles
433.  
434.     DIM cd AS LONG
435.     DIM r AS INTEGER, g AS INTEGER, b AS INTEGER, a AS INTEGER, mb AS INTEGER, mx AS INTEGER, my AS INTEGER, i AS INTEGER
436.     DIM makeConst$, k$
437.     DIM f AS SINGLE
438.  
439.     'save old settings to restore at end ofsub
440.     curRow = CSRLIN
441.     curCol = POS(0)
442.     autoDisplay = _AUTODISPLAY
443.     sw = _WIDTH
444.     sh = _HEIGHT
445.     fg = _DEFAULTCOLOR
446.     bg = _BACKGROUNDCOLOR
447.     _KEYCLEAR
448.     'screen snapshot
449.     curScrn = _DEST
450.     backScrn = _NEWIMAGE(sw, sh, 32)
451.     _PUTIMAGE , curScrn, backScrn
452.  
453.     cd = _NEWIMAGE(800, 600, 32)
454.     SCREEN cd
455.     r = 128: g = 128: b = 128: a = 128
456.     COLOR &HFFDDDDDD, 0
457.     DO
458.         CLS
459.         makeConst$ = "&H" + RIGHT$(STRING$(8, "0") + HEX$(_RGBA32(r, g, b, a)), 8)
460.         slider 16, 10, r, "Red"
461.         slider 16, 60, g, "Green"
462.         slider 16, 110, b, "Blue"
463.         slider 16, 160, a, "Alpha"
464.         _PRINTSTRING (150, 260), "Press Enter or Spacebar, if you want to use the color: " + makeConst$
465.         _PRINTSTRING (210, 280), "Press Escape or Q to not use any color, returns 0."
466.         LINE (90, 300)-(710, 590), , B
467.         FOR i = 100 TO 700
468.             f = 255 * (i - 100) / 600
469.             LINE (i, 310)-STEP(0, 30), _RGB32(f, 0, 0): LINE (i, 310)-STEP(0, 20), VAL(makeConst$)
470.             LINE (i, 340)-STEP(0, 30), _RGB32(0, f, 0): LINE (i, 340)-STEP(0, 20), VAL(makeConst$)
471.             LINE (i, 370)-STEP(0, 30), _RGB32(0, 0, f): LINE (i, 370)-STEP(0, 20), VAL(makeConst$)
472.             LINE (i, 400)-STEP(0, 30), _RGB32(f, f, 0): LINE (i, 400)-STEP(0, 20), VAL(makeConst$)
473.             LINE (i, 430)-STEP(0, 30), _RGB32(0, f, f): LINE (i, 430)-STEP(0, 20), VAL(makeConst$)
474.             LINE (i, 460)-STEP(0, 30), _RGB32(f, 0, f): LINE (i, 460)-STEP(0, 20), VAL(makeConst$)
475.             LINE (i, 490)-STEP(0, 30), _RGB32(f, f, f): LINE (i, 490)-STEP(0, 20), VAL(makeConst$)
476.             LINE (i, 520)-STEP(0, 30), _RGB32(0, 0, 0): LINE (i, 520)-STEP(0, 20), VAL(makeConst$)
477.             LINE (i, 550)-STEP(0, 30), _RGB32(255, 255, 255): LINE (i, 550)-STEP(0, 20), VAL(makeConst$)
478.         NEXT
479.         WHILE _MOUSEINPUT: WEND
480.         mb = _MOUSEBUTTON(1)
481.         IF mb THEN 'clear it
482.             mx = _MOUSEX: my = _MOUSEY
483.             IF mx >= 16 AND mx <= 781 THEN
484.                 IF my >= 10 AND my <= 50 THEN
485.                     r = INT((mx - 16) / 3)
486.                 ELSEIF my >= 60 AND my <= 100 THEN
487.                     g = INT((mx - 16) / 3)
488.                 ELSEIF my >= 110 AND my <= 150 THEN
489.                     b = INT((mx - 16) / 3)
490.                 ELSEIF my >= 160 AND my <= 200 THEN
491.                     a = INT((mx - 16) / 3)
492.                 END IF
493.             END IF
494.         END IF
495.         k$ = INKEY$
496.         IF LEN(k$) THEN
497.             IF ASC(k$) = 27 OR k$ = "q" THEN EXIT DO
498.             IF ASC(k$) = 13 OR k$ = " " THEN colorDialog$ = makeConst$: EXIT DO
499.         END IF
500.         _DISPLAY
501.         _LIMIT 60
502.     LOOP
503.  
504.     'put things back
505.     SCREEN curScrn
506.     COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0): CLS
507.     _PUTIMAGE , backScrn
508.     _DISPLAY
509.     COLOR fg, bg
510.     _FREEIMAGE backScrn
511.     _FREEIMAGE cd
512.     IF autoDisplay THEN _AUTODISPLAY
513.     'clear key presses
514.     _KEYCLEAR
515.     'clear mouse clicks
516.     WHILE _MOUSEINPUT: WEND
517.     mb = _MOUSEBUTTON(1)
518.     IF mb THEN 'clear it
519.         WHILE mb 'OK!
520.             IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
521.             _LIMIT 10
522.         WEND
523.     END IF
524.     LOCATE curRow, curCol
525.  
526. END FUNCTION
527.  
528. SUB slider (x, y, value, label$)
529.     DIM c~&, s$
530.     SELECT CASE label$
531.         CASE "Red": c~& = &HFFFF0000
532.         CASE "Green": c~& = &HFF008800
533.         CASE "Blue": c~& = &HFF0000FF
534.         CASE "Alpha": c~& = &H88FFFFFF
535.     END SELECT
536.     LINE (x, y)-STEP(765, 40), c~&, B
537.     LINE (x, y)-STEP(3 * value, 40), c~&, BF
538.     s2$ = STR$(value)
539.     s3$ = LTRIM$(RTRIM$(s2$))
540.     s$ = label$ + " = " + s3$
541.     _PRINTSTRING (x + 384 - 4 * LEN(s$), y + 12), s$
542. END SUB
543.  
544.