VB.NET 2005 如何做部分窗体透明

简单的部分透明比较难做，不过可以换个方式考虑一下。

网站建设哪家好，找成都创新互联公司！专注于网页设计、网站建设、微信开发、小程序设计、集团企业网站建设等服务项目。为回馈新老客户创新互联还提供了兴宾免费建站欢迎大家使用！

把本问题转换成在VB.NET 2005环境下创建不规则窗体（＝普通窗体 － 透明部分）问题，解决方法就很多了，网上也有许多例子。如 章立民 的书里就详细讲过。

大致思路如下：

1。将backgroundimage设成一个位图（点阵图）

2.将Transparaencykey设成位图的背景颜色（位图最取背景单纯，单纯部分将成为透明部分）

3.如需要可以将formborderstyle设为none，会移除标题栏，并需要手动编写窗体移动、关闭等动作代码，

vb 窗体透明 控件半透明

PS：一下代码是复制的，因为Google一下就有

‘添加新模块：

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 Declare Function SetLayeredwindowAttributes Lib "user32" ( _

ByVal hwnd As Long, _

ByVal crKey As Long, _

ByVal bAlpha As Long, _

ByVal dwFlags As Long) _

As Long

Private Const GWL_EXSTYLE = (-20)

Private Const LWA_ALPHA As Long = H2

Private Const WS_EX_LAYERED As Long = H80000

'设置窗口透明度

Public Sub SetFormToAlpha(hwnd As Long, lngAlpha As Long)

Dim tmpLog As Long

If hwnd = 0 Then Exit Sub

If lngAlpha = 0 And lngAlpha = 255 Then

tmpLog = GetwindowLong(hwnd, GWL_EXSTYLE) '窗口属性

Call SetwindowLong(hwnd, GWL_EXSTYLE, tmpLog or WS_EX_LAYERED)

Call SetLayeredwindowAttributes(hwnd, 0, lngAlpha, LWA_ALPHA)

End If

End Sub

VB6如何设置半透明窗体和控件

先建一个标准EXE工程，然后添加一个用户控件，把以下代码复制到控件代码中，再把此控件放置到Form1上。

[vb] view plain copy

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long

Private Type POINTAPI

X As Long

Y As Long

End Type

Private Type RECT

Left As Long

Top As Long

Right As Long

Bottom As Long

End Type

Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long

Private Const DT_SINGLELINE = H20

Private Const DT_CENTER = H1

Private Const DT_VCENTER = H4

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

Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long

Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Private Const SW_SHOW = 5

Private Const SW_HIDE = 0

Private 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

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

Dim m_hMemDC As Long

Dim m_hMemBmp As Long, m_hMemBmpPrev As Long

Dim m_rcControl As RECT

Private Sub UserControl_Initialize()

UserControl.AutoRedraw = True

UserControl.BackColor = vbRed

m_hMemDC = CreateCompatibleDC(UserControl.hdc)

End Sub

Private Sub UserControl_Terminate()

If m_hMemBmp  0 Then

DeleteObject SelectObject(m_hMemDC, m_hMemBmpPrev)

End If

DeleteDC m_hMemDC

End Sub

Public Sub Translucence()

Dim hdc As Long

Dim tPt As POINTAPI

'获得控件当前位置和大小

ClientToScreen UserControl.hwnd, tPt

ScreenToClient UserControl.ContainerHwnd, tPt

Call GetClientRect(UserControl.hwnd, m_rcControl)

OffsetRect m_rcControl, tPt.X, tPt.Y

'创建一幅内存位图

If m_hMemBmp  0 Then

DeleteObject (SelectObject(m_hMemDC, m_hMemBmpPrev))

End If

m_hMemBmp = CreateCompatibleBitmap(UserControl.hdc, m_rcControl.Right, m_rcControl.Bottom)

m_hMemBmpPrev = SelectObject(m_hMemDC, m_hMemBmp)

'隐藏控件

ShowWindow UserControl.hwnd, SW_HIDE

