Code archives/Graphics/EXTREMELY FAST FADER...
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
This is a extremely fast bitmap-fader!!! Works only with 16 color images!!! You can fade in/out automaticale a full screen bitmap... | |||||
Graphics 640,480,32,1 Global fader_tmp=CreateImage(300,100) Global fader_max=1 Dim fader_bmp(fader_max) Dim fader_col(fader_max) Dim fader_r (fader_max,15) Dim fader_g (fader_max,15) Dim fader_b (fader_max,15) Delay 1000 ;example loadfader 0,"bitmap.bmp" animfader 0,170,190,0,2000 animfader 0,170,190,1,2000 freefader 0 FreeImage fader_tmp WaitKey() End Function animfader(nr,x,y,mode,time) source=ImageBuffer(fader_tmp) dest =BackBuffer() sizex =ImageWidth(fader_bmp(nr)) sizey =ImageHeight(fader_bmp(nr)) time2 =MilliSecs() Repeat time3=MilliSecs()-time2 pro=(1000*time3)/time If pro>1000 Then pro=1000 If mode=1 Then pro=1000-pro SetBuffer source DrawBlock fader_bmp(nr),0,0 SetBuffer dest For i=0 To fader_col(nr)-1 MaskImage fader_tmp,fader_r(nr,i),fader_g(nr,i),fader_b(nr,i) Color (fader_r(nr,i)*pro)/1000,(fader_g(nr,i)*pro)/1000,(fader_b(nr,i)*pro)/1000 Rect x,y,sizex,sizey,1 DrawImageRect fader_tmp,x,y,0,0,sizex,sizey CopyRect x,y,sizex,sizey,0,0,dest,source Next Flip Until time3>time If mode=0 Then DrawBlock fader_bmp(nr),x,y If mode=1 Then Color 0,0,0: Rect x,y,sizex,sizey,1 Flip End Function Function freefader(nr) If nr<0 Then Return If nr>fader_max Then Return If fader_bmp(nr)=0 Then Return FreeImage fader_bmp(nr) fader_bmp(nr)=0 End Function Function loadfader(nr,file$) If nr<0 Then Return If nr>fader_max Then Return If fader_bmp(nr)<>0 Then Return fader_bmp(nr)=LoadImage(file$) If fader_bmp(nr)=0 Then Return open=ReadFile(file$) SeekFile open,28 depth=ReadShort(open) If depth<>4 Then CloseFile open freefader nr Return End If SeekFile open,54 For i=0 To 15 colb =ReadByte(open) colg =ReadByte(open) colr =ReadByte(open) dummy=ReadByte(open) If fader_col(nr)>0 Then For ii=0 To fader_col(nr)-1 If fader_r(nr,ii)=colr And fader_g(nr,ii)=colg And fader_b(nr,ii)=colb Then colr=0 colg=0 colb=0 End If Next End If If colr+colg+colb>0 Then fader_col(nr)=fader_col(nr)+1 fader_r(nr,fader_col(nr)-1)=colr fader_g(nr,fader_col(nr)-1)=colg fader_b(nr,fader_col(nr)-1)=colb End If Next CloseFile open For i=0 To fader_col(nr)-2 For ii=i+1 To fader_col(nr)-1 If fader_r(nr,i)+fader_g(nr,i)+fader_b(nr,i)>fader_r(nr,ii)+fader_g(nr,ii)+fader_b(nr,ii) Then fader_r_tmp=fader_r(nr,i) fader_g_tmp=fader_g(nr,i) fader_b_tmp=fader_b(nr,i) fader_r(nr,i)=fader_r(nr,ii) fader_g(nr,i)=fader_g(nr,ii) fader_b(nr,i)=fader_b(nr,ii) fader_r(nr,ii)=fader_r_tmp fader_g(nr,ii)=fader_g_tmp fader_b(nr,ii)=fader_b_tmp End If Next Next End Function |
Comments
None.
Code Archives Forum