Image Viewer with fading effect

Just starting out? Need help? Post your questions and find answers here.
User avatar
Michael Vogel
Addict
Addict
Posts: 2807
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Image Viewer with fading effect

Post by Michael Vogel »

Hi,
I'd like to do a dia show, where all pictures are resized to full screen and faded in and out...

I searched in the forum, but all sprite commands seem to have a transparent color (128/128/128) and there are no image commands to do so... I also found a skinwindow library here, but there I get memory access errors (I don't like libraries)...

So my "solution" is a little bit crazy, I need 3 windows - one for the (black) background and two other for the fading effect - this works slow and seems to be "a little bit" complicate. So, anyone has a better solution for doing the fading?

Thanks,
Michael

Code: Select all

Procedure Init()

	EnableExplicit

	Enumeration
		#Back
		#Pict1
		#Pict2
	EndEnumeration

	Global Bild1=LoadImage(100,"Picture1.bmp")
	Global Bild2=LoadImage(200,"Picture2.bmp")

	Global ScreenX=GetSystemMetrics_(#SM_CXSCREEN)
	Global ScreenY=GetSystemMetrics_(#SM_CYSCREEN)

	;InitSprite()

	Global WinBack=OpenWindow(#Back,0,0,ScreenX,ScreenY,"",#PB_Window_BorderLess|#PB_Window_Invisible)
	Global WinPict1=OpenWindow(#Pict1,0,0,ScreenX,ScreenY,"",#PB_Window_BorderLess|#PB_Window_Invisible)
	Global WinPict2=OpenWindow(#Pict2,0,0,ScreenX,ScreenY,"",#PB_Window_BorderLess|#PB_Window_Invisible)

	SetWindowColor(#Back,0)
	SetWindowColor(#Pict1,0)
	SetWindowColor(#Pict2,0)

	HideWindow(#Back,0)

	CreateGadgetList(WinPict1)
	ImageGadget(100,0,0,ScreenX,ScreenY,Bild1)
	CreateGadgetList(WinPict2)
	ImageGadget(200,0,0,ScreenX,ScreenY,Bild2)

	SetWindowLong_(WinBack,#GWL_EXSTYLE,GetWindowLong_(WinBack,#GWL_EXSTYLE)|#WS_EX_TOOLWINDOW|#WS_EX_TOPMOST)
	SetWindowLong_(WinPict1,#GWL_EXSTYLE,GetWindowLong_(WinPict1,#GWL_EXSTYLE)|#WS_EX_LAYERED|#WS_EX_TOOLWINDOW|#WS_EX_TOPMOST)
	SetWindowLong_(WinPict2,#GWL_EXSTYLE,GetWindowLong_(WinPict2,#GWL_EXSTYLE)|#WS_EX_LAYERED|#WS_EX_TOOLWINDOW|#WS_EX_TOPMOST)

	SetLayeredWindowAttributes_(WinPict1,0,0,#LWA_ALPHA)
	SetLayeredWindowAttributes_(WinPict2,0,0,#LWA_ALPHA)
	HideWindow(#Pict1,0)
	HideWindow(#Pict2,0)
	UpdateWindow_(WinPict1)
	UpdateWindow_(WinPict2)

EndProcedure
Procedure Schwupp(a,b)
	Protected i
	#Overlaped=128
	For i=0 To 511-#Overlaped Step 12
		Select i
		Case 0 To 255-#Overlaped
			SetLayeredWindowAttributes_(WinPict1,0,255-i,#LWA_ALPHA)
		Case 256-#Overlaped To 255
			SetLayeredWindowAttributes_(WinPict1,0,255-i,#LWA_ALPHA)
			SetLayeredWindowAttributes_(WinPict2,0,i-256+#Overlaped,#LWA_ALPHA)
		Default
			SetLayeredWindowAttributes_(WinPict2,0,i-256+#Overlaped,#LWA_ALPHA)
		EndSelect
	Next i
EndProcedure
Procedure Main()

	Init()
	Schwupp(0,255)

EndProcedure

Main()
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

Code: Select all

; Yet another useless program by netmaestro 
;

Global NewList brush() 
   
Procedure Wait(secs)
  start=ElapsedMilliseconds() 
  While ElapsedMilliseconds()-start < secs * 1000 
    ev = WaitWindowEvent(1) 
    If ev = #WM_CHAR
      ForEach brush() 
        DeleteObject_(brush()) 
      Next 
      ShowCursor_(#True) 
      End 
    EndIf
  Wend
EndProcedure
; 
Procedure Init() 

   Enumeration 
      #Back 
      #Pict 
   EndEnumeration 
  
   Global Bild1=LoadImage(100,"d:\pic1.bmp") 
   Global Bild2=LoadImage(200,"d:\pic2.bmp") 
   ResizeImage(100,640,480) 
   ResizeImage(200,640,480) 
   Global ScreenX=GetSystemMetrics_(#SM_CXSCREEN) 
   Global ScreenY=GetSystemMetrics_(#SM_CYSCREEN) 
    
   AddElement(brush()) 
   brush() = CreatePatternBrush_(Bild1) 
   AddElement(brush()) 
   brush() = CreatePatternBrush_(Bild2) 
  
   Global WinBack=OpenWindow(#Back,0,0,ScreenX,ScreenY,"",#PB_Window_BorderLess) 
   Global WinPict=OpenWindow(#Pict,0,0,640,480,"",#PB_Window_ScreenCentered|#PB_Window_BorderLess|#WS_POPUP|#PB_Window_Invisible) 
    
   SetWindowColor(#Back,0) 
EndProcedure 

init() 
ShowCursor_(0) 
While WindowEvent():Wend 

Repeat 
  StartDrawing(WindowOutput(#back))
    DrawText(ScreenX/2-70,ScreenY-60,"Press any key to end...",#Yellow,#Black)
  StopDrawing()
  ForEach brush() 
    SetClassLong_(WindowID(#Pict), #GCL_HBRBACKGROUND, brush()) 
    AnimateWindow_(WindowID(#Pict), 3000, #AW_BLEND | #AW_ACTIVATE) 
    Wait(2)
    AnimateWindow_(WindowID(#Pict), 3000, #AW_BLEND | #AW_HIDE)
    Wait(1)
   Next 
ForEver 
BERESHEIT
User avatar
Paul
PureBasic Expert
PureBasic Expert
Posts: 1285
Joined: Fri Apr 25, 2003 4:34 pm
Location: Canada
Contact:

Post by Paul »

DirectX version using Sprites...

Code: Select all

If InitSprite()=0 Or InitSprite3D()=0 Or InitKeyboard()=0
  MessageRequester("Error","Could Not Initialize DirectX",#MB_ICONERROR)
  End
EndIf


Enumeration
  #Black
  #Pic1
  #Pic2
EndEnumeration

timer=AddDate(Date(),#PB_Date_Second,5)
fade=2
level=255
speed=4
pic=#Pic1




If OpenScreen(640,480,32,"Pictures")
  SetFrameRate(60)
  CreateSprite(#Black,8,8,#PB_Sprite_Texture)
  StartDrawing(SpriteOutput(#Black))
    Box(0,0,8,8,RGB(10,10,10))
  StopDrawing()
  CreateSprite3D(#Black,#Black)
  
  LoadSprite(#Pic1,"Picture1.bmp")
  LoadSprite(#Pic2,"Picture2.bmp")
  
  
  
  Repeat
    ClearScreen(0)
    ExamineKeyboard()
    
    If Date()>timer
      timer=AddDate(Date(),#PB_Date_Second,5)
      fade=1
    EndIf
    
    Select fade
      Case 1  ;fade out
        level+speed
        If level>255
          level=255
          fade=2
          pic+1
          If pic>#Pic2
            pic=#Pic1
          EndIf
        EndIf
        
      Case 2  ;fade in
        level-speed
        If level<0
          level=0
          fade=0
        EndIf
    EndSelect
    
    
    DisplaySprite(pic,0,0)
    Start3D()
      ZoomSprite3D(#Black,640,480)
      DisplaySprite3D(#Black,0,0,level)
    Stop3D()
    FlipBuffers()
  Until KeyboardPushed(#PB_Key_Escape)
EndIf
Image Image
User avatar
Michael Vogel
Addict
Addict
Posts: 2807
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Post by Michael Vogel »

Thanks to you both - I'll check these codes immediately...
User avatar
Michael Vogel
Addict
Addict
Posts: 2807
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Post by Michael Vogel »

Hmm...
still having (quite a lot of) problems...

On my notebook Netmaestros code only brings up the text on a black screen - when I set remarks before the black window and even disable the #PB_Window_Invisible option for the second window, I only get a grey window with nothing in it) - I will play around in the upcoming night, but at the moment I can't get it running...

The following code (from Paul) works (when the texture size changed to 16x16), but has the following problems: I can't resize (too big) pictures to screen size, and it fades to and from black, not from opne picture to the other...

Code: Select all

fading...

If InitSprite()=0 Or InitSprite3D()=0 Or InitKeyboard()=0
	MessageRequester("Error","Could Not Initialize DirectX",#MB_ICONERROR)
	End
EndIf


Enumeration
	#Black
	#Pic1
	#Pic2
EndEnumeration

timer=AddDate(Date(),#PB_Date_Second,5)
fade=2
level=255
speed=8
pic=#Pic1

Global ScreenX=GetSystemMetrics_(#SM_CXSCREEN)
Global ScreenY=GetSystemMetrics_(#SM_CYSCREEN)


If OpenScreen(ScreenX,ScreenY,32,"Pictures")
	SetFrameRate(60)

	CreateSprite(#Black,16,16,#PB_Sprite_Texture)
	StartDrawing(SpriteOutput(#Black))
	Box(0,0,15,15,1)
	StopDrawing()
	CreateSprite3D(#Black,#Black)
	ZoomSprite3D(#Black,ScreenX,ScreenY)



	UseJPEGImageDecoder()
	UsePNGImageDecoder()


	LoadSprite(#Pic1,"1.jpg")
	LoadSprite(#Pic2,"2.jpg")



	Repeat
		ClearScreen(0)
		ExamineKeyboard()

		If Date()>timer
			timer=AddDate(Date(),#PB_Date_Second,5)
			fade=1
		EndIf

		Select fade
		Case 1  ;fade out
			level+speed
			If level>255
				level=255
				fade=2
				pic+1
				If pic>#Pic2
					pic=#Pic1
				EndIf
			EndIf

		Case 2  ;fade in
			level-speed
			If level<0
				level=0
				fade=0
			EndIf
		EndSelect


		DisplaySprite(pic,0,0)
		Start3D()
		DisplaySprite3D(#Black,0,0,level)
		Stop3D()
		FlipBuffers()
	Until KeyboardPushed(#PB_Key_Escape)
EndIf

I tried to change it to do "cross fading", but now it worked only on my notebook (Windows XP) at work, not at my (older) notebook at home (Windows 2000) - and I'm still not possile to resize the pictures...

Code: Select all

If InitSprite()=0 Or InitSprite3D()=0 Or InitKeyboard()=0
	MessageRequester("Error","Could Not Initialize DirectX",#MB_ICONERROR)
	End
EndIf


Enumeration
	#Black
	#Pic1
	#Pic2
EndEnumeration

timer=AddDate(Date(),#PB_Date_Second,5)
fade=2
level=255
speed=4
pic=#Pic1

Global ScreenX=GetSystemMetrics_(#SM_CXSCREEN)
Global ScreenY=GetSystemMetrics_(#SM_CYSCREEN)


If OpenScreen(ScreenX,ScreenY,32,"Pictures")
	SetFrameRate(60)

	CreateSprite(#Black,16,16,#PB_Sprite_Texture)
	StartDrawing(SpriteOutput(#Black))
	Box(0,0,15,15,1)
	StopDrawing()
	CreateSprite3D(#Black,#Black)
	ZoomSprite3D(#Black,ScreenX,ScreenY)

	UseJPEGImageDecoder()
	UsePNGImageDecoder()

	LoadSprite(#Pic1,"1.jpg",#PB_Sprite_Texture)
	LoadSprite(#Pic2,"2.jpg",#PB_Sprite_Texture)
	CreateSprite3D(#pic1,#pic1)
	CreateSprite3D(#pic2,#pic2)

	Repeat
		ClearScreen(0)
		ExamineKeyboard()

		If Date()>timer
			timer=AddDate(Date(),#PB_Date_Second,5)
			fade=1
		EndIf

		Select fade
		Case 1  ;fade out
			level+speed
			If level>255
				level=255
				fade=2
				pic+1
				If pic>#Pic2
					pic=#Pic1
				EndIf
			EndIf

		Case 2  ;fade in
			level-speed
			If level<0
				level=0
				fade=0
			EndIf
		EndSelect


		;DisplaySprite(pic,0,0)
		Start3D()
		;DisplaySprite3D(#Black,0,0,level)
		DisplaySprite3D(#pic1,0,0,level)
		DisplaySprite3D(#pic2,0,0,255-level)

		Stop3D()
		FlipBuffers()
	Until KeyboardPushed(#PB_Key_Escape)
EndIf
Last variant of Pauls code (should do resizing and cross fading - but does not work on my notebook):

Code: Select all

If InitSprite()=0 Or InitSprite3D()=0 Or InitKeyboard()=0
	MessageRequester("Error","Could Not Initialize DirectX",#MB_ICONERROR)
	End
EndIf


Enumeration
	#Black
	#Pic1
	#Pic2
EndEnumeration

timer=AddDate(Date(),#PB_Date_Second,5)
fade=2
level=255
speed=4
pic=#Pic1

Global ScreenX=GetSystemMetrics_(#SM_CXSCREEN)/2
Global ScreenY=GetSystemMetrics_(#SM_CYSCREEN)/2

If OpenScreen(ScreenX,ScreenY,32,"Pictures")
	;	SetFrameRate(60)

	CreateSprite(#Black,16,16,#PB_Sprite_Texture)
	StartDrawing(SpriteOutput(#Black))
	Box(0,0,16,16,$fff)
	StopDrawing()

	CreateSprite3D(#Black,#Black)
	ZoomSprite3D(#Black,ScreenX,ScreenY)

	UseJPEGImageDecoder()
	UsePNGImageDecoder()

	LoadImage(#Pic1,"1.jpg")
	LoadImage(#Pic2,"2.jpg")
	ResizeImage(#Pic1,ScreenX,ScreenY)
	;ResizeImage(#Pic2,ScreenX,ScreenY)

	CreateSprite(#Pic1,ScreenX,ScreenY,#PB_Sprite_Texture)
	StartDrawing(SpriteOutput(#Pic1))
	DrawImage(#Pic1,0,0)
	Line(0,0,16,16,$fff00)
	StopDrawing()
	CreateSprite(#Pic2,ScreenX,ScreenY,#PB_Sprite_Texture)
	StartDrawing(SpriteOutput(#Pic2))
	Box(0,0,16,16,$fff)
	DrawImage(#Pic2,0,0,ScreenX,ScreenY)
	StopDrawing()

	CreateSprite3D(#Black,#Black)
	ZoomSprite3D(#Black,ScreenX,ScreenY)

	CreateSprite3D(#pic1,#pic1)
	TransparentSpriteColor(#PIc2,0)
	CreateSprite3D(#pic2,#pic2)


	Repeat
		ClearScreen(0)
		ExamineKeyboard()

		If Date()>timer
			timer=AddDate(Date(),#PB_Date_Second,5)
			fade=1
		EndIf

		Select fade
		Case 1  ;fade out
			level+speed
			If level>255
				level=255
				fade=2
				pic+1
				If pic>#Pic2
					pic=#Pic1
				EndIf
			EndIf

		Case 2  ;fade in
			level-speed
			If level<0
				level=0
				fade=0
			EndIf
		EndSelect

		;StartDrawing(ScreenOutput())
		;DrawImage(#Pic1,0,0)
		;StopDrawing()

		;DisplaySprite(#pic1,0,0)
		Start3D()
		;DisplaySprite3D(#Black,0,0,level)
		DisplaySprite3D(#pic1,0,0,level)
		DisplaySprite3D(#pic2,0,0,255-level)

		Stop3D()
		FlipBuffers()
	Until KeyboardPushed(#PB_Key_Escape)
EndIf
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

Could you post hw and os specs for your notebook please?
BERESHEIT
User avatar
Michael Vogel
Addict
Addict
Posts: 2807
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Post by Michael Vogel »

My own notebook is a Fujitsu Siemens Lifebook B2175 running with W2k, ATI Rage Mobility Graphic card with 800x600, 32 Bit.

The second notebook I tried out was also a (bigger and newer) Fujitsu running with Windows XP, graphic mode was 1024x768@32 but I didn't had a look whioch graphic card it was...
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

The API I'm using, AnimateWindow_(), is supported for Win98 and above, including Win2000. It should definitely work, is it possible that the images aren't coming in successfully? Maybe stick a debug IsImage() line in for each of them? If that's not it I'm befuddled.
BERESHEIT
User avatar
Michael Vogel
Addict
Addict
Posts: 2807
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Post by Michael Vogel »

netmaestro wrote:The API I'm using, AnimateWindow_(), is supported for Win98 and above, including Win2000. It should definitely work, is it possible that the images aren't coming in successfully? Maybe stick a debug IsImage() line in for each of them? If that's not it I'm befuddled.
I'm going crazy - now I tried it also on my companies notebook - same black screen...

MessageRequester(Str(IsImage(100)),Str(IsImage(200))) brings up non-zero values, so the images are in the memory.
User avatar
Michael Vogel
Addict
Addict
Posts: 2807
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Post by Michael Vogel »

Found reason why it netmaestros code did not work (on all notebooks I have checked the program):
It's the resize command - when it is in the code, the screen stays black here... (see also thread http://www.purebasic.fr/english/viewtop ... 880#153880)

Now this is my "working" code - what means it really can cross fade (on some notebooks, not on mine :( ).

:idea: therefore, also a fade out/in mode is implemented, this works also on my notebook
:arrow: this mode is default, it can be changed by pressing 'M'
:?: if anyone find, what could be changed, that cross fade will also work on my notebook, this would be great...
:roll: other improvements are also welcome...

Other keys:
:arrow: +/-: speed up/down fading time
:arrow: f/s: faster/slower dia show (decrease/increase delay between pictures)
:arrow: i: show information (and parameter values :wink:)
:arrow: space: next picture
:arrow: Escape: quit

Attention:
:!: Please change the scanpath variable to your picture directory
:!: You should also play around with the FrameX/Y values
:!: Don't change the copyright line with my name :P

Code: Select all

; Define

	#MaxNames=10000

	Global ScreenX=GetSystemMetrics_(#SM_CXSCREEN)
	Global ScreenY=GetSystemMetrics_(#SM_CYSCREEN)
	Global FrameSizeX=ScreenX*0.8;640
	Global FrameSizeY=ScreenY*0.9;540

	Structure PictStruct
		id.l
		x.l
		y.l
		w.l
		h.l
		nr.l
	EndStructure

	Global Dim Picture.PictStruct(2)
	Global Dim Names.s(#MaxNames)

	Global MainPict=1
	Global BackPict
	Global TotalPict
	Global ActualPict
	Global WaitTimer
	Global quit

	#WaitDefault=5000
	Global VarWait=#WaitDefault
	Global VarSpeed=5; 3; 5; 15; 17
  Global VarMode=1
	Global VarInfo=1

	DataSection
		SpeedTable:
		Data.l 6,3,5,15,17,45,85
		WaitTable:
		Data.l 8,500,1000,2000,3000,5000,10000,20000,30000
	EndDataSection

; EndDefine
Procedure Directory(depth,path.s)
	If ExamineDirectory(depth,path,"*.*")
		While NextDirectoryEntry(depth)
			Protected FileName.s = DirectoryEntryName(depth)
			If DirectoryEntryType(depth)=2
				If FileName<>"." And FileName<>".."
									Directory(depth+1,path+FileName+"\")
				EndIf
			Else
				If FindString("|.jpg|.bmp|",LCase(Right(FileName,4)),1) ;|.png|.gif|.tif| ???
					TotalPict+1
					Names(TotalPict)=path+FileName
				EndIf
			EndIf
		Wend
		FinishDirectory(depth)
	EndIf
EndProcedure
Procedure.l FindVal(mem,val)
	Protected i=0
	Protected n=PeekL(mem)
	Protected x
	Repeat
		i+1
		mem+4
		x=PeekL(mem)
		If x=val
			ProcedureReturn i
		EndIf
	Until i=n
	ProcedureReturn -1
EndProcedure
Procedure.l TakeVal(mem,nr)
	If nr<1
		nr=1
	ElseIf nr>PeekL(mem)
		nr=PeekL(mem)
	EndIf
	ProcedureReturn PeekL(mem+nr<<2)
EndProcedure

Procedure Scale(nr)
	Protected skalierung.f

	If IsImage(nr)=0
		CreateImage(nr,32,32,#PB_Image_DisplayFormat)
	EndIf

	Picture(nr)\w=ImageWidth(nr)
	Picture(nr)\h=ImageHeight(nr)

	If Picture(nr)\w>FrameSizeX
		skalierung=FrameSizeX/Picture(nr)\w
		Picture(nr)\w*skalierung
		Picture(nr)\h*skalierung
	EndIf
	If Picture(nr)\h>FrameSizeY
		skalierung.f=FrameSizeY/Picture(nr)\h
		Picture(nr)\w*skalierung
		Picture(nr)\h*skalierung
	EndIf

	Picture(nr)\id=ImageID(nr)
	Picture(nr)\x=(ScreenX-Picture(nr)\w)>>1
	Picture(nr)\y=(ScreenY-Picture(nr)\h)>>1

	;ResizeImage(nr,Picture(nr)\w,Picture(nr)\h,#PB_Image_Smooth)

	If IsSprite(nr) : FreeSprite(nr) : EndIf
	CreateSprite(nr,Picture(nr)\w,Picture(nr)\h,#PB_Sprite_Texture)
	StartDrawing(SpriteOutput(nr))
	DrawImage(Picture(nr)\id,0,0,Picture(nr)\w,Picture(nr)\h); because Resize doesn't work
	StopDrawing()

	If IsSprite3D(nr) : FreeSprite3D(nr) : EndIf
	CreateSprite3D(nr,nr)

EndProcedure
Procedure SwapPictures()

	BackPict=MainPict
	MainPict=3-MainPict

	If IsImage(MainPict)
		FreeImage(MainPict)
		If ActualPict<TotalPict
			ActualPict+1
		Else
			ActualPict=1
		EndIf
		Picture(MainPict)\nr=ActualPict
		;Debug Names(ActualPict)
		LoadImage(MainPict,Names(ActualPict),#PB_Image_DisplayFormat)
		Scale(MainPict)
	EndIf

EndProcedure
Procedure CheckKeys()
	Repeat
		count+1
		If WaitWindowEvent(5)=#WM_CHAR
			Select EventwParam()
			Case 27,8,'Q'
				quit=999
			Case ' ',13
				quit=1
			Case '+'
				VarSpeed=TakeVal(?SpeedTable,FindVal(?SpeedTable,VarSpeed)+1)
			Case '-'
				VarSpeed=TakeVal(?SpeedTable,FindVal(?SpeedTable,VarSpeed)-1)
			Case 'f','F'; Faster
				VarWait=TakeVal(?WaitTable,FindVal(?WaitTable,VarWait)-1)
				quit=1
			Case 's','S'; Slower
				VarWait=TakeVal(?WaitTable,FindVal(?WaitTable,VarWait)+1)
			Case 'd','D'; Default
				VarWait=#WaitDefault
			Case 'i','I','?'; Info
				VarInfo=1-VarInfo
				quit=1
			Case 'm','M'; Mode
				VarMode=1-VarMode
			Case 'r','R'; Restart
				ActualPict=0
				quit=1
			EndSelect
		EndIf
	Until (quit) Or (GetTickCount_()>WaitTimer)

EndProcedure

Procedure Show()

	If (InitSprite() And InitSprite3D() And OpenScreen(ScreenX,ScreenY,32,"Show me a bird..."))

	LoadFont(0,"Verdana",8)

		CreateSprite(0,16,16,#PB_Sprite_Texture)
		;TransparentSpriteColor(Spr,$80808)
		StartDrawing(SpriteOutput(0))
		Box(0,0,16,16,$20202)
		StopDrawing()
		CreateSprite3D(0,0)
		ZoomSprite3D(0,ScreenX,ScreenY)
		Scale(1)
		Scale(2)

		Repeat
			quit=0
			check+1

			SwapPictures()

			i=0
			Repeat

				WaitTimer=GetTickCount_()+50

				If VarMode
					Start3D()
					DisplaySprite3D(0,0,0,255)
					Stop3D()
					If i<128
						DisplaySprite(BackPict,Picture(BackPict)\x,Picture(BackPict)\y)
						Start3D()
						DisplaySprite3D(0,0,0,i<<1)
						Stop3D()
					Else
						DisplaySprite(MainPict,Picture(MainPict)\x,Picture(MainPict)\y)
						Start3D()
						DisplaySprite3D(0,0,0,511-i<<1)
						Stop3D()
					EndIf

				Else
					Start3D()
					DisplaySprite3D(0,0,0,255)
					DisplaySprite3D(BackPict,Picture(BackPict)\x,Picture(BackPict)\y,255-i)
					DisplaySprite3D(MainPict,Picture(MainPict)\x,Picture(MainPict)\y,i)
					Stop3D()

				EndIf

				If VarInfo
					StartDrawing(ScreenOutput())
				    DrawingFont(FontID(0))
					DrawText(10,10,Names(ActualPict),#Green,#Black)
					DrawText(10,ScreenY-14,"©2006 Michael Vogel • V"+Str(VarSpeed)+"."+Str(VarWait)+Str(VarMode),#Green,#Black)
					StopDrawing()
				EndIf

				FlipBuffers()

				CheckKeys()
				;If quit : Break : EndIf

				i+VarSpeed
			Until i>255

			If quit=0
				WaitTimer=GetTickCount_()+VarWait
				CheckKeys()
			EndIf

		Until quit>1

	EndIf

	FreeFont(0)
	;MessageRequester(Str(count),"-"
EndProcedure
Procedure Main()
	scanpath.s="F:\Programs\Prog\Source\Fade\"

	Directory(0,scanpath)

	UseJPEGImageDecoder()
	;UsePNGImageDecoder(); 80kByte !

	If TotalPict : Show() : EndIf

EndProcedure

Main()
Post Reply