PureBasic Forums - English

Posted: **Wed Jul 12, 2006 2:16 pm**

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()

Posted: **Wed Jul 12, 2006 3:04 pm**

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

Posted: **Wed Jul 12, 2006 3:54 pm**

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

Posted: **Thu Jul 13, 2006 6:52 am**

Thanks to you both - I'll check these codes immediately...

Posted: **Thu Jul 13, 2006 2:41 pm**

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

Posted: **Thu Jul 13, 2006 2:43 pm**

Could you post hw and os specs for your notebook please?

Posted: **Thu Jul 13, 2006 2:54 pm**

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...

Posted: **Thu Jul 13, 2006 3:11 pm**

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.

Posted: **Mon Jul 17, 2006 8:06 am**

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.

Posted: **Wed Jul 19, 2006 11:52 am**

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

).

therefore, also a fade out/in mode is implemented, this works also on my notebook

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:

+/-: speed up/down fading time

f/s: faster/slower dia show (decrease/increase delay between pictures)

i: show information (and parameter values

)

space: next picture

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

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()

PureBasic Forums - English

Image Viewer with fading effect

Image Viewer with fading effect