Author Topic: Paint Pixels 4 (Read 8557 times)

bplus · « **Reply #15 on:** October 07, 2019, 08:23:12 pm »

picture& = _NEWIMAGE(640, 480, 32) near start of program

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

right after main loop starts over again.

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

Dang! touchdown on first play!

Update, didn't know you were using s& for screen handle, here is what I have hacked into your code:

Code: QB64: [Select]

'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)
    picture& = _NEWIMAGE(640, 480, 32)
 
    LINE (0, 0)-(640, 480), _RGB(255, 255, 255), BF
    _PUTIMAGE , s&, picture&
    GOTO more2:
END IF
IF bcolor$ = "B" OR bcolor$ = "b" THEN
    '_FULLSCREEN
    s& = _NEWIMAGE(640, 480, 32)
    picture& = _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
    _PUTIMAGE , picture&, s&
    SCREEN s&
    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 THEN
        LINE (lastx, lastY)-(mouseX, mouseY), clr~&
        IF mouseLeftButton THEN lastx = mouseX: lastY = mouseY: _PUTIMAGE , s&, picture&
    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
 
 

Browns are doing poorly

SierraKen · « **Reply #16 on:** October 07, 2019, 09:13:36 pm »

Am sorry to say that I did everything you said, but no luck. After you press R and just move the mouse, it makes a bunch of lines wherever you move the mouse and the lines stay there.
When you press the mouse button, then it starts to work right, the animated line starts. The R key seems to work fine because you can still use that to make different lines in different locations. The only problem is that as soon as you start a new location, the line doesn't animate, it just makes a bunch of them.

I put this on line 11 before the welcome text:

Code: QB64: [Select]

picture& = _NEWIMAGE(640, 480, 32)    
 

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

Code: QB64: [Select]

  _PUTIMAGE , picture&, 0   
 

And here is the Ray code:

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
 

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

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:
picture& = _NEWIMAGE(640, 480, 32)
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
    _PUTIMAGE , picture&, 0
    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
            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
 
    '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 #17 on:** October 07, 2019, 09:33:42 pm »

Like I said in my update, I didn't know you were using s& for screen handle, so had to change up stuff for that plus ..

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

Parts of interest:

Code: QB64: [Select]

IF bcolor$ = "w" OR bcolor$ = "W" THEN
    '_FULLSCREEN
    s& = _NEWIMAGE(640, 480, 32)
    picture& = _NEWIMAGE(640, 480, 32)  '<<<<<<<<<<<<<<<<<<
 
    LINE (0, 0)-(640, 480), _RGB(255, 255, 255), BF
    _PUTIMAGE , s&, picture&  '<<<<<<<<<<<<<<<<<<<<<<<<< hmm, not tested and different than black?
    GOTO more2:
END IF
IF bcolor$ = "B" OR bcolor$ = "b" THEN
    '_FULLSCREEN
    s& = _NEWIMAGE(640, 480, 32)
    picture& = _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
    _PUTIMAGE , picture&, s& '<<<<<<<<<<<<<<<,
    SCREEN s&                       '<<<<<<<<<<<<<<<
 

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
    END IF
    IF rMode THEN
        LINE (lastx, lastY)-(mouseX, mouseY), clr~&
        IF mouseLeftButton THEN lastx = mouseX: lastY = mouseY: _PUTIMAGE , s&, picture&
    END IF
 

bplus · « **Reply #18 on:** October 07, 2019, 09:43:59 pm »

OK White did need fixed:

Code: QB64: [Select]

IF bcolor$ = "w" OR bcolor$ = "W" THEN
    '_FULLSCREEN
    s& = _NEWIMAGE(640, 480, 32)
    picture& = _NEWIMAGE(640, 480, 32)
    SCREEN s&
    LINE (0, 0)-(640, 480), _RGB32(255, 255, 255), BF
    _PUTIMAGE , s&, picture&
    GOTO more2:
END IF
 

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

SierraKen · « **Reply #19 on:** October 07, 2019, 11:03:50 pm »

AWESOME!!! Thanks B+!!! I got the lines down pact now. Now I will work on the rest. Also, I like how you commented out the FULLSCREEN, I like it as a window better too. Now I can add some things on the TITLE bar.

bplus · « **Reply #20 on:** October 07, 2019, 11:15:52 pm »