DoEvents

'保存控件容器的图像到内存位图中

Dim hDesktopDC As Long

hDesktopDC = GetDC(UserControl.hwnd)

BitBlt m_hMemDC, 0, 0, m_rcControl.Right, m_rcControl.Bottom, hDesktopDC, 0, 0, vbSrcCopy

ReleaseDC 0, hDesktopDC

'通过alpha效果进行半透明渲染

UserControl.AutoRedraw = True

AlphaBlend m_hMemDC, 0, 0, m_rcControl.Right, m_rcControl.Bottom, UserControl.hdc, 0, 0, m_rcControl.Right, m_rcControl.Bottom, 5242880

UserControl.AutoRedraw = False

'显示控件

ShowWindow UserControl.hwnd, SW_SHOW

'将渲染后的结果复制到控件中

BitBlt UserControl.hdc, 0, 0, m_rcControl.Right, m_rcControl.Bottom, m_hMemDC, 0, 0, vbSrcCopy

End Sub

Private Sub UserControl_Paint()

BitBlt UserControl.hdc, 0, 0, m_rcControl.Right, m_rcControl.Bottom, m_hMemDC, 0, 0, vbSrcCopy

End Sub

在Form1的Form_Activate事件里输入以下代码：

[vb] view plain copy

Private Sub Form_Activate()

Me.UserControl11.Translucence

End Sub

最后，你将看到一个粉红色半透明的方块，该方块就是你所需要的半透明的控件。至于控件的其它功能，可以自行扩展。

怎么样让VB窗口变透明？

'函数SetLayeredWindowAttributes ' 使用这个函数，可以轻松的实现半透明窗体。按照微软的要求，透明窗体窗体在创建时应使用WS_EX_LAYERED参数（用CreateWindowEx），或者在创建后设置该参数（用SetWindowLong），我选用后者。全部函数、常量声明如下： 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 ' 其中hwnd是透明窗体的句柄，crKey为颜色值，bAlpha是透明度，取值范围是[0,255]，dwFlags是透明方式，可以取两个值：当取值为LWA_ALPHA时，crKey参数无效，bAlpha参数有效；当取值为LWA_COLORKEY时，bAlpha参数有效而窗体中的所有颜色为crKey的地方将变为透明－－这个功能很有用：我们不必再为建立不规则形状的窗体而调用一大堆区域分析、创建、合并函数了，只需指定透明处的颜色值即可，哈哈哈哈！请看具体代码。 Private Const WS_EX_LAYERED = H80000 Private Const GWL_EXSTYLE = (-20) Private Const LWA_ALPHA = H2 Private Const LWA_COLORKEY = H1 Private Sub Command1_Click() Unload Me End Sub Private Sub Form_Load() Dim rtn As Long rtn = GetWindowLong(hwnd, GWL_EXSTYLE) rtn = rtn Or WS_EX_LAYERED SetWindowLong hwnd, GWL_EXSTYLE, rtn SetLayeredWindowAttributes hwnd, 0, 150, LWA_ALPHA End Sub

如何用VB实现半透明控件

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong 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 Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex 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 Sub SetFormTranslucency(hwnd As Long, crKey As Long, bAlpha As Byte, dwFlags As Long)'实现半透明窗体

Dim rtn As Long

rtn = GetWindowLong(hwnd, GWL_EXSTYLE)

rtn = rtn Or WS_EX_LAYERED

SetWindowLong hwnd, GWL_EXSTYLE, rtn

SetLayeredWindowAttributes hwnd, crKey, bAlpha, dwFlags

End Sub

Private Sub Form_Load()

Call SetFormTranslucency(Me.hwnd, 0, 200, 2) '窗体半透明，200为透明值

End Sub

可以实现窗体和窗体上的控件全都半透明，透明度可调

新闻名称：vb.net窗体半透明,vb窗体透明改哪个属性
当前网址：http://scyanting.com/article/hescpe.html