'Paint Pixels 8
'by Sierraken and B+
'Made on June 30, 2020
'Technical Notes:
'First I want to thank all of the people that have helped me so far in this program:
'B+ for the color picker and help with the circles, boxes and rays and other help.
'Petr for help with the file opening and saving dialog and saveimage libraries.
'SpriggySpriggs for his file opening and saving examples that inspired me to keep going.
'Dav for the Right Click Menu.
'Thank you also to everyone else who has used and helped me with this!
'New Additions for Version 8:
'Right Click Menu to select everything you need to draw with.
'Fixed Lines, Circles, and Boxes so that you can put them anywhere using the mouse by
'dragging their sizes with the left mouse button. Also lets you place as many as you want.
'Made boxes not fill-in anymore because there is already a fill-in option.
'-----------------------------------------------------------------------------------------------
'$include:'saveimage.bi'
'$include:'opensave.bi'
'=== =============DEFINES FOR RIGHT CLICK MENU - CHANGE TO SUIT ==========================
DIM SHARED RightClickItems: RightClickItems
= 22 ' <----- Number of items in your menu
RightClickList$(1) = "New" ' <------------ List all your menu items here
RightClickList$(2) = "Open..."
RightClickList$(3) = "Save As..."
RightClickList$(4) = "---" ' <------------ This means it's a separator (---)
RightClickList$(5) = "Draw"
RightClickList$(6) = "---"
RightClickList$(7) = "Erase"
RightClickList$(8) = "---"
RightClickList$(9) = "Color"
RightClickList$(10) = "Straight Lines"
RightClickList$(11) = "Circles"
RightClickList$(12) = "Boxes"
RightClickList$(13) = "Fill-In"
RightClickList$(14) = "---"
RightClickList$(15) = "Undo"
RightClickList$(16) = "---" ' <------------ (another separator)
RightClickList$(17) = "Print"
RightClickList$(18) = "---"
RightClickList$(19) = "Help"
RightClickList$(20) = "Exit Menu"
RightClickList$(21) = "---"
RightClickList$(22) = "Exit Paint Pixels"
'========================================================================================
start:
PRINT " By Ken G. and B+" PRINT " Right-Click on the drawing screen" PRINT " with your mouse to see the Menu." PRINT " Supports: JPG, PNG, GIF, BMP" PRINT "Use mouse to paint and also to plot and" PRINT "change sizes of lines, circles, and" PRINT "squares holding down the left mouse" PRINT "button. Release button to keep them." PRINT " Press the Space Bar to begin." paintpixelsinst:
start2:
PRINT "Type number (1-5) here:" screensize:
IF screensz
= 1 THEN screenx
= 640: screeny
= 480:
GOTO nextsc:
IF screensz
= 2 THEN screenx
= 800: screeny
= 600:
GOTO nextsc:
IF screensz
= 3 THEN screenx
= 1024: screeny
= 768:
GOTO nextsc:
IF screensz
= 4 THEN screenx
= 1536: screeny
= 1024:
GOTO nextsc:
morescreensz:
INPUT "Horizontal X (640-1920): ", screenx
INPUT "Vertical Y (480-1024): ", screeny
'Choose Background Color.
nextsc:
begin = 1
bcol = 0
background&
= _LOADIMAGE("colorwheelpage.png", 32)mouseLeftButton = 0
colorwheel:
back&
= POINT(mousex
, mousey
) mouseLeftButton = 0
mousex = 0: mousey = 0
start3:
LINE (0, 0)-(screenx
, screeny
), back&
, BF
begin = 1
_TITLE "Choose Your Paint Color Here By Using The 4 Sliders With Your Mouse." start4:
m = 1
_TITLE "Right Click Mouse To See Menu." '---------------------------------------------------
'Here is the main loop of the program when painting.
'---------------------------------------------------
'a% = 0 '### making sure a% is cleared (used by Dav for testing)
IF mouseLeftButton
= 0 THEN button
= 1 a% = RightClickMenu% ' <----- Check for rightclick menu
'=== what did you select?
IF a%
= 10 THEN a$
= "r": lastx
= 0: lasty
= 0 IF a%
= 11 THEN a$
= "o": lastx
= 0: lasty
= 0 IF a%
= 12 THEN a$
= "b": lastx
= 0: lasty
= 0 mouseLeftButton = 0
a% = 0
'Here is when someone whipes the screen blank with the space bar.
a$ = ""
a$ = ""
'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.
a$ = ""
chosencolor:
check$ = colorDialog$
IF check$
<> "" THEN clr~&
= VAL(check$
) 'ELSE <<< don't change drawing color a$ = ""
a& = 0
m = 1
mm = 1
LINE (mousex
, mousey
)-(lastx
+ sz
, lasty
+ sz
), clr~&
LINE (mousex
+ sz
, mousey
+ sz
)-(lastx
+ sz
, lasty
+ sz
), clr~&
LINE (mousex
+ sz
, mousey
)-(lastx
+ sz
, lasty
), clr~&
LINE (mousex
, mousey
+ sz
)-(lastx
, lasty
+ sz
), clr~&
button = 0
mm = 0
lastx = mousex: lasty = mousey
a$ = ""
a& = 0
m = 2
mm = 2
LINE (mousex
, mousey
)-(lastx
+ sz
, lasty
+ sz
), back&
LINE (mousex
+ sz
, mousey
+ sz
)-(lastx
+ sz
, lasty
+ sz
), back&
LINE (mousex
+ sz
, mousey
)-(lastx
+ sz
, lasty
), back&
LINE (mousex
, mousey
+ sz
)-(lastx
, lasty
+ sz
), back&
button = 0
mm = 0
lastx = mousex: lasty = mousey
'Here is the Ray Lines code.
a$ = ""
a% = 0
m = 3
IF mm
= 0 THEN lastx
= mousex: lasty
= mousey
LINE (lastx
, lasty
)-(mousex
, mousey
), clr~&
LINE (lastx
+ sz
, lasty
)-(mousex
+ sz
, mousey
), clr~&
LINE (lastx
, lasty
+ sz
)-(mousex
, mousey
+ sz
), clr~&
LINE (lastx
, lasty
+ sz
)-(mousex
+ sz
, mousey
), clr~&
mm = 3
LINE (lastx
, lasty
)-(mousex
, mousey
), clr~&
LINE (lastx
+ sz
, lasty
)-(mousex
+ sz
, mousey
), clr~&
LINE (lastx
, lasty
+ sz
)-(mousex
, mousey
+ sz
), clr~&
LINE (lastx
, lasty
+ sz
)-(mousex
+ sz
, mousey
), clr~&
lastx = mousex: lasty = mousey
mm = 0
'Here is the Orbit Circles code.
a$ = ""
a% = 0
m = 4
IF mm
= 0 THEN lastx
= mousex: lasty
= mousey
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
seconds = 0
two:
mm = 4
three:
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
seconds = 0
four:
lastx = mousex: lasty = mousey
mm = 0
size = 0: size2 = 0
'Here is the Boxes code.
a$ = ""
a% = 0
m = 5
lastx = mousex: lasty = mousey
IF mm
= 0 THEN lastx
= mousex: lasty
= mousey
LINE (lastx
- sz
, lasty
- sz
)-(mousex
+ sz
, mousey
+ sz
), clr~&
, B
mm = 5
LINE (lastx
- sz
, lasty
- sz
)-(mousex
+ sz
, mousey
+ sz
), clr~&
, B
lastx = mousex: lasty = mousey
mm = 0
'Here is Fill-In
a$ = ""
m = 6
mouseLeftButton = 0
IF mouseLeftButton
THEN paint3 mousex
, mousey
, clr~&
IF mouseLeftButton
THEN mouseLeftButton
= 0 a$ = ""
s& = undo&
mouseLeftButton = 0
'Here is the Printing of the picture.
a$ = ""
m = 0
INPUT "Print on printer (Y/N)?", i$
'print screen page on printer 'printer prep (code copied and pasted from bplus Free Calendar Program)
_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&
landscape& = 0
s& = j&
'Saving Section
saving:
nm$
= GetSaveFileName
("Save Image", ".\", "JPG Image (.jpg)|*.jpg|PNG Image (.png)|*.png|GIF Image (.gif)|*.gif|BMP Image (.bmp)|*.bmp", 1, OFN_OVERWRITEPROMPT
+ OFN_NOCHANGEDIR
, _WINDOWHANDLE)Result
= SaveImage
(nm$
, 0, 0, 0, _WIDTH(img
), _HEIGHT(img
)) 'first zero is your screen, second zero is X start, 3th zero is y startnm$ = ""
skipsave:
m = 0
a% = 0
a$ = ""
mouseLeftButton = 0
button = 1
'Loading Section
loading:
nm$
= GetOpenFileName$
("Open Image", ".\", "JPG Image (.jpg)|*.jpg|PNG Image (.png)|*.png|GIF Image (.gif)|*.gif|BMP Image (.bmp)|*.bmp", 1, OFN_FILEMUSTEXIST
+ OFN_NOCHANGEDIR
+ OFN_READONLY
, _WINDOWHANDLE)l = 0
s& = i&
i& = 0
nm$ = ""
skipopen:
m = 0
a% = 0
a$ = ""
mouseLeftButton = 0
button = 1
'first screen dimensions items to restore at exit
'save old settings to restore at end ofsub
'screen snapshot
r = 128: g = 128: b = 128: a = 128
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
f = 255 * (i - 100) / 600
'put things back
'clear key presses
'clear mouse clicks
SUB slider
(x
, y
, value
, label$
) CASE "Red": c~&
= &HFFFF0000 CASE "Green": c~&
= &HFF008800 CASE "Blue": c~&
= &HFF0000FF CASE "Alpha": c~&
= &H88FFFFFF LINE (x
, y
)-STEP(3 * value
, 40), c~&
, BF
s$ = label$ + " = " + s3$
DIM fillColor
AS _UNSIGNED LONG, W
, H
, parentF
, tick
, ystart
, ystop
, xstart
, xstop
, x
, y
fillColor
= POINT(x0
, y0
) 'PRINT fillColor
temp(x0, y0) = 1: parentF = 1
parentF = 0: tick = tick + 1
ystart = max(y0 - tick, 0): ystop = min(y0 + tick, H)
y = ystart
xstart = max(x0 - tick, 0): xstop = min(x0 + tick, W)
x = xstart
IF temp
(max
(0, x
- 1), y
) THEN temp
(x
, y
) = 1: parentF
= 1:
PSET (x
, y
), fill
temp
(x
, y
) = 1: parentF
= 1:
PSET (x
, y
), fill
temp
(x
, y
) = 1: parentF
= 1:
PSET (x
, y
), fill
temp
(x
, y
) = 1: parentF
= 1:
PSET (x
, y
), fill
x = x + 1
y = y + 1
'================================================================================
'================================================================================
'================================================================================
'Returns 0 if nothing selected, else return number of item selected.
'Requires RightClickList$ array defined.
x = Col * 8 - 8: y = Row * 16 - 16
'=== Compute BoxWidth based on longest menu item string length
BoxWidth = 0
FOR t
= 1 TO RightClickItems
temp
= LEN(RightClickList$
(t
)) IF LEFT$(RightClickList$
(t
), 1) = "-" THEN temp
= temp
- 1 IF temp
> BoxWidth
THEN BoxWidth
= temp
NEXT: BoxWidth
= BoxWidth
* 8
'=== Compute BoxHeight based on num of menu items
BoxHeight = RightClickItems * 16
'===== Make sure Mouse not too close to edge of screen
'===== If it is, Adjust x & y position here, move in closer...
Col = 3: x = Col * 8 - 8:
Col
= FIX(xm
/ 8): x
= Col
* 8 - 8:
Row = 2: y = Row * 16 - 16
Row
= FIX(xy
/ 16): y
= Row
* 16 - 16
FirstRow = Row - 1
'=== copy screen using _mem (thanks Steve!)
'=== trap until buttons up
'=== Draw Box (10 pix padding)
LINE (x
- 10, y
- 10)-(x
+ 10 + BoxWidth
, y
+ 10 + BoxHeight
), _RGB(214, 211, 206), BF
LINE (x
+ 10 + BoxWidth
, y
- 10)-(x
+ 10 + BoxWidth
, y
+ 10 + BoxHeight
), _RGB(66, 65, 66), B
LINE (x
- 10, y
+ 10 + BoxHeight
)-(x
+ 10 + BoxWidth
, y
+ 10 + BoxHeight
), _RGB(66, 65, 66), B
LINE (x
- 9, y
- 9)-(x
+ 9 + BoxWidth
, y
+ 9 + BoxHeight
), _RGB(255, 255, 255), B
LINE (x
- 9, y
- 9)-(x
+ 9 + BoxWidth
, y
+ 9 + BoxHeight
), _RGB(255, 255, 255), B
LINE (x
+ 9 + BoxWidth
, y
- 9)-(x
+ 9 + BoxWidth
, y
+ 9 + BoxHeight
), _RGB(127, 127, 127), B
LINE (x
- 9, y
+ 9 + BoxHeight
)-(x
+ 9 + BoxWidth
, y
+ 9 + BoxHeight
), _RGB(127, 127, 127), B
'=== if in bounds of menu space
'=== Draw items
FOR t
= 0 TO RightClickItems
- 1 'Draw highlight box...
padme
= BoxWidth
/ 8 - LEN(RightClickList$
(t
+ 1)) IF LEFT$(RightClickList$
(t
+ 1), 1) = "-" THEN padme
= padme
- 1 IF RightClickList$
(t
+ 1) = "---" THEN PRINT " ";
RIGHT$(RightClickList$
(t
+ 1), LEN(RightClickList$
(t
+ 1)) - 1); pad$;
" ";
PRINT " "; RightClickList$
(t
+ 1); pad$;
" ";
'only select if not a seperator and not disabled
IF RightClickList$
(sel
) <> "---" THEN RightClickMenu%
= sel:
EXIT DO
'=== Draw items
FOR t
= 0 TO RightClickItems
- 1 padme
= BoxWidth
/ 8 - LEN(RightClickList$
(t
+ 1)) IF LEFT$(RightClickList$
(t
+ 1), 1) = "-" THEN padme
= padme
- 1 IF RightClickList$
(t
+ 1) = "---" THEN
PRINT " ";
RIGHT$(RightClickList$
(t
+ 1), LEN(RightClickList$
(t
+ 1)) - 1); pad$;
" ";
PRINT " "; RightClickList$
(t
+ 1); pad$;
" ";
'=== Mark current row mouse is in
'### Make sure both buttons are up before leaving
'### Added by Dav for bug testing...
'=== restore screen
'================================================================================
'================================================================================
'================================================================================
'$include:'saveimage.bm'
'$include:'opensave.bm'