Good! sounds like you have it working. _DISPLAY just before the LOOP back around should stop the blinking.

Trouble is, once you start using display you have to _display everything you want seen until execution sees _DISPLAY again unless you switch it off with _AUTODISPLAY.

SierraKen · « **Reply #21 on:** October 08, 2019, 01:59:28 am »

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

Code: QB64: [Select]

'This program was finished on October 7, 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,
'the ray line making code, and general help in making this program.
'-------------------------------------------------------------------------------------------
_LIMIT 100
start:
picture& = _NEWIMAGE(640, 480, 32)
CLS
SCREEN 0
_FULLSCREEN _OFF
_TITLE "Paint Pixels 5"
WIDTH 40, 43
_FONT 16
COLOR 15, 0
_SCREENMOVE 400, 200
PRINT
PRINT "        Paint Pixels 5"
PRINT
PRINT "       By Ken G. and B+"
PRINT
PRINT "     Use your Mouse for:"
PRINT "     (R)ays, (B)oxes, (O)rbits,"
PRINT "     (D)raw, (E)rase, (C)olors,"
PRINT "     (S)ave, (L)oad."
PRINT "     (P)rint to your Printer."
PRINT "     (I)nstructions."
PRINT "     Space Bar to erase picture."
PRINT
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
PRINT "   * 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 "               Page 2"
PRINT
PRINT "     Commands are self-explanatory"
PRINT "     on Title Bar of Paint Window."
PRINT "     Here are some others:"
PRINT "     * Space Bar clears the screen."
PRINT "     * A color choosing window"
PRINT "       will come up right before"
PRINT "       you start painting. It also"
PRINT "       comes up when you press Space"
PRINT "       Bar to clear the screen."
PRINT "       Move the slides to the color"
PRINT "       you wish to use."
PRINT "     * Esc to end program."
PRINT "     * Use Left Mouse Button"
PRINT "     * (I)nstructions"
PRINT "     - There is no Undo feature."
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."
PRINT "     It will rename temp.bmp to your"
PRINT "     chosen name."
PRINT
PRINT "       Press Esc to end."
PRINT
PRINT "    *  Any other key to start. *"
ggggo:
_LIMIT 100
ecc2$ = INKEY$
IF ecc2$ = CHR$(27) THEN END
IF ecc2$ = "" THEN GOTO ggggo:
CLS
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
    s& = _NEWIMAGE(640, 480, 32)
    picture& = _NEWIMAGE(640, 480, 32)
    bcol = 1
    SCREEN s&
    LINE (0, 0)-(640, 480), _RGB(255, 255, 255), BF
    _PUTIMAGE , s&, picture&
    GOTO more2:
END IF
IF bcolor$ = "B" OR bcolor$ = "b" THEN
    s& = _NEWIMAGE(640, 480, 32)
    picture& = _NEWIMAGE(640, 480, 32)
    bcol = 2
    SCREEN s&
    CLS
    GOTO more2:
