TheGameCreators - CodeBase

Return to the CodeBase listing

Category: Complete Applications

Version: 1.8

Information

Uploaded: 13th Jan 2009 16:21

Modified: 1st Jan 1970 01:00

Author: Caleb1994

Summary

Simple Paint Program.

Full Description

Draws Lines Pencil Circle(filled) Circle(outline) Box(filled) Box(Outline) Other Features: Eraser Clear Button Lead image save image Warns when image your trying to save already exists Minimize Exit !!Note!! Media and DBA File in download :) !!Note!!

DarkBASIC Source Code

` This code was downloaded from The Game Creators

` It is reproduced here with full permission

` http://www.thegamecreators.com

sync on

sync rate 0

Disable escapekey

hide mouse

#include "GUI.dba"

load image "Colors.bmp",1

Load image "Save.bmp",2

Load image "Save_Pressed.bmp",3

Load image "Clear.bmp",4

Load image "Clear_Pressed.bmp",5

Load image "Pencil.bmp",6

Load image "Pencil_pressed.bmp",7

Load image "eraser.bmp",8

Load image "Eraser_Pressed.bmp",9

ink rgb(255,255,255),0

box 1,1,18,18

get image 10,0,0,20,20

Load image "Load.bmp",11

Load image "load_Pressed.bmp",12

Load image "WindowNo.png",13

Load image "WindowEnd.png",14

Load image "WindowMin.png",15

Load image "Box.bmp",16

Load image "Box_Pressed.bmp",17

Load image "Circle.bmp",18

Load image "Circle_Clicked.bmp",19

Load image "line.bmp",20

Load image "Line Pressed.bmp",21

cls

Ink RGB(0,0,128),0

Circle 5,5,5

Ink RGB(215,2,7),0

Circle 5.9,5,3

Ink RGB(40,172,2),0

Dot 5,5

Get image 64000,0,0,15,15

Dim Files$(1000,2): Dim Drv$(26)

Dim Temp$(1000,2): Dim GotDrives(0)

Dim Path$(0): Dim Filename$(0)

Dim SliderHeight(0): Dim FileOffset(0)

initguisystem()

draw_box()

Pencil=1

Draw_Color=RGB(255,255,255)

Filled=1

Outline=0

pdone=1

Sprite 11,MouseX()-5,MOuseY()-5,64000

draw_box()

Paste image 1,0,20

Paste image 13,0,0

Gosub Buttons

if mouseclick() and pickcolor(mouseX(),175,mouseY(),50)=1 and hold=0 and mousey()>15

Draw_Color=Point(MouseX(),MouseY() )

Dclick=1

endif

IF dclick=1 and mouseclick()=0

Clicknum=Clicknum+1

endif

if Eraser=1

gosub Erase

else

if sprite exist(10)

delete sprite 10

endif

If drawbox#=1

Gosub Drawbox

endif

If Pencil=1

Gosub Pencil

endif

If circle=1

Gosub Circles

endif

if line=1

gosub lines

endif

If mouseclick() and MouseX()<175 and MouseY()<50 and Clicknum>0 and Clicknum<10

show mouse

Colourval=Colourpicker(1)

hide mouse

IF colourval<>-1

Draw_Color=ColourVal

endif

clicknum=0

dclick=0

endif

If Clicknum>10

Clicknum=0

Dclick=0

endif

sync

get image 50,175,15,640,480

clear()

loop

`---------------------------

`-----Subroutines-----------

`---------------------------

Buttons:

if controlkey() and keystate(31)

if Pressed=0

if image exist(40)

delete image 40

endif

get image 40,175,15,screen width()-2,screen height()-5

check:

if file exist("saved images/Untitled"+str$(num)+".bmp")

Num=Num+1

endif

If file exist("saved images/Untitled"+str$(num)+".bmp")

Gosub Check

endif

Save image "saved images/Untitled"+str$(num)+".bmp",40

pressed=1

endif

else

Pressed=0

endif

if controlkey() and keystate(46)

show mouse

if Alertbox("Clear screen","Are you sure you want to clear the screen?",0,1)=1

