Author Topic: Paint Pixels 4 (Read 8556 times)

SierraKen · « **on:** October 06, 2019, 12:05:39 am »

Tonight I decided to finally spruce up and finish my old Paint Pixels saga. lol This is the drawing program I made over a month ago that uses the mouse to draw and an awesome color picker that B+ gave me to use. You can also save, load, and print on the printer. The reason I never finished it was because I was bummed that I had used the wrong code making JPG pictures. Instead I was just actually saving .bmp code as a .jpg name. So I changed it to only use .bmp pictures like the code is supposed to do. I also fixed one major problem I had with renaming the temp.bmp, which for some reason wouldn't change to the name you wanted if that name already existed. So I used SHELL to delete the old one and then rename temp.bmp to the new name you want it to be. Thanks also to B+ for the code I used on my calendar making program that rotates a picture 180 degrees to print on the printer as a landscape rather than what it was before and squishing your picture to a letter size on the paper. Thanks B+, I also kept your name as well as mine on the credits on the welcome screen. Plus I edited a tiny bit on some text within the program to make it look a little better. Please tell me what you think of this little program. I know Windows Paint is better, but I like how you can paint with this program on a FULL screen with nothing else on your entire screen as you paint. I am really happy it's finally finished, unless of course someone finds a problem with it that I need to fix. Thank you.
Here it is:

Code: QB64: [Select]

'This program was finished on October 5, 2019.
'Technical Notes:
'This program uses around 55 MB RAM and 1% of the CPU on my semi-new computer.
'Use at your own risk. I hold no responsibility for any problems whatsoever.
'
'Thank you to B+ from the QB64.org forum for the color picker and the picture rotation code!
'-------------------------------------------------------------------------------------------
_LIMIT 100
start:
CLS
SCREEN 0
_FULLSCREEN _OFF
_TITLE "Paint Pixels 4"
WIDTH 40, 43
_FONT 16
_SCREENMOVE 400, 200
PRINT "        Paint Pixels 4"
PRINT
PRINT "       By Ken G. and B+"
PRINT
PRINT "Use your mouse to paint on a"
PRINT "full screen."
PRINT "You also can make lines: (R)ays,"
PRINT "circles: (O)rbits, and (B)oxes."
PRINT
PRINT "You also can print to"
PRINT "your USB printer as well as edit"
PRINT "an old picture file."
PRINT "It saves under .bmp files which can"
PRINT "be used with most other programs."
PRINT
PRINT "Press the Space Bar to"
PRINT "skip instructions."
PRINT
PRINT "Press Esc to end program."
PRINT
PRINT "Press any other key to continue."
gggo:
_LIMIT 100
ecc$ = INKEY$
IF ecc$ = " " THEN GOTO start2:
IF ecc$ = CHR$(27) THEN END
IF ecc$ = "" THEN GOTO gggo:
CLS
PRINT
PRINT "       Instructions"
PRINT
PRINT "(S)ave (L)oad (H)ome"
PRINT "(R)ay coordinates for line."
PRINT "Press R once to start line"
PRINT "and again to finish it."
PRINT "(O)rbit coordinates for circles."
PRINT "Press O once to start circle."
PRINT "and again to finish it."
PRINT "The size of the circle depends"
PRINT "on the length difference"
PRINT "between where you pressed O"
PRINT "both times. The center of the circle"
PRINT "will be the first place you pressed O."
PRINT "(B)oxes are the same way as (O)rbits."
PRINT "(P)rints the picture on"
PRINT "your printer. It will not work"
PRINT "if you choose a black background"
PRINT "because of heavy ink or toner use."
PRINT "To go around that, choose a white"
PRINT "background and on the color picker"
PRINT "window, choose black and press F"
PRINT "to fill entire window."
PRINT
PRINT "Esc to end program."
PRINT "Space Bar clears the screen."
PRINT "Left Mouse Button draws."
PRINT "Right Mouse Button erases."
PRINT "There is no Undo feature on"
PRINT "this program."
PRINT
PRINT "Press Esc to end program or"
PRINT "any other key to continue."
ggggo:
_LIMIT 100
ecc2$ = INKEY$
IF ecc2$ = CHR$(27) THEN END
IF ecc2$ = "" THEN GOTO ggggo:
CLS
PRINT "    Instructions Page 2"
PRINT
PRINT "(C)olor changes colors."
PRINT "A window will come up to use"
PRINT "your mouse to choose a color."
PRINT "This will also happen when you"
PRINT "first start your painting."
PRINT
PRINT "(B)oxes makes a filled box."
PRINT "First press B once to start the"
PRINT "box corner, then press B again"
PRINT "to set the 2nd corner and size"
PRINT "diagonally from the first one."
PRINT
PRINT "Paint slowly to leave out gaps."
PRINT
PRINT "When you press S to save,"
PRINT "the program will create a temp.bmp"
PRINT "of the screen and when asking you"
PRINT "for a file name, it will rename temp.bmp"
PRINT "to your chosen name."
PRINT
PRINT "Press Esc to end program or"
PRINT "any other key to start."
gggggo:
_LIMIT 1000
s$ = INKEY$
IF s$ = "" THEN GOTO gggggo:
IF s$ = CHR$(27) THEN END
start2:
CLS
begin = 1
PRINT "Background Color"
PRINT
PRINT "(B)lack (W)hite"
PRINT
PRINT "Or Esc to end program."
start3:
_LIMIT 1000
bcolor$ = INKEY$
IF bcolor$ = CHR$(27) THEN END
IF bcolor$ = "" THEN GOTO start3:
IF bcolor$ = "w" OR bcolor$ = "W" THEN
    _FULLSCREEN
    s& = _NEWIMAGE(640, 480, 32)
    SCREEN s&
    LINE (0, 0)-(640, 480), _RGB(255, 255, 255), BF
    GOTO more2:
END IF
IF bcolor$ = "B" OR bcolor$ = "b" THEN
    _FULLSCREEN
    s& = _NEWIMAGE(640, 480, 32)
    SCREEN s&
    CLS
    GOTO more2:
END IF
GOTO start3:
more2:
begin = 1
GOSUB chosencolor:
'---------------------------------------------------
'Here is the main loop of the program when painting.
'---------------------------------------------------
DO
    _LIMIT 1000
    DO WHILE _MOUSEINPUT
        mouseX = _MOUSEX
        mouseY = _MOUSEY
        mouseLeftButton = _MOUSEBUTTON(1)
        mouseRightButton = _MOUSEBUTTON(2)
        mouseMiddleButton = _MOUSEBUTTON(3)
    LOOP
    IF mouseLeftButton = -1 THEN
        LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), clr~&, BF
    END IF
    IF mouseRightButton = -1 THEN
        LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), 0, BF
    END IF
    a$ = INKEY$
    'Here is when someone whipes the screen blank with the space bar.
    IF a$ = " " THEN GOTO start2:
    IF a$ = CHR$(27) THEN END
    IF a$ = "s" OR a$ = "S" THEN GOTO saving:
    IF a$ = "l" OR a$ = "L" THEN GOSUB loading:
    IF a$ = "h" OR a$ = "H" THEN GOTO start:
    'Here is code needed to call up the Windows Color Picker.
    'It also uses the code on top of this program and the Function at the end
    'of this program.
    IF a$ = "c" OR a$ = "C" THEN
        chosencolor:
        check$ = colorDialog$
        IF check$ <> "" THEN clr~& = VAL(check$) ELSE clr~& = &HFF0000FF '<<< I am blue if colorDialog does not work
 
        IF begin = 1 THEN begin = 0: RETURN
    END IF
    'Here is the Ray Lines code.
    IF a$ = "r" OR a$ = "R" THEN
        ck = ck + 1
        IF ck > 1 THEN GOTO ray:
        xxx = mouseX: yyy = mouseY
        LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), clr~&, BF
        GOTO firstray:
        ray:
        LINE (mouseX, mouseY)-(xxx, yyy), clr~&
        xxx = 0: yyy = 0
        ck = 0
        firstray:
    END IF
    'Here is the Orbit Circles code.
    IF a$ = "o" OR a$ = "O" THEN
        ck2 = ck2 + 1
        IF ck2 > 1 THEN GOTO orbit:
        xxx2 = mouseX: yyy2 = mouseY
        GOTO firstorbit:
        orbit:
        IF mouseX < xxx2 THEN size = xxx2 - mouseX
        IF mouseX > xxx2 THEN size = mouseX - xxx2
        IF mouseY < yyy2 THEN size2 = yyy2 - mouseY
        IF mouseY > yyy2 THEN size2 = mouseY - yyy2
        size3 = INT((size + size2) / 2)
        CIRCLE (xxx2, yyy2), size3, clr~&
        xxx2 = 0: yyy2 = 0
        size = 0: size2 = 0: size3 = 0
        ck2 = 0
        firstorbit:
    END IF
    'Here is the Boxes code.
    IF a$ = "b" OR a$ = "B" THEN
        ck3 = ck3 + 1
        IF ck3 > 1 THEN GOTO box:
        xxx3 = mouseX: yyy3 = mouseY
        GOTO firstbox:
        box:
        LINE (mouseX, mouseY)-(xxx3 + 1, yyy3 + 1), clr~&, BF
        xxx3 = 0: yyy3 = 0
        ck3 = 0
        firstbox:
    END IF
    'Here is the Printing of the picture.
    IF a$ = "p" OR a$ = "P" THEN
        IF bcolor$ = "w" OR bcolor$ = "W" THEN
            j& = _COPYIMAGE(0)
            _DELAY .25
            INPUT "Print on printer (Y/N)?", i$ 'print screen page on printer
            CLS
            SCREEN j&
            _DELAY .25
            IF LEFT$(i$, 1) = "y" OR LEFT$(i$, 1) = "Y" THEN
                'printer prep (code copied and pasted from bplus Free Calendar Program)
                YMAX = _HEIGHT: XMAX = _WIDTH
                landscape& = _NEWIMAGE(YMAX, XMAX, 32)
                _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
                _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
                _PRINTIMAGE landscape&
                _DELAY 2
                landscape& = 0
                j& = 0
            END IF
        END IF
    END IF
LOOP
 
'Saving
'This section first saves your picture as temp.bmp and then
'asks you a name for your picture and then renames temp.bmp to your name.
saving:
'Now we call up the SUB to save the image to BMP.
SaveImage 0, "temp.bmp"
_DELAY .25
SCREEN 0
CLS
COLOR 12
PRINT "                       Saving"
PRINT
PRINT "         Your bmp file will be saved in the"
PRINT "         same directory as this program is."
PRINT "         It can be used with almost any"
PRINT "         other graphics program or website."
PRINT "         It is saved using:"
PRINT "         width: 640  height: 480 pixels."
PRINT
PRINT "         Type a name to save your picture"
PRINT "         and press the Enter key. Do not"
PRINT "         add .bmp at the end, the program"
PRINT "         will do it automatically."
PRINT
PRINT "         Also do not use the name temp"
PRINT "         because the program uses that name"
PRINT "         and it would be erased the next time"
PRINT "         you save a picture."
PRINT "         Example: MyPic"
PRINT "         Quit and Enter key ends program."
PRINT
INPUT "         ->"; nm$
IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
nm$ = nm$ + ".bmp"
'Checking to see if the file already exists on your computer.
theFileExists = _FILEEXISTS(nm$)
IF theFileExists = -1 THEN
    PRINT "       File Already Exists"
    PRINT "       Saving will delete your old"
    PRINT "       bmp picture."
    PRINT "       Would you like to still do it?"
    PRINT "      (Y/N). Esc ends program."
    llloop:
    _LIMIT 100
    ag2$ = INKEY$
    IF ag2$ = CHR$(27) THEN END
    IF ag2$ = "" THEN GOTO llloop:
    IF ag2$ = "y" OR ag$ = "Y" THEN
        SHELL _HIDE "DEL " + nm$
        GOTO saving2:
    END IF
    GOTO llloop:
END IF
saving2:
SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
nm$ = ""
FOR snd = 100 TO 700 STEP 100
    SOUND snd, 2
NEXT snd
CLS
GOTO start:
loading: 'This section loads your picture from your computer.
SCREEN 0
CLS
COLOR 12
PRINT "                    Loading"
PRINT
PRINT "         Do not add .bmp at the end."
PRINT "         The bmp picture must be in the same"
PRINT "         directory as this program is."
PRINT "         You will not be able to edit your"
PRINT "         picture file with this program."
PRINT "         Type the name of your picture file"
PRINT "         here and press the Enter key."
PRINT "         Example: MyPic"
PRINT "         Quit and Enter key ends program."
PRINT
INPUT "         ->"; nm$
IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
nm$ = nm$ + ".bmp"
theFileExists = _FILEEXISTS(nm$)
IF theFileExists = 0 THEN
    PRINT "         File Does Not Exist."
    PRINT "         Would you like to try again (Y/N)"
    PRINT "         Esc ends program."
    _LIMIT 100
    llloop2:
    ag$ = INKEY$
    IF ag$ = "" THEN GOTO llloop2:
    IF ag$ = "y" OR ag$ = "Y" THEN GOTO loading:
    IF ag$ = CHR$(27) THEN END
    GOTO start:
END IF
CLS
l = 0
i& = _LOADIMAGE(nm$, 32)
SCREEN i&
FOR snd2 = 100 TO 700 STEP 100
    SOUND snd2, 2
NEXT snd2
s& = i&
i& = 0
SCREEN s&
RETURN
 
