colorindicator

This commit is contained in:
visionmercer 2026-05-11 10:03:44 +02:00
commit 6435128e22

View file

@ -45,19 +45,25 @@ layers(3).ihandle=_newimage(320,320,32)
_dest layers(0).ihandle _dest layers(0).ihandle
line (0,0)-(_width-1,_height-1),_rgb32(255),bf line (0,0)-(_width-1,_height-1),_rgb32(255),bf
_dest 0 _dest 0
state.tool = 1 state.tool = 1
state.fcolor = 1
state.bcolor = 2
state.zoom = 1.0 state.zoom = 1.0
state.offsetX = 70 + 20 ' To the right of the toolbox state.offsetX = 70 + 20
state.offsetY = 20 state.offsetY = 20
state. brushsize = 1 state. brushsize = 1
state.fcolor=closestcolor(_rgb32(0,0,0),pal())
state.bcolor=closestcolor(_rgb32(255,255,255),pal())
addcommand "fcolor ("+hex$(state.fcolor)+")"
addcommand "bcolor ("+hex$(state.bcolor)+")"
dim lastMX, lastMY dim lastMX, lastMY
dim diffX as integer dim diffX as integer
dim diffY as integer dim diffY as integer
dim oldWidth as integer dim oldWidth as integer
dim oldHeight as integer dim oldHeight as integer
dim keyin as string dim keyin as string
dim mouseWorldY as integer
dim mouseWorldX as integer
oldWidth=_width oldWidth=_width
oldHeight=_height oldHeight=_height
@ -71,7 +77,12 @@ do
oldHeight = _height oldHeight = _height
end if end if
line (0,0)-(_width-1,_height-1),backgroundcolor1,bf canvas
if showtoolbox then toolbox
if showcolorpicker then colorpicker
if showcommands then commandlist
'Mouse Handling 'Mouse Handling
while _mouseinput:mw=mw+_mousewheel:wend while _mouseinput:mw=mw+_mousewheel:wend
@ -92,8 +103,8 @@ do
' Zooming ' Zooming
if mw <> 0 then if mw <> 0 then
' 1. Capture current world position ' 1. Capture current world position
dim mouseWorldX as single: mouseWorldX = (_mousex - state.offsetX) / state.zoom mouseWorldX = (_mousex - state.offsetX) / state.zoom
dim mouseWorldY as single: mouseWorldY = (_mousey - state.offsetY) / state.zoom mouseWorldY = (_mousey - state.offsetY) / state.zoom
' 2. Calculate the new zoom level (Snap to whole numbers) ' 2. Calculate the new zoom level (Snap to whole numbers)
if mw > 0 then if mw > 0 then
@ -106,8 +117,7 @@ do
if state.zoom < 1 then state.zoom = 1 if state.zoom < 1 then state.zoom = 1
if state.zoom > 20 then state.zoom = 20 if state.zoom > 20 then state.zoom = 20
' 4. Adjust offsets and LOCK them to integers ' 4. Adjust offsets
' This prevents the canvas from sitting "between" screen pixels
state.offsetX = _mousex - (mouseWorldX * state.zoom) state.offsetX = _mousex - (mouseWorldX * state.zoom)
state.offsetY = _mousey - (mouseWorldY * state.zoom) state.offsetY = _mousey - (mouseWorldY * state.zoom)
@ -126,9 +136,9 @@ do
case chr$(27)' esc case chr$(27)' esc
menu menu
case "h" case "h"
state.zoom = 1.0 state.zoom=1.0
state.offsetX = (_width / 2) - (_width(layers(0).ihandle) / 2) state.offsetX=(_width/2)- (_width(layers(0).ihandle)/2)
state.offsetY = (_height / 2) - (_height(layers(0).ihandle) / 2) state.offsetY=(_height/2)- (_height(layers(0).ihandle)/2)
case "t" case "t"
showtoolbox=not showtoolbox showtoolbox=not showtoolbox
case "c" case "c"
@ -137,26 +147,24 @@ do
showcommands=not showcommands showcommands=not showcommands
end select end select
canvas
if showtoolbox then toolbox
if showcolorpicker then colorpicker
if showcommands then commandlist
_limit 30 _limit 30
_display _display
line (0,0)-(_width-1,_height-1),backgroundcolor1,bf
loop loop
sub commandlist sub commandlist
dim i as long dim i as long
dim listWidth as integer: listWidth = 150 dim listWidth as integer:listWidth = 150
dim x as integer: x = _width - listWidth dim x as integer:x=_width-listWidth
' Draw background for the list ' Draw background for the list
line (x, 0)-(_width - 1, _height - 1), _rgb32(40, 40, 40), bf line (x,0)-(_width-1,_height - 1),backgroundcolor1, bf
line (x, 0)-(x, _height - 1), _rgb32(100, 100, 100) line (x,0)-(x,_height-1),backgroundcolor2
_printmode _keepbackground _printmode _keepbackground
for i = 0 to ubound(commands) - 1 dim y as integer
dim y as integer: y = i * 16 for i = ubound(commands) - 1 to 0 step -1
y = (ubound(commands)-i) * 16
if y < _height - 20 then if y < _height - 20 then
_printstring (x + 5, y + 5), left$(commands(i), 18) _printstring (x + 5, y + 5), left$(commands(i), 18)
end if end if
@ -181,6 +189,14 @@ sub toolbox
state.tool = i + 1 state.tool = i + 1
end if end if
next next
'colorindicator
y=y+btnSize+16
line (16,y+16)-(64,y+64),state.bcolor,bf
line (16,y+16)-(64,y+64),highlightcolor,b
line (0,y)-(48,y+48),state.fcolor,bf
line (0,y)-(48,y+48),highlightcolor,b
end sub end sub
sub colorpicker sub colorpicker
@ -209,7 +225,6 @@ sub addcommand(cmd as string)
commands(ubound(commands))=cmd commands(ubound(commands))=cmd
redim _preserve commands(ubound(commands)+1) as string redim _preserve commands(ubound(commands)+1) as string
end if end if
end sub end sub
sub canvas sub canvas
@ -221,7 +236,6 @@ sub canvas
if showcommands then viewX2 = _width - 151 else viewX2 = _width - 1 if showcommands then viewX2 = _width - 151 else viewX2 = _width - 1
dim viewY2 as integer dim viewY2 as integer
if showcolorpicker then viewY2 = _height - 20 else viewY2 = _height - 1 if showcolorpicker then viewY2 = _height - 20 else viewY2 = _height - 1
_dest 0 _dest 0
' 2. Render Layers with Clipping ' 2. Render Layers with Clipping
@ -353,7 +367,6 @@ sub canvas
' We use Layer 2 as the temporary preview "rubber-band" layer ' We use Layer 2 as the temporary preview "rubber-band" layer
_dest layers(2).ihandle _dest layers(2).ihandle
cls , 0 cls , 0
select case state.tool select case state.tool
case 1 ' Pencil case 1 ' Pencil
_dest layers(1).ihandle _dest layers(1).ihandle
@ -417,7 +430,7 @@ sub canvas
end if end if
else else
' Merge the preview into the drawing layer ' Merge the preview into the drawing layer
_putimage , layers(2).ihandle, layers(1).ihandle '_putimage , layers(2).ihandle, layers(1).ihandle
select case state.tool select case state.tool
case 2 ' Line case 2 ' Line
thickline state.startX, state.startY, canX, canY, drawCol thickline state.startX, state.startY, canX, canY, drawCol
@ -566,23 +579,49 @@ FUNCTION CheckResize (CurrentScreen AS _UNSIGNED LONG) 'pulled straight out of t
_FREEIMAGE TempScreen _FREEIMAGE TempScreen
CheckResize = -1 CheckResize = -1
END IF END IF
END FUNCTION END FUNCTION
sub menu() sub menu()
Line (0,0)-(_width-1,_height-1),_rgb32(0,1),bf dim logo as long
logo=_loadimage("logo.png")
Line (0,0)-(_width-1,_height-1),_rgb32(0,192),bf
do until done do until done
k$=inkey$ k$=inkey$
while _mouseinput:wend while _mouseinput:wend
mouseclicked=mbd and not _mousebutton(1) mouseclicked=mbd and not _mousebutton(1)
mbd=_mousebutton(1) mbd=_mousebutton(1)
if button(10,10,60,23,"open") then system
if button(10,34,60,23,"save") then system if link(10,10,"open") then system
if button(10,56,60,23,"exit") then system if link(10,34,"save") then system
if link(10,56,"exit") then system
if k$=chr$(27) then done=-1 if k$=chr$(27) then done=-1
_limit 30 _limit 30
_display _display
loop loop
end sub end sub
FUNCTION closestcolor~& (colour AS _UNSIGNED LONG, carr() AS _UNSIGNED LONG)
DIM r AS INTEGER
DIM g AS INTEGER
DIM b AS INTEGER
DIM ar AS INTEGER
DIM ag AS INTEGER
DIM ab AS INTEGER
DIM i AS INTEGER
DIM nearest AS INTEGER
DIM shortestdistance AS INTEGER
DIM distance AS INTEGER
r = _RED (colour)
g = _GREEN(colour)
b = _BLUE (colour)
shortestdistance = 443
FOR i = 0 TO UBOUND(carr)
ar = _RED (carr(i))
ag = _GREEN(carr(i))
ab = _BLUE (carr(i))
distance = SQR((r - ar) ^ 2 + (g - ag) ^ 2 + (b - ab) ^ 2)
IF distance <= shortestdistance THEN shortestdistance = distance: nearest = i
NEXT i
closestcolor = carr(nearest)
END FUNCTION