"paint" by Sven B27th Dec 2004 7:08
|
---|
Summary It's not really a paint program. I didn't program the freehand tool for example. But it makes a good start... Description Code ` This code was downloaded from The Game Creators ` It is reproduced here with full permission ` http://www.thegamecreators.com `*************************************** `paint `*************************************** sync on : sync rate 0 dim line(1000,5) : lines=0 dim circle(1000,4) : circles=0 dim fbox(1000,5) : dim ebox(1000,5) : fboxes=0 : eboxes=0 dim ellipse(1000,5) : ellipses=0 mode$="" : message$="" red=55 green=255 blue=25 color=rgb(red,green,blue) do message$="" cls ink color,0 if draw=1 then gosub draw gosub display gosub interface sync loop `********* `submenu's `********* draw: if mode$="line" if mouseclick()=1 if mode=0 mode=1 startx=mousex() starty=mousey() endif if mode=1 line startx,starty,mousex(),mousey() endif endif if mouseclick()=0 and mode=1 mode=0 inc lines line(lines,1)=startx : line(lines,2)=starty line(lines,3)=mousex() : line(lines,4)=mousey() line(lines,5)=color endif endif if mode$="circle" if mouseclick()=1 if mode=0 mode=1 startx=mousex() starty=mousey() endif if mode=1 circle startx,starty,mousex()-startx endif endif if mouseclick()=0 and mode=1 mode=0 inc circles circle(circles,1)=startx : circle(circles,2)=starty circle(circles,3)=mousex()-startx circle(circles,4)=color endif endif if mode$="fbox" if mouseclick()=1 if mode=0 mode=1 startx=mousex() starty=mousey() endif if mode=1 box startx,starty,mousex(),mousey() endif endif if mouseclick()=0 and mode=1 mode=0 inc fboxes fbox(fboxes,1)=startx : fbox(fboxes,2)=starty fbox(fboxes,3)=mousex() : fbox(fboxes,4)=mousey() fbox(fboxes,5)=color endif endif if mode$="ebox" if mouseclick()=1 if mode=0 mode=1 startx=mousex() starty=mousey() endif if mode=1 line startx,starty,mousex(),starty line startx,starty,startx,mousey() line mousex(),mousey(),startx,mousey() line mousex(),mousey(),mousex(),starty endif endif if mouseclick()=0 and mode=1 mode=0 inc eboxes ebox(eboxes,1)=startx : ebox(eboxes,2)=starty ebox(eboxes,3)=mousex() : ebox(eboxes,4)=mousey() ebox(eboxes,5)=color endif endif if mode$="ellipse" if mouseclick()=1 if mode=0 mode=1 startx=mousex() starty=mousey() endif if mode=1 ellipse startx,starty,mousex()-startx,mousey()-starty endif endif if mouseclick()=0 and mode=1 mode=0 inc ellipses ellipse(ellipses,1)=startx : ellipse(ellipses,2)=starty ellipse(ellipses,3)=mousex()-startx : ellipse(ellipses,4)=mousey()-starty ellipse(ellipses,5)=color endif endif return display: if lines>0 and lines<1000 for x=1 to lines ink line(x,5),0 line line(x,1),line(x,2),line(x,3),line(x,4) next x endif if circles>0 and circles<1000 for x=1 to circles ink circle(x,4),0 circle circle(x,1),circle(x,2),circle(x,3) next x endif if fboxes>0 and fboxes<1000 for x=1 to fboxes ink fbox(x,5),0 box fbox(x,1),fbox(x,2),fbox(x,3),fbox(x,4) next x endif if eboxes>0 and eboxes<1000 for x=1 to eboxes ink ebox(x,5),0 line ebox(x,1),ebox(x,2),ebox(x,3),ebox(x,2) line ebox(x,1),ebox(x,2),ebox(x,1),ebox(x,4) line ebox(x,3),ebox(x,4),ebox(x,3),ebox(x,2) line ebox(x,3),ebox(x,4),ebox(x,1),ebox(x,4) next x endif if ellipses>0 and ellipses<1000 for x=1 to ellipses ink ellipse(x,5),0 ellipse ellipse(x,1),ellipse(x,2),ellipse(x,3),ellipse(x,4) next x endif return interface: ink rgb(0,0,0),0 : box 1,screen height()-30,screen width()-1,screen height()-1 ink rgb(200,200,200),0 : line 0,screen height()-30,screen width()-1,screen height()-30 if mousey()>screen height()-30 then draw=0 else draw=1 `line if mousey()>screen height()-30 and mousex()<30 message$="draw a line" ink rgb(255,0,0),0 if mouseclick()=1 then mode$="line" else message$="" ink rgb(200,200,200),0 endif line 5,screen height()-5,25,screen height()-25 `circle if mousey()>screen height()-30 and mousex()>30 and mousex()<60 message$="draw a circle" ink rgb(255,0,0),0 if mouseclick()=1 then mode$="circle" else ink rgb(200,200,200),0 endif circle 45,screen height()-15,10 `filled box if mousey()>screen height()-30 and mousex()>60 and mousex()<90 message$="draw a filled box" ink rgb(255,0,0),0 if mouseclick()=1 then mode$="fbox" else ink rgb(200,200,200),0 endif box 65,screen height()-25,85,screen height()-5 `empty box if mousey()>screen height()-30 and mousex()>90 and mousex()<120 message$="draw an empty box" ink rgb(255,0,0),0 if mouseclick()=1 then mode$="ebox" else ink rgb(200,200,200),0 endif line 95,screen height()-25,115,screen height()-25 line 95,screen height()-25,95,screen height()-5 line 95,screen height()-5,115,screen height()-5 line 115,screen height()-25,115,screen height()-5 `ellipse if mousey()>screen height()-30 and mousex()>120 and mousex()<150 message$="draw an ellipse" ink rgb(255,0,0),0 if mouseclick()=1 then mode$="ellipse" else ink rgb(200,200,200),0 endif ellipse 135,screen height()-15,10,7 `color if mousey()>screen height()-30 and mousex()>150 and mousex()<180 message$="choose color" ink rgb(255,0,0),0 if mouseclick()=1 and hold=0 then hold=1 : gosub choose_color else ink color,0 endif box 155,screen height()-20,175,screen height()-10 `exit if button(320,screen height()-15,"exit")>0 then end `message ink rgb(255,255,255),0 if draw=1 if mode$="line" then message$="drag the mouse to draw a line" if mode$="circle" then message$="drag the mouse to draw a circle" if mode$="fbox" then message$="drag the mouse to draw a filled box" if mode$="ebox" then message$="drag the mouse to draw an empty box" if mode$="ellipse" then message$="drag the mouse to draw an ellipse" endif text screen width()-10-text width(message$),screen height()-23,message$ return choose_color: mode$="" do cls `interface ink rgb(200,200,200),0 : line 0,screen height()-30,screen width()-1,screen height()-30 line 5,screen height()-5,25,screen height()-25 circle 45,screen height()-15,10 box 65,screen height()-25,85,screen height()-5 line 95,screen height()-25,115,screen height()-25 line 95,screen height()-25,95,screen height()-5 line 95,screen height()-5,115,screen height()-5 line 115,screen height()-25,115,screen height()-5 ellipse 135,screen height()-15,10,7 gosub display ink rgb(red,green,blue),0 box 155,screen height()-20,175,screen height()-10 `display red,green and blue values ink rgb(255,255,255),0 box 154,screen height()-285,159,screen height()-30 box 161,screen height()-285,166,screen height()-30 box 168,screen height()-285,173,screen height()-30 ink rgb(255,0,0),0 : box 154,screen height()-30-red,159,screen height()-30 ink rgb(0,255,0),0 : box 161,screen height()-30-green,166,screen height()-30 ink rgb(0,0,255),0 : box 168,screen height()-30-blue,173,screen height()-30 if mousey()<screen height()-30 if mouseclick()=1 if mousex()>154 and mousex()<159 then red=screen height()-30-mousey() if mousex()>161 and mousex()<166 then green=screen height()-30-mousey() if mousex()>168 and mousex()<173 then blue=screen height()-30-mousey() if red>255 then red=255 if green>255 then green=255 if blue>255 then blue=255 endif else if mouseclick()=1 and hold=0 then color=rgb(red,green,blue) : exit endif if mouseclick()=0 then hold=0 sync loop return `******** `function `******** function button(x,y,text$) pressed=0 tx=text width(text$) ty=text height(text$) if mousex()>x and mousex()<x+tx if mousey()>y-ty and mousey()<y+ty pressed=1 endif endif if pressed=1 then ink rgb(255,0,0),0 else ink rgb(200,200,200),0 set text size 18 : text x,y-8,text$ if mouseclick()=0 then pressed=0 endfunction pressed |