END IF
GOTO start3:
more2:
begin = 1
GOSUB chosencolor:
_TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
'---------------------------------------------------
'Here is the main loop of the program when painting.
'---------------------------------------------------
DO
    _LIMIT 1000
    _PUTIMAGE , picture&, s&
    SCREEN s&
    a$ = INKEY$
    DO WHILE _MOUSEINPUT
        mouseX = _MOUSEX
        mouseY = _MOUSEY
        mouseLeftButton = _MOUSEBUTTON(1)
        mouseRightButton = _MOUSEBUTTON(2)
        mouseMiddleButton = _MOUSEBUTTON(3)
    LOOP
    IF a$ = "d" OR a$ = "D" THEN
        dMode = 1 - dMode
        IF m = 1 THEN _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint": GOTO nex1:
        m = 1
    END IF
    IF dMode AND m = 1 THEN
        _TITLE "Mode: (D)raw | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
        IF mouseLeftButton THEN LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), clr~&, BF: _PUTIMAGE , s&, picture&
    END IF
    nex1:
    IF a$ = "e" OR a$ = "E" THEN
        eMode = 1 - eMode
        IF m = 2 THEN _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint": GOTO nex2:
        m = 2
    END IF
    IF eMode AND m = 2 THEN
        _TITLE "Mode: (E)raser | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
        IF mouseLeftButton AND bcol = 1 THEN LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), _RGB32(255, 255, 255), BF: _PUTIMAGE , s&, picture&
        IF mouseLeftButton AND bcol = 2 THEN LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), _RGB32(0, 0, 0), BF: _PUTIMAGE , s&, picture&
    END IF
    nex2:
    '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 m = 0: 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 m = 3 THEN _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint": GOTO nex3:
        m = 3
        IF rMode THEN lastx = mouseX: lastY = mouseY 'set first lastx, lasty
    END IF
    IF rMode AND m = 3 THEN
        _TITLE "Mode: (R)ays | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
        LINE (lastx, lastY)-(mouseX, mouseY), clr~&
        IF mouseLeftButton THEN lastx = mouseX: lastY = mouseY: _PUTIMAGE , s&, picture&
    END IF
    nex3:
    'Here is the Orbit Circles code.
    IF a$ = "o" OR a$ = "O" THEN
        oMode = 1 - oMode
        IF m = 4 THEN _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint": GOTO nex4:
        m = 4
        IF oMode THEN lastx = mouseX: lastY = mouseY
    END IF
    IF oMode AND m = 4 THEN
        _TITLE "Mode: (O)rbits | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
        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
        IF mouseLeftButton THEN
            lastx = mouseX
            lastY = mouseY
            _PUTIMAGE , s&, picture&
        END IF
    END IF
    nex4:
    'Here is the Boxes code.
    IF a$ = "b" OR a$ = "B" THEN
        bMode = 1 - bMode
        IF m = 5 THEN _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint": GOTO nex5:
        m = 5
        IF bMode THEN lastx = mouseX: lastY = mouseY
    END IF
    IF bMode AND m = 5 THEN
        _TITLE "Mode: (B)oxes | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
        LINE (lastx, lastY)-(mouseX, mouseY), clr~&, BF
        IF mouseLeftButton THEN lastx = mouseX: lastY = mouseY: _PUTIMAGE , s&, picture&
    END IF
    nex5:
    'Here is the Printing of the picture.
    IF a$ = "p" OR a$ = "P" THEN
        _TITLE "Mode: (P)rint | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
        m = 0
        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
                _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
            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:
_TITLE "Mode: (S)ave | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
'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)."
    PRINT "      Esc goes to start screen."
    llloop:
    _LIMIT 100
    ag2$ = INKEY$
    IF ag2$ = CHR$(27) THEN GOTO start:
    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
m = 0
CLS
GOTO start:
loading: 'This section loads your picture from your computer.
_TITLE "Mode: (L)oad | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
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 goes to start screen."
    _LIMIT 100
    llloop2:
    ag$ = INKEY$
    IF ag$ = "" THEN GOTO llloop2:
    IF ag$ = "y" OR ag$ = "Y" THEN GOTO loading:
    IF ag$ = CHR$(27) THEN GOTO start:
    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
picture& = _NEWIMAGE(640, 480, 32)
SCREEN s&
m = 0
_TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
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 #22 on:** October 08, 2019, 03:13:28 pm »

LOL like usual I spoke too soon. Working on the _TITLE stuff last night I put code the wrong locations. So I fixed it today and I also changed the size of the paint area to 800 x 600, which nowadays is the usual picture size for drawing. I also just ran another printer test and found out that the screen turns black after you print, so I fixed that. I made it so people can still draw on the same drawing after it prints on paper and the drawing is not lost.

Here is the fixed version:

Code: QB64: [Select]

