Author Topic: Paint Pixels 4  (Read 8250 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Paint Pixels 4
« Reply #15 on: October 07, 2019, 08:23:12 pm »
picture& = _NEWIMAGE(640, 480, 32)   near start of program

My code is right, need _putimage , picture&, 0

right after main loop starts over again.

Dang! not 5 mins of Browns Game, and another frickin 5 minutes of commercials!

Dang! touchdown on first play!

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

Browns are doing poorly
« Last Edit: October 07, 2019, 09:03:50 pm by bplus »

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Paint Pixels 4
« Reply #16 on: October 07, 2019, 09:13:36 pm »
Am sorry to say that I did everything you said, but no luck. After you press R and just move the mouse, it makes a bunch of lines wherever you move the mouse and the lines stay there.
When you press the mouse button, then it starts to work right, the animated line starts. The R key seems to work fine because you can still use that to make different lines in different locations. The only problem is that as soon as you start a new location, the line doesn't animate, it just makes a bunch of them.


I put this on line 11 before the welcome text:

Code: QB64: [Select]
  1. picture& = _NEWIMAGE(640, 480, 32)    
  2.  

I put this right after the _LIMIT 1000 and right before that is the start of the main DO loop:

Code: QB64: [Select]
  1.   _PUTIMAGE , picture&, 0  
  2.  

And here is the Ray code:

Code: QB64: [Select]
  1.     'Here is the Ray Lines code.
  2.     IF a$ = "r" OR a$ = "R" THEN
  3.         rMode = 1 - rMode
  4.         IF rMode THEN
  5.             lastx = mouseX: lastY = mouseY 'set first lastx, lasty
  6.             picture& = _NEWIMAGE(640, 480, 32)
  7.         END IF
  8.     END IF
  9.     IF rMode THEN
  10.         LINE (lastx, lastY)-(mouseX, mouseY), clr~&
  11.         '_DISPLAY 'if you are using it
  12.         IF mouseLeftButton = -1 THEN _PUTIMAGE , 0, picture&
  13.     END IF
  14.  

And if anyone is interested, here's all of the code:

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

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Paint Pixels 4
« Reply #17 on: October 07, 2019, 09:33:42 pm »
Like I said in my update, I didn't know you were using s& for screen handle, so had to change up stuff for that plus ..

well it's working correctly (just the Ray stuff is all I changed and checked) in update in reply above.

Parts of interest:
Code: QB64: [Select]
  1. IF bcolor$ = "w" OR bcolor$ = "W" THEN
  2.     '_FULLSCREEN
  3.     s& = _NEWIMAGE(640, 480, 32)
  4.     picture& = _NEWIMAGE(640, 480, 32)  '<<<<<<<<<<<<<<<<<<
  5.  
  6.     LINE (0, 0)-(640, 480), _RGB(255, 255, 255), BF
  7.     _PUTIMAGE , s&, picture&  '<<<<<<<<<<<<<<<<<<<<<<<<< hmm, not tested and different than black?
  8.     GOTO more2:
  9. IF bcolor$ = "B" OR bcolor$ = "b" THEN
  10.     '_FULLSCREEN
  11.     s& = _NEWIMAGE(640, 480, 32)
  12.     picture& = _NEWIMAGE(640, 480, 32)  '<<<<<<<<<<<<<<<<<,
  13.  
  14.  
  15.     SCREEN s&
  16.     CLS
  17.     GOTO more2:
  18. GOTO start3:
  19. more2:
  20. begin = 1
  21. GOSUB chosencolor:
  22. '---------------------------------------------------
  23. 'Here is the main loop of the program when painting.
  24. '---------------------------------------------------
  25.     _LIMIT 1000
  26.     _PUTIMAGE , picture&, s& '<<<<<<<<<<<<<<<,
  27.     SCREEN s&                       '<<<<<<<<<<<<<<<
  28.  

Code: QB64: [Select]
  1.     'Here is the Ray Lines code.
  2.     IF a$ = "r" OR a$ = "R" THEN
  3.         rMode = 1 - rMode
  4.         IF rMode THEN lastx = mouseX: lastY = mouseY 'set first lastx, lasty
  5.     END IF
  6.     IF rMode THEN
  7.         LINE (lastx, lastY)-(mouseX, mouseY), clr~&
  8.         IF mouseLeftButton THEN lastx = mouseX: lastY = mouseY: _PUTIMAGE , s&, picture&
  9.     END IF
  10.  
« Last Edit: October 07, 2019, 09:37:45 pm by bplus »

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Paint Pixels 4
« Reply #18 on: October 07, 2019, 09:43:59 pm »
OK White did need fixed:
Code: QB64: [Select]
  1. IF bcolor$ = "w" OR bcolor$ = "W" THEN
  2.     '_FULLSCREEN
  3.     s& = _NEWIMAGE(640, 480, 32)
  4.     picture& = _NEWIMAGE(640, 480, 32)
  5.     SCREEN s&
  6.     LINE (0, 0)-(640, 480), _RGB32(255, 255, 255), BF
  7.     _PUTIMAGE , s&, picture&
  8.     GOTO more2:
  9.  

BTW nothing else will draw but R mode until you set them up like Rmode.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Paint Pixels 4
« Reply #19 on: October 07, 2019, 11:03:50 pm »
AWESOME!!! Thanks B+!!! I got the lines down pact now. Now I will work on the rest. Also, I like how you commented out the FULLSCREEN, I like it as a window better too. Now I can add some things on the TITLE bar.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Paint Pixels 4
« Reply #20 on: October 07, 2019, 11:15:52 pm »
Good! sounds like you have it working. _DISPLAY just before the LOOP back around should stop the blinking.

Trouble is, once you start using display you have to _display everything you want seen until execution sees _DISPLAY again unless you switch it off with _AUTODISPLAY.
« Last Edit: October 07, 2019, 11:19:23 pm by bplus »

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Paint Pixels 4
« Reply #21 on: October 08, 2019, 01:59:28 am »
Whew, I almost stayed up until midnight on this one, but I think I have finished it! I tried the _DISPLAY in a few different areas but couldn't get it right so I just left it out, there's no need for it.
Everything works just the way I want it I think. The funny thing is, it took me longer to re-make the welcome screens and _TITLE bar info than anything else tonight. When someone changes a Mode, the Title Bar says what mode it's in. It also says almost all the commands for people to easily use the program. The only things it doesn't say is Space Bar, Esc, and (I)nstructions but I have those explained in the welcome screens. I also re-arranged the welcome screens to look a lot better. Now people don't have to cherry pick through my endless text to find what they need. lol
Oh also, I did another printer test with it and it automatically changes a 640x480 picture to a full piece of paper just about, just so you know. Which is good in my opinion. It makes the pictures stand out.
So here it is!!! Almost 3 months in the making... Thanks again B+ for all the help. I'll put it on my website in a day or 2 most likely.

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

« Last Edit: October 08, 2019, 02:04:06 am by SierraKen »

Marked as best answer by SierraKen on October 08, 2019, 11:13:36 am

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Paint Pixels 4
« Reply #22 on: October 08, 2019, 03:13:28 pm »
LOL like usual I spoke too soon. Working on the _TITLE stuff last night I put code the wrong locations. So I fixed it today and I also changed the size of the paint area to 800 x 600, which nowadays is the usual picture size for drawing. I also just ran another printer test and found out that the screen turns black after you print, so I fixed that. I made it so people can still draw on the same drawing after it prints on paper and the drawing is not lost.

Here is the fixed version:

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

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Paint Pixels 4
« Reply #23 on: October 08, 2019, 04:53:09 pm »
Hi Ken,

I think if you use just use one variable for mode number, you can dump all the toggles, ie mode = 1 drawing, mode = 2 Rays mode = 3 Orbits... that way one variable tracks it all. When you change modes with keypress remember to initialize the lastX and lastY and of course the Title.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Paint Pixels 4
« Reply #24 on: October 08, 2019, 06:15:01 pm »
That's exactly what I did B+, m=1, m=2, m=3, m=4, and m=5 are all different modes. I did that so things don't get confused and also to say, ie. If m=4 and oMode=0 then... where I put a _TITLE with all the modes off. That's how I fixed it with the last update I posted earlier.
« Last Edit: October 08, 2019, 06:17:09 pm by SierraKen »

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Paint Pixels 4
« Reply #25 on: October 08, 2019, 07:48:54 pm »
Paint Pixels 5 is now on my website and I consider it finished. I've tested it a lot and everything seems to work fine. Thank you again B+ for all your help. So unless someone finds a bad problem with it, I'm not going to work on it any time soon I think.

Here is my website with all 29 programs on it. There is a link to this program on the top of the list. I also added an example .bmp picture to show people what it can make. It's a 800 x 600 picture of a jet. I'm no artist but I think it's neat. :)

http://www.KensPrograms.com/

Thank you.

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: Paint Pixels 4
« Reply #26 on: October 08, 2019, 08:38:48 pm »
Had fun playing with this Ken - nice use of the alpha. Maybe version 6 will have a toolbar like paint?

Actually, come to think of it, with all the stuff QB64 can do with multiple pages, images, alpha, we could make a DANK photoshop clone. Well, "clone". You all know what I mean.

If anyone wants to frame this out, I can help with the parts that I'd be good at. I'm thinking curved gradients and stuff you want calculus for. But the rest is pure QB64 legwork. This can be that holy grail group project we've been wondering how to start. Any takers?
You're not done when it works, you're done when it's right.

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Paint Pixels 4
« Reply #27 on: October 08, 2019, 09:49:25 pm »
Thanks Static!
Wow that would be an amazing project. Feel free to use any of my code from Paint Pixels. But me being the lesser of the programmers in here, I would mostly just watch and test it for you guys. :))

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Paint Pixels 4
« Reply #28 on: October 09, 2019, 02:29:38 pm »
Very interesting work. I'm interested in it. I did a bit of an ape after drawing in Windows, so far only a few things work, it has been a while since I wrote it. In the end I interrupted it, now I don't even know why...


 
my paint.jpg

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Paint Pixels 4
« Reply #29 on: October 09, 2019, 05:04:49 pm »
Hi Ken,

