pixler/pixler.bas
visionmercer 7cfd54d39d canvas
2026-04-29 21:17:20 +02:00

206 lines
5.4 KiB
QBasic

type statetype
tool as long
fcolor as long
bcolor as long
end type
type layertype
ihandle as long
blendmode as long
filter as long
kind as long
end type
redim shared layers(1) as layertype
dim shared state as statetype
dim shared mouseclicked as integer
dim shared mousedown as integer
dim shared rmouseclicked as integer
dim shared rmousedown as integer
$resize:on
screen _newimage(740,480,32)
_delay 0.1
temp&=_resize
redim shared pal(0) as _unsigned long
dim as integer ch1,ch2,ch3,bt
loadpalette "endesga16",pal()
layers(0).ihandle=_newimage(640,350,32)
layers(1).ihandle=_newimage(640,350,32)
_dest layers(0).ihandle
line (0,0)-(_width-1,_height-1),_rgb32(255),bf
_dest 0
do
line (0,0)-(_width-1,_height-1),backgroundcolor1,bf
IF CheckResize(_SOURCE) = -1 then rem 'whatever, maybe some day somthing needs changing if the window is resized'
while _mouseinput:wend
mouseclicked=0
rmouseclicked=0
if mousedown=-1 and _mousebutton(1)=0 then mouseclicked=-1
if rmousedown=-1 and _mousebutton(2)=0 then rmouseclicked=-1
mousedown=_mousebutton(1)
rmousedown=_mousebutton(2)
toolbox
colorpicker
canvas
locate 10,10: print state.tool
locate 11,10: color state.fcolor: print state.fcolor
locate 12,10: color state.bcolor: print state.bcolor
_limit 30
_display
loop
sub toolbox
dim x,y
if imagebutton(0,0,32,32,icon(0)) then state.tool=1
if imagebutton(32,0,32,32,icon(1)) then state.tool=2
end sub
sub colorpicker
dim img as long
img=_newimage(16,16,32)
for i=0 to ubound(pal)
_dest img
cls ,pal(i)
line (0,0)-(_width-1,height-1),pal(i),bf
_dest 0
select case imagebutton(i*16,_height-17,16,16,img)
case -1
state.fcolor=pal(i)
case -2
state.bcolor=pal(i)
end select
next i
_freeimage img
end sub
sub canvas
' 1. Define the box boundaries
dim boxX1 as integer: boxX1 = 70
dim boxWidth as integer: boxWidth = _width - 1 - boxX1
dim boxHeight as integer: boxHeight = _height - 20
' 2. Draw the background box
line (boxX1, 0)-(_width - 1, boxHeight), _rgb32(64), bf
' 3. Loop through layers and calculate centering for each
for i = 0 to ubound(layers)
dim imgW as integer: imgW = _width(layers(i).ihandle)
' Calculate X to center the image relative to the box
' We take the box start (70) and add half of the remaining whitespace
dim drawX as integer
drawX = boxX1 + (boxWidth - imgW) / 2
' If you also want it centered vertically:
dim imgH as integer: imgH = _height(layers(i).ihandle)
dim drawY as integer
drawY = (boxHeight - imgH) / 2
_putimage (drawX, drawY), layers(i).ihandle
next
end sub
function icon(index as long)
static init as integer
static icons() as long
if not init then
dim icons(5) as long
icons(0)=_newimage(32,32,32)
_dest icons(0)
line (5,27)-(27,5)
icons(1)=_newimage(32,32,32)
_dest icons(1)
circle (15,15),13
icons(2)=_newimage(32,32,32)
_dest icons(2)
_dest 0
init = -1
end if
if (index>=lbound(icons)) and (index<=ubound(icons)) then
icon=icons(index)
end if
end function
'$include: 'include/ui.bm'
'$include: 'include/imgout.bm'
'$include: 'include/palette.bm'
function adduiicon(imagehandle as long)
dim unknown as long
adduiicon=__internaluiicon(unknown,imagehandle,1)
end function
function adduiiconfromfile(filename as string)
dim unknown as long
adduiiconfromfile=__internaluiicon(unknown,_loadimage(filename),1)
end function
function uiicon(index)
dim unknown as long
uiicon=internaluiicon(index,unknown,2)
end function
function __internaluiicon&(index as long,imagehandle as long,mode as integer)
static init as integer
static icons() as long
if not init or mode=3 then
if mode<3 then
redim icons(3) as long
else
_freeimage icons(0)
_freeimage icons(1)
_freeimage icons(2)
_freeimage icons(3)
end if
icons(0)=_newimage(23,23,32) 'Up arrow'
_dest icons(0)
color textcolor
icons(1)=_newimage(23,23,32) 'Down arrow'
_dest icons(1)
color textcolor
icons(2)=_newimage(23,23,32) 'Left arrow'
_dest icons(2)
color textcolor
icons(3)=_newimage(23,23,32) 'Right arrow'
_dest icons(3)
color textcolor
_dest 0
init=-1
end if
select case mode
case 1
redim _preserve icons(ubound(icons)+1)
icons(ubound(icons))=imagehandle
__internaluiicon=ubound(icons)
case 2
__internaluiicon=icons(index)
end select
end function
FUNCTION CheckResize (CurrentScreen AS _UNSIGNED LONG) 'pulled straight out of the wiki'
DIM TempScreen AS _UNSIGNED LONG
CheckResize = 0
IF _RESIZE THEN
TempScreen = _COPYIMAGE(CurrentScreen, 32)
SCREEN TempScreen
_FREEIMAGE CurrentScreen
CurrentScreen = _NEWIMAGE(_RESIZEWIDTH, _RESIZEHEIGHT, 32)
SCREEN CurrentScreen
_PUTIMAGE (0, 0), TempScreen, CurrentScreen
_DISPLAY
_FREEIMAGE TempScreen
CheckResize = -1
END IF
END FUNCTION