Cls

Paste image 5,0,230

paste image 2,0,200

draw_box()

paste image 1,0,15

Paste image 13,0,0

hide mouse

endif

if saving=1 and mouseclick()=0

paste image 2,0,100

if MouseX()>0 and MouseX()<80 and MouseY()>100 and MouseY()<130

SaveSelect=Fileselect(GET DIR$(),"Save Image","BMP",0,1)

hide mouse

else

saving=0

endif

If saveselect>0

If File exist(Path$(0)+Filename$(0))

show mouse

Alert=AlertBox("Overwrite","File Already Exists! Overwrite?",0,2)

hide mouse

If alert=1

Delete file Path$(0)+FileName$(0)

Save Image Path$(0)+FileName$(0),40

Clear=1

else

clear=1

endif

if file exist(Path$(0)+FileName$(0))=0

Save image Path$(0)+FileName$(0),40

endif

saving=0

saveselect=0

else

saving=0

saveselect=0

endif

if clear=1

CLS

Paste image 40,175,15

clear=0

endif

if mouseclick()

if MouseX()>0 and MouseX()<80 and MouseY()>100 and MouseY()<130

Paste image 3,0,100

if IMAGE EXIST(40)

delete image 40

endif

get image 40,175,15,screen width()-2,screen height()-5.

Get image 40,174,15,638,475

saving=1

else

paste image 2,0,100

endif

else

paste image 2,0,100

endif

if mouseclick() and mouseX()>0 and MouseX()<80 and MouseY()>130 and mouseY()<160

paste image 5,0,130

clearscreen=1

else

paste image 4,0,130

endif

if clearscreen=1 and mouseclick()=0

if mouseX()>0 and MouseX()<80 and MouseY()>130 and mouseY()<160

show mouse

paste image 4,0,130

get image 40,175,15,640,480

if Alertbox("Clear screen","Are you sure you want to clear the screen?",0,1)=1

Cls

Paste image 5,0,130

paste image 2,0,100

draw_box()

paste image 1,0,20

Paste image 13,0,0

Hide mouse

else

Cls

Paste image 5,0,130

paste image 2,0,100

draw_box()

paste image 1,0,20

Paste image 13,0,0

paste image 40,175,15

Hide mouse

endif

else

clearscreen=0

endif

clearscreen=0

endif

If mouseclick() and mouseX()>0 and MouseX()<80 and MouseY()>160 and MouseY()<190

paste image 7,0,160

Pencil=1

Drawbox#=0

Eraser=0

Circle=0

Line=0

else

paste image 6,0,160

endif

If mouseclick() and mouseX()>0 and MouseX()<80 and MouseY()>190 and MouseY()<220

paste image 9,0,190

Eraser=1

Drawbox#=0

pencil=0

Circle=0

Line=0

hide mouse

else

paste image 8,0,190

endif

If mouseclick() and MouseX()>0 and MouseX()<80 and MouseY()>220 and Mousey()<250

Paste image 17,0,220

Drawbox#=1

Eraser=0

Pencil=0

Circle=0

Line=0

else

Paste image 16,0,220

endif

If mouseclick() and MouseX()>0 and MOuseX()<80 and MouseY()>250 and MouseY()<280

Paste image 19,0,250

Circle=1

Eraser=0

Pencil=0

Drawbox#=0

Line=0

else

paste image 18,0,250

endif

If mouseclick() and MouseX()>0 and MouseX()<80 and MouseY()>280 and MouseY()<310

Paste image 20,0,280

Line=1

Circle=0

Pencil=0

Eraser=0

Drawbox#=0

else

Paste image 21,0,280

endif

If mouseclick() and MouseX()>0 and MouseX()<80 and MouseY()>310 and MouseY()<340

Paste image 12,0,310

CLicked=1

else

Paste image 11,0,310

endif

if clicked=1

if mouseclick()=0

if MouseX()>0 and MouseX()<80 and MouseY()>310 and MouseY()<340

Load:

Show Mouse

selected=fileselect(Get Dir$(),"Load Image(Image size Less then 465X465) ","BMP",0,1)

