Print Page - Paint Pixels 4

Active Forums => Programs => Topic started by: SierraKen on October 06, 2019, 12:05:39 am

Title: Paint Pixels 4
Post by: 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
 

Title: Re: Paint Pixels 4
Post by: euklides 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 ? ...

Title: Re: Paint Pixels 4
Post by: bplus 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?

Title: Re: Paint Pixels 4
Post by: SierraKen 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.

Title: Re: Paint Pixels 4
Post by: SierraKen 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
 

Title: Re: Paint Pixels 4
Post by: bplus 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.

Title: Re: Paint Pixels 4
Post by: SierraKen 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
 

Title: Re: Paint Pixels 4
Post by: bplus on October 06, 2019, 11:47:26 pm

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

Title: Re: Paint Pixels 4
Post by: SierraKen 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
 

Title: Re: Paint Pixels 4
Post by: bplus 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.

Title: Re: Paint Pixels 4
Post by: SierraKen 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.

Title: Re: Paint Pixels 4
Post by: SierraKen 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
 

Title: Re: Paint Pixels 4
Post by: SierraKen 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
 
 

Title: Re: Paint Pixels 4
Post by: bplus 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
 
 

Title: Re: Paint Pixels 4
Post by: SierraKen 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
 

Title: Re: Paint Pixels 4
Post by: bplus 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

Title: Re: Paint Pixels 4
Post by: SierraKen 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
 

Title: Re: Paint Pixels 4
Post by: bplus 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
 

Title: Re: Paint Pixels 4
Post by: bplus 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.

Title: Re: Paint Pixels 4
Post by: SierraKen 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.

Title: Re: Paint Pixels 4
Post by: bplus 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.

Title: Re: Paint Pixels 4
Post by: SierraKen 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
 

Title: Re: Paint Pixels 4
Post by: SierraKen 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
 
 

Title: Re: Paint Pixels 4
Post by: bplus 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.

Title: Re: Paint Pixels 4
Post by: SierraKen 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.

Title: Re: Paint Pixels 4
Post by: SierraKen 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/ (http://www.KensPrograms.com/)

Thank you.

Title: Re: Paint Pixels 4
Post by: STxAxTIC 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?

Title: Re: Paint Pixels 4
Post by: SierraKen 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. :))

Title: Re: Paint Pixels 4
Post by: Petr 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...

[ This attachment cannot be displayed inline in 'Print Page' view ]

Title: Re: Paint Pixels 4
Post by: bplus 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
 
 

Title: Re: Paint Pixels 4
Post by: SierraKen on October 09, 2019, 07:34:46 pm

I kinda see what you did, and when I tried it, it sorta worked, but you had to press U a bunch of times. Then I added too much code and was lost in my own code lol. So I gave up and went back to where it was. I might try it next week more and see what I can come up with. I saved your code to a Notepad. I will be away from programming for a few days starting tomorrow and hopefully back in a few days. Thanks anyways B+. By the way, my modem broke this morning so thankfully I found one I had in my closet that works. So hopefully that will work for a long time.

Title: Re: Paint Pixels 4
Post by: TempodiBasic on October 13, 2019, 11:39:05 am

Hi Sierraken

you're creature is growing up to a more professional look!
Thanks to share!
Good job!

If you like I can give you some feedbacks...otherwise go to read some other responses
1. Initial window is not centered on the screen... you can do it with _SCREENMOVE
2. Orbist starts with the initial position of mouse without any left click
2.1 circle flickers while I move mouse to decide the ray of the circle with the second left click
2.2 it may be useful to choose if I want a circle or an ellipse so that I draw that shape without spending more attention to what you see on the screen
2.3 As soon as I dothe second left click to define the ray of the circle/ellipse, the program starts to draw a second circle/ellipse with the centre in the second left click.... I think that this issue is related to the issue 2(.0)
3 Boxes starts with first angle to the actual mouse position and the second to the next position without left click
3.1 boxes are full
3.2 also box flickers while I move mouse to decide the dimensions of it
4. Ray does the same
4.1 it starts where is the mouse without any left click
4.2 the next ray starts at the end of the previous ray
4.3 ray flickers while I choose the second extremity of it

and I agree with
STxAxTIC

Quote

Maybe version 6 will have a toolbar like paint?

this powers up your application to a more professional world
and Bplus

Quote

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

Title: Re: Paint Pixels 4
Post by: TempodiBasic on October 13, 2019, 11:53:21 am

@Petr

Quote

it has been a while since I wrote it. In the end I interrupted it, now I don't even know why...

Mhhhmhhh...
let me say you that I have had a first unknown why, just 18 years ago and he had brought me to leave hobbies and to fall deep and deep in the work..
just some time ago that reason gave me a bridge by pc programming, we started together with Java (and in that time I found on the web QB64 and then Terry Ritchie and the this wonderful community).
But it has spent just little time to change direction/interest, the hystory repeats itself. :-)

Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: SierraKen on October 06, 2019, 12:05:39 am