TheGameCreators - CodeBase

Return to the CodeBase listing

Category: Complete Applications

Version: 1.0

Information

Uploaded: 22nd Feb 2007 20:00

Modified: 1st Jan 1970 01:00

Author: moqzart

Summary

A slide show program

Full Description

This program will display files (".BMP",".JPG",".TGA", ".DDS", ".DIB" & ".PNG") in the current directory and its subfolders (only 1 level deep) in a slideshow. The pictures fade in one after the other.<br /> NOTE: it can take some time to load the directory, esp. if there a large amount of files. Large pictures will also generally slow it down as pictures are rescaled to fit the screen and faded in on top of the last picture.

DarkBASIC Professional Source Code

` This code was downloaded from The Game Creators

` It is reproduced here with full permission

` http://www.thegamecreators.com

REM Types

type fileh

name as string

date as string

creation as string

type as boolean

endtype

REM Globals

global dim directory(0) as fileh

global dim parent(0) as fileh

global continualloop as boolean

global autoslide as boolean

global viewtime

global show2D as boolean

show2D=1                    ` set this to false to show picture on 3d object

continualloop=1             ` set this to run in a continuous loop -default (esc to quit)

autoslide=1                 ` advance slideshow 0 = manual advance - click mouse to advance

`                   1 = automatic advance - default

viewtime=0                  ` auto advance time in milliseconds (1000 = 1 sec - default )

fadeeffect=1                ` fade between pictures

hide mouse

Rem you can use SET DIR Path$ here to set

index=0

find first

while get file type()>-1

array insert at bottom parent()

parent(index).name=get file name$()

parent(index).date=get file date$()

parent(index).creation=get file creation$()

parent(index).type=get file type()

inc index

find next

endwhile

i = 2

repeat

if parent(i).type = 1

getdirectory(parent(i).name)

slideshow()

empty array directory()

set dir parent(1).name

else

getdirectory("")

slideshow()

empty array directory()

endif

inc i

if continualloop

if i=array count(parent()) then i = 2

endif

until i=array count(parent())

function slideshow()

index=0

total=array count(directory())

repeat

displaybitmap(directory(index).name)

if autoslide

wait viewtime

else

suspend for mouse

endif

inc index

until index=total

endfunction

function displaybitmap(bm$)

load bitmap bm$,1

create bitmap 2,screen width(),screen height()

rem get bitmaps dimensions

srcWidth#=bitmap width(1) : srcHeight#=bitmap height(1)

dstWidth#=bitmap width(2) : dstHeight#=bitmap height(2)

rem source dimensions

srcX1=0 : srcX2=srcWidth#

srcY1=0 : srcY2=srcHeight#

rem calculate the difference of the bitmaps ratios

RatioDiff#=(dstHeight#/dstWidth#)-(srcHeight#/srcWidth#)

rem calculate best fit if the picture is too big to display

if srcWidth#>dstWidth# or srcHeight#>dstHeight#

if RatioDiff#>0

rem widescreen solution

Ratio#=srcHeight#/srcWidth#   `calculate needed ratio

dstHeight#=dstWidth#*Ratio#   `rescale height only

endif

if RatioDiff#<0

rem portrait solution

Ratio#=srcWidth#/srcHeight#   `calculate needed ratio

dstWidth#=dstHeight#*Ratio#   `rescale width only

endif

else

rem display picture in original size for best quality

dstWidth#=srcWidth#

dstHeight#=srcHeight#

endif

rem NOTE:- with same ratio we need not do any ratio rescaling

rem now we centre the bitmap

dstX1=(bitmap width(2)/2)-(dstWidth#/2)

dstX2=dstX1+dstWidth#

dstY1=(bitmap height(2)/2)-(dstHeight#/2)

dstY2=dstY1+dstHeight#

rem and now draw the rescaled bitmap

copy bitmap 1,srcX1,srcY1,srcX2,srcY2,2,dstX1,dstY1,dstX2,dstY2

rem we no longer need source bitmap

delete bitmap 1

set current bitmap 0

rem following code is modified from aliasNIGMA's MERGE IMAGE

Width   as Dword

Height  as Dword

Depth   as Dword

Red     as Byte

Green   as Byte

Blue    as Byte

Alpha   as Byte

rem copy bitmaps to memblocks

make memblock from bitmap 1, 0    rem copy current picture

make memblock from bitmap 2, 2    rem copy new picture

rem discard bitmap

delete bitmap 2

dst = 1

Fade# = 0.0

for F = 1 to 100

inc Fade#,0.01

Position = 12

match = 0

for y = 1 to Screen Height()

for x = 1 to Screen Width()

Blue1   =  memblock byte(1,Position)     : Blue2   =  memblock byte(2,Position)

Green1  =  memblock byte(1,Position + 1) : Green2  =  memblock byte(2,Position + 1)

Red1    =  memblock byte(1,Position + 2) : Red2    =  memblock byte(2,Position + 2)

if Blue1=Blue2 and Green1=Green2 and Red1=Red2

inc match,4

else

Blue  = __FadeMerge(Blue1, Blue2, Fade#) : write memblock byte dst,Position    ,Blue

Green = __FadeMerge(Green1,Green2,Fade#) : write memblock byte dst,Position + 1,Green

Red   = __FadeMerge(Red1,  Red2,  Fade#) : write memblock byte dst,Position + 2,Red

endif

inc Position,4

next x

next y

make image from memblock 1,dst

paste image 1,0,0

if scancode()=1 then exit

wait 1

if match=get memblock size(1) then exit

next F

delete memblock 1

delete memblock 2

endfunction

function getdirectory(d$)

if d$<>"" then set dir d$

find first

index=0

while get file type()>-1

array insert at bottom directory(0)

directory(index).name=get file name$()

ext$=GetFilenameExtension(directory(index).name)

select upper$(ext$)

case ".BMP",".JPG",".TGA", ".DDS", ".DIB", ".PNG"

directory(index).date=get file date$()

directory(index).creation=get file creation$()

directory(index).type=get file type()

inc index

endcase

case default

array delete element directory(0),index

endcase

endselect

find next

endwhile

endfunction

function GetFilenameExtension(f$) as string

l=len(f$)

rv$=""

repeat

i$=mid$(f$,l)

rv$=i$+rv$

l=l-1

if l=0 then exit

until i$="."

rv$=lower$(rv$)

endfunction rv$

function __FadeMerge(c1, c2, f#)

result = c1 * (1.0 - f#) + c2 * f#

if result > 255 then result = 255

endfunction result

Download

Please login to download

Comments

No comments yet.

CodeBase - Slideshow

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments

Author Name:	moqzart
CodeBase Entries:	7