ALPHABLEND透明图片不好用的问题。
第四天了,还没搞懂。求高人。
Private Sub PicT_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Not IsMoving Then IsMoving = True
GetCursorPos Coursor_me '取得鼠标位置
Pic_X = PicT.Left
Pic_Y = PicT.Top
End Sub
'鼠标移动的时候,取得当前鼠标位置,通过计算得到移动的时候图片应该的在的位置。
Private Sub PicT_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Coursor_me2 As POINTAPI
If IsMoving Then
GetCursorPos Coursor_me2 '取得鼠标位置
PicT.Left = Pic_X + (Coursor_me2.x - Coursor_me.x) * Screen.TwipsPerPixelX '原位置+(现在鼠标位置-原来鼠标位置)*twip,twip的介绍自己查下吧。
PicT.Top = Pic_Y + (Coursor_me2.y - Coursor_me.y) * Screen.TwipsPerPixelY
End If
FreshPic
End Sub
'鼠标抬起,不许移动了。
Private Sub PicT_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
IsMoving = False
End Sub
Private Function FreshPic()
PicB.Picture = LoadPicture(LinkDir(App.Path, "img\1.jpg")) '加载图片
PicT.Picture = LoadPicture(LinkDir(App.Path, "img\1.jpg"))
PicT.AutoRedraw = True
PicB.AutoRedraw = True
PicT.ScaleMode = vbPixels
PicB.ScaleMode = vbPixels
Dim BF As BLENDFUNCTION, lBF As Long
With BF
.BlendOp = AC_SRC_OVER
.BlendFlags = 0
.SourceConstantAlpha = Alphaval
.AlphaFormat = 0
End With
RtlMoveMemory lBF, BF, 4
AlphaBlend PicT.hdc, GetTx(PicB, PicT), GetTy(PicB, PicT), GetW(PicB, PicT), GetH(PicB, PicT), PicB.hdc, GetBx(PicB, PicT), GetBy(PicB, PicT), GetW(PicB, PicT), GetH(PicB, PicT), lBF
PicT.Refresh
End Function
get..是取得x,y和两图片重叠区域的函数。
也不知道这些说明够不够,有不够的,我继续往下贴。
说说出现的问题:当图片向右和向下移动,超出picb--就是底面的图片的时候,两图片重叠区域就不透明了。但是向上向左没有问题。
各位哥哥姐姐多多帮忙。