怎么做透明的窗体？？

Question

怎么做透明的窗体？？

Answer 1

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
Const GWL_EXSTYLE = (-20)
Const WS_EX_TRANSPARENT = &H20&
Private PreValue As LongPrivate Sub Command2_Click() '还原变成不透明
Call SetWindowLong(Me.hwnd, GWL_EXSTYLE, PreValue)
Me.Hide
Me.Show
End SubPrivate Sub Form_Load()
Dim i As Longi = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
'变成透明的Form
PreValue = SetWindowLong(Me.hwnd, GWL_EXSTYLE, i Or WS_EX_TRANSPARENT)
Me.Show
DoEvents
Command1.Refresh '令Command1可见
Command2.Refresh '令Command2可见
End Sub

Answer 2

Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000Private 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 Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long                                                  '  Note  that  if  you  declare  the  lpData  parameter  as  String,  you  must  pass  it  By  Value.
Private Const HKEY_CURRENT_USER = &H80000001
Private Const REG_DWORD = 4                                                '  32-bit  numberDim reg As LongPrivate Sub Form_Load()SetFromtransparence Me, 50'这个参数从1到255,表示不同的透明度End Sub
Private Sub SetFromtransparence(Obform As Object, TransparenceTolerance As Integer)   '
Dim Ret As LongRet = GetWindowLong(Obform.hwnd, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED
SetWindowLong Obform.hwnd, GWL_EXSTYLE, RetSetLayeredWindowAttributes Obform.hwnd, 0, TransparenceTolerance, LWA_ALPHA
End Sub

Answer 3

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 LongPrivate Sub Form_Load()
Me.AutoRedraw = True
Dim bmp As Long
bmp = CreateCompatibleBitmap(Me.hdc, 0, 0)
SelectObject Me.hdc, bmp
Me.RefreshEnd Sub

Answer 4

一般方法只有在Win2000以上才支持，到这儿看看，这儿有全面的代码！
http://wind-love.com/bbs/article.asp?id=172