;*** Zeichnet Bilder mit Transparenz
;*** 14.10.2005, by Triton
;*** http://www.silizium-net.de
Graphics 800,600,32,2
SetBuffer BackBuffer()
HidePointer
Dim alphaimage(GraphicsWidth(),GraphicsHeight())
bild=LoadImage("d:\ablage\sweet.jpg")
bg=LoadImage("d:\ablage\radio.jpg")
Color 255,255,255
SetBuffer BackBuffer()
While Not KeyDown(1)
If MouseDown(1) Then a=a+5
If MouseDown(2) Then a=a-5
DrawBlock(bg,0,0)
drawalphaimage(bild,MouseX(),MouseY(),a)
Plot MouseX(),MouseY()
If a < 0 Then a = 0
If a > 100 Then a = 100
Text 10,10, "Maustaste L/R zur Änderung der Deckung: "+a+"%"
Flip
Cls
Wend
;---
Function drawalphaimage(pic,x,y,a) ;a=0(transp)-100(deckend)
If a <= 0 Then Return
If a => 100 Then
DrawBlock(pic,x,y)
Return
End If
SetBuffer ImageBuffer(pic) ;einlesen des Bildes
LockBuffer ImageBuffer(pic)
For scanx = 0 To ImageWidth(pic)-1
For scany= 0 To ImageHeight(pic)-1
alphaimage(scanx,scany)=ReadPixelFast(scanx,scany)
Next
Next
UnlockBuffer ImageBuffer(pic)
SetBuffer BackBuffer() ; auslesen des Hintergrundes und
LockBuffer BackBuffer() ; mischen und malen der neuen Pixel
For scanx = 0 To ImageWidth(pic)-1
For scany= 0 To ImageHeight(pic)-1
rgb2=ReadPixelFast(scanx+x,scany+y)
rbg=(rgb2 And $FF0000)/$10000
gbg=(rgb2 And $FF00)/$100
bbg=rgb2 And $FF
rpic=(alphaimage(scanx,scany) And $FF0000)/$10000
gpic=(alphaimage(scanx,scany) And $FF00)/$100
bpic=alphaimage(scanx,scany) And $FF
rneu=rbg*(1.0-(a/100.0))+rpic*a/100.0
gneu=gbg*(1.0-(a/100.0))+gpic*a/100.0
bneu=bbg*(1.0-(a/100.0))+bpic*a/100.0
rgbneu=255*$1000000 + rneu*$10000 + gneu*$100 + bneu
WritePixelFast(scanx+x,scany+y,rgbneu)
Next
Next
UnlockBuffer BackBuffer()
End Function
|