'Here is the SUB needed to save the image to BMP.
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 
FUNCTION colorDialog$
 
    'first screen dimensions items to restore at exit
    DIM curRow AS INTEGER, curCol AS INTEGER, autoDisplay AS INTEGER
    DIM sw AS INTEGER, sh AS INTEGER, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG
    DIM curScrn AS LONG, backScrn AS LONG 'some handles
 
    DIM cd AS LONG
    DIM r AS INTEGER, g AS INTEGER, b AS INTEGER, a AS INTEGER, mb AS INTEGER, mx AS INTEGER, my AS INTEGER, i AS INTEGER
    DIM makeConst$, k$
    DIM f AS SINGLE
 
    'save old settings to restore at end ofsub
    curRow = CSRLIN
    curCol = POS(0)
    autoDisplay = _AUTODISPLAY
    sw = _WIDTH
    sh = _HEIGHT
    fg = _DEFAULTCOLOR
    bg = _BACKGROUNDCOLOR
    _KEYCLEAR
    'screen snapshot
    curScrn = _DEST
    backScrn = _NEWIMAGE(sw, sh, 32)
    _PUTIMAGE , curScrn, backScrn
 
    cd = _NEWIMAGE(800, 600, 32)
    SCREEN cd
    r = 128: g = 128: b = 128: a = 128
    COLOR &HFFDDDDDD, 0
    DO
        CLS
        makeConst$ = "&H" + RIGHT$(STRING$(8, "0") + HEX$(_RGBA32(r, g, b, a)), 8)
        slider 16, 10, r, "Red"
        slider 16, 60, g, "Green"
        slider 16, 110, b, "Blue"
        slider 16, 160, a, "Alpha"
        _PRINTSTRING (150, 260), "Press enter or spacebar, if you want to use the color: " + makeConst$
        _PRINTSTRING (210, 280), "Press escape or q, to not use any color, returns 0."
        LINE (90, 300)-(710, 590), , B
        FOR i = 100 TO 700
            f = 255 * (i - 100) / 600
            LINE (i, 310)-STEP(0, 30), _RGB32(f, 0, 0): LINE (i, 310)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 340)-STEP(0, 30), _RGB32(0, f, 0): LINE (i, 340)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 370)-STEP(0, 30), _RGB32(0, 0, f): LINE (i, 370)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 400)-STEP(0, 30), _RGB32(f, f, 0): LINE (i, 400)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 430)-STEP(0, 30), _RGB32(0, f, f): LINE (i, 430)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 460)-STEP(0, 30), _RGB32(f, 0, f): LINE (i, 460)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 490)-STEP(0, 30), _RGB32(f, f, f): LINE (i, 490)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 520)-STEP(0, 30), _RGB32(0, 0, 0): LINE (i, 520)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 550)-STEP(0, 30), _RGB32(255, 255, 255): LINE (i, 550)-STEP(0, 20), VAL(makeConst$)
        NEXT
        WHILE _MOUSEINPUT: WEND
        mb = _MOUSEBUTTON(1)
        IF mb THEN 'clear it
            mx = _MOUSEX: my = _MOUSEY
            IF mx >= 16 AND mx <= 781 THEN
                IF my >= 10 AND my <= 50 THEN
                    r = INT((mx - 16) / 3)
                ELSEIF my >= 60 AND my <= 100 THEN
                    g = INT((mx - 16) / 3)
                ELSEIF my >= 110 AND my <= 150 THEN
                    b = INT((mx - 16) / 3)
                ELSEIF my >= 160 AND my <= 200 THEN
                    a = INT((mx - 16) / 3)
                END IF
            END IF
        END IF
        k$ = INKEY$
        IF LEN(k$) THEN
            IF ASC(k$) = 27 OR k$ = "q" THEN EXIT DO
            IF ASC(k$) = 13 OR k$ = " " THEN colorDialog$ = makeConst$: EXIT DO
        END IF
        _DISPLAY
        _LIMIT 60
    LOOP
 
    'put things back
    SCREEN curScrn
    COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0): CLS
    _PUTIMAGE , backScrn
    _DISPLAY
    COLOR fg, bg
    _FREEIMAGE backScrn
    _FREEIMAGE cd
    IF autoDisplay THEN _AUTODISPLAY
    'clear key presses
    _KEYCLEAR
    'clear mouse clicks
    WHILE _MOUSEINPUT: WEND
    mb = _MOUSEBUTTON(1)
    IF mb THEN 'clear it
        WHILE mb 'OK!
            IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
            _LIMIT 10
        WEND
    END IF
    LOCATE curRow, curCol
 
END FUNCTION
 
SUB slider (x, y, value, label$)
    DIM c~&, s$
    SELECT CASE label$
        CASE "Red": c~& = &HFFFF0000
        CASE "Green": c~& = &HFF008800
        CASE "Blue": c~& = &HFF0000FF
        CASE "Alpha": c~& = &H88FFFFFF
    END SELECT
    LINE (x, y)-STEP(765, 40), c~&, B
    LINE (x, y)-STEP(3 * value, 40), c~&, BF
    s2$ = STR$(value)
    s3$ = LTRIM$(RTRIM$(s2$))
    s$ = label$ + " = " + s3$
    _PRINTSTRING (x + 384 - 4 * LEN(s$), y + 12), s$
END SUB
 

euklides · « **Reply #1 on:** October 06, 2019, 03:46:38 am »

Nothing happens when I press "space" or "enter"...
What is wrong ?

...
What interesting is, in this program, is the fact to choice easily a color and get his code.
Why not put this color code in the "_clipboard", for instance to use it when creating QB64 program using colors ? ...

bplus · « **Reply #2 on:** October 06, 2019, 10:14:55 am »

Quote from: euklides on October 06, 2019, 03:46:38 am

...
What interesting is, in this program, is the fact to choice easily a color and get his code.
Why not put this color code in the "_clipboard", for instance to use it when creating QB64 program using colors ? ...

;-)) done! https://www.qb64.org/forum/index.php?topic=1755.msg109987#msg109987

Quote

Nothing happens when I press "space" or "enter"...
What is wrong ?

It took me a couple of tries = reads of Ken's instruction But if you press space bar at opening screen you will skip instructions, just as Ken instructed. You do have to read carefully, it is not super intuitive, but on my test all seems to work as Ken describes.

I was surprised that the Orbit draws half the radius or diameter I was expecting and is it circle or ellipse? I do like Ray drawing, maybe it could use LINE -STEP for repeating R's so don't have click start points all the time but draw next Ray from last point R was pressed?? Maybe go into a R mode with one R press and then draw line from point to point clicked of course then you need R press again to toggle R mode off, something like that? BTW THAT would also fill in all those dots when just sweeping the mouse around the screen.

(More): THEN with completely enclosed areas you could use PAINT to fill them in ie PAINT to border of last Color you draw with?

SierraKen · « **Reply #3 on:** October 06, 2019, 12:13:02 pm »

Thanks B+. Yeah awhile back I tried to fill things in but for some reason it doesn't work well, especially when the program often leaves gaps when you don't draw slow enough. I'll look into the rays and ovals better. They were just something I threw on there in the beginning. Going from point to point on the rays seems like a good idea, I will try to make it off and on, so people can turn it off and then go to a separate location and turn it back on if they want to put a ray somewhere else. Awesome idea, thanks!
Euk., I'm not sure why you are getting that problem, everything seems to work on my end, but I'll look into it later today.
Thanks you 2!

Edit: I think the hardest thing about using the PAINT command is that it requires the same color as the border around it. So if someone chooses a different color than the border, it won't work.

SierraKen · « **Reply #4 on:** October 06, 2019, 05:44:58 pm »

OK, I brightened the instructions and made it easier to read. I also changed the way the orbits (circles) are made that is a bit better. I used my SIN and COS code instead. But as I say in the instructions, the more diagonal your 2 presses of the key O are apart, the more of a circle it will be. If they are horizontal or vertical, they will be almost a straight line instead. I tried to change the Rays (lines) as off and on, but figured out that it would be too difficult to remember the right keys to press to turn off and on AND make the rays. You can't just use the R key for both, so I gave up on that. Thankfully it does leave a mark on where the line starts so you know where that is when you press the second R to make the line. I also changed the (H)ome key to (I)nstructions to make it easier to remember if you need to read the instructions again. That's all I've done so far. Here is the newest version:

Code: QB64: [Select]

'This program was finished on October 5, 2019.
'Technical Notes:
'This program uses around 55 MB RAM and 1% of the CPU on my semi-new computer.
'Use at your own risk. I hold no responsibility for any problems whatsoever.
'
'Thank you to B+ from the QB64.org forum for the color picker and the picture rotation code!
'-------------------------------------------------------------------------------------------
_LIMIT 100
start:
CLS
SCREEN 0
_FULLSCREEN _OFF
_TITLE "Paint Pixels 4"
WIDTH 40, 43
_FONT 16
COLOR 15, 0
_SCREENMOVE 400, 200
PRINT "        Paint Pixels 4"
PRINT
PRINT "       By Ken G. and B+"
PRINT
PRINT "Use your mouse to paint on a"
PRINT "full screen."
PRINT "You also can make lines: (R)ays,"
PRINT "(O)rbits, and (B)oxes."
PRINT
PRINT "You also can (P)rint to"
PRINT "your USB printer as well as edit"
PRINT "an old picture file."
PRINT "It saves under .bmp files which can"
PRINT "be used with most other programs."
PRINT
PRINT "Press the Space Bar to"
PRINT "skip instructions."
PRINT
PRINT "Press Esc to end."
PRINT "Press any other key to continue."
gggo:
_LIMIT 100
ecc$ = INKEY$
IF ecc$ = " " THEN GOTO start2:
IF ecc$ = CHR$(27) THEN END
IF ecc$ = "" THEN GOTO gggo:
CLS
PRINT "       Instructions"
PRINT
PRINT "(S)ave (L)oad (I)nstructions"
PRINT "(R)ay coordinates for line."
PRINT "Press R once to start line"
PRINT "and again to finish it."
PRINT
PRINT "(O)rbit coordinates for circles."
PRINT "Press O once to start circle."
PRINT "and again to finish it."
PRINT "The size of the circle depends"
PRINT "on the length difference"
PRINT "between where you pressed O"
PRINT "both times. The center of the circle"
PRINT "will be the first place you pressed O."
PRINT "The shape of the circle depends on the"
PRINT "angle between your 2 presses. A diagonal"
PRINT "difference between them will show more"
PRINT "of a circle than straight up and down"
PRINT "or side to side between the presses."
PRINT
PRINT "(B)oxes are the same way as (O)rbits."
PRINT
PRINT "(P)rints the picture on"
PRINT "your printer. It will not work"
PRINT "if you choose a black background"
PRINT "because of heavy ink or toner use."
PRINT "To go around that, choose a white"
PRINT "background and on the color picker"
PRINT "window, choose black and press F"
PRINT "to fill entire window."
PRINT
PRINT "Esc to end program."
PRINT "Space Bar clears the screen."
PRINT "Left Mouse Button draws."
PRINT "Right Mouse Button erases."
PRINT "There is no Undo feature."
PRINT
PRINT "Press Esc to end."
PRINT "Press any other key to continue."
ggggo:
_LIMIT 100
ecc2$ = INKEY$
IF ecc2$ = CHR$(27) THEN END
IF ecc2$ = "" THEN GOTO ggggo:
CLS
PRINT "    Instructions Page 2"
PRINT
PRINT "(C)olor changes colors."
PRINT "A window will come up to use"
PRINT "your mouse to choose a color."
PRINT "* This will also happen when you"
PRINT "  first start your painting."
PRINT
PRINT "(B)oxes makes a filled box."
PRINT "First press B once to start the"
PRINT "box corner, then press B again"
PRINT "to set the 2nd corner and size"
PRINT "diagonally from the first one."
PRINT
PRINT "Paint slowly to leave out gaps."
PRINT
PRINT "When you press S to save,"
PRINT "the program will create a temp.bmp"
PRINT "of the screen and when asking you"
PRINT "for a file name, it will rename temp.bmp"
PRINT "to your chosen name."
PRINT
PRINT "Press Esc to end program."
PRINT "Press any other key to start."
gggggo:
_LIMIT 1000
s$ = INKEY$
IF s$ = "" THEN GOTO gggggo:
IF s$ = CHR$(27) THEN END
start2:
CLS
begin = 1
PRINT "Background Color"
PRINT
PRINT "(B)lack (W)hite"
PRINT
PRINT "Or Esc to end program."
start3:
_LIMIT 1000
bcolor$ = INKEY$
IF bcolor$ = CHR$(27) THEN END
IF bcolor$ = "" THEN GOTO start3:
IF bcolor$ = "w" OR bcolor$ = "W" THEN
    _FULLSCREEN
    s& = _NEWIMAGE(640, 480, 32)
    SCREEN s&
    LINE (0, 0)-(640, 480), _RGB(255, 255, 255), BF
    GOTO more2:
END IF
IF bcolor$ = "B" OR bcolor$ = "b" THEN
    _FULLSCREEN
    s& = _NEWIMAGE(640, 480, 32)
    SCREEN s&
    CLS
    GOTO more2:
END IF
GOTO start3:
more2:
begin = 1
GOSUB chosencolor:
'---------------------------------------------------
'Here is the main loop of the program when painting.
'---------------------------------------------------
DO
    _LIMIT 1000
    DO WHILE _MOUSEINPUT
        mouseX = _MOUSEX
        mouseY = _MOUSEY
        mouseLeftButton = _MOUSEBUTTON(1)
        mouseRightButton = _MOUSEBUTTON(2)
        mouseMiddleButton = _MOUSEBUTTON(3)
    LOOP
    IF mouseLeftButton = -1 THEN
        LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), clr~&, BF
    END IF
    IF mouseRightButton = -1 THEN
        LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), 0, BF
    END IF
    a$ = INKEY$
    'Here is when someone whipes the screen blank with the space bar.
    IF a$ = " " THEN GOTO start2:
    IF a$ = CHR$(27) THEN END
    IF a$ = "s" OR a$ = "S" THEN GOTO saving:
    IF a$ = "l" OR a$ = "L" THEN GOSUB loading:
    IF a$ = "i" OR a$ = "I" THEN GOTO start:
    'Here is code needed to call up the Windows Color Picker.
    'It also uses the code on top of this program and the Function at the end
    'of this program.
    IF a$ = "c" OR a$ = "C" THEN
        chosencolor:
        check$ = colorDialog$
        IF check$ <> "" THEN clr~& = VAL(check$) ELSE clr~& = &HFF0000FF '<<< I am blue if colorDialog does not work
 
        IF begin = 1 THEN begin = 0: RETURN
    END IF
    'Here is the Ray Lines code.
    IF a$ = "r" OR a$ = "R" THEN
        ck = ck + 1
        IF ck > 1 THEN GOTO ray:
        xxx = mouseX: yyy = mouseY
        LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), clr~&, BF
        GOTO firstray:
        ray:
        LINE (mouseX, mouseY)-(xxx, yyy), clr~&
        xxx = 0: yyy = 0
        ck = 0
        firstray:
    END IF
    'Here is the Orbit Circles code.
    IF a$ = "o" OR a$ = "O" THEN
        ck2 = ck2 + 1
        IF ck2 > 1 THEN GOTO orbit:
        xxx2 = mouseX: yyy2 = mouseY
        GOTO firstorbit:
        orbit:
        IF mouseX < xxx2 THEN size = xxx2 - mouseX
        IF mouseX > xxx2 THEN size = mouseX - xxx2
        IF mouseY < yyy2 THEN size2 = yyy2 - mouseY
        IF mouseY > yyy2 THEN size2 = mouseY - yyy2
        one:
        seconds = seconds + .01
        s = (60 - seconds) * 6 + size
        x = INT(SIN(s / 180 * 3.141592) * size) + xxx2
        y = INT(COS(s / 180 * 3.141592) * size2) + yyy2
        CIRCLE (x, y), 1, clr~&
        IF seconds > 60 THEN
            seconds = 0
            GOTO two:
        END IF
        GOTO one:
        two:
        xxx2 = 0: yyy2 = 0
        size = 0: size2 = 0: size3 = 0
        ck2 = 0
        firstorbit:
    END IF
    'Here is the Boxes code.
    IF a$ = "b" OR a$ = "B" THEN
        ck3 = ck3 + 1
        IF ck3 > 1 THEN GOTO box:
        xxx3 = mouseX: yyy3 = mouseY
        GOTO firstbox:
        box:
        LINE (mouseX, mouseY)-(xxx3 + 1, yyy3 + 1), clr~&, BF
        xxx3 = 0: yyy3 = 0
        ck3 = 0
        firstbox:
    END IF
    'Here is the Printing of the picture.
    IF a$ = "p" OR a$ = "P" THEN
        IF bcolor$ = "w" OR bcolor$ = "W" THEN
            j& = _COPYIMAGE(0)
            _DELAY .25
            INPUT "Print on printer (Y/N)?", i$ 'print screen page on printer
            CLS
            SCREEN j&
            _DELAY .25
            IF LEFT$(i$, 1) = "y" OR LEFT$(i$, 1) = "Y" THEN
                'printer prep (code copied and pasted from bplus Free Calendar Program)
                YMAX = _HEIGHT: XMAX = _WIDTH
                landscape& = _NEWIMAGE(YMAX, XMAX, 32)
                _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
                _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
                _PRINTIMAGE landscape&
                _DELAY 2
                landscape& = 0
                j& = 0
            END IF
        END IF
    END IF