'This program was finished on October 8, 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,
'the ray line making code, and general help in making this program.
'-------------------------------------------------------------------------------------------
_LIMIT 100
start:
picture& = _NEWIMAGE(800, 600, 32)
CLS
SCREEN 0
_FULLSCREEN _OFF
_TITLE "Paint Pixels 5"
WIDTH 40, 43
_FONT 16
COLOR 15, 0
_SCREENMOVE 400, 200
PRINT
PRINT "        Paint Pixels 5"
PRINT
PRINT "       By Ken G. and B+"
PRINT
PRINT "     Use your Mouse for:"
PRINT "     (R)ays, (B)oxes, (O)rbits,"
PRINT "     (D)raw, (E)rase, (C)olors,"
PRINT "     (S)ave, (L)oad."
PRINT "     (P)rint to your Printer."
PRINT "     (I)nstructions - which will"
PRINT "     cause your picture to be lost."
print
PRINT "     Space Bar to erase picture."
PRINT
PRINT " It saves under .bmp files which can"
PRINT " be used with most other programs."
PRINT " It saves as 800 x 600 pixels."
PRINT
PRINT "     Press the Space Bar to"
PRINT "     skip instructions."
PRINT
PRINT "     Press Esc to end."
PRINT
PRINT "   * 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 "               Page 2"
PRINT
PRINT "     Commands are self-explanatory"
PRINT "     on Title Bar of Paint Window."
PRINT "     Here are some others:"
PRINT "     * Space Bar clears the screen."
PRINT "     * A color choosing window"
PRINT "       will come up right before"
PRINT "       you start painting. It also"
PRINT "       comes up when you press Space"
PRINT "       Bar to clear the screen."
PRINT "       Move the slides to the color"
PRINT "       you wish to use."
PRINT "     * Esc to end program."
PRINT "     * Use Left Mouse Button"
PRINT "     * (I)nstructions"
PRINT "     - There is no Undo feature."
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."
PRINT "     It will rename temp.bmp to your"
PRINT "     chosen name."
PRINT
PRINT "       Press Esc to end."
PRINT
PRINT "    *  Any other key to start. *"
ggggo:
_LIMIT 100
ecc2$ = INKEY$
IF ecc2$ = CHR$(27) THEN END
IF ecc2$ = "" THEN GOTO ggggo:
CLS
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
    s& = _NEWIMAGE(800, 600, 32)
    picture& = _NEWIMAGE(800, 600, 32)
    bcol = 1
    SCREEN s&
    LINE (0, 0)-(800, 600), _RGB(255, 255, 255), BF
    _PUTIMAGE , s&, picture&
    GOTO more2:
END IF
IF bcolor$ = "B" OR bcolor$ = "b" THEN
    s& = _NEWIMAGE(800, 600, 32)
    picture& = _NEWIMAGE(800, 600, 32)
    bcol = 2
    SCREEN s&
    CLS
    GOTO more2:
END IF
GOTO start3:
more2:
begin = 1
GOSUB chosencolor:
_TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
'---------------------------------------------------
'Here is the main loop of the program when painting.
'---------------------------------------------------
DO
    _LIMIT 1000
    _PUTIMAGE , picture&, s&
    SCREEN s&
    a$ = INKEY$
    DO WHILE _MOUSEINPUT
        mouseX = _MOUSEX
        mouseY = _MOUSEY
        mouseLeftButton = _MOUSEBUTTON(1)
        mouseRightButton = _MOUSEBUTTON(2)
        mouseMiddleButton = _MOUSEBUTTON(3)
    LOOP
    IF a$ = "d" OR a$ = "D" THEN
        dMode = 1 - dMode
        m = 1
    END IF
    IF dMode AND m = 1 THEN
        _TITLE "Mode: (D)raw | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
        IF mouseLeftButton THEN
            LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), clr~&, BF
            _PUTIMAGE , s&, picture&
        END IF
    END IF
    IF m = 1 AND dMode = 0 THEN
        _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
    END IF
    IF a$ = "e" OR a$ = "E" THEN
        eMode = 1 - eMode
        m = 2
    END IF
    IF eMode AND m = 2 THEN
        _TITLE "Mode: (E)raser | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
        IF mouseLeftButton AND bcol = 1 THEN
            LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), _RGB32(255, 255, 255), BF
            _PUTIMAGE , s&, picture&
        END IF
        IF mouseLeftButton AND bcol = 2 THEN
            LINE (mouseX, mouseY)-(mouseX + 1, mouseY + 1), _RGB32(0, 0, 0), BF
            _PUTIMAGE , s&, picture&
        END IF
    END IF
    IF m = 2 AND eMode = 0 THEN
        _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
    END IF
    '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 m = 0: 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
        m = 3
        IF rMode THEN lastx = mouseX: lastY = mouseY 'set first lastx, lasty
    END IF
    IF rMode AND m = 3 THEN
        _TITLE "Mode: (R)ays | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
        LINE (lastx, lastY)-(mouseX, mouseY), clr~&
        IF mouseLeftButton THEN
            lastx = mouseX: lastY = mouseY
            _PUTIMAGE , s&, picture&
        END IF
    END IF
    IF m = 3 AND rMode = 0 THEN
        _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
    END IF
    'Here is the Orbit Circles code.
    IF a$ = "o" OR a$ = "O" THEN
        oMode = 1 - oMode
        m = 4
        IF oMode THEN lastx = mouseX: lastY = mouseY
    END IF
    IF oMode AND m = 4 THEN
        _TITLE "Mode: (O)rbits | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
        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
        IF mouseLeftButton THEN
            lastx = mouseX
            lastY = mouseY
            _PUTIMAGE , s&, picture&
        END IF
    END IF
    IF m = 4 AND oMode = 0 THEN
        _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
    END IF
    'Here is the Boxes code.
    IF a$ = "b" OR a$ = "B" THEN
        bMode = 1 - bMode
        m = 5
        IF bMode THEN lastx = mouseX: lastY = mouseY
    END IF
    IF bMode AND m = 5 THEN
        _TITLE "Mode: (B)oxes | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
        LINE (lastx, lastY)-(mouseX, mouseY), clr~&, BF
        IF mouseLeftButton THEN
            lastx = mouseX:
            lastY = mouseY
            _PUTIMAGE , s&, picture&
        END IF
    END IF
    IF m = 5 AND bMode = 0 THEN
        _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
    END IF
    'Here is the Printing of the picture.
    IF a$ = "p" OR a$ = "P" THEN
        _TITLE "Mode: (P)rint | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
        m = 0
        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
                s& = j&
                _TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
            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:
_TITLE "Mode: (S)ave | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
'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: 800  height: 600 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
    PRINT "       File Already Exists"
    PRINT "       Saving will delete your old"
    PRINT "       bmp picture."
    PRINT "       Would you like to still do it?"
    PRINT "      (Y/N)."
    PRINT "      Esc goes to start screen."
    llloop:
    _LIMIT 100
    ag2$ = INKEY$
    IF ag2$ = CHR$(27) THEN GOTO start:
    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
m = 0
_TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
CLS
GOTO start:
loading: 'This section loads your picture from your computer.
_TITLE "Mode: (L)oad | (D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
SCREEN 0
CLS
COLOR 12
PRINT
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
    PRINT "           File Does Not Exist."
    PRINT "           Would you like to try again (Y/N)"
    PRINT "           Esc goes to start screen."
    _LIMIT 100
    llloop2:
    ag$ = INKEY$
    IF ag$ = "" THEN GOTO llloop2:
    IF ag$ = "y" OR ag$ = "Y" THEN GOTO loading:
    IF ag$ = CHR$(27) THEN GOTO start:
    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
picture& = _NEWIMAGE(800, 600, 32)
SCREEN s&
m = 0
_TITLE "(D)raw, (E)rase, (C)olors, (R)ays, (O)rbits, (B)oxes, (S)ave, (L)oad, (P)rint"
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 #23 on:** October 08, 2019, 04:53:09 pm »

Hi Ken,

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

SierraKen · « **Reply #24 on:** October 08, 2019, 06:15:01 pm »

That's exactly what I did B+, m=1, m=2, m=3, m=4, and m=5 are all different modes. I did that so things don't get confused and also to say, ie. If m=4 and oMode=0 then... where I put a _TITLE with all the modes off. That's how I fixed it with the last update I posted earlier.

SierraKen · « **Reply #25 on:** October 08, 2019, 07:48:54 pm »

Paint Pixels 5 is now on my website and I consider it finished. I've tested it a lot and everything seems to work fine. Thank you again B+ for all your help. So unless someone finds a bad problem with it, I'm not going to work on it any time soon I think.

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

http://www.KensPrograms.com/

Thank you.

STxAxTIC · « **Reply #26 on:** October 08, 2019, 08:38:48 pm »

Had fun playing with this Ken - nice use of the alpha. Maybe version 6 will have a toolbar like paint?

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

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

SierraKen · « **Reply #27 on:** October 08, 2019, 09:49:25 pm »

Thanks Static!
Wow that would be an amazing project. Feel free to use any of my code from Paint Pixels. But me being the lesser of the programmers in here, I would mostly just watch and test it for you guys. :))

