VB文本框透明

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