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 Sub SetWindowPos Lib "user32" ( _
ByVal hWnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags 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 WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1&
Private Const LWA_ALPHA = &H2&
Private Const LWA_OPAQUE = &HFF&
Private Const GWL_STYLE = (-16)
Private Const WS_CAPTION = &HC00000
Private Const WS_THICKFRAME = &H40000
Private Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_NOZORDER = &H4
Private Const SWP_FRAMECHANGED = &H20
Private m_ColorKey As OLE_COLOR
Private Declare Function GetSysColor Lib "user32" ( _
ByVal nIndex As Long _
) As Long
Private Function CheckSysColor(ByVal ColorRef As OLE_COLOR) As Long
Const HighBit = &H80000000
If ColorRef And HighBit Then
CheckSysColor = GetSysColor(ColorRef And Not HighBit)
Else
CheckSysColor = ColorRef
End If
End Function
Private Function MakeTransparent(ByVal hWnd As Long) As Boolean
Dim nStyle As Long
If hWnd Then
nStyle = GetWindowLong(hWnd, GWL_EXSTYLE) And Not WS_EX_LAYERED
If SetWindowLong(hWnd, GWL_EXSTYLE, nStyle) Then
nStyle = nStyle Or WS_EX_LAYERED
If SetWindowLong(hWnd, GWL_EXSTYLE, nStyle) Then
MakeTransparent = CBool(SetLayeredWindowAttributes( _
hWnd, CheckSysColor(m_ColorKey), _
0, _
LWA_COLORKEY))
End If
End If
End If
End Function
Private Function ToggleCaption(ByVal Value As Boolean) As Boolean
Dim nStyle As Long
' Retrieve current style bits.
nStyle = GetWindowLong(Me.hWnd, GWL_STYLE)
' Set WS_SYSMENU On or Off as requested.
If Value Then
nStyle = nStyle Or WS_CAPTION Or WS_THICKFRAME
Else
nStyle = nStyle And Not WS_CAPTION
nStyle = nStyle And Not WS_THICKFRAME
End If
' Try to set new style.
If SetWindowLong(Me.hWnd, GWL_STYLE, nStyle) Then
If nStyle = GetWindowLong(Me.hWnd, GWL_STYLE) Then
ToggleCaption = True
End If
End If
' Redraw window with new style.
SetWindowPos hWnd, 0, 0, 0, 0, 0, SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOZORDER Or SWP_NOSIZE
End Function
Private Sub Form_Load()
'setup label
Label1.AutoSize = True
Label1.Caption = "Click Me"
'make transparent
'Toggle titlebar off.
'Call ToggleCaption(False)
m_ColorKey = vbGreen
MakeTransparent Me.hWnd
' Set backgrounds to green so they
' become transparent too.
Me.BackColor = vbGreen
Label1.BackColor = vbGreen
End Sub
Private Sub Label1_Click()
Unload Me
End Sub