LOOP
 
'Saving
'This section first saves your picture as temp.bmp and then
'asks you a name for your picture and then renames temp.bmp to your name.
saving:
'Now we call up the SUB to save the image to BMP.
SaveImage 0, "temp.bmp"
_DELAY .25
SCREEN 0
CLS
COLOR 12
PRINT "                       Saving"
PRINT
PRINT "         Your bmp file will be saved in the"
PRINT "         same directory as this program is."
PRINT "         It can be used with almost any"
PRINT "         other graphics program or website."
PRINT "         It is saved using:"
PRINT "         width: 640  height: 480 pixels."
PRINT
PRINT "         Type a name to save your picture"
PRINT "         and press the Enter key. Do not"
PRINT "         add .bmp at the end, the program"
PRINT "         will do it automatically."
PRINT
PRINT "         Also do not use the name temp"
PRINT "         because the program uses that name"
PRINT "         and it would be erased the next time"
PRINT "         you save a picture."
PRINT "         Example: MyPic"
PRINT "         Quit and Enter key ends program."
PRINT
INPUT "         ->"; nm$
IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
nm$ = nm$ + ".bmp"
'Checking to see if the file already exists on your computer.
theFileExists = _FILEEXISTS(nm$)
IF theFileExists = -1 THEN
    PRINT "       File Already Exists"
    PRINT "       Saving will delete your old"
    PRINT "       bmp picture."
    PRINT "       Would you like to still do it?"
    PRINT "      (Y/N). Esc ends program."
    llloop:
    _LIMIT 100
    ag2$ = INKEY$
    IF ag2$ = CHR$(27) THEN END
    IF ag2$ = "" THEN GOTO llloop:
    IF ag2$ = "y" OR ag$ = "Y" THEN
        SHELL _HIDE "DEL " + nm$
        GOTO saving2:
    END IF
    GOTO llloop:
END IF
saving2:
SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
nm$ = ""
FOR snd = 100 TO 700 STEP 100
    SOUND snd, 2
NEXT snd
CLS
GOTO start:
loading: 'This section loads your picture from your computer.
SCREEN 0
CLS
COLOR 12
PRINT "                    Loading"
PRINT
PRINT "         Do not add .bmp at the end."
PRINT "         The bmp picture must be in the same"
PRINT "         directory as this program is."
PRINT "         You will not be able to edit your"
PRINT "         picture file with this program."
PRINT "         Type the name of your picture file"
PRINT "         here and press the Enter key."
PRINT "         Example: MyPic"
PRINT "         Quit and Enter key ends program."
PRINT
INPUT "         ->"; nm$
IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
nm$ = nm$ + ".bmp"
theFileExists = _FILEEXISTS(nm$)
IF theFileExists = 0 THEN
    PRINT "         File Does Not Exist."
    PRINT "         Would you like to try again (Y/N)"
    PRINT "         Esc ends program."
    _LIMIT 100
    llloop2:
    ag$ = INKEY$
    IF ag$ = "" THEN GOTO llloop2:
    IF ag$ = "y" OR ag$ = "Y" THEN GOTO loading:
    IF ag$ = CHR$(27) THEN END
    GOTO start:
END IF
CLS
l = 0
i& = _LOADIMAGE(nm$, 32)
SCREEN i&
FOR snd2 = 100 TO 700 STEP 100
    SOUND snd2, 2
NEXT snd2
s& = i&
i& = 0
SCREEN s&
RETURN
 
'Here is the SUB needed to save the image to BMP.
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 
FUNCTION colorDialog$
 
    'first screen dimensions items to restore at exit
    DIM curRow AS INTEGER, curCol AS INTEGER, autoDisplay AS INTEGER
    DIM sw AS INTEGER, sh AS INTEGER, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG
    DIM curScrn AS LONG, backScrn AS LONG 'some handles
 
    DIM cd AS LONG
    DIM r AS INTEGER, g AS INTEGER, b AS INTEGER, a AS INTEGER, mb AS INTEGER, mx AS INTEGER, my AS INTEGER, i AS INTEGER
    DIM makeConst$, k$
    DIM f AS SINGLE
 
    'save old settings to restore at end ofsub
    curRow = CSRLIN
    curCol = POS(0)
    autoDisplay = _AUTODISPLAY
    sw = _WIDTH
    sh = _HEIGHT
    fg = _DEFAULTCOLOR
    bg = _BACKGROUNDCOLOR
    _KEYCLEAR
    'screen snapshot
    curScrn = _DEST
    backScrn = _NEWIMAGE(sw, sh, 32)
    _PUTIMAGE , curScrn, backScrn
 
    cd = _NEWIMAGE(800, 600, 32)
    SCREEN cd
    r = 128: g = 128: b = 128: a = 128
    COLOR &HFFDDDDDD, 0
    DO
        CLS
        makeConst$ = "&H" + RIGHT$(STRING$(8, "0") + HEX$(_RGBA32(r, g, b, a)), 8)
        slider 16, 10, r, "Red"
        slider 16, 60, g, "Green"
        slider 16, 110, b, "Blue"
        slider 16, 160, a, "Alpha"
        _PRINTSTRING (150, 260), "Press enter or spacebar, if you want to use the color: " + makeConst$
        _PRINTSTRING (210, 280), "Press escape or q, to not use any color, returns 0."
        LINE (90, 300)-(710, 590), , B
        FOR i = 100 TO 700
            f = 255 * (i - 100) / 600
            LINE (i, 310)-STEP(0, 30), _RGB32(f, 0, 0): LINE (i, 310)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 340)-STEP(0, 30), _RGB32(0, f, 0): LINE (i, 340)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 370)-STEP(0, 30), _RGB32(0, 0, f): LINE (i, 370)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 400)-STEP(0, 30), _RGB32(f, f, 0): LINE (i, 400)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 430)-STEP(0, 30), _RGB32(0, f, f): LINE (i, 430)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 460)-STEP(0, 30), _RGB32(f, 0, f): LINE (i, 460)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 490)-STEP(0, 30), _RGB32(f, f, f): LINE (i, 490)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 520)-STEP(0, 30), _RGB32(0, 0, 0): LINE (i, 520)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 550)-STEP(0, 30), _RGB32(255, 255, 255): LINE (i, 550)-STEP(0, 20), VAL(makeConst$)
        NEXT
        WHILE _MOUSEINPUT: WEND
        mb = _MOUSEBUTTON(1)
        IF mb THEN 'clear it
            mx = _MOUSEX: my = _MOUSEY
            IF mx >= 16 AND mx <= 781 THEN
                IF my >= 10 AND my <= 50 THEN
                    r = INT((mx - 16) / 3)
                ELSEIF my >= 60 AND my <= 100 THEN
                    g = INT((mx - 16) / 3)
                ELSEIF my >= 110 AND my <= 150 THEN
                    b = INT((mx - 16) / 3)
                ELSEIF my >= 160 AND my <= 200 THEN
                    a = INT((mx - 16) / 3)
                END IF
            END IF
        END IF
        k$ = INKEY$
        IF LEN(k$) THEN
            IF ASC(k$) = 27 OR k$ = "q" THEN EXIT DO
            IF ASC(k$) = 13 OR k$ = " " THEN colorDialog$ = makeConst$: EXIT DO
        END IF
        _DISPLAY
        _LIMIT 60
    LOOP
 
    'put things back
    SCREEN curScrn
    COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0): CLS
    _PUTIMAGE , backScrn
    _DISPLAY
    COLOR fg, bg
    _FREEIMAGE backScrn
    _FREEIMAGE cd
    IF autoDisplay THEN _AUTODISPLAY
    'clear key presses
    _KEYCLEAR
    'clear mouse clicks
    WHILE _MOUSEINPUT: WEND
    mb = _MOUSEBUTTON(1)
    IF mb THEN 'clear it
        WHILE mb 'OK!
            IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
            _LIMIT 10
        WEND
    END IF
    LOCATE curRow, curCol
 
END FUNCTION
 
SUB slider (x, y, value, label$)
    DIM c~&, s$
    SELECT CASE label$
        CASE "Red": c~& = &HFFFF0000
        CASE "Green": c~& = &HFF008800
        CASE "Blue": c~& = &HFF0000FF
        CASE "Alpha": c~& = &H88FFFFFF
    END SELECT
    LINE (x, y)-STEP(765, 40), c~&, B
    LINE (x, y)-STEP(3 * value, 40), c~&, BF
    s2$ = STR$(value)
    s3$ = LTRIM$(RTRIM$(s2$))
    s$ = label$ + " = " + s3$
    _PRINTSTRING (x + 384 - 4 * LEN(s$), y + 12), s$
END SUB
 

bplus · « **Reply #5 on:** October 06, 2019, 06:11:48 pm »

Hi Ken,

Here is code change to make R toggle on and off and to draw straight lines from click to click while in R mode.

Code: QB64: [Select]

    'Here is the Ray Lines code.
    IF a$ = "r" OR a$ = "R" THEN
        rMode = 1 - rMode
        IF rMode THEN lastx = mouseX: lastY = mouseY 'set first lastx, lasty
        'ck = ck + 1
        'IF ck > 1 THEN GOTO ray:
        'xxx = mouseX: yyy = mouseY
        'LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), clr~&, BF
        'GOTO firstray:
        'ray:
        'LINE (mouseX, mouseY)-(xxx, yyy), clr~&
        'xxx = 0: yyy = 0
        'ck = 0
        'firstray:
    END IF
    IF rMode AND mouseLeftButton THEN LINE (lastx, lastY)-(mouseX, mouseY), clr~&: lastx = mouseX: lastY = mouseY
 

You can click straight lines or drag mouse around with left button pressed to draw continuous line.

SierraKen · « **Reply #6 on:** October 06, 2019, 07:00:24 pm »

That is so awesome. Thanks again B+!!! I added it to my program. I also drew 2 examples that people can do with this program. This program has turned from a simple experimental program to something pretty high-tech, in my opinion.

Here is the update:

Code: QB64: [Select]

'This program was finished on October 6, 2019.
'Technical Notes:
'This program uses around 55 MB RAM and 1% of the CPU on my semi-new computer.
'Use at your own risk. I hold no responsibility for any problems whatsoever.
'
'Thank you to B+ from the QB64.org forum for the color picker, the picture rotation code and
'the ray line making code!
'-------------------------------------------------------------------------------------------
_LIMIT 100
start:
CLS
SCREEN 0
_FULLSCREEN _OFF
_TITLE "Paint Pixels 4"
WIDTH 40, 43
_FONT 16
COLOR 15, 0
_SCREENMOVE 400, 200
PRINT "        Paint Pixels 4"
PRINT
PRINT "       By Ken G. and B+"
PRINT
PRINT "Use your mouse to paint on a"
PRINT "full screen."
PRINT "You also can make lines: (R)ays,"
PRINT "(O)rbits, and (B)oxes."
PRINT
PRINT "You also can (P)rint to"
PRINT "your USB printer as well as edit"
PRINT "an old picture file."
PRINT "It saves under .bmp files which can"
PRINT "be used with most other programs."
PRINT
PRINT "Press the Space Bar to"
PRINT "skip instructions."
PRINT
PRINT "Press Esc to end."
PRINT "Press any other key to continue."
gggo:
_LIMIT 100
ecc$ = INKEY$
IF ecc$ = " " THEN GOTO start2:
IF ecc$ = CHR$(27) THEN END
IF ecc$ = "" THEN GOTO gggo:
CLS
PRINT "       Instructions"
PRINT
PRINT "(S)ave (L)oad (I)nstructions"
PRINT "(R)ay coordinates for line."
PRINT "Press R once to start line"
PRINT "and again to finish it."
PRINT
PRINT "(O)rbit coordinates for circles."
PRINT "Press O once to start circle."
PRINT "and again to finish it."
PRINT "The size of the circle depends"
PRINT "on the length difference"
PRINT "between where you pressed O"
PRINT "both times. The center of the circle"
PRINT "will be the first place you pressed O."
PRINT "The shape of the circle depends on the"
PRINT "angle between your 2 presses. A diagonal"
PRINT "difference between them will show more"
PRINT "of a circle than straight up and down"
PRINT "or side to side between the presses."
PRINT
PRINT "(B)oxes are the same way as (O)rbits."
PRINT
PRINT "(P)rints the picture on"
PRINT "your printer. It will not work"
PRINT "if you choose a black background"
PRINT "because of heavy ink or toner use."
PRINT "To go around that, choose a white"
PRINT "background and on the color picker"
PRINT "window, choose black and press F"
PRINT "to fill entire window."
PRINT
PRINT "Esc to end program."
PRINT "Space Bar clears the screen."
PRINT "Left Mouse Button draws."
PRINT "Right Mouse Button erases."
PRINT "There is no Undo feature."
PRINT
PRINT "Press Esc to end."
PRINT "Press any other key to continue."
ggggo:
_LIMIT 100
ecc2$ = INKEY$
IF ecc2$ = CHR$(27) THEN END
IF ecc2$ = "" THEN GOTO ggggo:
CLS
PRINT "    Instructions Page 2"
PRINT
PRINT "(C)olor changes colors."
PRINT "A window will come up to use"
PRINT "your mouse to choose a color."
PRINT "* This will also happen when you"
PRINT "  first start your painting."
PRINT
PRINT "(B)oxes makes a filled box."
PRINT "First press B once to start the"
PRINT "box corner, then press B again"
PRINT "to set the 2nd corner and size"
PRINT "diagonally from the first one."
PRINT
PRINT "Paint slowly to leave out gaps."
PRINT
PRINT "When you press S to save,"
PRINT "the program will create a temp.bmp"
PRINT "of the screen and when asking you"
PRINT "for a file name, it will rename temp.bmp"
PRINT "to your chosen name."
PRINT
PRINT "Press Esc to end program."
PRINT "Press any other key to start."
gggggo:
_LIMIT 1000
s$ = INKEY$
IF s$ = "" THEN GOTO gggggo:
IF s$ = CHR$(27) THEN END
start2:
CLS
begin = 1
PRINT "Background Color"
PRINT
PRINT "(B)lack (W)hite"
PRINT
PRINT "Or Esc to end program."
start3:
_LIMIT 1000
bcolor$ = INKEY$
IF bcolor$ = CHR$(27) THEN END
IF bcolor$ = "" THEN GOTO start3:
IF bcolor$ = "w" OR bcolor$ = "W" THEN
    _FULLSCREEN
    s& = _NEWIMAGE(640, 480, 32)
    SCREEN s&
    LINE (0, 0)-(640, 480), _RGB(255, 255, 255), BF
    GOTO more2:
