TheGameCreators - CodeBase

Return to the CodeBase listing

Category: Basic 2D

Version: 1.0

Information

Uploaded: 27th Dec 2004 07:08

Modified: 1st Jan 1970 01:00

Author: Sven B

Summary

It's not really a paint program. I didn't program the freehand tool for example. But it makes a good start...

Full Description

DarkBASIC Source 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)

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

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

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

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

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

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

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

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

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

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

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$=""

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

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

Download

Please login to download

Comments

No comments yet.

CodeBase - "paint"

Information

Summary

Full Description

DarkBASIC Source Code

Download

Screen Shot

Author

Comments

Author Name:	Sven B
CodeBase Entries:	12

CodeBase - &quot;paint&quot;

Information

Summary

Full Description

DarkBASIC Source Code

Download

Screen Shot

Author

Comments

CodeBase - "paint"