$include "savebitmap.inc" 'a simple drawing program. 'for Emergence BASIC 'Compile as a WINDOWS target DEF mywin AS WINDOW DEF drawcolor,l,t,w,h,x,tempx,tempy,linesize:INT DEF out1,out2,temp,temo2:FLOAT DEF filename,filter:STRING DEF bml,bmt,bmw,bmh,hbitmap:INT DECLARE handlemouse(mx:int,my:int,qual:int) 'open a window and add the menus OPENWINDOW mywin,0,0,640,480,@SIZE|@MINBOX|@MAXBOX|@MAXIMIZED,0,"Simple Draw",&mysub BEGINMENU mywin MENUTITLE "&File" MENUITEM "Print",0,101 MENUITEM "&Save",0,102 MENUITEM "&Load",0,103 MENUITEM "Quit",0,100 MENUTITLE "Options" MENUITEM "Color",0,99 MENUITEM "Clear",0,1 BEGINPOPUP "Line Size" MENUITEM "1",@MENUCHECK,2 MENUITEM "2",0,3 MENUITEM "3",0,4 MENUITEM "4",0,5 ENDPOPUP MENUTITLE "Tools" MENUITEM "Line",@MENUCHECK,6 MENUITEM "Rectangle",0,7 MENUITEM "Circle",0,8 MENUITEM "Spray",0,9 MENUITEM "FILL",0,10 ENDMENU drawcolor = 0 linesize = 1 'line mywin,5,5,200,5,RGB(0,255,255) 'lineto mywin,200,100,RGB(0,255,255) 'lineto mywin,5,100,RGB(0,255,255) 'lineto mywin,5,5,RGB(0,255,255) FRONTPEN mywin,drawcolor run = 1 mode = 0 'process messages until someone closes us WAITUNTIL run = 0 CLOSEWINDOW mywin END 'the windows message handler 'all interaction is handled by this subroutine SUB mysub SELECT @CLASS CASE @IDCLOSEWINDOW run = 0 CASE @IDLBUTTONDN l = @MOUSEX t = @MOUSEY w = 0 h = 0 MOVE mywin,l,t IF mode = 3 STARTTIMER mywin,10 ENDIF IF mode = 4 FLOODFILL mywin,l,t,drawcolor ENDIF CASE @IDMOUSEMOVE handlemouse(@MOUSEX,@MOUSEY,@QUAL) CASE @IDLBUTTONUP SELECT mode CASE 0 line mywin, l,t,@MOUSEX,@MOUSEY,drawcolor CASE 1 RECT mywin, l,t,@MOUSEX-l,@MOUSEY-t,drawcolor,drawcolor CASE 2 ELLIPSE mywin, l,t,@MOUSEX-l,@MOUSEY-t,drawcolor,drawcolor CASE 3 STOPTIMER mywin ENDSELECT CASE @IDRBUTTONUP CONTEXTMENU mywin,@MOUSEX,@MOUSEY MENUITEM "Color",0,99 MENUITEM "Clear",0,1 BEGINPOPUP "Line Size" MENUITEM "1",(linesize = 1) * @MENUCHECK,2 MENUITEM "2",(linesize = 2) * @MENUCHECK,3 MENUITEM "3",(linesize = 3) * @MENUCHECK,4 MENUITEM "4",(linesize = 4) * @MENUCHECK,5 ENDPOPUP ENDMENU CASE @IDMENUPICK 'clear the window IF(@MENUNUM = 1) GETSCREENSIZE w,h rect mywin,0,0,w,h,RGB(255,255,255),RGB(255,255,255) ENDIF 'set line size IF(@MENUNUM > 1 & @MENUNUM < 6) SETLINESTYLE mywin,@LSSOLID, @MENUNUM - 1 linesize = @MENUNUM - 1 ENDIF 'pick a tool IF(@MENUNUM > 5 & @MENUNUM < 11) mode = @MENUNUM - 6 ENDIF 'pick a color IF(@MENUNUM = 99) temp = drawcolor drawcolor = COLORREQUEST(mywin,drawcolor) IF(drawcolor = -1) drawcolor = temp ENDIF FRONTPEN mywin,drawcolor ENDIF 'quit IF @MENUNUM = 100 run = 0 ENDIF 'print IF @MENUNUM = 101 PRINTWINDOW mywin ENDIF 'save the image IF @MENUNUM = 102 filter = "Bitmap Files (*.bmp)|*.bmp||" filename = FILEREQUEST("Save Bitmap",mywin,0,filter,"bmp") if len(filename) GETCLIENTSIZE mywin,bml,bmt,bmw,bmh SaveBitmap(filename,mywin,bml,bmt,bmw,bmh) endif ENDIF 'load a btimap IF @MENUNUM = 103 filter = "Bitmap Files (*.bmp)|*.bmp||" filename = FILEREQUEST("Load Bitmap",mywin,1,filter,"bmp") if len(filename) hbitmap = loadimage(filename,0) if hbitmap GETSCREENSIZE w,h rect mywin,0,0,w,h,RGB(255,255,255),RGB(255,255,255) getbitmapsize hbitmap,bmw,bmh showimage mywin,hbitmap,0,0,0,bmw,bmh deleteimage hbitmap,0 endif endif ENDIF CASE @IDMENUINIT CHECKMENUITEM mywin,6,(mode = 0) CHECKMENUITEM mywin,7,(mode = 1) CHECKMENUITEM mywin,8,(mode = 2) CHECKMENUITEM mywin,9,(mode = 3) CHECKMENUITEM mywin,10,(mode = 4) CHECKMENUITEM mywin,2,(linesize = 1) CHECKMENUITEM mywin,3,(linesize = 2) CHECKMENUITEM mywin,4,(linesize = 3) CHECKMENUITEM mywin,5,(linesize = 4) CASE @IDTIMER for x = 1 to 10 temp = RND(360) * (3.1415/180.0) temp2 = RND(10) out1 = SIN(temp) * temp2 out2 = COS(temp) * temp2 PSET mywin,tempx+out1,tempy+out2 next x ENDSELECT RETURN ENDSUB 'this subroutine handles mouse move messages 'we perform various actions depending on the 'current drawing mode. SUB handlemouse(mx:int,my:int,qual:int) tempx = mx tempy = my IF(qual = 1) SELECT mode case 0 RASTERMODE mywin,@RMXORPEN LINE mywin,l,t,mx,my,RGB(255,255,255) RASTERMODE mywin,@RMCOPYPEN case 1 RASTERMODE mywin,@RMXORPEN RECT mywin,l,t,w,h,RGB(255,255,255) RASTERMODE mywin,@RMCOPYPEN case 2 RASTERMODE mywin,@RMXORPEN ELLIPSE mywin,l,t,w,h,RGB(255,255,255) RASTERMODE mywin,@RMCOPYPEN ENDSELECT w = mx - l h = my - t SELECT mode case 0 RASTERMODE mywin,@RMXORPEN LINE mywin,l,t,mx,my,RGB(255,255,255) RASTERMODE mywin,@RMCOPYPEN case 1 RASTERMODE mywin,@RMXORPEN RECT mywin,l,t,w,h,RGB(255,255,255) RASTERMODE mywin,@RMCOPYPEN case 2 RASTERMODE mywin,@RMXORPEN ELLIPSE mywin,l,t,w,h,RGB(255,255,255) RASTERMODE mywin,@RMCOPYPEN ENDSELECT ENDIF RETURN ENDSUB