I'd like to implement a fade transition in my program, but I have absolutely no idea how to go about programming this. Could someone give me a very basic example and explain to me how to perform this kind of action?
Fade Transition
BlitzPlus Forums/BlitzPlus Beginners Area/Fade Transition BlitzPlus doesn't do native transparancies and such, so you either:
1) Need to read each pixel on the screen, apply the effect you need, and write the modified version back (which is pretty slow! you'll probably only going to get a couple of frames a second at best, not very smooth)
2) use a 3rd party library that can apply transparancy effects.
3) use one of the blitz versions that does 2D-in-3D rather than old fashioned 2D-only. Both Blitz3D and BlitzMax are much better suited for getting the effect for you want here, because they can ofload the work of doing the blending to the 3D processor on your video card.
1) Need to read each pixel on the screen, apply the effect you need, and write the modified version back (which is pretty slow! you'll probably only going to get a couple of frames a second at best, not very smooth)
2) use a 3rd party library that can apply transparancy effects.
3) use one of the blitz versions that does 2D-in-3D rather than old fashioned 2D-only. Both Blitz3D and BlitzMax are much better suited for getting the effect for you want here, because they can ofload the work of doing the blending to the 3D processor on your video card.
One way of doing a blend:
Graphics 640,480,16,1 img%=LoadImage("X:\sprite.png") bck%=LoadImage("X:\background.jpg") MaskImage img%,0,255,0 While Not KeyDown(1) For t#=0 To 1 Step 0.1 DrawImage bck%,0,0 Flip draw_alpha(img%,MouseX(),MouseY(),0.3) Flip Next Wend Function draw_alpha(image%, x%, y%, alpha#) ; if the opacity is 100% then no point in rendering the opaque image ; just draw original image If alpha# >= 1 Then han_x% = ImageXHandle(image%) han_y% = ImageYHandle(image%) HandleImage image%, 0, 0 DrawImage image%, x%, y% HandleImage image%, han_x%, han_y% ; else if the opacity is greater than zero (if less the 0 don't bother drawing it!) Else If alpha# > 0 Then nalpha# = 1 - alpha# ; Lock the buffers LockBuffer BackBuffer() LockBuffer ImageBuffer(image%) ; Loop through each pixel in the image, ; To create New opaque image pixel by pixel For xx% = 0 To ImageWidth(image%) For yy% = 0 To ImageHeight(image%) ; Get colors from sprite pixel rgb1% = ReadPixelFast(xx%, yy%, ImageBuffer(image%)) If rgb1% <> 0 Then r1% = ((rgb1 And 16711680) Shr 16) g1% = ((rgb1 And 65280) Shr 8) b1% = (rgb1 And 255) rgb2% = ReadPixelFast(xx + x, yy + y, BackBuffer()) r2% = ((rgb2 And 16711680) Shr 16) g2% = ((rgb2 And 65280) Shr 8) b2% = (rgb2 And 255) ; Calculate the color of the new opaque pixel and draw pixel to new image r3 = r1%*alpha# + r2%*nalpha# g3 = g1%*alpha# + g2%*nalpha# b3 = b1%*alpha# + b2%*nalpha# WritePixelFast(xx + x, yy + y, ((r3 Shl 16) + (g3 Shl 8) + b3), BackBuffer()) End If Next Next ; Unlock the buffers UnlockBuffer BackBuffer() UnlockBuffer ImageBuffer(image%) End If End Function
Or here's another one I found on my HD:
Save this as "Test Fades.bb"
And save this include as "INC Fades.bb"
Save this as "Test Fades.bb"
; Screen fades (30/11/03) ; - Seeing as ordinary fades are too slow. Blitz+ only, ; though B2D and B3D users could rem out fades using lockpixels and still use others fades. ; ; Load the "INC fade.bb" for more information. AppTitle "Real time screen wipes" Graphics 640,480,16 ; feel free to mess about with any res. ; You'll need this early in your own code, sometime after calling Graphics Include "INC fades.bb" ; Set up some timers Dim time(100000) timenum=0 ; which fade to show in the demo fade=0 SetBuffer BackBuffer() ; Well, seeing as the last Lord of the Rings movie is out soon.... IMback=LoadImage("Gandalf.jpg") ; Resize the image is the wrong size for the screen. If ImageWidth(IMback)<>SCRwid Then ResizeImage IMback,SCRwid,SCRhi DrawImage IMback,0,0 : Flip : DrawImage IMback,0,0 txt$="Press any key..." : go=False : x=SCRwid Repeat Cls DrawImage IMback,0,0 Color 0,0,$080808 : Text 2,2,"1-9: Try fades" Text 2,14,"SPACE: Cycle demo" Text 2,26,"Any other: Random." ; Text 2,38,AvailVidMem() key=GetKey() If key>0 spd#=Rand(-10,10) ; Doesn't have to be a whole number, but usually works better as such. acl#=Rnd(0,0.4) ;acl#=0 Select key Case 32 ; press space to cycle through demo fades fade=fade+1 If fade>18 Then Restore demodata : fade=1 Read f : Read spd : Read acl# SetFade(f,spd,acl) Case 49,50,51,52,53,54,55,56,57 ; press 1-9 to demo a particular fade SetFade(key-48,spd,acl) Default ; any other key set's up a random fade. SetFade(Rand(1,8),spd,acl) End Select txt$="Working...(spd:"+spd+", acl:"+acl+")" go=True : TIMEnum=0 : TIMEshort=0 : TIMElong=0 : TIMEav#=0 EndIf If go=True m=MilliSecs() done=DoFade() time(TIMEnum)=MilliSecs()-m : TIMEnum=TIMEnum+1 ; Unrem to test the fade frame by frame (press space) ;Repeat : VWait : Until KeyDown(57) EndIf If done=True ; get timing results For n=0 To timenum-1 TIMEav=TIMEav+time(n) If time(n)>TIMElong Then TIMElong=time(n) If time(n)<TIMEshort Then TIMEshort=time(n) Next TIMEav=TIMEav/timenum ; Show the average milliseconds per frame taken for the last fade operation. txt$="Average:"+TIMEav+"ms, Longest:"+TIMElong+"ms" : go=False : done=False EndIf If KeyDown(66) Then SaveBuffer(BackBuffer,"fade shot.bmp") : VWait 25 Color 8,8,8 : Text x,201,txt$ Color $FF,$FF,$FF : Text x,200,txt$ x=x-1 : If x<0 Then x=SCRwid-StringWidth(txt$) Flip Until KeyDown(1)=True End .demodata Data FADcircle,-1,0.7 Data FADcircle,6,0.3 Data FADhatch,-6,0.4 Data FADhatch,6,0.4 Data FADbox,-8,0.5 Data FADbox,1,0.9 Data FADdropdown,-10,0.5 Data FADdropdown,10,0.9 Data FADragged,-10,0.2 Data FADragged,10,0.2 Data FADpixelST,-3,0.2 Data FADpixelST,0.3,0.1 Data FADrgbfadeST,-4,0 Data FADrgbfadeST,4,0 Data FADrgbdrop,-6,0.3 Data FADrgbdrop,6,0.3 Data FADrgbdropST,-4,0 Data FADrgbdropST,4,0
And save this include as "INC Fades.bb"
; Screen fades ; - Simon Smith, Nov 2003 ; simonisfound@... ; ; Updated very infrequently, and now available to the Blitz community. ; ; Feel free to add your own fades, I'm sure there are plenty of effective fades I've missed out. ; Send them on and I'll most likely add then to the available source. ; Also this code is Freeware, and you can feel free to use or modify to your own uses, as long ; as you give me a credit for the original code. An e-mail about it would be a nice ; bonus too. ; To use this just include this document with source. ; Then start a fade you just call SetFade() (check "Test Fades.bb" for examples) ; and then call DoFade() just before each display update. It will return a flag to say ; whether it's finished or not, a useful trigger for exiting a loop. ; The last frame of DoFade() will clean up any used system or graphics RAM. ; If you call a fade without any spd or acl parameters it will set a default for you. ; Values can be quite varying for different fades, it's trial and error for what looks good. ; The functions have a reasonable amount of correction for bad values. ; ; It's best to set the graphics buffer to Backbuffer() before Setting or doing fades. You can ; write your fades to a seperate image but it must be screen sized. This may change at some point. ; ---------------------------------------------------- ; Now on to the code.... ; * color to black out without being transparent in 16bit. ; Or feel free to change it to some other value for fadeout. Const COLshadow=$050605 Global SCRwid=GraphicsWidth(),SCRhi=GraphicsHeight(),SCRdep=GraphicsDepth() Global SCRbytes=SCRdep/8 ; You can choose from these fades, all are intended to work real time, unless noted otherwise ; * all time results recorded on a Geforce2MX / 16 bit 640x480 / Athlon 1.33ghz ; Screen just appears. I use this as default for low detail mode in my games. Feel free to ignore ; Uses no memory obviously Const FADnone=0 ; Mario style circle fade ; Time <1ms av per function call ; Screen sized image created, held in graphics RAM. Const FADcircle=1 ; Hatching passes down then up the screen, boring but effective in high resolutions. ; Time 1.1 ms av ; Uses <10k of graphics RAM for a small hatched image. Const FADhatch=2 ; Boring shrinking box ; Time 0.4 ms av ; Requires no extra memory. Const FADbox=3 ; Cute drop down with bounce. ; Time <1 ms av ; Requires no extra memory. Const FADdropdown=4 ; Ragged Chrono Trigger style fade. ; Time 0.2 ms av ; Requires an image sized 1/16th the screen held in graphics RAM. Const FADragged=5 ; SNES style pixellation, Static not Realtime ; Time 24ms av, 40ms when busy ; Requires a copy of the back buffer held in system RAM. Const FADpixelST=6 ; Slow fullscreen fadeout, Static not Realtime ; Time 22ms av, 33ms in 32bit ; Requires screen sized image in graphics RAM and static RAM Const FADrgbfadeST=7 ; Faded bar drops down the screen and wipes it. ; Time 12ms av ; Requires no extra memory. Const FADrgbdrop=8 ; Static screen version of rgbdrop, much nicer fade. ; Time 10ms av ; Requires screen sized image in graphics RAM and static RAM Const FADrgbdropST=9 Type fade Field x#,y#,ox#,oy# ; x,y plus alternate x,y Field xspd#,yspd# ; possible speed for both Field spd#,size#,acl# ; measure speed, size and acceleration Field flag1#,flag2# ; 2 general purpose flags Field IMbuffer ; for effects that need a copy of the buffer info Field BNKbuffer ; a bank to hold copy of buffer info Field IM ; temp imagefile Field channel ; Channel for sound effects Field kind ; Style of fade as set by constants FADxxx Field done ; Is it finished? End Type ; Set up all the necessary variables to start a fade ; -- Set SPD to negative to fade in ; -- acl is acceleration of fade, obviously Function SetFade(fadetype,spd#=0,acl#=0) buf=GraphicsBuffer() ; quick check to see if screenmodes have changed at some point If SCRwid<>GraphicsWidth() Then SCRwid=GraphicsWidth() : SCRhi=GraphicsHeight() : SCRdep=GraphicsDepth() ; rem this out if you want to try multiple fades. For f.fade=Each fade f\IM=FreeAllImage(f\IM) f\IMbuffer=FreeAllImage(f\IMbuffer) If f\BNKbuffer<>0 Then FreeBank f\BNKbuffer : f\BNKbuffer=0 Delete f Next ; If you use a low detail in your game, here would be a good place to filter out cpu heavy fades f.fade=New fade f\spd=spd : f\acl=acl ; * Set em up Select fadetype Case FADnone Case FADcircle ; a few defaults to fix bogus values If f\spd=0 Then f\spd=4 : f\acl=0.05 If f\acl=0 Then f\acl=f\spd/80 If Sgn(f\spd)<>Sgn(f\acl) Then f\acl=f\acl*-1 f\IMbuffer=CreateImage(SCRwid,SCRhi,1,2) If f\spd>0 Then f\size=SCRwid*1.25 Else f\size=0 ; get starting size of circle Case FADhatch ; default value If f\spd=0 Then f\spd=10 : f\acl=0 If f\spd>0 f\y=0 : f\flag1=False : f\flag2=SCRhi Else f\y=SCRhi : f\flag1=True : f\flag2=0 : f\acl=f\acl*-1 EndIf ; create a 2 px high hatched image f\IM=CreateImage(SCRwid+5,1) SetBuffer ImageBuffer(f\IM) ClsColor 0,0,COLshadow : Cls LockBuffer() : For x=0 To SCRwid+4 Step 2 : WritePixelFast x,y,0 : Next : UnlockBuffer() Case FADbox ; * WARNING: this assumes normal 4:3 screen ratios (640x480, 800x600 ect) ; Set default or check values will work If f\spd=0 Then f\spd=6 : f\acl=0.08 If f\acl=0 Then f\acl=f\spd/80 Else f\acl=acl If Sgn(f\spd)<>Sgn(f\acl) Then f\acl=f\acl*-1 ; prevents failed (i.e. reversing) box fades ; set up fade If f\spd>0 Then f\size=SCRwid Else f\size=0 Case FADdropdown ; set default (but f\spd=-10 : f\acl=0.5 is very cool) If f\spd=0 Then f\spd=1 : f\acl=0.5 If f\acl=0 Then f\acl=0.5 If f\acl<0 Then f\acl=f\acl*-1 If f\spd>0 f\y=-SCRhi :f\flag1=True Else f\y=0 : f\flag1=False EndIf Case FADragged If f\spd=0 Then f\spd=10 : f\acl=0.1 ; default If Sgn(f\spd)<>Sgn(f\acl) Then f\acl=f\acl*-1 ; prevent failure of fade wid=20 If f\spd>0 Then f\x=-wid-(SCRwid/7) Else f\x=SCRwid+wid+(SCRwid/7) f\IM=CreateImage(wid,SCRhi,1,2) SetBuffer ImageBuffer(f\IM) Color 0,0,COLshadow If f\spd>0 Then x=0 : dir=0 Else x=wid : dir=1 ; Create ragged edge. For y=0 To SCRhi If dir=0 Then r=Rand(0,1) Else r=Rnd(-1,0) If Rand(0,15)=10 Then r=Rand(-8,8) If Rand(0,30)=10 Then dir=1-dir x=x+r If x=>wid Then x=wid : dir=1-dir If x<0 Then x=0 : dir=1-dir Rect 0,y,x,1 Next ; Nice point to play a swishy sound effect. Case FADpixelST ; Simple but fast pixellation. f\BNKbuffer=ImagetoBank(buf) ; set the default, very low values work best for fadeouts, around 3 or so is good for fadeins. If f\spd=0 Then f\spd=0.3 If f\spd>0 f\size=2 : f\flag1=0 Else f\acl=0.05 f\size=90 : f\flag1=255 EndIf Case FADrgbfadeST ; alright, fade to black, but uses a static screen copy for speed. f\BNKbuffer=ImagetoBank(buf) f\IMbuffer=CreateImage(SCRwid,SCRhi,1,2) SetBuffer(ImageBuffer(f\IMbuffer)) ; set defaults, this fade is less impressive with high acceleration. If f\spd=0 Then f\spd=10 : f\acl=0.05 If f\spd>0 f\flag1=0 ; set destination rgb CopyRect 0,0,SCRwid,SCRhi,0,0,BackBuffer(),ImageBuffer(f\IMbuffer) Else f\flag1=255 Color 0,0,COLshadow : Rect 0,0,SCRwid,SCRhi,True EndIf If Sgn(f\spd)<>Sgn(f\acl) Then f\acl=f\acl*-1 ; prevents failed (i.e. reversing) fades Case FADrgbdrop ; fade to black using a bar down the screen f\flag1=25 ; size of bar If f\spd>0 f\y=-f\flag1 Else f\y=SCRhi EndIf If Sgn(f\spd)<>Sgn(f\acl) Then f\acl=f\acl*-1 ; prevents failed (i.e. reversing) fades Case FADrgbdropST ; fade to black using a bar down the screen f\flag1=160 ; size of bar f\BNKbuffer=ImagetoBank(buf) f\IMbuffer=CreateImage(SCRwid,SCRhi,1,2) If f\spd=0 Then f\spd=3 If f\spd>0 f\y=0 Else f\y=SCRhi EndIf If Sgn(f\spd)<>Sgn(f\acl) Then f\acl=f\acl*-1 ; prevents failed (i.e. reversing) fades Default RuntimeError "Fade "+fade+" is an unknown number for SetFade()" End Select SetBuffer buf f\kind=fadetype : f\done=False End Function ; Main fade loop, call me once pre game frame. Function Dofade() buf=GraphicsBuffer() ; Technically you can combine fades, but in reality there is little compatible with each other. done=0 For f.fade=Each fade num=num+1 ; count the fades If f\done=True Then f\kind=FADnone ; Decide wheter to clear the screen copy each frame If f\IMbuffer<>0 SetBuffer ImageBuffer(f\IMbuffer) Select f\kind Case FADrgbfadeST ; not all screen fades should clear the image buffer Default ClsColor 0,0,0 : Cls End Select EndIf Select f\kind Case FADnone ; None, SetBuffer buf : Cls : Flip : Cls f\done=True Case FADcircle ; * Mario style CIRCLE fade ClsColor 0,0,COLshadow : Cls If f\size>0 Color 0,0,0 : Oval (SCRwid-f\size)/2,(SCRhi-f\size)/2,f\size,f\size,True EndIf f\spd=f\spd+f\acl f\size=f\size-f\spd If f\spd>0 And f\size<-(f\spd*4) Then f\done=True If f\spd<1 And f\size>SCRwid*1.25 Then f\done=True Case FADhatch ; * Hatched double pass fade SetBuffer buf f\spd=f\spd+f\acl For y=0 To f\y DrawImage f\IM,-1+f\x,y : f\x=1-f\x Next If f\flag1=False f\y=f\y+f\spd If f\spd>0 And f\y>SCRhi+(f\spd*4) Then f\flag1=True If f\spd<0 And f\y<(f\spd*4) Then f\done=True Else f\flag2=f\flag2-f\spd If f\spd>0 And f\flag2<-(f\spd*4) Then f\done=True If f\spd<0 And f\flag2>SCRhi Then f\flag1=False Color 0,0,COLshadow : Rect 0,f\flag2,SCRwid,SCRhi*1.5,True EndIf Case FADbox ; * Boring box fade SetBuffer buf Color 0,0,COLshadow If f\size>0 Rect 0,0,SCRwid,((SCRhi-(f\size*0.75))/2),True ; top Rect ((SCRwid-f\size)/2)+f\size,0,SCRwid,SCRhi,True ; right Rect 0,((SCRhi-(f\size*0.75))/2)+f\size*0.75,SCRwid,SCRhi,True ; bottom Rect 0,0,(SCRwid-f\size)/2,SCRhi,True ; left Else Rect 0,0,SCRwid,SCRhi,True EndIf f\spd=f\spd+f\acl f\size=f\size-f\spd : f\y=f\y-f\spd If f\spd>0 And f\size<-(f\spd*6) Then f\done=True If f\spd<0 And f\size>SCRwid Then f\done=True Case FADdropdown ; * Screen drops down / off SetBuffer buf CopyRect 0,0,SCRwid,SCRhi,0,f\y,buf,buf : Color 0,0,COLshadow Rect 0,f\y+SCRhi,SCRwid,SCRhi-f\y f\spd=f\spd+f\acl If f\flag1=True f\y=f\y+f\spd If f\y>0 If f\spd<1 f\spd=0 : f\y=0 : f\done=True Else f\y=0 : f\spd=f\spd*-0.75 ; good point to play any bouncing sfx for the screen. EndIf EndIf Else Rect 0,0,SCRwid,f\y f\y=f\y+f\spd If f\y>SCRhi*1.25 Then f\done=True EndIf Case FADragged ; Chrono Trigger style screen wipe SetBuffer buf Color 0,0,COLshadow : Rect 0,0,f\x,SCRhi DrawImage f\IM,f\x,0 f\spd=f\spd+f\acl : f\x=f\x+f\spd If f\spd>0 And f\x>SCRwid+120 Then f\done=True If f\spd<0 And f\x<-20 Then f\done=True ; Good point to pan any swish sounds you played Case FADpixelST ; SNES style pixellation f\x=0 : size%=Int(f\size) ; figure out how far through the fade we are from 0-1 prop#=1-Float(f\flag1/255) LockBuffer buf ClsColor 0,0,COLshadow : Cls Repeat f\y=0 Repeat x=f\x : If x>SCRwid-1 Then x=SCRwid-1 y=f\y : If y>SCRhi-1 Then y=SCRhi-1 adr=((y*SCRwid)+x)*(SCRdep/8) If SCRdep=32 rgb=PeekInt(f\BNKbuffer,adr) ; a neat little sum to cut out any if statements rgb=((rgb And $FF)*prop)+((((rgb Shr 8) And $FF)*prop) Shl 8)+((((rgb Shr 16) And $FF)*prop) Shl 16) Else rgb=PeekShort(f\BNKbuffer,adr) rgb=((rgb And $1F)*prop*8)+((((rgb Shr 5) And $3F)*prop*4) Shl 8)+((((rgb Shr 11) And $1F)*prop*8) Shl 16) EndIf centre#=Float(size)/1.5 : x=f\x-centre : y=f\y-centre size=size-1 : wid=SCRwid : hi=SCRhi For ax=0 To size For ay=0 To size If x+ax<wid And y+ay<hi And x+ax>-1 And y+ay>-1 WritePixelFast x+ax,y+ay,rgb EndIf Next Next size=size+1 f\y=f\y+size Until f\y=>SCRhi+size f\x=f\x+size Until f\x=>SCRwid+size UnlockBuffer() ; check colour fade and set an appropriate alpha If f\spd>0 Then f\flag1=f\flag1+(f\spd*3) Else f\flag1=f\flag1+(f\spd*3) If f\flag1>255 Then f\flag1=255 If f\flag1<0 Then f\flag1=0 ; Figure out if it's finished If f\spd>0 And f\size>90 Then f\done=True If f\spd<0 And f\size=2 Then f\done=True f\spd=f\spd+f\acl If f\spd<0 And f\spd>-0.6 Then f\spd=-0.6 f\size=f\size+f\spd : If f\size<2 Then f\size=2 Case FADrgbfadeST ; Static screen RGB fadeout prop#=1-(f\flag1/255) LockBuffer(ImageBuffer(f\IMbuffer)) wid=SCRwid-1 : hi=SCRhi-1 ; how many pixels to skip this pass, 1,2,3 and 6 are good values. f\size=2 ; certain sizes need this fix to ensure hatching alternates pixels each frame If f\size=1 Or f\size=3 f\flag2=f\flag2+1 : If f\flag2>f\size Then f\flag2=0 EndIf For x=0 To wid For y=0+f\flag2 To hi adr=((y*SCRwid)+x)*SCRbytes If SCRdep=32 rgb=PeekInt(f\BNKbuffer,adr) WritePixelFast x,y,((rgb And $FF)*prop)+((((rgb Shr 8) And $FF)*prop) Shl 8)+((((rgb Shr 16) And $FF)*prop) Shl 16) Else rgb=PeekShort(f\BNKbuffer,adr) WritePixelFast x,y,((rgb And $1F)*prop*8)+((((rgb Shr 5) And $3F)*prop*4) Shl 8)+((((rgb Shr 11) And $1F)*prop*8) Shl 16) EndIf y=y+f\size Next f\flag2=f\flag2+1 : If f\flag2>f\size Then f\flag2=0 Next UnlockBuffer() f\flag1=Int(f\flag1+f\spd) f\spd=f\spd+f\acl If f\flag1<0 Then f\flag1=0 : f\done=True If f\flag1>255 Then f\flag1=255 : f\done=True Case FADrgbdrop ; Thin fading bar wiping the screen ; first decide if the bar is coming up or down. If f\spd>0 y=f\y-f\flag1 Else y=f\y+f\flag1 EndIf hi=0 LockBuffer(BackBuffer()) For n=1 To f\flag1 ; okay let's decided how big the bar is. If y>-1 And y<SCRhi prop=0.99-((Abs(f\y-y))/f\flag1) If prop<0 Then prop=0 If f\spd<0 Then prop=0.99-prop If prop>0.2 For x=0 To SCRwid-1 rgb=ReadPixelFast(x,y) WritePixelFast x,y,((rgb And $FF)*prop)+((((rgb Shr 8) And $FF)*prop) Shl 8)+((((rgb Shr 16) And $FF)*prop) Shl 16) Next Else ; find out where we draw the black retangle to. If f\spd>0 Then hi=y ElseIf hi=0 Then hi=y EndIf EndIf y=y+Sgn(f\spd) Next UnlockBuffer() Color 0,0,COLshadow f\y=f\y+f\spd f\spd=f\spd+f\acl If f\spd>0 Rect 0,0,SCRwid,hi+1,True If f\y=>SCRhi+f\flag1 Then f\done=True Else Rect 0,0,SCRwid,hi+1,True If f\y<-f\flag1 Then f\done=True EndIf Case FADrgbdropST ; Large fading effect passing downscreen, Static screen only. ; first decide if the bar is coming down or up, If f\spd>0 y=f\y-f\flag1 Else y=f\y+f\flag1 EndIf hi=0 LockBuffer(ImageBuffer(f\IMbuffer)) For n=1 To f\flag1 ; okay let's decided how big the bar is. If y>-1 And y<SCRhi prop=1-((Abs(f\y-y))/f\flag1) If prop<0 Then prop=0 If f\spd<0 Then prop=1-prop If prop>0.11 For x=0+f\flag2 To SCRwid-1 adr=((y*SCRwid)+x)*SCRbytes If SCRdep=32 rgb=PeekInt(f\BNKbuffer,adr) WritePixelFast x,y,((rgb And $FF)*prop)+((((rgb Shr 8) And $FF)*prop) Shl 8)+((((rgb Shr 16) And $FF)*prop) Shl 16) Else rgb=PeekShort(f\BNKbuffer,adr) WritePixelFast x,y,((rgb And $1F)*prop*8)+((((rgb Shr 5) And $3F)*prop*4) Shl 8)+((((rgb Shr 11) And $1F)*prop*8) Shl 16) EndIf Next Else If f\spd>0 Then hi=y ElseIf hi=0 Then hi=y EndIf EndIf y=y+Sgn(f\spd) Next UnlockBuffer() Color 0,0,COLshadow If f\spd>0 Rect 0,0,SCRwid,hi+1,True If f\y=>SCRhi+f\flag1 Then f\done=True Else Rect 0,0,SCRwid,hi+1,True If f\y<-f\flag1 Then f\done=True EndIf f\y=f\y+f\spd f\spd=f\spd+f\acl Default RuntimeError "You haven't specified a valid fade type for SetFade()" End Select ; The fade is done, but let's make extra sure it's blacked out the screen. If f\spd>0 And f\done=True Then Color 0,0,COLshadow : Rect 0,0,SCRwid,SCRhi SetBuffer(buf) If f\IMbuffer<>0 Select f\kind Case FADrgbfadeST DrawBlock f\IMbuffer,0,0 Default DrawImage f\IMbuffer,0,0 End Select EndIf If f\done=True f\IMbuffer=FreeAllImage(f\IMbuffer) : f\IM=FreeAllImage(f\IM) If f\BNKbuffer<>0 Then FreeBank f\BNKbuffer : f\BNKbuffer=0 Delete f done=done+1 EndIf Next If done=num Then done=True Else done=False Return done End Function ; create a bank using an image or backbuffer Function ImagetoBank(image) If image=BackBuffer() LockBuffer(BackBuffer()) wid=SCRwid : hi=SCRhi Else LockBuffer(ImageBuffer(image)) wid=ImageWidth(image) : hi=ImageHeight(image) EndIf bank=CreateBank(wid*SCRbytes*hi+4096) imagebank=LockedPixels() pitch=LockedPitch() imoff=0 : bnkoff=0 ; copy bank to image line by line For y=1 To hi CopyBank imagebank,imoff,bank,bnkoff,wid*SCRbytes bnkoff=bnkoff+(wid*SCRbytes) imoff=imoff+pitch Next UnlockBuffer() Return bank End Function ; Prevents the infamous memory leaks. Function FreeAllImage(IMtemp) If IMtemp<>0 Then FreeImage IMtemp Return False End Function
Or a cross-fade:
; Title: 640x480 full-screen fade ; Version: 3.1 ; Author: Leigh Bowers Dim argbScreen%(0, 0, 0) ; 2 screens, 307200 pixels, R, G and B values (1, 307239, 2) Graphics 320, 240, 16, 1 img1% = LoadImage("x:\monkey4-320.jpg") img2% = LoadImage("x:\monkey6-320.jpg") img3%=LoadImage ("x:\monkey6.jpg") For t=1 To 3 WaitKey ScreenFade img1 WaitKey ScreenFade img2 Next Graphics 640, 480, 16, 1 DrawImage img3%,0,0 Flip WaitKey End ScreenFade 0, 0.2, $ff, $ff, $ff ScreenFade Function ScreenFade(pimgDestinationImage% = 0, pdblFadeSpeed# = 0.05, ColourR% = 0, ColourG% = 0, ColourB% = 0, pimgSourceImage% = 0) Dim argbScreen(1, 307239, 2) ; Take a copy of the front buffer and the destination screen If pimgSourceImage > 0 Then SetBuffer ImageBuffer(pimgSourceImage) Else SetBuffer FrontBuffer() End If For bytLoop% = 0 To 1 If bytLoop = 1 Then SetBuffer BackBuffer() If pimgDestinationImage = 0 Then ClsColor ColourR, ColourG, ColourB : Cls ; Fading to a blank screen (of specified colour) Else DrawBlock pimgDestinationImage, 0, 0 ; The image we're cross-fading in to End If End If LockBuffer bnkScreenFade% = LockedPixels() intPitch% = LockedPitch() bytFormat% = LockedFormat() intElement% = 0 Select bytFormat Case 1 For intY% = 0 To 239 intOffset% = intY * intPitch For intX% = 0 To 319 lngPixel% = PeekShort(bnkScreenFade, intOffset) argbScreen(bytLoop , intElement, 0) = ((lngPixel And $F800) Shr 11) Shl 3 argbScreen(bytLoop , intElement, 1) = ((lngPixel And $7E0) Shr 5) Shl 2 argbScreen(bytLoop , intElement, 2) = (lngPixel And $1F) Shl 3 intOffset = intOffset + 2 intElement = intElement + 1 Next Next Case 2 For intY% = 0 To 239 intOffset% = intY * intPitch For intX% = 0 To 319 lngPixel = PeekShort(bnkScreenFade, intOffset) argbScreen(bytLoop , intElement, 0) = ((lngPixel And $7C00) Shr 10) Shl 3 argbScreen(bytLoop , intElement, 1) = ((lngPixel And $3E0) Shr 5) Shl 2 argbScreen(bytLoop , intElement, 2) = (lngPixel And $1F) Shl 3 intOffset = intOffset + 2 intElement = intElement + 1 Next Next Case 3, 4 For intY% = 0 To 239 intOffset% = intY * intPitch For intX% = 0 To 319 lngPixel = PeekInt(bnkScreenFade, intOffset) argbScreen(bytLoop , intElement, 0) = (lngPixel And $FF0000) Shr 16 argbScreen(bytLoop , intElement, 1) = (lngPixel And $FF00) Shr 8 argbScreen(bytLoop , intElement, 2) = lngPixel And $FF intOffset = intOffset + bytFormat intElement = intElement + 1 Next Next End Select UnlockBuffer Next ; Perform the fade using the appropriate "Poke" dblAlpha# = 0.0 Repeat dblAlpha = dblAlpha + pdblFadeSpeed If dblAlpha > 1 Then dblAlpha = 1 LockBuffer BackBuffer() bnkScreenFade% = LockedPixels() intPitch% = LockedPitch() bytFormat% = LockedFormat() intElement = 0 Select bytFormat Case 1 For intY% = 0 To 239 intOffset% = intY * intPitch For intX% = 0 To 319 r% = Int(argbScreen(0, intElement, 0) + ((argbScreen(1, intElement, 0) - argbScreen(0, intElement, 0)) * dblAlpha)) g% = Int(argbScreen(0, intElement, 1) + ((argbScreen(1, intElement, 1) - argbScreen(0, intElement, 1)) * dblAlpha)) b% = Int(argbScreen(0, intElement, 2) + ((argbScreen(1, intElement, 2) - argbScreen(0, intElement, 2)) * dblAlpha)) PokeShort bnkScreenFade, intOffset, ((r/8) Shl 11) Or ((g/4) Shl 5) Or (b/8) intOffset = intOffset + 2 intElement = intElement + 1 Next Next Case 2 For intY% = 0 To 239 intOffset% = intY * intPitch For intX% = 0 To 319 r% = Int(argbScreen(0, intElement, 0) + ((argbScreen(1, intElement, 0) - argbScreen(0, intElement, 0)) * dblAlpha)) g% = Int(argbScreen(0, intElement, 1) + ((argbScreen(1, intElement, 1) - argbScreen(0, intElement, 1)) * dblAlpha)) b% = Int(argbScreen(0, intElement, 2) + ((argbScreen(1, intElement, 2) - argbScreen(0, intElement, 2)) * dblAlpha)) PokeShort bnkScreenFade, intOffset, ((r/8) Shl 10) Or ((g/4) Shl 5) Or (b/8) intOffset = intOffset + 2 intElement = intElement + 1 Next Next Case 3, 4 For intY% = 0 To 239 intOffset% = intY * intPitch For intX% = 0 To 319 r% = Int(argbScreen(0, intElement, 0) + ((argbScreen(1, intElement, 0) - argbScreen(0, intElement, 0)) * dblAlpha)) g% = Int(argbScreen(0, intElement, 1) + ((argbScreen(1, intElement, 1) - argbScreen(0, intElement, 1)) * dblAlpha)) b% = Int(argbScreen(0, intElement, 2) + ((argbScreen(1, intElement, 2) - argbScreen(0, intElement, 2)) * dblAlpha)) PokeInt bnkScreenFade, intOffset, (r Shl 16) Or (g Shl 8) Or b intOffset = intOffset + bytFormat intElement = intElement + 1 Next Next End Select UnlockBuffer BackBuffer() VWait : Flip False Until dblAlpha = 1 ; Done Dim argbScreen(0, 0, 0) ; Release the memory End Function
Hmm. Okay. Thanks for the help.