END IF
IF bcolor$ = "B" OR bcolor$ = "b" THEN
    _FULLSCREEN
    s& = _NEWIMAGE(640, 480, 32)
    SCREEN s&
    CLS
    GOTO more2:
END IF
GOTO start3:
more2:
begin = 1
GOSUB chosencolor:
'---------------------------------------------------
'Here is the main loop of the program when painting.
'---------------------------------------------------
DO
    _LIMIT 1000
    DO WHILE _MOUSEINPUT
        mouseX = _MOUSEX
        mouseY = _MOUSEY
        mouseLeftButton = _MOUSEBUTTON(1)
        mouseRightButton = _MOUSEBUTTON(2)
        mouseMiddleButton = _MOUSEBUTTON(3)
    LOOP
    IF mouseLeftButton = -1 THEN
        LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), clr~&, BF
    END IF
    IF mouseRightButton = -1 THEN
        LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), 0, BF
    END IF
    a$ = INKEY$
    'Here is when someone whipes the screen blank with the space bar.
    IF a$ = " " THEN GOTO start2:
    IF a$ = CHR$(27) THEN END
    IF a$ = "s" OR a$ = "S" THEN GOTO saving:
    IF a$ = "l" OR a$ = "L" THEN GOSUB loading:
    IF a$ = "i" OR a$ = "I" THEN GOTO start:
    'Here is code needed to call up the Windows Color Picker.
    'It also uses the code on top of this program and the Function at the end
    'of this program.
    IF a$ = "c" OR a$ = "C" THEN
        chosencolor:
        check$ = colorDialog$
        IF check$ <> "" THEN clr~& = VAL(check$) ELSE clr~& = &HFF0000FF '<<< I am blue if colorDialog does not work
 
        IF begin = 1 THEN begin = 0: RETURN
    END IF
    'Here is the Ray Lines code.
    IF a$ = "r" OR a$ = "R" THEN
        rMode = 1 - rMode
        IF rMode THEN lastx = mouseX: lastY = mouseY 'set first lastx, lasty
    END IF
    IF rMode AND mouseLeftButton THEN LINE (lastx, lastY)-(mouseX, mouseY), clr~&: lastx = mouseX: lastY = mouseY
    'Here is the Orbit Circles code.
    IF a$ = "o" OR a$ = "O" THEN
        ck2 = ck2 + 1
        IF ck2 > 1 THEN GOTO orbit:
        xxx2 = mouseX: yyy2 = mouseY
        GOTO firstorbit:
        orbit:
        IF mouseX < xxx2 THEN size = xxx2 - mouseX
        IF mouseX > xxx2 THEN size = mouseX - xxx2
        IF mouseY < yyy2 THEN size2 = yyy2 - mouseY
        IF mouseY > yyy2 THEN size2 = mouseY - yyy2
        one:
        seconds = seconds + .01
        s = (60 - seconds) * 6 + size
        x = INT(SIN(s / 180 * 3.141592) * size) + xxx2
        y = INT(COS(s / 180 * 3.141592) * size2) + yyy2
        CIRCLE (x, y), 1, clr~&
        IF seconds > 60 THEN
            seconds = 0
            GOTO two:
        END IF
        GOTO one:
        two:
        xxx2 = 0: yyy2 = 0
        size = 0: size2 = 0: size3 = 0
        ck2 = 0
        firstorbit:
    END IF
    'Here is the Boxes code.
    IF a$ = "b" OR a$ = "B" THEN
        ck3 = ck3 + 1
        IF ck3 > 1 THEN GOTO box:
        xxx3 = mouseX: yyy3 = mouseY
        GOTO firstbox:
        box:
        LINE (mouseX, mouseY)-(xxx3 + 1, yyy3 + 1), clr~&, BF
        xxx3 = 0: yyy3 = 0
        ck3 = 0
        firstbox:
    END IF
    'Here is the Printing of the picture.
    IF a$ = "p" OR a$ = "P" THEN
        IF bcolor$ = "w" OR bcolor$ = "W" THEN
            j& = _COPYIMAGE(0)
            _DELAY .25
            INPUT "Print on printer (Y/N)?", i$ 'print screen page on printer
            CLS
            SCREEN j&
            _DELAY .25
            IF LEFT$(i$, 1) = "y" OR LEFT$(i$, 1) = "Y" THEN
                'printer prep (code copied and pasted from bplus Free Calendar Program)
                YMAX = _HEIGHT: XMAX = _WIDTH
                landscape& = _NEWIMAGE(YMAX, XMAX, 32)
                _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
                _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
                _PRINTIMAGE landscape&
                _DELAY 2
                landscape& = 0
                j& = 0
            END IF
        END IF
    END IF
LOOP
 
'Saving
'This section first saves your picture as temp.bmp and then
'asks you a name for your picture and then renames temp.bmp to your name.
saving:
'Now we call up the SUB to save the image to BMP.
SaveImage 0, "temp.bmp"
_DELAY .25
SCREEN 0
CLS
COLOR 12
PRINT "                       Saving"
PRINT
PRINT "         Your bmp file will be saved in the"
PRINT "         same directory as this program is."
PRINT "         It can be used with almost any"
PRINT "         other graphics program or website."
PRINT "         It is saved using:"
PRINT "         width: 640  height: 480 pixels."
PRINT
PRINT "         Type a name to save your picture"
PRINT "         and press the Enter key. Do not"
PRINT "         add .bmp at the end, the program"
PRINT "         will do it automatically."
PRINT
PRINT "         Also do not use the name temp"
PRINT "         because the program uses that name"
PRINT "         and it would be erased the next time"
PRINT "         you save a picture."
PRINT "         Example: MyPic"
PRINT "         Quit and Enter key ends program."
PRINT
INPUT "         ->"; nm$
IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
nm$ = nm$ + ".bmp"
'Checking to see if the file already exists on your computer.
theFileExists = _FILEEXISTS(nm$)
IF theFileExists = -1 THEN
    PRINT "       File Already Exists"
    PRINT "       Saving will delete your old"
    PRINT "       bmp picture."
    PRINT "       Would you like to still do it?"
    PRINT "      (Y/N). Esc ends program."
    llloop:
    _LIMIT 100
    ag2$ = INKEY$
    IF ag2$ = CHR$(27) THEN END
    IF ag2$ = "" THEN GOTO llloop:
    IF ag2$ = "y" OR ag$ = "Y" THEN
        SHELL _HIDE "DEL " + nm$
        GOTO saving2:
    END IF
    GOTO llloop:
END IF
saving2:
SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
nm$ = ""
FOR snd = 100 TO 700 STEP 100
    SOUND snd, 2
NEXT snd
CLS
GOTO start:
loading: 'This section loads your picture from your computer.
SCREEN 0
CLS
COLOR 12
PRINT "                    Loading"
PRINT
PRINT "         Do not add .bmp at the end."
PRINT "         The bmp picture must be in the same"
PRINT "         directory as this program is."
PRINT "         You will not be able to edit your"
PRINT "         picture file with this program."
PRINT "         Type the name of your picture file"
PRINT "         here and press the Enter key."
PRINT "         Example: MyPic"
PRINT "         Quit and Enter key ends program."
PRINT
INPUT "         ->"; nm$
IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
nm$ = nm$ + ".bmp"
theFileExists = _FILEEXISTS(nm$)
IF theFileExists = 0 THEN
    PRINT "         File Does Not Exist."
    PRINT "         Would you like to try again (Y/N)"
    PRINT "         Esc ends program."
    _LIMIT 100
    llloop2:
    ag$ = INKEY$
    IF ag$ = "" THEN GOTO llloop2:
    IF ag$ = "y" OR ag$ = "Y" THEN GOTO loading:
    IF ag$ = CHR$(27) THEN END
    GOTO start:
END IF
CLS
l = 0
i& = _LOADIMAGE(nm$, 32)
SCREEN i&
FOR snd2 = 100 TO 700 STEP 100
    SOUND snd2, 2
NEXT snd2
s& = i&
i& = 0
SCREEN s&
RETURN
 
'Here is the SUB needed to save the image to BMP.
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 
FUNCTION colorDialog$
 
    'first screen dimensions items to restore at exit
    DIM curRow AS INTEGER, curCol AS INTEGER, autoDisplay AS INTEGER
    DIM sw AS INTEGER, sh AS INTEGER, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG
    DIM curScrn AS LONG, backScrn AS LONG 'some handles
 
    DIM cd AS LONG
    DIM r AS INTEGER, g AS INTEGER, b AS INTEGER, a AS INTEGER, mb AS INTEGER, mx AS INTEGER, my AS INTEGER, i AS INTEGER
    DIM makeConst$, k$
    DIM f AS SINGLE
 
    'save old settings to restore at end ofsub
    curRow = CSRLIN
    curCol = POS(0)
    autoDisplay = _AUTODISPLAY
    sw = _WIDTH
    sh = _HEIGHT
    fg = _DEFAULTCOLOR
    bg = _BACKGROUNDCOLOR
    _KEYCLEAR
    'screen snapshot
    curScrn = _DEST
    backScrn = _NEWIMAGE(sw, sh, 32)
    _PUTIMAGE , curScrn, backScrn
 
    cd = _NEWIMAGE(800, 600, 32)
    SCREEN cd
    r = 128: g = 128: b = 128: a = 128
    COLOR &HFFDDDDDD, 0
    DO
        CLS
        makeConst$ = "&H" + RIGHT$(STRING$(8, "0") + HEX$(_RGBA32(r, g, b, a)), 8)
        slider 16, 10, r, "Red"
        slider 16, 60, g, "Green"
        slider 16, 110, b, "Blue"
        slider 16, 160, a, "Alpha"
        _PRINTSTRING (150, 260), "Press enter or spacebar, if you want to use the color: " + makeConst$
        _PRINTSTRING (210, 280), "Press escape or q, to not use any color, returns 0."
        LINE (90, 300)-(710, 590), , B
        FOR i = 100 TO 700
            f = 255 * (i - 100) / 600
            LINE (i, 310)-STEP(0, 30), _RGB32(f, 0, 0): LINE (i, 310)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 340)-STEP(0, 30), _RGB32(0, f, 0): LINE (i, 340)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 370)-STEP(0, 30), _RGB32(0, 0, f): LINE (i, 370)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 400)-STEP(0, 30), _RGB32(f, f, 0): LINE (i, 400)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 430)-STEP(0, 30), _RGB32(0, f, f): LINE (i, 430)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 460)-STEP(0, 30), _RGB32(f, 0, f): LINE (i, 460)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 490)-STEP(0, 30), _RGB32(f, f, f): LINE (i, 490)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 520)-STEP(0, 30), _RGB32(0, 0, 0): LINE (i, 520)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 550)-STEP(0, 30), _RGB32(255, 255, 255): LINE (i, 550)-STEP(0, 20), VAL(makeConst$)
        NEXT
        WHILE _MOUSEINPUT: WEND
        mb = _MOUSEBUTTON(1)
        IF mb THEN 'clear it
            mx = _MOUSEX: my = _MOUSEY
            IF mx >= 16 AND mx <= 781 THEN
                IF my >= 10 AND my <= 50 THEN
                    r = INT((mx - 16) / 3)
                ELSEIF my >= 60 AND my <= 100 THEN
                    g = INT((mx - 16) / 3)
                ELSEIF my >= 110 AND my <= 150 THEN
                    b = INT((mx - 16) / 3)
                ELSEIF my >= 160 AND my <= 200 THEN
                    a = INT((mx - 16) / 3)
                END IF
            END IF
        END IF
        k$ = INKEY$
        IF LEN(k$) THEN
            IF ASC(k$) = 27 OR k$ = "q" THEN EXIT DO
            IF ASC(k$) = 13 OR k$ = " " THEN colorDialog$ = makeConst$: EXIT DO
        END IF
        _DISPLAY
        _LIMIT 60
    LOOP
 
    'put things back
    SCREEN curScrn
    COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0): CLS
    _PUTIMAGE , backScrn
    _DISPLAY
    COLOR fg, bg
    _FREEIMAGE backScrn
    _FREEIMAGE cd
    IF autoDisplay THEN _AUTODISPLAY
    'clear key presses
    _KEYCLEAR
    'clear mouse clicks
    WHILE _MOUSEINPUT: WEND
    mb = _MOUSEBUTTON(1)
    IF mb THEN 'clear it
        WHILE mb 'OK!
            IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
            _LIMIT 10
        WEND
    END IF
    LOCATE curRow, curCol
 
END FUNCTION
 
SUB slider (x, y, value, label$)
    DIM c~&, s$
    SELECT CASE label$
        CASE "Red": c~& = &HFFFF0000
        CASE "Green": c~& = &HFF008800
        CASE "Blue": c~& = &HFF0000FF
        CASE "Alpha": c~& = &H88FFFFFF
    END SELECT
    LINE (x, y)-STEP(765, 40), c~&, B
    LINE (x, y)-STEP(3 * value, 40), c~&, BF
    s2$ = STR$(value)
    s3$ = LTRIM$(RTRIM$(s2$))
    s$ = label$ + " = " + s3$
    _PRINTSTRING (x + 384 - 4 * LEN(s$), y + 12), s$
END SUB
 

bplus · « **Reply #7 on:** October 06, 2019, 11:47:26 pm »

Well I am grinning from ear to ear! Glad you liked it.

SierraKen · « **Reply #8 on:** October 07, 2019, 12:26:17 am »

I updated the instructions better for the new way to make rays (lines).

Code: QB64: [Select]