select=1

Hide mouse

else

clicked=0

endif

If selected>0 and select=1

if file exist(path$(0)+Filename$(0))=0

show mouse

MessageBox("No Image","Image Does not exist",1)

Goto Load

endif

Load image Path$(0)+FileName$(0),1000

Paste image 1000,175,15

Clicked=0

path$(0)=""

Filename$(0)=""

selected=0

select=0

Hide mouse

endif

if select=1 and mouseclick()=0

select=0

clicked=0

selected=0

endif

If mouseclick() and MouseX()<Screen width()-5 and MouseX()>Screen Width()-23 and MouseY()>0 and MouseY()<15

Paste image 14,0,0

Exit=1

endif

If exit=1 and Mouseclick()=0

if sprite exist(10)

hide sprite 10

endif

Show mouse

Endprogram=Alertbox("End Program?","Are you sure you want to close?",1,1)

If endprogram=1

Messagebox("Info!","All Message Boxes were Made by TDKman",1)

end

else

Hide Mouse

endif

exit=0

endif

If Mouseclick() and MouseX()<screen width()-26 and MouseX()>Screen width()-44 and MouseY()>0 and mousey()<15

Paste image 15,0,0

Min=1

endif

If min=1 and mouseclick()=0

Minimize window

Min=0

endif

If mouseclick()=0 and MouseX()>screen width()-5 and MouseX()<Screen Width()-44 and Mousey()>15

Paste image 13,0,0

endif

return

Drawbox:

If keystate(2) then Filled=1 : Outline=0

if Keystate(3) then Filled=0 : Outline=1

If Filled=1

If Mouseclick() and Mouseinside(MouseX(),175) and MouseY()>15

If f=0

X1=MouseX()

y1=Mousey()

Get image 6000,175,15,640,480

endif

f=1

MC=1

Cls

paste image 2,0,100

draw_box()

paste image 1,0,20

Paste image 13,0,0

Paste image 4,0,130

Paste image 6,0,160

Paste image 8,0,190

Paste image 21,0,280

Paste image 18,0,250

Paste image 16,0,220

Paste image 6000,175,15

Paste image 11,0,310

INk Draw_Color,0

If MouseX()>X1

Box X1,Y1,MouseX(),MouseY()

else

Box MouseX(),MouseY(),X1,Y1

endif

if mouseclick()=0 and mc=1 then X2=MouseX() : Y2=MouseY() : MC=0 : draw=1

if draw=1

ink Draw_Color,0

box X1,y1,X2,y2

X1=0

y1=0

x2=0

y2=0

f=0

draw=0

endif

If Outline=1

If Mouseclick() and Mouseinside(MouseX(),175) and MouseY()>15

If f=0

X1=MouseX()

y1=Mousey()

Get image 6000,175,15,640,480

endif

f=1

MC=1

Cls

paste image 2,0,100

draw_box()

paste image 1,0,20

Paste image 13,0,0

Paste image 4,0,130

Paste image 6,0,160

Paste image 8,0,190

Paste image 21,0,280

Paste image 18,0,250

Paste image 16,0,220

Paste image 6000,175,15

paste image 11,0,310

If MouseX()>X1

ink Draw_Color,0

Line X1,Y1,MOuseX(),Y1

Line X1,Y1,X1,MouseY()

Line X1,MouseY(),MOuseX(),MouseY()

Line MouseX(),Y1,MOuseX(),MOuseY()

else

ink Draw_Color,0

Line X1,Y1,MOuseX(),Y1

Line X1,Y1,X1,MouseY()

Line X1,MouseY(),MOuseX(),MouseY()

Line MouseX(),Y1,MOuseX(),MOuseY()

endif

if mouseclick()=0 and mc=1 then X2=MouseX() : Y2=MouseY() : MC=0 : draw=1

if draw=1

ink Draw_Color,0

Line X1,Y1,X2,Y1

Line X1,Y1,X1,Y2

Line X1,Y2,X2,Y2

Line X2,Y1,X2,Y2

X1=0

