TheGameCreators - CodeBase

Category: Complete Applications

Version: 1.0

Information

Uploaded: 26th Jul 2004 09:54

Modified: 16th Aug 2004 05:19

Author: Sven B

Summary

reads .X,.3ds,.bmp,.jpg,.mid,.mp3,.wav and .avi. U can navigate inall files and folders... NO MEDIA ... Little problem: every time the code is current$=current$+""+name$ . there hes to be a backslash(like in DOS). please correct this at line 49,83,143,177,218 and 269. the codebase doesn't support this character...

Full Description

***** IMPORTANT ***** please read this help file... it says how to view imgs, ... - viewing bitmaps press left mouse too drag the picture over the screen. press right mouse button to resize the picture and press control to reset the size of the picture. - viewing models not very special: press the left mouse button to ratate the object around his X and Y axes. - viewing animation,music and sounds all buttons do what they say, so there should be no problems ****** when the browser can't read the file then it won't open.

DarkBASIC Source Code

` This code was downloaded from The Game Creators

` It is reproduced here with full permission

` http://www.thegamecreators.com

`***********************************************

`****              browser						  ****

`***********************************************

sync on

current$=get dir$()

set dir current$

perform checklist for files

`start

y=20

`clear screen

cls rgb(200,200,255)

`search files

find first

find next

name$=get file name$()

`"previous"-button

if button(10,y,"previous")>0 and hold=0 then gosub open : hold=1

`file buttons

for f=1 to checklist quantity()-2

find next

name$=get file name$()

if button(10,y+f*20,name$)>0 and hold=0 then gosub open : hold=1

next f

if upkey()=1 then y=y+3

if downkey()=1 then y=y-3

`create mouse lock

if mouseclick()=0 then hold=0

sync

loop

`********** open clicked files **********

open:

`check file

if get file type()=1

current$=current$+""+name$

set dir current$

current$=get dir$()

set dir current$

perform checklist for files

else

`get file extension:

`-3 character extension

l=len(name$)

type$=mid$(name$,l-2)+mid$(name$,l-1)+mid$(name$,l)

if type$="BMP" or type$="bmp" then gosub view_bmp

if type$="JPG" or type$="jpg" then gosub view_bmp

if type$="3ds" or type$="3DS" then gosub view_obj

if type$="avi" or type$="AVI" then gosub view_avi

if type$="mid" or type$="MID" then gosub view_mid

if type$="mp3" or type$="MP3" then gosub view_mid

if type$="wav" or type$="WAV" then gosub view_wav

`-1 character extension

type$=mid$(name$,l-1)+mid$(name$,l)

if type$=".x" or type$=".X" then gosub view_obj

endif

y=20

return

`********** view bitmaps ***********

view_bmp:

`clear screen

cls

`load bitmap

load bitmap current$+""+name$,1

bx=bitmap width(1)

by=bitmap height(1)

get image 1,0,0,bx,by

`start

mx=5

my=5

sizex=bx

sizey=by

`control

if mouseclick()=1

mx=mx+mousemovex()

my=my+mousemovey()

else

if mouseclick()=2

sizex=sizex+mousemovex()

sizey=sizey+mousemovey()

endif

`reset

if controlkey()=1 then sizex=bx : sizey=by

`exit key

if returnkey()=1 then exit

`update sprite

if sizex<1 then sizex=1

if sizey<1 then sizey=1

sprite 1,mx,my,1

size sprite 1,sizex,sizey

sync

loop

`delete images

delete bitmap 1

delete image 1

delete sprite 1

cls

return

`********** view models **********

view_obj:

`set camera

set camera view 0,0,640,480

set camera range 1,100000

autocam on

backdrop on

color backdrop rgb(200,200,255)

fog on

fog distance 5000

fog color rgb(200,200,255)

`load object

load object current$+""+name$,1

angx#=object angle x(1)

angy#=object angle y(1)

angz#=object angle z(1)

`control object