Here is how I would do Undo and some other things, mouse down starts draw object, mouse release is finishes:
Code: QB64: [Select]
  1. _TITLE "Quick Draw" 'b+ 2019-10-09
  2.  
  3. CONST xmax = 800, ymax = 600
  4. SCREEN _NEWIMAGE(xmax, ymax, 32)
  5. _SCREENMOVE 300, 100
  6. FOR i = 0 TO 9
  7.     d&(i) = _NEWIMAGE(xmax, ymax, 32)
  8.     _PUTIMAGE , 0, d&(i)
  9. t$ = "Menu: <L>ine <F>rame <B>ox <E>llipse <D>isk <C>olor CL<S> <U>ndo"
  10. m$ = "L": _TITLE t$ + "  Drawing Lines"
  11. p = 0
  12. _PUTIMAGE , 0, d&(p)
  13. c~& = &HFFFFFFFF
  14.     _PUTIMAGE , d&(p), 0
  15.     k$ = UCASE$(INKEY$)
  16.     IF k$ = "L" THEN ' rays
  17.         m$ = "L": _TITLE t$ + "  Drawing Lines"
  18.     ELSEIF k$ = "E" THEN ' orbits (cool name BTW)
  19.         m$ = "E": _TITLE t$ + "  Drawing Ellipse"
  20.     ELSEIF k$ = "F" THEN
  21.         m$ = "F": _TITLE t$ + "  Drawing Frames"
  22.     ELSEIF k$ = "B" THEN ' Boxes
  23.         m$ = "B": _TITLE t$ + "  Drawing Boxes"
  24.     ELSEIF k$ = "D" THEN
  25.         m$ = "D": _TITLE t$ + "  Drawing Disks"
  26.     ELSEIF k$ = "C" THEN
  27.         changeColor
  28.         CLS
  29.         _PUTIMAGE , d&(p), 0
  30.     ELSEIF k$ = "S" THEN
  31.         CLS
  32.         _PUTIMAGE , 0, d&(p)
  33.     ELSEIF k$ = "U" THEN
  34.         p = p - 1
  35.         IF p = -1 THEN p = 9
  36.     END IF
  37.     mxd = _MOUSEX: myd = _MOUSEY: mb = _MOUSEBUTTON(1): mxu = -1
  38.  
  39.     WHILE mb
  40.         mi = _MOUSEINPUT:
  41.         mxu = _MOUSEX: myu = _MOUSEY: mb = _MOUSEBUTTON(1)
  42.         CLS
  43.         _PUTIMAGE , d&(p), 0
  44.         IF mxu <> -1 THEN
  45.             SELECT CASE m$
  46.                 CASE "L": LINE (mxd, myd)-(mxu, myu), c~&
  47.                 CASE "F": LINE (mxd, myd)-(mxu, myu), c~&, B
  48.                 CASE "B": LINE (mxd, myd)-(mxu, myu), c~&, BF
  49.                 CASE "E"
  50.                     dx = ABS(mxd - mxu): dy = ABS(myd - myu)
  51.                     PSET (mxd, myd), &HFFFFFFFF
  52.                     Ell mxd, myd, dx, dy, 0
  53.                     LINE (mxd - dx, myd - dy)-STEP(2 * dx, 2 * dy), &HFFFFFFFF, B
  54.                 CASE "D"
  55.                     dx = ABS(mxd - mxu): dy = ABS(myd - myu)
  56.                     PSET (mxd, myd), &HFFFFFFFF
  57.                     Ell mxd, myd, dx, dy, 1
  58.                     LINE (mxd - dx, myd - dy)-STEP(2 * dx, 2 * dy), &HFFFFFFFF, B
  59.             END SELECT
  60.             _DISPLAY
  61.         END IF
  62.         _LIMIT 500
  63.     WEND
  64.     IF mxu <> -1 THEN
  65.         CLS
  66.         _PUTIMAGE , d&(p), 0
  67.         SELECT CASE m$
  68.             CASE "L": LINE (mxd, myd)-(mxu, myu), c~&
  69.             CASE "F": LINE (mxd, myd)-(mxu, myu), c~&, B
  70.             CASE "B": LINE (mxd, myd)-(mxu, myu), c~&, BF
  71.             CASE "E"
  72.                 dx = ABS(mxd - mxu): dy = ABS(myd - myu)
  73.                 Ell mxd, myd, dx, dy, 0
  74.             CASE "D"
  75.                 dx = ABS(mxd - mxu): dy = ABS(myd - myu)
  76.                 Ell mxd, myd, dx, dy, 1
  77.         END SELECT
  78.         _DISPLAY
  79.         p = (p + 1) MOD 10
  80.         _PUTIMAGE , 0, d&(p)
  81.     END IF
  82.     _DISPLAY
  83.     _LIMIT 20
  84.  
  85. SUB changeColor
  86.     r = 128: g = 128: b = 128: a = 128
  87.     COLOR &HFFFFFFFF, &HFF000000
  88.     DO
  89.         CLS
  90.         test~& = _RGBA32(r, g, b, a)
  91.         slider 16, 10, r, "Red"
  92.         slider 16, 60, g, "Green"
  93.         slider 16, 110, b, "Blue"
  94.         slider 16, 160, a, "Alpha"
  95.         _PRINTSTRING (140, 260), "Press spacebar or enter to accept color change, q or esc to cancel"
  96.         LINE (90, 300)-(710, 590), , B
  97.         LINE (100, 310)-(700, 580), test~&, BF
  98.         WHILE _MOUSEINPUT: WEND
  99.         mb = _MOUSEBUTTON(1)
  100.         IF mb THEN 'clear it
  101.             mx = _MOUSEX: my = _MOUSEY
  102.             IF mx >= 16 AND mx <= 784 THEN
  103.                 IF my >= 10 AND my <= 50 THEN
  104.                     r = _ROUND((mx - 16) / 3)
  105.                 ELSEIF my >= 60 AND my <= 100 THEN
  106.                     g = _ROUND((mx - 16) / 3)
  107.                 ELSEIF my >= 110 AND my <= 150 THEN
  108.                     b = _ROUND((mx - 16) / 3)
  109.                 ELSEIF my >= 160 AND my <= 200 THEN
  110.                     a = _ROUND((mx - 16) / 3)
  111.                 END IF
  112.             END IF
  113.         END IF
  114.         k$ = INKEY$
  115.         IF LEN(k$) THEN
  116.             IF ASC(k$) = 13 OR ASC(k$) = 32 THEN c~& = test~&: EXIT SUB
  117.             IF k$ = "q" OR ASC(k$) = 27 THEN EXIT SUB
  118.         END IF
  119.         _DISPLAY
  120.         _LIMIT 60
  121.     LOOP
  122.  
  123. SUB slider (x, y, value, label$)
  124.     SELECT CASE label$
  125.         CASE "Red": cr~& = &HFFFF0000
  126.         CASE "Green": cr~& = &HFF008800
  127.         CASE "Blue": cr~& = &HFF0000FF
  128.         CASE "Alpha": cr~& = &H88FFFFFF
  129.     END SELECT
  130.     LINE (x, y)-STEP(768, 40), cr~&, B
  131.     LINE (x, y)-STEP(3 * value, 40), cr~&, BF
  132.     COLOR &HFFFFFFFF, cr~&
  133.     s$ = label$ + " = " + _TRIM$(STR$(value))
  134.     _PRINTSTRING (x + 384 - 4 * LEN(s$), y + 12), s$
  135.     COLOR &HFFFFFFFF, &HFF000000
  136.  
  137. SUB Ell (CX AS LONG, CY AS LONG, xRadius AS LONG, yRadius AS LONG, fillTF)
  138.     DIM scale AS SINGLE, x AS LONG, y AS LONG, a AS SINGLE, xx AS SINGLE, yy AS SINGLE
  139.     scale = yRadius / xRadius
  140.     IF fillTF THEN
  141.         LINE (CX, CY - yRadius)-(CX, CY + yRadius), c~&, BF
  142.         FOR x = 1 TO xRadius
  143.             y = scale * SQR(xRadius * xRadius - x * x)
  144.             LINE (CX + x, CY - y)-(CX + x, CY + y), c~&, BF
  145.             LINE (CX - x, CY - y)-(CX - x, CY + y), c~&, BF
  146.         NEXT
  147.     ELSE
  148.         FOR a = 0 TO _PI(2.01) STEP .1
  149.             xx = CX + xRadius * COS(a)
  150.             yy = CY + yRadius * SIN(a)
  151.             IF a > 0 THEN LINE (lastx, lasty)-(xx, yy), c~&
  152.             lastx = xx: lasty = yy
  153.         NEXT
  154.     END IF
  155.  
  156.  
« Last Edit: October 09, 2019, 05:07:50 pm by bplus »