'This program was finished on October 6, 2019.
'Technical Notes:
'This program uses around 55 MB RAM and 1% of the CPU on my semi-new computer.
'Use at your own risk. I hold no responsibility for any problems whatsoever.
'
'Thank you to B+ from the QB64.org forum for the color picker, the picture rotation code and
'the ray line making code!
'-------------------------------------------------------------------------------------------
_LIMIT 100
start:
CLS
SCREEN 0
_FULLSCREEN _OFF
_TITLE "Paint Pixels 4"
WIDTH 40, 43
_FONT 16
COLOR 15, 0
_SCREENMOVE 400, 200
PRINT "        Paint Pixels 4"
PRINT
PRINT "       By Ken G. and B+"
PRINT
PRINT "Use your mouse to paint on a"
PRINT "full screen."
PRINT "You also can make lines: (R)ays,"
PRINT "(O)rbits, and (B)oxes."
PRINT
PRINT "You also can (P)rint to"
PRINT "your USB printer as well as edit"
PRINT "an old picture file."
PRINT "It saves under .bmp files which can"
PRINT "be used with most other programs."
PRINT
PRINT "Press the Space Bar to"
PRINT "skip instructions."
PRINT
PRINT "Press Esc to end."
PRINT "Press any other key to continue."
gggo:
_LIMIT 100
ecc$ = INKEY$
IF ecc$ = " " THEN GOTO start2:
IF ecc$ = CHR$(27) THEN END
IF ecc$ = "" THEN GOTO gggo:
CLS
PRINT "       Instructions"
PRINT
PRINT "* (S)ave (L)oad (I)nstructions"
PRINT "* (R)ay for new line(s)."
PRINT "Press R once to start line,"
PRINT "then use the mouse to where you"
PRINT "want the end of it to be. You can"
PRINT "keep using the mouse and the line"
PRINT "will start where it left off at."
PRINT "Press R again to go back to drawing."
PRINT "* (O)rbit coordinates for circles."
PRINT "Press O once to start circle."
PRINT "and again to finish it."
PRINT "The size of the circle depends"
PRINT "on the length difference"
PRINT "between where you pressed O"
PRINT "both times. The center of the circle"
PRINT "will be the first place you pressed O."
PRINT "The shape of the circle depends on the"
PRINT "angle between your 2 presses. A diagonal"
PRINT "difference between them will show more"
PRINT "of a circle than straight up and down"
PRINT "or side to side between the presses."
PRINT "* (B)oxes are the same way as (O)rbits."
PRINT "* (P)rints the picture on"
PRINT "your printer. It will not work"
PRINT "if you choose a black background"
PRINT "because of heavy ink or toner use."
PRINT "To go around that, choose a white"
PRINT "background and on the color picker"
PRINT "window, choose black and press F"
PRINT "to fill entire window."
PRINT "* Esc to end program."
PRINT "* Space Bar clears the screen."
PRINT "* Left Mouse Button draws."
PRINT "* Right Mouse Button erases."
PRINT "- There is no Undo feature."
PRINT
PRINT "Press Esc to end."
PRINT "Press any other key to continue."
ggggo:
_LIMIT 100
ecc2$ = INKEY$
IF ecc2$ = CHR$(27) THEN END
IF ecc2$ = "" THEN GOTO ggggo:
CLS
PRINT "    Instructions Page 2"
PRINT
PRINT "(C)olor changes colors."
PRINT "A window will come up to use"
PRINT "your mouse to choose a color."
PRINT "* This will also happen when you"
PRINT "  first start your painting."
PRINT
PRINT "(B)oxes makes a filled box."
PRINT "First press B once to start the"
PRINT "box corner, then press B again"
PRINT "to set the 2nd corner and size"
PRINT "diagonally from the first one."
PRINT
PRINT "Paint slowly to leave out gaps."
PRINT
PRINT "When you press S to save,"
PRINT "the program will create a temp.bmp"
PRINT "of the screen and when asking you"
PRINT "for a file name, it will rename temp.bmp"
PRINT "to your chosen name."
PRINT
PRINT "Press Esc to end program."
PRINT "Press any other key to start."
gggggo:
_LIMIT 1000
s$ = INKEY$
IF s$ = "" THEN GOTO gggggo:
IF s$ = CHR$(27) THEN END
start2:
CLS
begin = 1
PRINT "Background Color"
PRINT
PRINT "(B)lack (W)hite"
PRINT
PRINT "Or Esc to end program."
start3:
_LIMIT 1000
bcolor$ = INKEY$
IF bcolor$ = CHR$(27) THEN END
IF bcolor$ = "" THEN GOTO start3:
IF bcolor$ = "w" OR bcolor$ = "W" THEN
    _FULLSCREEN
    s& = _NEWIMAGE(640, 480, 32)
    SCREEN s&
    LINE (0, 0)-(640, 480), _RGB(255, 255, 255), BF
    GOTO more2:
END IF
IF bcolor$ = "B" OR bcolor$ = "b" THEN
    _FULLSCREEN
    s& = _NEWIMAGE(640, 480, 32)
    SCREEN s&
    CLS
    GOTO more2:
END IF
GOTO start3:
more2:
begin = 1
GOSUB chosencolor:
'---------------------------------------------------
'Here is the main loop of the program when painting.
'---------------------------------------------------
DO
    _LIMIT 1000
    DO WHILE _MOUSEINPUT
        mouseX = _MOUSEX
        mouseY = _MOUSEY
        mouseLeftButton = _MOUSEBUTTON(1)
        mouseRightButton = _MOUSEBUTTON(2)
        mouseMiddleButton = _MOUSEBUTTON(3)
    LOOP
    IF mouseLeftButton = -1 THEN
        LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), clr~&, BF
    END IF
    IF mouseRightButton = -1 THEN
        LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), 0, BF
    END IF
    a$ = INKEY$
    'Here is when someone whipes the screen blank with the space bar.
    IF a$ = " " THEN GOTO start2:
    IF a$ = CHR$(27) THEN END
    IF a$ = "s" OR a$ = "S" THEN GOTO saving:
    IF a$ = "l" OR a$ = "L" THEN GOSUB loading:
    IF a$ = "i" OR a$ = "I" THEN GOTO start:
    'Here is code needed to call up the Windows Color Picker.
    'It also uses the code on top of this program and the Function at the end
    'of this program.
    IF a$ = "c" OR a$ = "C" THEN
        chosencolor:
        check$ = colorDialog$
        IF check$ <> "" THEN clr~& = VAL(check$) ELSE clr~& = &HFF0000FF '<<< I am blue if colorDialog does not work
 
        IF begin = 1 THEN begin = 0: RETURN
    END IF
    'Here is the Ray Lines code.
    IF a$ = "r" OR a$ = "R" THEN
        rMode = 1 - rMode
        IF rMode THEN lastx = mouseX: lastY = mouseY 'set first lastx, lasty
    END IF
    IF rMode AND mouseLeftButton THEN LINE (lastx, lastY)-(mouseX, mouseY), clr~&: lastx = mouseX: lastY = mouseY
    'Here is the Orbit Circles code.
    IF a$ = "o" OR a$ = "O" THEN
        ck2 = ck2 + 1
        IF ck2 > 1 THEN GOTO orbit:
        xxx2 = mouseX: yyy2 = mouseY
        GOTO firstorbit:
        orbit:
        IF mouseX < xxx2 THEN size = xxx2 - mouseX
        IF mouseX > xxx2 THEN size = mouseX - xxx2
        IF mouseY < yyy2 THEN size2 = yyy2 - mouseY
        IF mouseY > yyy2 THEN size2 = mouseY - yyy2
        one:
        seconds = seconds + .01
        s = (60 - seconds) * 6 + size
        x = INT(SIN(s / 180 * 3.141592) * size) + xxx2
        y = INT(COS(s / 180 * 3.141592) * size2) + yyy2
        CIRCLE (x, y), 1, clr~&
        IF seconds > 60 THEN
            seconds = 0
            GOTO two:
        END IF
        GOTO one:
        two:
        xxx2 = 0: yyy2 = 0
        size = 0: size2 = 0: size3 = 0
        ck2 = 0
        firstorbit:
    END IF
    'Here is the Boxes code.
    IF a$ = "b" OR a$ = "B" THEN
        ck3 = ck3 + 1
        IF ck3 > 1 THEN GOTO box:
        xxx3 = mouseX: yyy3 = mouseY
        GOTO firstbox:
        box:
        LINE (mouseX, mouseY)-(xxx3 + 1, yyy3 + 1), clr~&, BF
        xxx3 = 0: yyy3 = 0
        ck3 = 0
        firstbox:
    END IF
    'Here is the Printing of the picture.
    IF a$ = "p" OR a$ = "P" THEN
        IF bcolor$ = "w" OR bcolor$ = "W" THEN
            j& = _COPYIMAGE(0)
            _DELAY .25
            INPUT "Print on printer (Y/N)?", i$ 'print screen page on printer
            CLS
            SCREEN j&
            _DELAY .25
            IF LEFT$(i$, 1) = "y" OR LEFT$(i$, 1) = "Y" THEN
                'printer prep (code copied and pasted from bplus Free Calendar Program)
                YMAX = _HEIGHT: XMAX = _WIDTH
                landscape& = _NEWIMAGE(YMAX, XMAX, 32)
                _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
                _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
                _PRINTIMAGE landscape&
                _DELAY 2
                landscape& = 0
                j& = 0
            END IF
        END IF
    END IF
LOOP
 
'Saving
'This section first saves your picture as temp.bmp and then
'asks you a name for your picture and then renames temp.bmp to your name.
saving:
'Now we call up the SUB to save the image to BMP.
SaveImage 0, "temp.bmp"
_DELAY .25
SCREEN 0
CLS
COLOR 12
PRINT "                       Saving"
PRINT
PRINT "         Your bmp file will be saved in the"
PRINT "         same directory as this program is."
PRINT "         It can be used with almost any"
PRINT "         other graphics program or website."
PRINT "         It is saved using:"
PRINT "         width: 640  height: 480 pixels."
PRINT
PRINT "         Type a name to save your picture"
PRINT "         and press the Enter key. Do not"
PRINT "         add .bmp at the end, the program"
PRINT "         will do it automatically."
PRINT
PRINT "         Also do not use the name temp"
PRINT "         because the program uses that name"
PRINT "         and it would be erased the next time"
PRINT "         you save a picture."
PRINT "         Example: MyPic"
PRINT "         Quit and Enter key ends program."
PRINT
INPUT "         ->"; nm$
IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
nm$ = nm$ + ".bmp"
'Checking to see if the file already exists on your computer.
theFileExists = _FILEEXISTS(nm$)
IF theFileExists = -1 THEN
    PRINT "       File Already Exists"
    PRINT "       Saving will delete your old"
    PRINT "       bmp picture."
    PRINT "       Would you like to still do it?"
    PRINT "      (Y/N). Esc ends program."
    llloop:
    _LIMIT 100
    ag2$ = INKEY$
    IF ag2$ = CHR$(27) THEN END
    IF ag2$ = "" THEN GOTO llloop:
    IF ag2$ = "y" OR ag$ = "Y" THEN
        SHELL _HIDE "DEL " + nm$
        GOTO saving2:
    END IF
    GOTO llloop:
END IF
saving2:
SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
nm$ = ""
FOR snd = 100 TO 700 STEP 100
    SOUND snd, 2
NEXT snd
CLS
GOTO start:
loading: 'This section loads your picture from your computer.
SCREEN 0
CLS
COLOR 12
PRINT "                    Loading"
PRINT
PRINT "         Do not add .bmp at the end."
PRINT "         The bmp picture must be in the same"
PRINT "         directory as this program is."
PRINT "         You will not be able to edit your"
PRINT "         picture file with this program."
PRINT "         Type the name of your picture file"
PRINT "         here and press the Enter key."
PRINT "         Example: MyPic"
PRINT "         Quit and Enter key ends program."
PRINT
INPUT "         ->"; nm$
IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
nm$ = nm$ + ".bmp"
theFileExists = _FILEEXISTS(nm$)
IF theFileExists = 0 THEN
    PRINT "         File Does Not Exist."
    PRINT "         Would you like to try again (Y/N)"
    PRINT "         Esc ends program."
    _LIMIT 100
    llloop2:
    ag$ = INKEY$
    IF ag$ = "" THEN GOTO llloop2:
    IF ag$ = "y" OR ag$ = "Y" THEN GOTO loading:
    IF ag$ = CHR$(27) THEN END
    GOTO start:
END IF
CLS
l = 0
i& = _LOADIMAGE(nm$, 32)
SCREEN i&
FOR snd2 = 100 TO 700 STEP 100
    SOUND snd2, 2
NEXT snd2
s& = i&
i& = 0
SCREEN s&
RETURN
 
'Here is the SUB needed to save the image to BMP.
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 
FUNCTION colorDialog$
 
    'first screen dimensions items to restore at exit
    DIM curRow AS INTEGER, curCol AS INTEGER, autoDisplay AS INTEGER
    DIM sw AS INTEGER, sh AS INTEGER, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG
    DIM curScrn AS LONG, backScrn AS LONG 'some handles
 
    DIM cd AS LONG
    DIM r AS INTEGER, g AS INTEGER, b AS INTEGER, a AS INTEGER, mb AS INTEGER, mx AS INTEGER, my AS INTEGER, i AS INTEGER
    DIM makeConst$, k$
    DIM f AS SINGLE
 
    'save old settings to restore at end ofsub
    curRow = CSRLIN
    curCol = POS(0)
    autoDisplay = _AUTODISPLAY
    sw = _WIDTH
    sh = _HEIGHT
    fg = _DEFAULTCOLOR
    bg = _BACKGROUNDCOLOR
    _KEYCLEAR
    'screen snapshot
    curScrn = _DEST
    backScrn = _NEWIMAGE(sw, sh, 32)
    _PUTIMAGE , curScrn, backScrn
 
    cd = _NEWIMAGE(800, 600, 32)
    SCREEN cd
    r = 128: g = 128: b = 128: a = 128
    COLOR &HFFDDDDDD, 0
    DO
        CLS
        makeConst$ = "&H" + RIGHT$(STRING$(8, "0") + HEX$(_RGBA32(r, g, b, a)), 8)
        slider 16, 10, r, "Red"
        slider 16, 60, g, "Green"
        slider 16, 110, b, "Blue"
        slider 16, 160, a, "Alpha"
        _PRINTSTRING (150, 260), "Press enter or spacebar, if you want to use the color: " + makeConst$
        _PRINTSTRING (210, 280), "Press escape or q, to not use any color, returns 0."
        LINE (90, 300)-(710, 590), , B
        FOR i = 100 TO 700
            f = 255 * (i - 100) / 600
            LINE (i, 310)-STEP(0, 30), _RGB32(f, 0, 0): LINE (i, 310)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 340)-STEP(0, 30), _RGB32(0, f, 0): LINE (i, 340)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 370)-STEP(0, 30), _RGB32(0, 0, f): LINE (i, 370)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 400)-STEP(0, 30), _RGB32(f, f, 0): LINE (i, 400)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 430)-STEP(0, 30), _RGB32(0, f, f): LINE (i, 430)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 460)-STEP(0, 30), _RGB32(f, 0, f): LINE (i, 460)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 490)-STEP(0, 30), _RGB32(f, f, f): LINE (i, 490)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 520)-STEP(0, 30), _RGB32(0, 0, 0): LINE (i, 520)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 550)-STEP(0, 30), _RGB32(255, 255, 255): LINE (i, 550)-STEP(0, 20), VAL(makeConst$)
        NEXT
        WHILE _MOUSEINPUT: WEND
        mb = _MOUSEBUTTON(1)
        IF mb THEN 'clear it
            mx = _MOUSEX: my = _MOUSEY
            IF mx >= 16 AND mx <= 781 THEN
                IF my >= 10 AND my <= 50 THEN
                    r = INT((mx - 16) / 3)
                ELSEIF my >= 60 AND my <= 100 THEN
                    g = INT((mx - 16) / 3)
                ELSEIF my >= 110 AND my <= 150 THEN
                    b = INT((mx - 16) / 3)
                ELSEIF my >= 160 AND my <= 200 THEN
                    a = INT((mx - 16) / 3)
                END IF
            END IF
        END IF
        k$ = INKEY$
        IF LEN(k$) THEN
            IF ASC(k$) = 27 OR k$ = "q" THEN EXIT DO
            IF ASC(k$) = 13 OR k$ = " " THEN colorDialog$ = makeConst$: EXIT DO
        END IF
        _DISPLAY
        _LIMIT 60
    LOOP
 
    'put things back
    SCREEN curScrn
    COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0): CLS
    _PUTIMAGE , backScrn
    _DISPLAY
    COLOR fg, bg
    _FREEIMAGE backScrn
    _FREEIMAGE cd
    IF autoDisplay THEN _AUTODISPLAY
    'clear key presses
    _KEYCLEAR
    'clear mouse clicks
    WHILE _MOUSEINPUT: WEND
    mb = _MOUSEBUTTON(1)
    IF mb THEN 'clear it
        WHILE mb 'OK!
            IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
            _LIMIT 10
        WEND
    END IF
    LOCATE curRow, curCol
 
