Question

用VB做透明的窗体

就像QQ宠物那样背景是透明的。对的话追加200分，绝不食言！

Answer 1

不知道你说的透明是半透明还是全部透明,提供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

不知这些符不符合你的要求.

Answer 2

Private
Declare
Function
GetWindowLong
Lib
"user32"
Alias
"GetWindowLongA"
(ByVal
hwnd
As
Long,
ByVal
nIndex
As
Long)
As
LongPrivate
Declare
Function
SetWindowLong
Lib
"user32"
Alias
"SetWindowLongA"
(ByVal
hwnd
As
Long,
ByVal
nIndex
As
Long,
ByVal
dwNewLong
As
Long)
As
LongPrivate
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
=
&H80000Private
Const
GWL_EXSTYLE
=
(-20)Private
Const
LWA_ALPHA
=
&H2Private
Const
LWA_COLORKEY
=
&H1Dim
rtn
As
Long
Private
Sub
Form_Load()
rtn
=
GetWindowLong(hwnd,
GWL_EXSTYLE)rtn
=
rtn
Or
WS_EX_LAYEREDSetWindowLong
hwnd,
GWL_EXSTYLE,
rtnSetLayeredWindowAttributes
hwnd,
0,
120,
LWA_ALPHAEnd
Sub效果：

Answer 3

用SetWindowLong和GetWindowLong
在delphi里是这样的
SetWindowLong(RichEdit1.Handle,GWL_EXSTYLE,GetWindowLong(RichEdit1.Handle, GWL_EXSTYLE) or WS_EX_TRANSPARENT);

Answer 4

依靠CreateRectRgn/CreateRoundRectRgn/CreatePolygonRgn/CreatePolyPolygonRgn来创建一个Region，CombineRgn来处理多个Region的叠加，使用SetWindowRgn来设置异形窗口。
使用:
Dim Region As Long
Region=Create....Rgn(.....) '创建一个Region
Combine Region, Region, Create....Rgn(.....), ...... '创建另一个Region并和前一个Region叠加并保存到Region。
... '若干步骤
SetWindowRgn(Me.hwnd, Region) '设置窗口的显示区域为Region。
必要的，你还要在Form_MouseDown里加入:
ReleaseCapture()
SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MOVE, 0
来实现无标题栏窗口的拖动。