vb6.0 使图片半透明化 急~~~
我希望将在image1或者picturesbox1中图片变成半透明的具体应用为我的form1窗体中有一幅大图,我在该大图上添加了多个image框,在判断条件数据库中字段d...
我希望将在image1或者picturesbox1中图片变成半透明的
具体应用为
我的form1窗体中有一幅大图,我在该大图上添加了多个image框,在判断条件数据库中字段d>5时,某些image框中的图片会=image1或者picture1中的图片,因为我希望image的图片在大图上,但并不会遮住大图,即我能透过image1的图片看到大图,谢谢回答~ 展开
具体应用为
我的form1窗体中有一幅大图,我在该大图上添加了多个image框,在判断条件数据库中字段d>5时,某些image框中的图片会=image1或者picture1中的图片,因为我希望image的图片在大图上,但并不会遮住大图,即我能透过image1的图片看到大图,谢谢回答~ 展开
展开全部
一、这其实就是一个图片混合的过程,可以用AlphaBlend函数来实现。
二、关键代码如下(请复制代码到模块中):
Private Type rBlendProps
tBlendOp As Byte
tBlendOptions As Byte
tBlendAmount As Byte
tAlphaType As Byte
End Type
Private Declare Function AlphaBlend Lib "msimg32" (ByVal hDestDC As Long, _
ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hSrcDC As Long, _
ByVal xSrc As Long, ByVal ySrc As Long, ByVal widthSrc As Long, _
ByVal heightSrc As Long, ByVal blendFunct As Long) As Boolean
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Dim ctlNew As PictureBox, ctlNewWnd As Long
'函数名称:图片混合透明
'参数说明:cSrc 源图片控件名称、cDest 目标图片控件名称、nLevel 透明度(0-255)
'调用举例:TransPic2 Picture2, Picture1, 150 '把cSrc图片混合到cDest图片中,效果在cDest中体现。
Sub TransPic2(cSrc As PictureBox, cDest As PictureBox, ByVal nLevel As Byte)
Dim LrProps As rBlendProps
Dim LnBlendPtr As Long
Dim Mode As Integer, AutoDraw As Boolean
'保存设置
Mode = cSrc.ScaleMode
AutoDraw = cDest.AutoRedraw
cSrc.ScaleMode = 3
cDest.AutoRedraw = True
'透明处理
cDest.Cls
LrProps.tBlendAmount = nLevel
CopyMemory LnBlendPtr, LrProps, 4
With cSrc
AlphaBlend cDest.hdc, 0, 0, .ScaleWidth, .ScaleHeight, _
.hdc, 0, 0, .ScaleWidth, .ScaleHeight, LnBlendPtr
End With
cDest.Refresh
'恢复设置
cSrc.ScaleMode = Mode
cDest.AutoRedraw = AutoDraw
End Sub
三、至于实际问题的应用,你只需把上述代码稍加修改即可。如还有疑问,请短消息联系。
二、关键代码如下(请复制代码到模块中):
Private Type rBlendProps
tBlendOp As Byte
tBlendOptions As Byte
tBlendAmount As Byte
tAlphaType As Byte
End Type
Private Declare Function AlphaBlend Lib "msimg32" (ByVal hDestDC As Long, _
ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hSrcDC As Long, _
ByVal xSrc As Long, ByVal ySrc As Long, ByVal widthSrc As Long, _
ByVal heightSrc As Long, ByVal blendFunct As Long) As Boolean
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Dim ctlNew As PictureBox, ctlNewWnd As Long
'函数名称:图片混合透明
'参数说明:cSrc 源图片控件名称、cDest 目标图片控件名称、nLevel 透明度(0-255)
'调用举例:TransPic2 Picture2, Picture1, 150 '把cSrc图片混合到cDest图片中,效果在cDest中体现。
Sub TransPic2(cSrc As PictureBox, cDest As PictureBox, ByVal nLevel As Byte)
Dim LrProps As rBlendProps
Dim LnBlendPtr As Long
Dim Mode As Integer, AutoDraw As Boolean
'保存设置
Mode = cSrc.ScaleMode
AutoDraw = cDest.AutoRedraw
cSrc.ScaleMode = 3
cDest.AutoRedraw = True
'透明处理
cDest.Cls
LrProps.tBlendAmount = nLevel
CopyMemory LnBlendPtr, LrProps, 4
With cSrc
AlphaBlend cDest.hdc, 0, 0, .ScaleWidth, .ScaleHeight, _
.hdc, 0, 0, .ScaleWidth, .ScaleHeight, LnBlendPtr
End With
cDest.Refresh
'恢复设置
cSrc.ScaleMode = Mode
cDest.AutoRedraw = AutoDraw
End Sub
三、至于实际问题的应用,你只需把上述代码稍加修改即可。如还有疑问,请短消息联系。
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询