END FUNCTION
 
SUB slider (x, y, value, label$)
    DIM c~&, s$
    SELECT CASE label$
        CASE "Red": c~& = &HFFFF0000
        CASE "Green": c~& = &HFF008800
        CASE "Blue": c~& = &HFF0000FF
        CASE "Alpha": c~& = &H88FFFFFF
    END SELECT
    LINE (x, y)-STEP(765, 40), c~&, B
    LINE (x, y)-STEP(3 * value, 40), c~&, BF
    s2$ = STR$(value)
    s3$ = LTRIM$(RTRIM$(s2$))
    s$ = label$ + " = " + s3$
    _PRINTSTRING (x + 384 - 4 * LEN(s$), y + 12), s$
END SUB
 

bplus · « **Reply #9 on:** October 07, 2019, 11:26:43 am »

Hi Ken,

Have you realized yet, what we did for Rays we can also do also for Orbit (modeO or Omode) and Boxes (Bmode) when in those modes the first click sets the x1, y1 center for Orbit and the 2nd sets the corner for Box or Orbit Ellipse/Circle to draw.

PLUS!!!! you can _putimage of a snap shot / copy of the main screen at the beginning of a loop as back ground and then as mouse moves around in say the Rmode, you can show a ray from X1, y1 to MouseX, MouseY until user clicks the mouse again which will "set" the ray where mouse is permanently by taking a snapshot of the picture. You build the picture from snapshots at every second click in O or B mode and every click in R mode and every mouse move in No Mode.

SierraKen · « **Reply #10 on:** October 07, 2019, 12:37:50 pm »

Wow B+, I knew there was a way to do this, but I had no idea where to start. I will look into this real soon. That would make circles, boxes, and rays a LOT easier to work with. Thanks, I have to do some things but if I have time I'll get to it later today.

SierraKen · « **Reply #11 on:** October 07, 2019, 05:41:15 pm »

I am SOOO close! But I came to (hopefully) a small snag. I'm using _COPYIMAGE and _PUTIMAGE and whenever the finished image is put on the screen, that you place a ray with using the mouse, the whole screen moves down a couple of pixels. I have no idea why. I've looked the numbers over many times and don't understand why this is happening. Is it a fluke with _FULLSCREEN ? Anyway, please check it out and see if you can help me. I haven't done the orbits or boxes yet except I have put all of them in their own modes now, as you suggested, and they work great with those! I just want to use the mouse with _PUTIMAGE like you said. Thank you. If we can figure this out, then we can figure out the orbits and boxes very easily.
On a side note, I found a problem using the right mouse button to erase, so I fixed that. I think I never finished that part to begin with, so that's good now.
This will be called Paint Pixels 5.

Code: QB64: [Select]

'This program was finished on October 6, 2019.
'Technical Notes:
'This program uses around 55 MB RAM and 1% of the CPU on my semi-new computer.
'Use at your own risk. I hold no responsibility for any problems whatsoever.
'
'Thank you to B+ from the QB64.org forum for the color picker, the picture rotation code and
'the ray line making code!
'-------------------------------------------------------------------------------------------
_LIMIT 100
start:
CLS
SCREEN 0
_FULLSCREEN _OFF
_TITLE "Paint Pixels 5"
WIDTH 40, 43
_FONT 16
COLOR 15, 0
_SCREENMOVE 400, 200
PRINT "        Paint Pixels 5"
PRINT
PRINT "       By Ken G. and B+"
PRINT
PRINT "Use your mouse to paint on a"
PRINT "full screen."
PRINT "You also can make lines: (R)ays,"
PRINT "(O)rbits, and (B)oxes."
PRINT
PRINT "You also can (P)rint to"
PRINT "your USB printer as well as edit"
PRINT "an old picture file."
PRINT "It saves under .bmp files which can"
PRINT "be used with most other programs."
PRINT
PRINT "Press the Space Bar to"
PRINT "skip instructions."
PRINT
PRINT "Press Esc to end."
PRINT "Press any other key to continue."
gggo:
_LIMIT 100
ecc$ = INKEY$
IF ecc$ = " " THEN GOTO start2:
IF ecc$ = CHR$(27) THEN END
IF ecc$ = "" THEN GOTO gggo:
CLS
PRINT "       Instructions"
PRINT
PRINT "* (S)ave (L)oad (I)nstructions"
PRINT "* (R)ay for new line(s)."
PRINT "Press R once to start line,"
PRINT "then use the mouse to where you"
PRINT "want the end of it to be. You can"
PRINT "keep using the mouse and the line"
PRINT "will start where it left off at."
PRINT "Press R again to go back to drawing."
PRINT "* (O)rbit coordinates for circles."
PRINT "Press O once to start circle."
PRINT "and again to finish it."
PRINT "The size of the circle depends"
PRINT "on the length difference"
PRINT "between where you pressed O"
PRINT "both times. The center of the circle"
PRINT "will be the first place you pressed O."
PRINT "The shape of the circle depends on the"
PRINT "angle between your 2 presses. A diagonal"
PRINT "difference between them will show more"
PRINT "of a circle than straight up and down"
PRINT "or side to side between the presses."
PRINT "* (B)oxes are the same way as (O)rbits."
PRINT "* (P)rints the picture on"
PRINT "your printer. It will not work"
PRINT "if you choose a black background"
PRINT "because of heavy ink or toner use."
PRINT "To go around that, choose a white"
PRINT "background and on the color picker"
PRINT "window, choose black and press F"
PRINT "to fill entire window."
PRINT "* Esc to end program."
PRINT "* Space Bar clears the screen."
PRINT "* Left Mouse Button draws."
PRINT "* Right Mouse Button erases."
PRINT "- There is no Undo feature."
PRINT
PRINT "Press Esc to end."
PRINT "Press any other key to continue."
ggggo:
_LIMIT 100
ecc2$ = INKEY$
IF ecc2$ = CHR$(27) THEN END
IF ecc2$ = "" THEN GOTO ggggo:
CLS
PRINT "    Instructions Page 2"
PRINT
PRINT "(C)olor changes colors."
PRINT "A window will come up to use"
PRINT "your mouse to choose a color."
PRINT "* This will also happen when you"
PRINT "  first start your painting."
PRINT
PRINT "(B)oxes makes a filled box."
PRINT "First press B once to start the"
PRINT "box corner, then press B again"
PRINT "to set the 2nd corner and size"
PRINT "diagonally from the first one."
PRINT
PRINT "Paint slowly to leave out gaps."
PRINT
PRINT "When you press S to save,"
PRINT "the program will create a temp.bmp"
PRINT "of the screen and when asking you"
PRINT "for a file name, it will rename temp.bmp"
PRINT "to your chosen name."
PRINT
PRINT "Press Esc to end program."
PRINT "Press any other key to start."
gggggo:
_LIMIT 1000
s$ = INKEY$
IF s$ = "" THEN GOTO gggggo:
IF s$ = CHR$(27) THEN END
start2:
CLS
begin = 1
PRINT "Background Color"
PRINT
PRINT "(B)lack (W)hite"
PRINT
PRINT "Or Esc to end program."
start3:
_LIMIT 1000
bcolor$ = INKEY$
IF bcolor$ = CHR$(27) THEN END
IF bcolor$ = "" THEN GOTO start3:
IF bcolor$ = "w" OR bcolor$ = "W" THEN
    _FULLSCREEN
    s& = _NEWIMAGE(640, 480, 32)
    bcol = 1
    SCREEN s&
    LINE (0, 0)-(640, 480), _RGB(255, 255, 255), BF
    GOTO more2:
END IF
IF bcolor$ = "B" OR bcolor$ = "b" THEN
    _FULLSCREEN
    s& = _NEWIMAGE(640, 480, 32)
    bcol = 2
    SCREEN s&
    CLS
    GOTO more2:
END IF
GOTO start3:
more2:
begin = 1
GOSUB chosencolor:
'---------------------------------------------------
'Here is the main loop of the program when painting.
'---------------------------------------------------
DO
    _LIMIT 1000
    DO WHILE _MOUSEINPUT
        mouseX = _MOUSEX
        mouseY = _MOUSEY
        mouseLeftButton = _MOUSEBUTTON(1)
        mouseRightButton = _MOUSEBUTTON(2)
        mouseMiddleButton = _MOUSEBUTTON(3)
    LOOP
    IF mouseLeftButton = -1 THEN
        LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), clr~&, BF
    END IF
    IF mouseRightButton = -1 AND bcol = 1 THEN
        LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), _RGB32(255, 255, 255), BF
    END IF
    IF mouseRightButton = -1 AND bcol = 2 THEN
        LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), _RGB32(0, 0, 0), BF
    END IF
    a$ = INKEY$
    'Here is when someone whipes the screen blank with the space bar.
    IF a$ = " " THEN GOTO start2:
    IF a$ = CHR$(27) THEN END
    IF a$ = "s" OR a$ = "S" THEN GOTO saving:
    IF a$ = "l" OR a$ = "L" THEN GOSUB loading:
    IF a$ = "i" OR a$ = "I" THEN GOTO start:
    'Here is code needed to call up the Windows Color Picker.
    'It also uses the code on top of this program and the Function at the end
    'of this program.
    IF a$ = "c" OR a$ = "C" THEN
        chosencolor:
        check$ = colorDialog$
        IF check$ <> "" THEN clr~& = VAL(check$) ELSE clr~& = &HFF0000FF '<<< I am blue if colorDialog does not work
        IF begin = 1 THEN begin = 0: RETURN
    END IF
    'Here is the Ray Lines code.
    IF a$ = "r" OR a$ = "R" THEN
        rMode = 1 - rMode
        IF rMode THEN
            lastx = mouseX: lastY = mouseY 'set first lastx, lasty
            j& = _COPYIMAGE(0)
        END IF
    END IF
    IF rMode AND mouseLeftButton <> -1 THEN LINE (lastx, lastY)-(mouseX, mouseY), clr~&: _PUTIMAGE (0, 0)-(640, 480), j&
    IF rMode AND mouseLeftButton = -1 THEN LINE (lastx, lastY)-(mouseX, mouseY), clr~&: j& = _COPYIMAGE(0): _PUTIMAGE (0, 0)-(640, 480), j&: rMode = 1 - rMode
    'Here is the Orbit Circles code.
    IF a$ = "o" OR a$ = "O" THEN
        oMode = 1 - oMode
        IF oMode THEN lastx = mouseX: lastY = mouseY
    END IF
    IF oMode AND mouseLeftButton THEN
        IF mouseX < lastx THEN size = lastx - mouseX
        IF mouseX > lastx THEN size = mouseX - lastx
        IF mouseY < lastY THEN size2 = lastY - mouseY
        IF mouseY > lastY THEN size2 = mouseY - lastY
        one:
        seconds = seconds + .01
        s = (60 - seconds) * 6 + size
        x = INT(SIN(s / 180 * 3.141592) * size) + lastx
        y = INT(COS(s / 180 * 3.141592) * size2) + lastY
        CIRCLE (x, y), 1, clr~&
        IF seconds > 60 THEN
            seconds = 0
            GOTO two:
        END IF
        GOTO one:
        two:
        size = 0: size2 = 0
    END IF
    'Here is the Boxes code.
    IF a$ = "b" OR a$ = "B" THEN
        bMode = 1 - bMode
        IF bMode THEN lastx = mouseX: lastY = mouseY 'set first lastx, lasty
    END IF
    IF bMode AND mouseLeftButton THEN LINE (lastx, lastY)-(mouseX, mouseY), clr~&, BF: lastx = mouseX: lastY = mouseY
    'Here is the Printing of the picture.
    IF a$ = "p" OR a$ = "P" THEN
        IF bcolor$ = "w" OR bcolor$ = "W" THEN
            j& = _COPYIMAGE(0)
            _DELAY .25
            INPUT "Print on printer (Y/N)?", i$ 'print screen page on printer
            CLS
            SCREEN j&
            _DELAY .25
            IF LEFT$(i$, 1) = "y" OR LEFT$(i$, 1) = "Y" THEN
                'printer prep (code copied and pasted from bplus Free Calendar Program)
                YMAX = _HEIGHT: XMAX = _WIDTH
                landscape& = _NEWIMAGE(YMAX, XMAX, 32)
                _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
                _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
                _PRINTIMAGE landscape&
                _DELAY 2
                landscape& = 0
                j& = 0
            END IF
        END IF
    END IF
LOOP
 
'Saving
'This section first saves your picture as temp.bmp and then
'asks you a name for your picture and then renames temp.bmp to your name.
saving:
'Now we call up the SUB to save the image to BMP.
SaveImage 0, "temp.bmp"
_DELAY .25
SCREEN 0
CLS
COLOR 12
PRINT "                       Saving"
PRINT
PRINT "         Your bmp file will be saved in the"
PRINT "         same directory as this program is."
PRINT "         It can be used with almost any"
PRINT "         other graphics program or website."
PRINT "         It is saved using:"
PRINT "         width: 640  height: 480 pixels."
PRINT
PRINT "         Type a name to save your picture"
PRINT "         and press the Enter key. Do not"
PRINT "         add .bmp at the end, the program"
PRINT "         will do it automatically."
PRINT
PRINT "         Also do not use the name temp"
PRINT "         because the program uses that name"
PRINT "         and it would be erased the next time"
PRINT "         you save a picture."
PRINT "         Example: MyPic"
PRINT "         Quit and Enter key ends program."
PRINT
INPUT "         ->"; nm$
IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
nm$ = nm$ + ".bmp"
'Checking to see if the file already exists on your computer.
theFileExists = _FILEEXISTS(nm$)
IF theFileExists = -1 THEN
    PRINT "       File Already Exists"
    PRINT "       Saving will delete your old"
    PRINT "       bmp picture."
    PRINT "       Would you like to still do it?"
    PRINT "      (Y/N). Esc ends program."
    llloop:
    _LIMIT 100
    ag2$ = INKEY$
    IF ag2$ = CHR$(27) THEN END
    IF ag2$ = "" THEN GOTO llloop:
    IF ag2$ = "y" OR ag$ = "Y" THEN
        SHELL _HIDE "DEL " + nm$
        GOTO saving2:
    END IF
    GOTO llloop:
END IF
saving2:
SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
nm$ = ""
FOR snd = 100 TO 700 STEP 100
    SOUND snd, 2
