[polopok]

Вот немного улучшил ...
только с этим

ddd=CreateImage(42,42) 
SetBuffer ImageBuffer(ddd) 
Color 0,0,0
Rect 0,0,31,31,1
Color 0,0,155
Oval 14-10,14-10,20,20,1
SetBuffer BackBuffer()

куском кода работать не желает , почему ,непонятно...

Type pop Field x,y, f# End Type 


Graphics 800,600,32,2 
ssd2 = LoadImage ("C:\Program Files\Blitz3D\Samples\Blitz 2D Samples\Stone2.bmp")
;ssd2 = LoadImage ("D:\vitalii\2\Particle Effect_files\vip.png")

ddd=CreateImage(42,42) 
SetBuffer ImageBuffer(ddd) 
Color 0,0,0
Rect 0,0,31,31,1
Color 0,0,155
Oval 14-10,14-10,20,20,1
SetBuffer BackBuffer() 
For e= 1 To 5
	pp.pop = New pop
	pp\x = Rand(200,240)
	pp\y = Rand(200,240)
	pp\f = 0.5
Next 

q#=0.5
;T=CreateTimer(60)
ClsColor 125,111,25 
While Not KeyHit(1) 
Cls 
mx# = MouseX() : my# = MouseY()

Color 255,0,0
Rect 20,20,350,250,1
Color 0,255,0
Rect 250,250,150,150,1
Color 0,0,255
Rect 450,250,150,150,1
Color 255,255,255
Rect 450,20,150,150,1

	 
	If KeyDown(200) Then q# = q+ .01
	If KeyDown(208) Then q# = q- .01
	If q#>=1 q# = 1
	If q#<= 0 q# = 0 
;WaitTimer(T)	
		For p.pop = Each pop
		p\x = p\x +3
		If p\x >= 799 Then p\x = Rand(1,700)
		p\f = p\f +0.01
		If p\f >= 1.01 Then p\f = 0.01
		AlphaSprite(ssd2 ,p\x,p\y,p\f)
		Next 

;AlphaSprite(ddd ,mx+10,my,q)

Color 255,255,255
Text 700,40 , q


;Flip 
VWait: Flip False
Wend 
FreeImage ssd2
FreeImage ddd
;FreeTimer(T) 

End 

Function AlphaSprite#(AlphaImage,XP%,YP%,v# =0.5)
	;AlphaImage = CopyImage(Image)
	
	W = ImageWidth(AlphaImage)
	H = ImageHeight(AlphaImage)
	gw=GraphicsWidth()
	gh=GraphicsWidth()
; clip
	x0=px:y0=py
	If x0<0 w=w+x0 x0=0
	If y0<0 h=h+y0 y0=0
	If x0+w>gw w=gw-x0
	If y0+h>gh h=gh-y0
	If w<=0 Or h<=0 Return
	x1=x0+w-1
	y1=y0+h-1	
	
	LockBuffer ImageBuffer(AlphaImage)
;	LockBuffer BackBuffer() 
	LockBuffer GraphicsBuffer()
	For X = 0 To x1
		For Y = 0 To y1
			Value  = ReadPixelFast(XP+X,YP+Y,GraphicsBuffer() ) 
			Value2= ReadPixelFast(X,Y,ImageBuffer(AlphaImage)) 
		
			a1 = GetA(Value )
			r1 = GetR(Value )
			g1 = GetG(Value )
			b1 = GetB(Value )
		
			a2 = GetA(Value2 )	
			r2 = GetR(Value2 )
			g2 = GetG(Value2 )
			b2 = GetB(Value2 )
			
		If r2 = 0 Or g2=0 Or b2=0 Then 
		r2 = r1 : g2 = g1 : b2 = b1
		EndIf
			a=	a2                     ;a1*(1-v)+a2*v
			r=	r1*(1-v)+r2*v
			g=	g1*(1-v)+g2*v
			b=	b1*(1-v)+b2*v
			

					
			alpha = CombineARGB(a,r,g,b) 
		
			WritePixelFast XP+x,YP+y, alpha; ,ImageBuffer(AlphaImage)

		Next
	Next
	
	UnlockBuffer ImageBuffer(AlphaImage)
;	UnlockBuffer BackBuffer() 
	UnlockBuffer GraphicsBuffer()
	
;	DrawImage alphaImage,XP,YP
;	FreeImage alphaimage
	
End Function

Function GetA(RGB)	
	Return RGB Shr 24 And %11111111	
End Function

Function GetR(RGB)
    Return RGB Shr 16 And %11111111
End Function

; return Green value out of a RGB value
Function GetG(RGB)
	Return RGB Shr 8 And %11111111	
End Function

; return Blue value out of a RGB value
Function GetB(RGB)	
	Return RGB And %11111111	
End Function

; combine Alpha, Red, Green, Blue values to a RGB value
Function CombineARGB#(aa#,rr%,gg%,bb%)	
	;Return aa*$1000000+rr*$10000+gg*$100+bb	
	Return $ff000000 Or rr Shl 16 Or gg Shl 8 Or bb 
End Function
;--------------------------------------------------------------------------------------------------------------

Function Min%(a%,b%)
	If a<b Then Return a Else Return b
End Function

Function Max%(a%,b%)	
	If a>b Then Return a Else Return b	
End Function

Function Lighten%(a%,b%)	
	If a>b Then Return a Else Return b	
End Function