Petr · « **Reply #28 on:** October 09, 2019, 02:29:38 pm »

Very interesting work. I'm interested in it. I did a bit of an ape after drawing in Windows, so far only a few things work, it has been a while since I wrote it. In the end I interrupted it, now I don't even know why...

bplus · « **Reply #29 on:** October 09, 2019, 05:04:49 pm »

Hi Ken,

Here is how I would do Undo and some other things, mouse down starts draw object, mouse release is finishes:

Code: QB64: [Select]

_TITLE "Quick Draw" 'b+ 2019-10-09
 
CONST xmax = 800, ymax = 600
DIM SHARED c~&
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 300, 100
FOR i = 0 TO 9
    d&(i) = _NEWIMAGE(xmax, ymax, 32)
    _PUTIMAGE , 0, d&(i)
NEXT
t$ = "Menu: <L>ine <F>rame <B>ox <E>llipse <D>isk <C>olor CL<S> <U>ndo"
m$ = "L": _TITLE t$ + "  Drawing Lines"
p = 0
_PUTIMAGE , 0, d&(p)
c~& = &HFFFFFFFF
WHILE 1
    _PUTIMAGE , d&(p), 0
    k$ = UCASE$(INKEY$)
    IF k$ = "L" THEN ' rays
        m$ = "L": _TITLE t$ + "  Drawing Lines"
    ELSEIF k$ = "E" THEN ' orbits (cool name BTW)
        m$ = "E": _TITLE t$ + "  Drawing Ellipse"
    ELSEIF k$ = "F" THEN
        m$ = "F": _TITLE t$ + "  Drawing Frames"
    ELSEIF k$ = "B" THEN ' Boxes
        m$ = "B": _TITLE t$ + "  Drawing Boxes"
    ELSEIF k$ = "D" THEN
        m$ = "D": _TITLE t$ + "  Drawing Disks"
    ELSEIF k$ = "C" THEN
        changeColor
        CLS
        _PUTIMAGE , d&(p), 0
    ELSEIF k$ = "S" THEN
        CLS
        _PUTIMAGE , 0, d&(p)
    ELSEIF k$ = "U" THEN
        p = p - 1
        IF p = -1 THEN p = 9
    END IF
    WHILE _MOUSEINPUT: WEND
    mxd = _MOUSEX: myd = _MOUSEY: mb = _MOUSEBUTTON(1): mxu = -1
 
    WHILE mb
        mi = _MOUSEINPUT:
        mxu = _MOUSEX: myu = _MOUSEY: mb = _MOUSEBUTTON(1)
        CLS
        _PUTIMAGE , d&(p), 0
        IF mxu <> -1 THEN
            SELECT CASE m$
                CASE "L": LINE (mxd, myd)-(mxu, myu), c~&
                CASE "F": LINE (mxd, myd)-(mxu, myu), c~&, B
                CASE "B": LINE (mxd, myd)-(mxu, myu), c~&, BF
                CASE "E"
                    dx = ABS(mxd - mxu): dy = ABS(myd - myu)
                    PSET (mxd, myd), &HFFFFFFFF
                    Ell mxd, myd, dx, dy, 0
                    LINE (mxd - dx, myd - dy)-STEP(2 * dx, 2 * dy), &HFFFFFFFF, B
                CASE "D"
                    dx = ABS(mxd - mxu): dy = ABS(myd - myu)
                    PSET (mxd, myd), &HFFFFFFFF
                    Ell mxd, myd, dx, dy, 1
                    LINE (mxd - dx, myd - dy)-STEP(2 * dx, 2 * dy), &HFFFFFFFF, B
            END SELECT
            _DISPLAY
        END IF
        _LIMIT 500
    WEND
    IF mxu <> -1 THEN
        CLS
        _PUTIMAGE , d&(p), 0
        SELECT CASE m$
            CASE "L": LINE (mxd, myd)-(mxu, myu), c~&
            CASE "F": LINE (mxd, myd)-(mxu, myu), c~&, B
            CASE "B": LINE (mxd, myd)-(mxu, myu), c~&, BF
            CASE "E"
                dx = ABS(mxd - mxu): dy = ABS(myd - myu)
                Ell mxd, myd, dx, dy, 0
            CASE "D"
                dx = ABS(mxd - mxu): dy = ABS(myd - myu)
                Ell mxd, myd, dx, dy, 1
        END SELECT
        _DISPLAY
        p = (p + 1) MOD 10
        _PUTIMAGE , 0, d&(p)
    END IF
    _DISPLAY
    _LIMIT 20
