Create Color CONSTs for Clipboard

[bplus]

Code: QB64: [Select]

1. _TITLE "Color CONST for _RGBA32(red, green, blue, alpha)" 'B+ 2019-05-19
2.  
3. '>>>>>>>>>>>> test your colors here
4. '>>>>>>>>>>>> then create and name Hex string CONSTs if you want to the Clipboard
5.  
6. SCREEN _NEWIMAGE(800, 600, 32)
7. _SCREENMOVE _MIDDLE
8. IF _CLIPBOARD$ <> "" THEN
9.     INPUT "Clear clipboard? enter y for yes "; w$
10.     IF w$ = "y" THEN _CLIPBOARD$ = ""
11. END IF
12. DO
13.     CLS
14.     PRINT "Enter 4 numbers (0-255) for _RGBA32( red, green, blue, alpha)  you want to test "
15.     INPUT "(Don't forget commas) "; r, g, b, a
16.     MakeConst$ = "&H" + RIGHT$(STRING$(8, "0") + HEX$(_RGBA32(r, g, b, a)), 8)
17.     LINE (90, 300)-(710, 590), , B
18.     LINE (100, 310)-(700, 580), VAL(MakeConst$), BF
19.     PRINT "Use this Hex string for color CONST: "; MakeConst$
20.     INPUT "  Press c enter to add to ClipBoard, press q enter to quit, just enter to continue.."; w$
21.     IF w$ = "c" THEN
22.         INPUT "Name your CONST "; cname$
23.         _CLIPBOARD$ = _CLIPBOARD$ + CHR$(10) + "CONST " + cname$ + " = " + MakeConst$
24.     END IF
25.     IF w$ = "q" THEN SYSTEM
26. LOOP
27.  
28. 'sample from clipboard
29. CONST rarelyRed = &H00FF0000
30. CONST barelyBlue = &H0A0000FF
31.  
32.  

[bplus]

Hi TempodiBasic :)

Code: QB64: [Select]

1. _TITLE "Color CONST for _RGBA32(red, green, blue, alpha)" 'B+ 2019-05-19
2. '2019-05-26 update this for mouse inputs
3. '>>>>>>>>>>>> test your colors here
4. '>>>>>>>>>>>> then create and name Hex string CONSTs if you want to the Clipboard
5.  
6. SCREEN _NEWIMAGE(800, 600, 32)
7. _SCREENMOVE _MIDDLE
8. IF _CLIPBOARD$ <> "" THEN
9.     INPUT "Clear clipboard? enter y for yes "; w$
10.     IF w$ = "y" THEN _CLIPBOARD$ = ""
11. END IF
12. r = 128: g = 128: b = 128: a = 128
13. COLOR &HFFDDDDDD, 0
14. DO
15.     CLS
16.     MakeConst$ = "&H" + RIGHT$(STRING$(8, "0") + HEX$(_RGBA32(r, g, b, a)), 8)
17.     slider 16, 10, r, "Red"
18.     slider 16, 60, g, "Green"
19.     slider 16, 110, b, "Blue"
20.     slider 16, 160, a, "Alpha"
21.     _PRINTSTRING (250, 260), "Press c to create CONST for Clipboard"
22.     _PRINTSTRING (210, 280), "Use this Hex string for color CONST: " + MakeConst$
23.     LINE (90, 300)-(710, 590), , B
24.     LINE (100, 310)-(700, 580), VAL(MakeConst$), BF
25.  
26.     WHILE _MOUSEINPUT: WEND
27.     mb = _MOUSEBUTTON(1)
28.     IF mb THEN 'clear it
29.         mx = _MOUSEX: my = _MOUSEY
30.         IF mx >= 16 AND mx <= 784 THEN
31.             IF my >= 10 AND my <= 50 THEN
32.                 r = _ROUND((mx - 16) / 3)
33.             ELSEIF my >= 60 AND my <= 100 THEN
34.                 g = _ROUND((mx - 16) / 3)
35.             ELSEIF my >= 110 AND my <= 150 THEN
36.                 b = _ROUND((mx - 16) / 3)
37.             ELSEIF my >= 160 AND my <= 200 THEN
38.                 a = _ROUND((mx - 16) / 3)
39.             END IF
40.         END IF
41.     END IF
42.     k$ = INKEY$
43.     IF k$ = "q" THEN EXIT DO
44.     IF k$ = "c" THEN
45.         LOCATE 16, 30
46.         INPUT "Enter name for your color CONST "; cname$
47.         _CLIPBOARD$ = _CLIPBOARD$ + CHR$(10) + "CONST " + cname$ + " = " + MakeConst$
48.     END IF
49.     _DISPLAY
50.     _LIMIT 60
51. LOOP
52.  
53. SUB slider (x, y, value, label$)
54.     SELECT CASE label$
55.         CASE "Red": c~& = &HFFFF0000
56.         CASE "Green": c~& = &HFF008800
57.         CASE "Blue": c~& = &HFF0000FF
58.         CASE "Alpha": c~& = &H88FFFFFF
59.     END SELECT
60.     LINE (x, y)-STEP(768, 40), c~&, B
61.     LINE (x, y)-STEP(3 * value, 40), c~&, BF
62.     s$ = label$ + " = " + _TRIM$(STR$(value))
63.     _PRINTSTRING (x + 384 - 4 * LEN(s$), y + 12), s$
64. END SUB
65.  

EDIT: add _ROUND

[TempodiBasic]

Hi Bplus
thank you very much for your attention and activity
I find very handful and useful both OldDosversion and MouseGraphicVersion