if mouseclick()=1

yrotate object 1,wrapvalue(angy#-mousemovex())

xrotate object 1,wrapvalue(angx#-mousemovey())

endif

if controlkey()=1 then rotate object 1,0,0,0

`exit key

if returnkey()=1 then exit

sync

loop

`delete

delete object 1

cls

return

`********** view animation **********

view_avi:

`clear screen

cls

`load movie

load animation current$+""+name$,1

`update animation

place animation 1,160,120,480,360

`control

if controlbutton(40,450,"play")>0 and hold=0

if animation playing(1)=0

play animation 1

endif

hold=1

endif

if controlbutton(140,450,"stop")>0 and hold=0

if animation playing(1)=1

stop animation 1

endif

hold=1

endif

if mouseclick()=0 then hold=0

`exit key

if returnkey()=1 then exit

sync

loop

`delete

delete animation 1

cls

return

`********** view music **********

view_mid:

`clear screen

cls

`load midi

load music current$+""+name$,1

if music playing(1)=1 then stop music 1

`start

ink rgb(255,0,0),0

set cursor 50,60

print name$

`control panel

if controlbutton(40,450,"play")>0 and hold=0

if music playing(1)=0 then play music 1

hold=1

endif

if controlbutton(140,450,"stop")>0 and hold=0

if music playing(1)>0 then stop music 1

hold=1

endif

if music paused(1)=0

if controlbutton(240,450,"pause")>0 and hold=0

pause music 1

hold=1

endif

else

if controlbutton(240,450,"resume")>0 and hold=0

resume music 1

hold=1

endif

if mouseclick()=0 then hold=0

`exit key

if returnkey()=1 then exit

sync

loop

`delete

delete music 1

cls

return

`********** view sounds **********

view_wav:

`clear screen

cls

`load sound

load sound current$+""+name$,1

if sound playing(1)=1 then stop sound 1

`start

ink rgb(255,0,0),0

set cursor 50,60

print name$

`control

if controlbutton(40,450,"play")>0 and hold=0

if sound playing(1)=0 then play sound 1

endif

if controlbutton(140,450,"stop")>0 and hold=0

if sound playing(1)=1 then stop sound 1

endif

if mouseclick()=0 then hold=0

`exit key

if returnkey()=1 then exit

sync

loop

`delete

delete sound 1

cls

return

`********************

`functions

`********************

function button(x,y,text$)

pressed=0

tx=text width(text$)

ty=text height(text$)/2

if mousex()<x+tx and mousex()>x

if mousey()<y+ty and mousey()>y-ty

pressed=1

endif

if pressed=1 then ink rgb(0,0,255),0 else ink 0,0

set cursor x,y-8

print text$

if mouseclick()=0 then pressed=0

ink 0,0

endfunction pressed

function controlbutton(x,y,text$)

pressed=0

if mousex()<x+30 and mousex()>x-30

if mousey()<y+10 and mousey()>y-10

pressed=1

endif

if pressed=1 then inkr=1 else inkr=0

if mouseclick()=0 then pressed=0

if pressed=0

ink rgb(230,230,255),0 : box x-31,y-11,x+30,y+10

ink rgb(0,0,75),0 : box x-30,y-10,x+31,y+11

ink rgb(200,200,255),0 : box x-30,y-10,x+30,y+10

else

ink rgb(230,230,255),0 : box x-30,y-10,x+31,y+11

ink rgb(0,0,75),0 : box x-31,y-11,x+30,y+10

ink rgb(100,100,175),0 : box x-30,y-10,x+30,y+10

endif

if inkr=1 then ink rgb(255,0,0),0 else ink 0,0

center text x,y-8,text$

endfunction pressed

Download

Please login to download

Comments

No comments yet.

CodeBase - browser

Information

Summary

Full Description

DarkBASIC Source Code

Download

Screen Shot

Author

Comments

Author Name:	Sven B
CodeBase Entries:	12