vb picturebox背景透明

xwylpsy 2009-10-29 11:37:52
如题
...全文
198 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
SYSSZ 2009-10-30
  • 打赏
  • 举报
回复
这也只是图片透明,并不是Picture 透明,仅共参考.
SYSSZ 2009-10-30
  • 打赏
  • 举报
回复
去掉Picture2.AutoRedraw = True一句
SYSSZ 2009-10-30
  • 打赏
  • 举报
回复
Private Declare Function TransparentBlt Lib "msimg32.dll" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal crTransparent As Long) As Boolean

Private Sub Form_Load()
Picture1.AutoRedraw = True
Picture2.AutoRedraw = True
Picture1.Picture = LoadPicture(App.Path & "\001.JPG") '一张白色背景图片
Picture1.Left = -1 * Picture1.Width ' Picture1是辅助图片框,放在窗体之外
Picture1.ScaleMode = vbPixels
Picture2.ScaleMode = vbPixels
End Sub

Private Sub Picture2_Paint()
DoEvents
TransparentBlt Picture2.hdc, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, Picture1.hdc, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, RGB(255, 255, 255) 'RGB(255, 255, 255)是透明色-- 白色
End Sub
getemail 2009-10-29
  • 打赏
  • 举报
回复
把上面的Me.hwnd换成Picture1.hwnd即可
getemail 2009-10-29
  • 打赏
  • 举报
回复
不知道你说的透明是半透明还是全部透明,提供3个例子给你吧: 


半透明窗体(窗体对鼠标点击有反应):
Option Explicit

'Transparancy API's
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function UpdateLayeredWindow Lib "user32" (ByVal hWnd As Long, ByVal hdcDst As Long, pptDst As Any, psize As Any, ByVal hdcSrc As Long, pptSrc As Any, crKey As Long, ByVal pblend As Long, ByVal dwFlags As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Const GWL_EXSTYLE = (-20)
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const ULW_COLORKEY = &H1
Private Const ULW_ALPHA = &H2
Private Const ULW_OPAQUE = &H4
Private Const WS_EX_LAYERED = &H80000


Public Function isTransparent(ByVal hWnd As Long) As Boolean
On Error Resume Next
Dim Msg As Long
Msg = GetWindowLong(hWnd, GWL_EXSTYLE)
If (Msg And WS_EX_LAYERED) = WS_EX_LAYERED Then
isTransparent = True
Else
isTransparent = False
End If
If Err Then
isTransparent = False
End If
End Function

Public Function MakeTransparent(ByVal hWnd As Long, ByVal Perc As Integer) As Long
Dim Msg As Long
On Error Resume Next

Perc = 100
If Perc < 0 Or Perc > 255 Then
MakeTransparent = 1
Else
Msg = GetWindowLong(hWnd, GWL_EXSTYLE)
Msg = Msg Or WS_EX_LAYERED
SetWindowLong hWnd, GWL_EXSTYLE, Msg
SetLayeredWindowAttributes hWnd, 0, Perc, LWA_ALPHA
MakeTransparent = 0
End If
If Err Then
MakeTransparent = 2
End If
End Function

Public Function MakeOpaque(ByVal hWnd As Long) As Long
Dim Msg As Long
On Error Resume Next
Msg = GetWindowLong(hWnd, GWL_EXSTYLE)
Msg = Msg And Not WS_EX_LAYERED
SetWindowLong hWnd, GWL_EXSTYLE, Msg
SetLayeredWindowAttributes hWnd, 0, 0, LWA_ALPHA
MakeOpaque = 0
If Err Then
MakeOpaque = 2
End If
End Function
''窗体加载时
Private Sub Form_Load()
MakeTransparent Me.hWnd, 20
End Sub

半透明窗体(对鼠标点击无反应):
Option Explicit

Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long

Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const WS_EX_TRANSPARENT = &H20&
Private Const LWA_ALPHA = &H2&

'//还有种类似的"窗体" 可以隔着它点击 比如那个窗体是在桌面上,右键点击窗体,就是再右击桌面,好多桌面时钟呀~ 天气预报~什么都那样,这是怎么做的?

'请参考MSDN关于WS_EX_TRANSPARENT扩展样式的示例:
'http://support.microsoft.com/default.aspx?scid=kb;en-us;249341

' --- 代码 ---

Private Sub Form_Load()
Dim lOldStyle As Long
Dim bTrans As Byte ' The level of transparency (0 - 255)
bTrans = 128
lOldStyle = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
SetWindowLong Me.hwnd, GWL_EXSTYLE, lOldStyle Or WS_EX_LAYERED Or WS_EX_TRANSPARENT
SetLayeredWindowAttributes Me.hwnd, 0, bTrans, LWA_ALPHA
End Sub

透明窗体(完全看不见):
Option Explicit

Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) _
As Long
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) _
As Long

Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA As Long = &H2
Private Const WS_EX_LAYERED As Long = &H80000

Private Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hwnd As Long, _
ByVal crKey As Long, _
ByVal bAlpha As Long, _
ByVal dwFlags As Long) _
As Long

Private Sub Form_Load()
Dim p As Long
p = GetWindowLong(Me.hwnd, GWL_EXSTYLE) '取得当前窗口属性
Call SetWindowLong(Me.hwnd, GWL_EXSTYLE, p Or WS_EX_LAYERED)
'加上一个透明属性
Call SetLayeredWindowAttributes(Me.hwnd, 0, 0, LWA_ALPHA)
End Sub


这些代码都是本人平时积累的,经试验可用.


这里还有一个文本框透明的例子,也许对你有用:
Option Explicit

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1

Private Sub Form_Load()
Text1.BackColor = vbBlue
Dim rtn As Long
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, vbBlue, 0, LWA_COLORKEY
End Sub
cBirdNO1NO1 2009-10-29
  • 打赏
  • 举报
回复
如果你需要的是背景图片的透明背景效果,需要将图片在PS中处理并另存为GIF格式或TIF格式,并在存储对话框中选择背景透明选项。
booksoon 2009-10-29
  • 打赏
  • 举报
回复
顶一个~~
getemail 2009-10-29
  • 打赏
  • 举报
回复
xwylpsy 2009-10-29
  • 打赏
  • 举报
回复
[Quote=引用 2 楼 getemail 的回复:]
把上面的Me.hwnd换成Picture1.hwnd即可
[/Quote]
非常感谢共享!可能我没有写清楚问题,是要picturebox背景透明,不是它本身透明

7,757

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