y1=0

x2=0

y2=0

f=0

draw=0

endif

return

erase:

sprite 10,mouseX(),Mousey(),10

set sprite 10,1,0

hide sprite 10

if mouseclick()

if mouseinside(mouseX(),175)

show sprite 10

mx#=mouseX()

my#=MouseY()

ink RGB(0,0,0),0

box mx#,My#,MX#+20,My#+20

endif

if mouseinside(mouseX(),175) and MouseY()>15

show sprite 10

hide mouse

hide sprite 11

else

hide sprite 10

show sprite 11

endif

return

Pencil:

if mouseclick() and Mouseinside(mouseX(),175)>0 and Eraser=0 and drawbox#=0

if hold=0

hold=1

oldmx#=mouseX()

oldmy#=mouseY()

endif

else

hold=0

endif

if hold=1

mx#=mouseX()

my#=MouseY()

ink Draw_Color,0

line oldmx#,oldmy#,mx#,my#

oldmx#=mx#

oldmy#=my#

endif

return

Circles:

If keystate(2) then Filled=1 : outline=0

If keystate(3) then Outline=1 : filled=0

If filled=1

If Mouseclick() and Mouseinside(MouseX(),175) and MouseY()>15

If f=0

X1=MouseX()

y1=Mousey()

endif

f=1

MC=1

endif

if mouseclick()=0 and mc=1

if MouseX()>175

X2=MouseX() : Y2=MouseY() : MC=0 : draw=1

else

MC=0

endif

if draw=1

Ink Draw_Color,0

CircleD=(X2-X1)

For D2=0 to CircleD

Circle X1+(circleD/2),Y1+(circled/2),D2

next D2

X1=0

y1=0

x2=0

y2=0

f=0

draw=0

endif

If Outline=1

If Mouseclick() and Mouseinside(MouseX(),175) and MouseY()>15

If f=0

X1=MouseX()

y1=Mousey()

endif

f=1

MC=1

endif

if mouseclick()=0 and mc=1

if MouseX()>175

X2=MouseX() : Y2=MouseY() : MC=0 : draw=1

else

MC=0

endif

if draw=1

Ink Draw_Color,0

CircleD=(X2-X1)

Circle X1+(circleD/2),Y1+(circled/2),Circled

X1=0

y1=0

x2=0

y2=0

f=0

draw=0

endif

return

Lines:

If mouseclick() and MouseX()>175 and MouseY()>15

If F=0

X1=MouseX()

Y1=MouseY()

Get image 6000,175,15,640,480

endif

F=1

MC=1

Cls

paste image 2,0,100

draw_box()

paste image 1,0,20

Paste image 13,0,0

Paste image 4,0,130

Paste image 6,0,160

Paste image 8,0,190

Paste image 11,0,310

Paste image 18,0,250

Paste image 16,0,220

Paste image 21,0,280

Paste image 6000,175,15

ink draw_color,0

Line X1,Y1,MouseX(),Mousey()

endif

If mouseclick()=0 and MC=1

ink draw_color,0

Line X1,Y1,MouseX(),Mousey()

X1=0

Y1=0

X2=0

Y2=0

MC=0

F=0

endif

return

function mouseinside(mx,num)

if mx>num

Outside=1

else

outside=0

endif

endfunction outside

function pickcolor(mx,num1,my,num2)

if mx<num1 and my<num2

picked=1

else

picked=0

endif

endfunction picked

function draw_box()

ink rgb(255,255,255),0

line 175,0,175,900

line 175,15,900,15

line screen width()-2,0,screen width()-2,900

line 175,screen height()-5,900,screen height()-5

endfunction

function clear()

Cls

paste image 50,175,15

Paste image 5,0,130

paste image 2,0,100

paste image 4,0,130

paste image 6,0,160

paste image 8,0,190

Paste image 16,0,220

paste image 18,0,250

Paste image 21,0,280

paste image 11,0,310

draw_box()

paste image 1,0,20

Paste image 13,0,0

Hide mouse

endfunction

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:	Caleb1994
CodeBase Entries:	3