WEND
 
SUB changeColor
    r = 128: g = 128: b = 128: a = 128
    COLOR &HFFFFFFFF, &HFF000000
    DO
        CLS
        test~& = _RGBA32(r, g, b, a)
        slider 16, 10, r, "Red"
        slider 16, 60, g, "Green"
        slider 16, 110, b, "Blue"
        slider 16, 160, a, "Alpha"
        _PRINTSTRING (140, 260), "Press spacebar or enter to accept color change, q or esc to cancel"
        LINE (90, 300)-(710, 590), , B
        LINE (100, 310)-(700, 580), test~&, BF
        WHILE _MOUSEINPUT: WEND
        mb = _MOUSEBUTTON(1)
        IF mb THEN 'clear it
            mx = _MOUSEX: my = _MOUSEY
            IF mx >= 16 AND mx <= 784 THEN
                IF my >= 10 AND my <= 50 THEN
                    r = _ROUND((mx - 16) / 3)
                ELSEIF my >= 60 AND my <= 100 THEN
                    g = _ROUND((mx - 16) / 3)
                ELSEIF my >= 110 AND my <= 150 THEN
                    b = _ROUND((mx - 16) / 3)
                ELSEIF my >= 160 AND my <= 200 THEN
                    a = _ROUND((mx - 16) / 3)
                END IF
            END IF
        END IF
        k$ = INKEY$
        IF LEN(k$) THEN
            IF ASC(k$) = 13 OR ASC(k$) = 32 THEN c~& = test~&: EXIT SUB
            IF k$ = "q" OR ASC(k$) = 27 THEN EXIT SUB
        END IF
        _DISPLAY
        _LIMIT 60
    LOOP
END SUB
 
SUB slider (x, y, value, label$)
    SELECT CASE label$
        CASE "Red": cr~& = &HFFFF0000
        CASE "Green": cr~& = &HFF008800
        CASE "Blue": cr~& = &HFF0000FF
        CASE "Alpha": cr~& = &H88FFFFFF
    END SELECT
    LINE (x, y)-STEP(768, 40), cr~&, B
    LINE (x, y)-STEP(3 * value, 40), cr~&, BF
    COLOR &HFFFFFFFF, cr~&
    s$ = label$ + " = " + _TRIM$(STR$(value))
    _PRINTSTRING (x + 384 - 4 * LEN(s$), y + 12), s$
    COLOR &HFFFFFFFF, &HFF000000
END SUB
 
SUB Ell (CX AS LONG, CY AS LONG, xRadius AS LONG, yRadius AS LONG, fillTF)
    DIM scale AS SINGLE, x AS LONG, y AS LONG, a AS SINGLE, xx AS SINGLE, yy AS SINGLE
    scale = yRadius / xRadius
    IF fillTF THEN
        LINE (CX, CY - yRadius)-(CX, CY + yRadius), c~&, BF
        FOR x = 1 TO xRadius
            y = scale * SQR(xRadius * xRadius - x * x)
            LINE (CX + x, CY - y)-(CX + x, CY + y), c~&, BF
            LINE (CX - x, CY - y)-(CX - x, CY + y), c~&, BF
        NEXT
    ELSE
        FOR a = 0 TO _PI(2.01) STEP .1
            xx = CX + xRadius * COS(a)
            yy = CY + yRadius * SIN(a)
            IF a > 0 THEN LINE (lastx, lasty)-(xx, yy), c~&
            lastx = xx: lasty = yy
        NEXT
    END IF
END SUB
 
 

News:

Author Topic: Paint Pixels 4 (Read 8557 times)

bplus

Re: Paint Pixels 4

SierraKen

Re: Paint Pixels 4

bplus

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

bplus

Re: Paint Pixels 4

SierraKen

Re: Paint Pixels 4

SierraKen

Re: Paint Pixels 4

STxAxTIC

Re: Paint Pixels 4

SierraKen

Re: Paint Pixels 4

Petr

Re: Paint Pixels 4

bplus

Re: Paint Pixels 4