type statetype tool as long fcolor as long bcolor as long offsetX as single offsetY as single zoom as single brushsize as integer startX as integer startY as integer isDrawing as integer end type type layertype ihandle as long blendmode as long filter as long kind as long end type redim shared layers(2) 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(750,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) layers(2).ihandle=_newimage(640,350,32) _dest layers(0).ihandle line (0,0)-(_width-1,_height-1),_rgb32(255),bf _dest 0 state.tool = 1 state.fcolor = 1 state.bcolor = 2 state.zoom = 1.0 state.offsetX = 70 + 20 ' To the right of the toolbox state.offsetY = 20 state. brushsize = 1 dim lastMX, lastMY dim diffX as integer dim diffY as integer dim oldWidth as integer dim oldHeight as integer dim keyin as string oldWidth=_width oldHeight=_height do if CheckResize(_source) = -1 THEN diffX = _width - oldWidth diffY = _height - oldHeight state.offsetX = state.offsetX + (diffX / 2) state.offsetY = state.offsetY + (diffY / 2) oldWidth = _width oldHeight = _height end if cls line (0,0)-(_width-1,_height-1),backgroundcolor1,bf 'Mouse Handling while _mouseinput:mw=mw+_mousewheel: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) ' Panning (Middle Mouse) if _mousebutton(3) then state.offsetX = state.offsetX + (_mousex - lastMX) state.offsetY = state.offsetY + (_mousey - lastMY) end if lastMX = _mousex: lastMY = _mousey ' Zooming if mw <> 0 then state.zoom = state.zoom + (mw * 0.1) if state.zoom < 0.1 then state.zoom = 0.1 mw=0 end if ' Keyboarding keyin=inkey$ select case keyin case "+" state.brushsize=state.brushsize+1 case "-" if state.brushsize>1 then state.brushsize=state.brushsize-1 end select _dest 0 canvas 'draw canvas first so it doesn't over toolbox colorpicker _limit 30 _display loop sub toolbox dim i, x, y dim btnSize : btnSize = 32 dim spacing : spacing = 1 for i = 0 to 19 ' Force integer math to keep columns locked at 2 ' x will only ever be 0 or 33 x = (i mod 2) * (btnSize + spacing) ' y will only increase every 2 buttons ' Use Int() if your language doesn't support the \ operator y = Int(i / 2) * (btnSize + spacing) if imagebutton(x, y, btnSize, btnSize, icon(i)) then state.tool = i + 1 end if next 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 dim boxX1 as integer: boxX1 = 70 dim boxWidth as integer: boxWidth = _width - 1 - boxX1 dim boxHeight as integer: boxHeight = _height - 20 ' Workspace background line (boxX1, 0)-(_width - 1, boxHeight), _rgb32(32), bf ' Render Layers (0 = background,1 = drawlayer, 2=reference 3 = Preview) dim i as integer for i = 0 to ubound(layers) dim w as integer: w = _width(layers(i).ihandle) * state.zoom dim h as integer: h = _height(layers(i).ihandle) * state.zoom _putimage (state.offsetX, state.offsetY)-(state.offsetX + w, state.offsetY + h), layers(i).ihandle next ' Translate Mouse to Canvas Space dim canX as integer: canX = (_mousex - state.offsetX) / state.zoom dim canY as integer: canY = (_mousey - state.offsetY) / state.zoom ' Color Selection: Left Click = Foreground, Right Click = Background dim drawCol as _unsigned long if mousedown or mouseclicked then drawCol = state.fcolor else drawCol = state.bcolor ' Interaction Boundary Check if _mousex > boxX1 then ' On Initial Click: Set the anchor point for shapes if (mousedown or rmousedown) and state.isDrawing = 0 then state.startX = canX state.startY = canY state.isDrawing = -1 end if if state.isDrawing then ' preview layer handles the "rubber-banding" of shapes _dest layers(2).ihandle cls , 0 select case state.tool case 1 ' Pencil (Direct to Canvas) _dest layers(1).ihandle thickline state.startX, state.startY, canX, canY, drawCol state.startX = canX: state.startY = canY case 2 ' Straight Line thickline state.startX, state.startY, canX, canY, drawCol case 3 ' Thick Circle (Outline) dim r as single: r = sqr((canX - state.startX)^2 + (canY - state.startY)^2) r=abs(r)+1 thickcircle state.startX, state.startY, r, drawCol case 4 ' Filled Circle dim r_fill as single: r_fill = sqr((canX - state.startX)^2 + (canY - state.startY)^2) filledcircle state.startX, state.startY, r_fill, drawCol case 5 ' Rectangle Outline (using thickline) thickline state.startX, state.startY, canX, state.startY, drawCol thickline canX, state.startY, canX, canY, drawCol thickline canX, canY, state.startX, canY, drawCol thickline state.startX, canY, state.startX, state.startY, drawCol case 6 ' Filled Rectangle line (state.startX, state.startY)-(canX, canY), drawCol, bf case 7 case 8 ' Polygon Outline (using thickline) ' Simple preview of a line; complex polygons usually require ' a point-collection state machine. thickline state.startX, state.startY, canX, canY, drawCol end select ' Release Logic: Commit preview to permanent layer if _mousebutton(1) = 0 and _mousebutton(2) = 0 then _dest layers(1).ihandle _putimage , layers(2).ihandle _dest layers(2).ihandle cls , 0 state.isDrawing = 0 end if _dest 0 end if end if end sub function icon (index as long) static init as integer static icons() as long if not init then redim icons(19) as long ' Room for 20 icons ' Define your specific tool icons here icons(0) = _newimage(32, 32, 32): _dest icons(0): line (5, 27)-(27, 5): _dest 0 icons(1) = _newimage(32, 32, 32): _dest icons(1): circle (15, 15), 13: _dest 0 icons(2) = _newimage(32, 32, 32): _dest icons(2): line (5, 5)-(27, 27), , b: _dest 0 ' Fill the remaining slots with blank 32x32 images dim j as integer for j = 3 to 19 if icons(j) = 0 then icons(j) = _newimage(32, 32, 32) next init = -1 end if ' Bounds checking to prevent returning 0 or crashing if index >= 0 and index <= 19 then icon = icons(index) else icon = icons(0) end if end function '$include: 'include/ui.bm' '$include: 'include/imgout.bm' '$include: 'include/palette.bm' '$include: 'include/tools.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