NEXT snd
CLS
GOTO start:
loading: 'This section loads your picture from your computer.
SCREEN 0
CLS
COLOR 12
PRINT "                    Loading"
PRINT
PRINT "         Do not add .bmp at the end."
PRINT "         The bmp picture must be in the same"
PRINT "         directory as this program is."
PRINT "         You will not be able to edit your"
PRINT "         picture file with this program."
PRINT "         Type the name of your picture file"
PRINT "         here and press the Enter key."
PRINT "         Example: MyPic"
PRINT "         Quit and Enter key ends program."
PRINT
INPUT "         ->"; nm$
IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
nm$ = nm$ + ".bmp"
theFileExists = _FILEEXISTS(nm$)
IF theFileExists = 0 THEN
    PRINT "         File Does Not Exist."
    PRINT "         Would you like to try again (Y/N)"
    PRINT "         Esc ends program."
    _LIMIT 100
    llloop2:
    ag$ = INKEY$
    IF ag$ = "" THEN GOTO llloop2:
    IF ag$ = "y" OR ag$ = "Y" THEN GOTO loading:
    IF ag$ = CHR$(27) THEN END
    GOTO start:
END IF
CLS
l = 0
i& = _LOADIMAGE(nm$, 32)
SCREEN i&
FOR snd2 = 100 TO 700 STEP 100
    SOUND snd2, 2
NEXT snd2
s& = i&
i& = 0
SCREEN s&
RETURN
 
'Here is the SUB needed to save the image to BMP.
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 
FUNCTION colorDialog$
 
    'first screen dimensions items to restore at exit
    DIM curRow AS INTEGER, curCol AS INTEGER, autoDisplay AS INTEGER
    DIM sw AS INTEGER, sh AS INTEGER, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG
    DIM curScrn AS LONG, backScrn AS LONG 'some handles
 
    DIM cd AS LONG
    DIM r AS INTEGER, g AS INTEGER, b AS INTEGER, a AS INTEGER, mb AS INTEGER, mx AS INTEGER, my AS INTEGER, i AS INTEGER
    DIM makeConst$, k$
    DIM f AS SINGLE
 
    'save old settings to restore at end ofsub
    curRow = CSRLIN
    curCol = POS(0)
    autoDisplay = _AUTODISPLAY
    sw = _WIDTH
    sh = _HEIGHT
    fg = _DEFAULTCOLOR
    bg = _BACKGROUNDCOLOR
    _KEYCLEAR
    'screen snapshot
    curScrn = _DEST
    backScrn = _NEWIMAGE(sw, sh, 32)
    _PUTIMAGE , curScrn, backScrn
 
    cd = _NEWIMAGE(800, 600, 32)
    SCREEN cd
    r = 128: g = 128: b = 128: a = 128
    COLOR &HFFDDDDDD, 0
    DO
        CLS
        makeConst$ = "&H" + RIGHT$(STRING$(8, "0") + HEX$(_RGBA32(r, g, b, a)), 8)
        slider 16, 10, r, "Red"
        slider 16, 60, g, "Green"
        slider 16, 110, b, "Blue"
        slider 16, 160, a, "Alpha"
        _PRINTSTRING (150, 260), "Press enter or spacebar, if you want to use the color: " + makeConst$
        _PRINTSTRING (210, 280), "Press escape or q, to not use any color, returns 0."
        LINE (90, 300)-(710, 590), , B
        FOR i = 100 TO 700
            f = 255 * (i - 100) / 600
            LINE (i, 310)-STEP(0, 30), _RGB32(f, 0, 0): LINE (i, 310)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 340)-STEP(0, 30), _RGB32(0, f, 0): LINE (i, 340)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 370)-STEP(0, 30), _RGB32(0, 0, f): LINE (i, 370)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 400)-STEP(0, 30), _RGB32(f, f, 0): LINE (i, 400)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 430)-STEP(0, 30), _RGB32(0, f, f): LINE (i, 430)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 460)-STEP(0, 30), _RGB32(f, 0, f): LINE (i, 460)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 490)-STEP(0, 30), _RGB32(f, f, f): LINE (i, 490)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 520)-STEP(0, 30), _RGB32(0, 0, 0): LINE (i, 520)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 550)-STEP(0, 30), _RGB32(255, 255, 255): LINE (i, 550)-STEP(0, 20), VAL(makeConst$)
        NEXT
        WHILE _MOUSEINPUT: WEND
        mb = _MOUSEBUTTON(1)
        IF mb THEN 'clear it
            mx = _MOUSEX: my = _MOUSEY
            IF mx >= 16 AND mx <= 781 THEN
                IF my >= 10 AND my <= 50 THEN
                    r = INT((mx - 16) / 3)
                ELSEIF my >= 60 AND my <= 100 THEN
                    g = INT((mx - 16) / 3)
                ELSEIF my >= 110 AND my <= 150 THEN
                    b = INT((mx - 16) / 3)
                ELSEIF my >= 160 AND my <= 200 THEN
                    a = INT((mx - 16) / 3)
                END IF
            END IF
        END IF
        k$ = INKEY$
        IF LEN(k$) THEN
            IF ASC(k$) = 27 OR k$ = "q" THEN EXIT DO
            IF ASC(k$) = 13 OR k$ = " " THEN colorDialog$ = makeConst$: EXIT DO
        END IF
        _DISPLAY
        _LIMIT 60
    LOOP
 
    'put things back
    SCREEN curScrn
    COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0): CLS
    _PUTIMAGE , backScrn
    _DISPLAY
    COLOR fg, bg
    _FREEIMAGE backScrn
    _FREEIMAGE cd
    IF autoDisplay THEN _AUTODISPLAY
    'clear key presses
    _KEYCLEAR
    'clear mouse clicks
    WHILE _MOUSEINPUT: WEND
    mb = _MOUSEBUTTON(1)
    IF mb THEN 'clear it
        WHILE mb 'OK!
            IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
            _LIMIT 10
        WEND
    END IF
    LOCATE curRow, curCol
 
END FUNCTION
 
SUB slider (x, y, value, label$)
    DIM c~&, s$
    SELECT CASE label$
        CASE "Red": c~& = &HFFFF0000
        CASE "Green": c~& = &HFF008800
        CASE "Blue": c~& = &HFF0000FF
        CASE "Alpha": c~& = &H88FFFFFF
    END SELECT
    LINE (x, y)-STEP(765, 40), c~&, B
    LINE (x, y)-STEP(3 * value, 40), c~&, BF
    s2$ = STR$(value)
    s3$ = LTRIM$(RTRIM$(s2$))
    s$ = label$ + " = " + s3$
    _PRINTSTRING (x + 384 - 4 * LEN(s$), y + 12), s$
END SUB
 

SierraKen · « **Reply #12 on:** October 07, 2019, 06:01:33 pm »

I removed a COPYIMAGE and a PUTIMAGE since they were not needed, but it still does the same thing, pushing the bottom part of the screen down a few pixels every time I press R.

Code: QB64: [Select]

'This program was finished on October 6, 2019.
'Technical Notes:
'This program uses around 55 MB RAM and 1% of the CPU on my semi-new computer.
'Use at your own risk. I hold no responsibility for any problems whatsoever.
'
'Thank you to B+ from the QB64.org forum for the color picker, the picture rotation code and
'the ray line making code!
'-------------------------------------------------------------------------------------------
_LIMIT 100
start:
CLS
SCREEN 0
_FULLSCREEN _OFF
_TITLE "Paint Pixels 5"
WIDTH 40, 43
_FONT 16
COLOR 15, 0
_SCREENMOVE 400, 200
PRINT "        Paint Pixels 5"
PRINT
PRINT "       By Ken G. and B+"
PRINT
PRINT "Use your mouse to paint on a"
PRINT "full screen."
PRINT "You also can make lines: (R)ays,"
PRINT "(O)rbits, and (B)oxes."
PRINT
PRINT "You also can (P)rint to"
PRINT "your USB printer as well as edit"
PRINT "an old picture file."
PRINT "It saves under .bmp files which can"
PRINT "be used with most other programs."
PRINT
PRINT "Press the Space Bar to"
PRINT "skip instructions."
PRINT
PRINT "Press Esc to end."
PRINT "Press any other key to continue."
gggo:
_LIMIT 100
ecc$ = INKEY$
IF ecc$ = " " THEN GOTO start2:
IF ecc$ = CHR$(27) THEN END
IF ecc$ = "" THEN GOTO gggo:
CLS
PRINT "       Instructions"
PRINT
PRINT "* (S)ave (L)oad (I)nstructions"
PRINT "* (R)ay for new line(s)."
PRINT "Press R once to start line,"
PRINT "then use the mouse to where you"
PRINT "want the end of it to be. You can"
PRINT "keep using the mouse and the line"
PRINT "will start where it left off at."
PRINT "Press R again to go back to drawing."
PRINT "* (O)rbit coordinates for circles."
PRINT "Press O once to start circle."
PRINT "and again to finish it."
PRINT "The size of the circle depends"
PRINT "on the length difference"
PRINT "between where you pressed O"
PRINT "both times. The center of the circle"
PRINT "will be the first place you pressed O."
PRINT "The shape of the circle depends on the"
PRINT "angle between your 2 presses. A diagonal"
PRINT "difference between them will show more"
PRINT "of a circle than straight up and down"
PRINT "or side to side between the presses."
PRINT "* (B)oxes are the same way as (O)rbits."
PRINT "* (P)rints the picture on"
PRINT "your printer. It will not work"
PRINT "if you choose a black background"
PRINT "because of heavy ink or toner use."
PRINT "To go around that, choose a white"
PRINT "background and on the color picker"
PRINT "window, choose black and press F"
PRINT "to fill entire window."
PRINT "* Esc to end program."
PRINT "* Space Bar clears the screen."
PRINT "* Left Mouse Button draws."
PRINT "* Right Mouse Button erases."
PRINT "- There is no Undo feature."
PRINT
PRINT "Press Esc to end."
PRINT "Press any other key to continue."
ggggo:
_LIMIT 100
ecc2$ = INKEY$
IF ecc2$ = CHR$(27) THEN END
IF ecc2$ = "" THEN GOTO ggggo:
CLS
PRINT "    Instructions Page 2"
PRINT
PRINT "(C)olor changes colors."
PRINT "A window will come up to use"
PRINT "your mouse to choose a color."
PRINT "* This will also happen when you"
PRINT "  first start your painting."
PRINT
PRINT "(B)oxes makes a filled box."
PRINT "First press B once to start the"
PRINT "box corner, then press B again"
PRINT "to set the 2nd corner and size"
PRINT "diagonally from the first one."
PRINT
PRINT "Paint slowly to leave out gaps."
PRINT
PRINT "When you press S to save,"
PRINT "the program will create a temp.bmp"
PRINT "of the screen and when asking you"
PRINT "for a file name, it will rename temp.bmp"
PRINT "to your chosen name."
PRINT
PRINT "Press Esc to end program."
PRINT "Press any other key to start."
gggggo:
_LIMIT 1000
s$ = INKEY$
IF s$ = "" THEN GOTO gggggo:
IF s$ = CHR$(27) THEN END
start2:
CLS
begin = 1
PRINT "Background Color"
PRINT
PRINT "(B)lack (W)hite"
PRINT
PRINT "Or Esc to end program."
start3:
_LIMIT 1000
bcolor$ = INKEY$
IF bcolor$ = CHR$(27) THEN END
IF bcolor$ = "" THEN GOTO start3:
IF bcolor$ = "w" OR bcolor$ = "W" THEN
    _FULLSCREEN
    s& = _NEWIMAGE(640, 480, 32)
    bcol = 1
    SCREEN s&
    LINE (0, 0)-(640, 480), _RGB(255, 255, 255), BF
    GOTO more2:
END IF
IF bcolor$ = "B" OR bcolor$ = "b" THEN
    _FULLSCREEN
    s& = _NEWIMAGE(640, 480, 32)
    bcol = 2
    SCREEN s&
    CLS
    GOTO more2:
END IF
GOTO start3:
more2:
begin = 1
GOSUB chosencolor:
'---------------------------------------------------
'Here is the main loop of the program when painting.
'---------------------------------------------------
DO
    _LIMIT 1000
    DO WHILE _MOUSEINPUT
        mouseX = _MOUSEX
        mouseY = _MOUSEY
        mouseLeftButton = _MOUSEBUTTON(1)
        mouseRightButton = _MOUSEBUTTON(2)
        mouseMiddleButton = _MOUSEBUTTON(3)
    LOOP
    IF mouseLeftButton = -1 THEN
        LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), clr~&, BF
    END IF
    IF mouseRightButton = -1 AND bcol = 1 THEN
        LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), _RGB32(255, 255, 255), BF
    END IF
    IF mouseRightButton = -1 AND bcol = 2 THEN
        LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), _RGB32(0, 0, 0), BF
    END IF
    a$ = INKEY$
    'Here is when someone whipes the screen blank with the space bar.
    IF a$ = " " THEN GOTO start2:
    IF a$ = CHR$(27) THEN END
    IF a$ = "s" OR a$ = "S" THEN GOTO saving:
    IF a$ = "l" OR a$ = "L" THEN GOSUB loading:
    IF a$ = "i" OR a$ = "I" THEN GOTO start:
    'Here is code needed to call up the Windows Color Picker.
    'It also uses the code on top of this program and the Function at the end
    'of this program.
    IF a$ = "c" OR a$ = "C" THEN
        chosencolor:
        check$ = colorDialog$
        IF check$ <> "" THEN clr~& = VAL(check$) ELSE clr~& = &HFF0000FF '<<< I am blue if colorDialog does not work
        IF begin = 1 THEN begin = 0: RETURN
    END IF
    'Here is the Ray Lines code.
    IF a$ = "r" OR a$ = "R" THEN
        rMode = 1 - rMode
        IF rMode THEN
            lastx = mouseX: lastY = mouseY 'set first lastx, lasty
            j& = _COPYIMAGE(0)
        END IF
    END IF
    IF rMode AND mouseLeftButton <> -1 THEN LINE (lastx, lastY)-(mouseX, mouseY), clr~&: _PUTIMAGE (0, 0)-(640, 480), j&
    IF rMode AND mouseLeftButton = -1 THEN LINE (lastx, lastY)-(mouseX, mouseY), clr~&: rMode = 1 - rMode
    'Here is the Orbit Circles code.
    IF a$ = "o" OR a$ = "O" THEN
        oMode = 1 - oMode
        IF oMode THEN lastx = mouseX: lastY = mouseY
    END IF
    IF oMode AND mouseLeftButton THEN
        IF mouseX < lastx THEN size = lastx - mouseX
        IF mouseX > lastx THEN size = mouseX - lastx
        IF mouseY < lastY THEN size2 = lastY - mouseY
        IF mouseY > lastY THEN size2 = mouseY - lastY
        one:
        seconds = seconds + .01
        s = (60 - seconds) * 6 + size
        x = INT(SIN(s / 180 * 3.141592) * size) + lastx
        y = INT(COS(s / 180 * 3.141592) * size2) + lastY
        CIRCLE (x, y), 1, clr~&
        IF seconds > 60 THEN
            seconds = 0
            GOTO two:
        END IF
        GOTO one:
        two:
        size = 0: size2 = 0
    END IF
    'Here is the Boxes code.
    IF a$ = "b" OR a$ = "B" THEN
        bMode = 1 - bMode
        IF bMode THEN lastx = mouseX: lastY = mouseY 'set first lastx, lasty
    END IF
    IF bMode AND mouseLeftButton THEN LINE (lastx, lastY)-(mouseX, mouseY), clr~&, BF: lastx = mouseX: lastY = mouseY
    'Here is the Printing of the picture.
    IF a$ = "p" OR a$ = "P" THEN
        IF bcolor$ = "w" OR bcolor$ = "W" THEN
            j& = _COPYIMAGE(0)
            _DELAY .25
            INPUT "Print on printer (Y/N)?", i$ 'print screen page on printer
            CLS
            SCREEN j&
            _DELAY .25
            IF LEFT$(i$, 1) = "y" OR LEFT$(i$, 1) = "Y" THEN
                'printer prep (code copied and pasted from bplus Free Calendar Program)
                YMAX = _HEIGHT: XMAX = _WIDTH
                landscape& = _NEWIMAGE(YMAX, XMAX, 32)
                _MAPTRIANGLE (XMAX, 0)-(0, 0)-(0, YMAX), 0 TO(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
                _MAPTRIANGLE (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 TO(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
                _PRINTIMAGE landscape&
                _DELAY 2
                landscape& = 0
                j& = 0
            END IF
        END IF
    END IF
LOOP
 
'Saving
'This section first saves your picture as temp.bmp and then
'asks you a name for your picture and then renames temp.bmp to your name.
saving:
'Now we call up the SUB to save the image to BMP.
SaveImage 0, "temp.bmp"
_DELAY .25
SCREEN 0
CLS
COLOR 12
PRINT "                       Saving"
PRINT
PRINT "         Your bmp file will be saved in the"
PRINT "         same directory as this program is."
PRINT "         It can be used with almost any"
PRINT "         other graphics program or website."
PRINT "         It is saved using:"
PRINT "         width: 640  height: 480 pixels."
PRINT
PRINT "         Type a name to save your picture"
PRINT "         and press the Enter key. Do not"
PRINT "         add .bmp at the end, the program"
PRINT "         will do it automatically."
PRINT
PRINT "         Also do not use the name temp"
PRINT "         because the program uses that name"
PRINT "         and it would be erased the next time"
PRINT "         you save a picture."
PRINT "         Example: MyPic"
PRINT "         Quit and Enter key ends program."
PRINT
INPUT "         ->"; nm$
IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
nm$ = nm$ + ".bmp"
'Checking to see if the file already exists on your computer.
theFileExists = _FILEEXISTS(nm$)
IF theFileExists = -1 THEN
    PRINT "       File Already Exists"
    PRINT "       Saving will delete your old"
    PRINT "       bmp picture."
    PRINT "       Would you like to still do it?"
    PRINT "      (Y/N). Esc ends program."
    llloop:
    _LIMIT 100
    ag2$ = INKEY$
    IF ag2$ = CHR$(27) THEN END
    IF ag2$ = "" THEN GOTO llloop:
    IF ag2$ = "y" OR ag$ = "Y" THEN
        SHELL _HIDE "DEL " + nm$
        GOTO saving2:
    END IF
    GOTO llloop:
END IF
saving2:
SHELL _HIDE "REN " + "temp.bmp" + " " + nm$
nm$ = ""
FOR snd = 100 TO 700 STEP 100
    SOUND snd, 2
NEXT snd
CLS
GOTO start:
loading: 'This section loads your picture from your computer.
SCREEN 0
CLS
COLOR 12
PRINT "                    Loading"
PRINT
PRINT "         Do not add .bmp at the end."
PRINT "         The bmp picture must be in the same"
PRINT "         directory as this program is."
PRINT "         You will not be able to edit your"
PRINT "         picture file with this program."
PRINT "         Type the name of your picture file"
PRINT "         here and press the Enter key."
PRINT "         Example: MyPic"
PRINT "         Quit and Enter key ends program."
PRINT
INPUT "         ->"; nm$
IF nm$ = "Quit" OR nm$ = "quit" OR nm$ = "QUIT" THEN END
nm$ = nm$ + ".bmp"
theFileExists = _FILEEXISTS(nm$)
IF theFileExists = 0 THEN
    PRINT "         File Does Not Exist."
    PRINT "         Would you like to try again (Y/N)"
    PRINT "         Esc ends program."
    _LIMIT 100
    llloop2:
    ag$ = INKEY$
    IF ag$ = "" THEN GOTO llloop2:
    IF ag$ = "y" OR ag$ = "Y" THEN GOTO loading:
    IF ag$ = CHR$(27) THEN END
    GOTO start:
END IF
CLS
l = 0
i& = _LOADIMAGE(nm$, 32)
SCREEN i&
FOR snd2 = 100 TO 700 STEP 100
    SOUND snd2, 2
NEXT snd2
s& = i&
i& = 0
SCREEN s&
RETURN
 
'Here is the SUB needed to save the image to BMP.
SUB SaveImage (image AS LONG, filename AS STRING)
    bytesperpixel& = _PIXELSIZE(image&)
    IF bytesperpixel& = 0 THEN PRINT "Text modes unsupported!": END
    IF bytesperpixel& = 1 THEN bpp& = 8 ELSE bpp& = 24
    x& = _WIDTH(image&)
    y& = _HEIGHT(image&)
    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)
    IF bytesperpixel& = 1 THEN
        FOR c& = 0 TO 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
            cv& = _PALETTECOLOR(c&, image&) ' color attribute to read.
            b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
        NEXT
    END IF
    MID$(b$, 11, 4) = MKL$(LEN(b$)) ' image pixel data offset(BMP header)
    lastsource& = _SOURCE
    _SOURCE image&
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = y& - 1 TO 0 STEP -1 ' read JPG image pixel color data
        r$ = ""
        FOR px& = 0 TO x& - 1
            c& = POINT(px&, py&) 'POINT 32 bit values are large LONG values
            IF bytesperpixel& = 1 THEN r$ = r$ + CHR$(c&) ELSE r$ = r$ + LEFT$(MKL$(c&), 3)
        NEXT px&
        d$ = d$ + r$ + padder$
    NEXT py&
    _SOURCE lastsource&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) ' image size(BMP header)
    b$ = b$ + d$ ' total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) ' size of data file(BMP header)
    IF LCASE$(RIGHT$(filename$, 4)) <> ".bmp" THEN ext$ = ".bmp"
    f& = FREEFILE
    OPEN filename$ + ext$ FOR OUTPUT AS #f&: CLOSE #f& ' erases an existing file
    OPEN filename$ + ext$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
END SUB
 
FUNCTION colorDialog$
 
    'first screen dimensions items to restore at exit
    DIM curRow AS INTEGER, curCol AS INTEGER, autoDisplay AS INTEGER
    DIM sw AS INTEGER, sh AS INTEGER, fg AS _UNSIGNED LONG, bg AS _UNSIGNED LONG
    DIM curScrn AS LONG, backScrn AS LONG 'some handles
 
    DIM cd AS LONG
    DIM r AS INTEGER, g AS INTEGER, b AS INTEGER, a AS INTEGER, mb AS INTEGER, mx AS INTEGER, my AS INTEGER, i AS INTEGER
    DIM makeConst$, k$
    DIM f AS SINGLE
 
    'save old settings to restore at end ofsub
    curRow = CSRLIN
    curCol = POS(0)
    autoDisplay = _AUTODISPLAY
    sw = _WIDTH
    sh = _HEIGHT
    fg = _DEFAULTCOLOR
    bg = _BACKGROUNDCOLOR
    _KEYCLEAR
    'screen snapshot
    curScrn = _DEST
    backScrn = _NEWIMAGE(sw, sh, 32)
    _PUTIMAGE , curScrn, backScrn
 
    cd = _NEWIMAGE(800, 600, 32)
    SCREEN cd
    r = 128: g = 128: b = 128: a = 128
    COLOR &HFFDDDDDD, 0
    DO
        CLS
        makeConst$ = "&H" + RIGHT$(STRING$(8, "0") + HEX$(_RGBA32(r, g, b, a)), 8)
        slider 16, 10, r, "Red"
        slider 16, 60, g, "Green"
        slider 16, 110, b, "Blue"
        slider 16, 160, a, "Alpha"
        _PRINTSTRING (150, 260), "Press enter or spacebar, if you want to use the color: " + makeConst$
        _PRINTSTRING (210, 280), "Press escape or q, to not use any color, returns 0."
        LINE (90, 300)-(710, 590), , B
        FOR i = 100 TO 700
            f = 255 * (i - 100) / 600
            LINE (i, 310)-STEP(0, 30), _RGB32(f, 0, 0): LINE (i, 310)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 340)-STEP(0, 30), _RGB32(0, f, 0): LINE (i, 340)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 370)-STEP(0, 30), _RGB32(0, 0, f): LINE (i, 370)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 400)-STEP(0, 30), _RGB32(f, f, 0): LINE (i, 400)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 430)-STEP(0, 30), _RGB32(0, f, f): LINE (i, 430)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 460)-STEP(0, 30), _RGB32(f, 0, f): LINE (i, 460)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 490)-STEP(0, 30), _RGB32(f, f, f): LINE (i, 490)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 520)-STEP(0, 30), _RGB32(0, 0, 0): LINE (i, 520)-STEP(0, 20), VAL(makeConst$)
            LINE (i, 550)-STEP(0, 30), _RGB32(255, 255, 255): LINE (i, 550)-STEP(0, 20), VAL(makeConst$)
        NEXT
        WHILE _MOUSEINPUT: WEND
        mb = _MOUSEBUTTON(1)
        IF mb THEN 'clear it
            mx = _MOUSEX: my = _MOUSEY
            IF mx >= 16 AND mx <= 781 THEN
                IF my >= 10 AND my <= 50 THEN
                    r = INT((mx - 16) / 3)
                ELSEIF my >= 60 AND my <= 100 THEN
                    g = INT((mx - 16) / 3)
                ELSEIF my >= 110 AND my <= 150 THEN
                    b = INT((mx - 16) / 3)
                ELSEIF my >= 160 AND my <= 200 THEN
                    a = INT((mx - 16) / 3)
                END IF
            END IF
        END IF
        k$ = INKEY$
        IF LEN(k$) THEN
            IF ASC(k$) = 27 OR k$ = "q" THEN EXIT DO
            IF ASC(k$) = 13 OR k$ = " " THEN colorDialog$ = makeConst$: EXIT DO
        END IF
        _DISPLAY
        _LIMIT 60
    LOOP
 
    'put things back
    SCREEN curScrn
    COLOR _RGB32(255, 255, 255), _RGB32(0, 0, 0): CLS
    _PUTIMAGE , backScrn
    _DISPLAY
    COLOR fg, bg
    _FREEIMAGE backScrn
    _FREEIMAGE cd
    IF autoDisplay THEN _AUTODISPLAY
    'clear key presses
    _KEYCLEAR
    'clear mouse clicks
    WHILE _MOUSEINPUT: WEND
    mb = _MOUSEBUTTON(1)
    IF mb THEN 'clear it
        WHILE mb 'OK!
            IF _MOUSEINPUT THEN mb = _MOUSEBUTTON(1)
            _LIMIT 10
        WEND
    END IF
    LOCATE curRow, curCol
 
END FUNCTION
 
SUB slider (x, y, value, label$)
    DIM c~&, s$
    SELECT CASE label$
        CASE "Red": c~& = &HFFFF0000
        CASE "Green": c~& = &HFF008800
        CASE "Blue": c~& = &HFF0000FF
        CASE "Alpha": c~& = &H88FFFFFF
    END SELECT
    LINE (x, y)-STEP(765, 40), c~&, B
    LINE (x, y)-STEP(3 * value, 40), c~&, BF
    s2$ = STR$(value)
    s3$ = LTRIM$(RTRIM$(s2$))
    s$ = label$ + " = " + s3$
    _PRINTSTRING (x + 384 - 4 * LEN(s$), y + 12), s$
END SUB
 
 

bplus · « **Reply #13 on:** October 07, 2019, 07:19:49 pm »

Hi Ken,

I don't think I want to wade through all your goto's :P

But on line 196 I see a CopyImage statement, that I thought you removed?

This is in the wrong place anyway. A snapshot of the screen should be after drawing a line with the end point clicked in.

Before then you are drawing lines from first click to mouse position but NOT saving the screen image.

To save a screen image, I prefer this method:
1. set up a new handle say picture&
picture& = _newimage(numbers same as screen setup) 'this is your storage container

when the 2nd point is clicked in for Ray:

_putimage , 0, picture& 'source to destination = screen to container

then at beginning of next drawing loop erase old screen by placing the image in picture& contain to screen:
_putimage , picture& , 0 ' container to screen 'always right after the start of loop

Code: QB64: [Select]

'Here is the Ray Lines code.
    IF a$ = "r" OR a$ = "R" THEN
        rMode = 1 - rMode
        IF rMode THEN
            lastx = mouseX: lastY = mouseY 'set first lastx, lasty
            ''''''''''''''''''''''''''''''j& = _COPYIMAGE(0)
        END IF
    END IF
 
    IF rMode THEN 
        LINE (lastx, lastY)-(mouseX, mouseY), clr~&
        '_display 'if you are using it
        if mouseLeftButton = -1 then _putimage , 0, picture&
    end if
 
 

SierraKen · « **Reply #14 on:** October 07, 2019, 08:04:36 pm »

Interesting. I think I just tried your code but when I move the mouse without pressing the mouse button, it just makes a bunch of lines without animating the line first before you place it. This is what I have so far for this section. I'm not sure if I have the _NEWIMAGE code in the right place either.

Edit: See, I was using the _PUTIMAGE to put the entire screen back to where it was when you moved the line around without placing it yet.

Code: QB64: [Select]

    'Here is the Ray Lines code.
    IF a$ = "r" OR a$ = "R" THEN
        rMode = 1 - rMode
        IF rMode THEN
            lastx = mouseX: lastY = mouseY 'set first lastx, lasty
            picture& = _NEWIMAGE(640, 480, 32)
        END IF
    END IF
    IF rMode THEN
        LINE (lastx, lastY)-(mouseX, mouseY), clr~&
        '_display 'if you are using it
        IF mouseLeftButton = -1 THEN _PUTIMAGE , 0, picture&
    END IF
 

News:

Author Topic: Paint Pixels 4 (Read 8556 times)

SierraKen

Paint Pixels 4

euklides

Re: Paint Pixels 4

bplus

Re: Paint Pixels 4

SierraKen

Re: Paint Pixels 4

SierraKen

Re: Paint Pixels 4

bplus

Re: Paint Pixels 4

SierraKen

Re: Paint Pixels 4

bplus

Re: Paint Pixels 4

SierraKen

Re: Paint Pixels 4

bplus

Re: Paint Pixels 4

SierraKen

Re: Paint Pixels 4

SierraKen

Re: Paint Pixels 4

SierraKen

Re: Paint Pixels 4

bplus

Re: Paint Pixels 4

SierraKen

Re: Paint Pixels 4