vb picturebox背景透明

2009-10-29 11:37:52 283 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

第十五届蓝桥杯省赛C/C++B组H题【拔河】题解（AC）由于枚举三个点肯定会超时，所以只能枚举两个点，我们尝试枚举第一个区间。的复杂度，需要找出右区间中和左区间的和最相近的值，可以考虑使用。一开始，我们将所有可能的右区间的区间和，都插入。做法同上，用前缀和优化数组求和的过程。的数组和差值最小是多少，其中。递增进行枚举左区间，当。的数组，求两个子数组。为左端点的区间的和。阅读详情

如题

...全文

从接线到组态：手把手教你搞定PROFIBUS-DP与PA的混合网络搭建（基于西门子TIA Portal）本文详细介绍了PROFIBUS-DP与PA混合网络的搭建方法，基于西门子TIA Portal平台，从硬件选型、网络架构设计到组态配置和现场调试，提供了一套完整的实战指南。重点解析了DP/PA耦合器的使用、地址映射策略及网络诊断技巧，帮助工程师高效构建高可靠性的工业自动化网络。阅读详情

xwylpsy

VB基础类 7,788 成员 197,583 内容

+ 关注 + 加入社区

切换为时间正序

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背景透明，不是它本身透明

vb picturebox背景透明

相关推荐