Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
(ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Const GWL_STYLE = (-16)
Public Const GWL_EXSTYLE = (-20)
'Requires Windows 2000 or later:
Public Const WS_EX_LAYERED = &H80000Public Type POINTAPI
x As Long
y As Long
End Type
Public Type SIZE
cx As Long
cy As Long
End TypePublic Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
'//
'// currentlly defined blend function
'//Public Const AC_SRC_OVER = &H0'//
'// alpha format flags
'//
Public Const AC_SRC_ALPHA = &H1
Public Const AC_SRC_NO_PREMULT_ALPHA = &H1
Public Const AC_SRC_NO_ALPHA = &H2
Public Const AC_DST_NO_PREMULT_ALPHA = &H10
Public Const AC_DST_NO_ALPHA = &H20Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hWnd As Long, ByVal crKey As Long, _
ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Const LWA_COLORKEY = &H1
Public Const LWA_ALPHA = &H2Declare 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
Public Const ULW_COLORKEY = &H1
Public Const ULW_ALPHA = &H2
Public Const ULW_OPAQUE = &H4
Public Function IsLayeredWindow(ByVal hWnd As Long) As Boolean
Dim l As Long l = GetWindowLong(hWnd, GWL_EXSTYLE)
If (l And WS_EX_LAYERED) = WS_EX_LAYERED Then
IsLayeredWindow = True
Else
IsLayeredWindow = False
End If
End FunctionPublic Sub SetLayeredWindow(ByVal hWnd As Long, _
ByVal bIsLayered As Boolean)
Dim l As Long l = GetWindowLong(hWnd, GWL_EXSTYLE) If bIsLayered = True Then
l = l Or WS_EX_LAYERED
Else
l = l And Not WS_EX_LAYERED
End If
SetWindowLong hWnd, GWL_EXSTYLE, l
End Sub
'--end block--'
Module modWndEnum.bas Option ExplicitDeclare Function EnumWindows Lib "user32" _
(ByVal lpFunc As Long, ByVal lParam As Long) As LongDeclare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Public Function EnumWndProc(ByVal hWnd As Long, ByVal lParam As Long) As Long Dim s2 As String 'Find out what kind of a window this is:
s2 = String$(255, 0)
GetClassName hWnd, s2, 255
s2 = Left$(s2, InStr(s2, Chr$(0)) - 1) 'Don't waste time on the following window classes,
'we'll only slow the system to a crawl:
If StrComp(s2, "tooltips_class32", vbTextCompare) = 0 Or _
StrComp(s2, "Progman", vbTextCompare) = 0 Or _
StrComp(s2, "OleDdeWndClass") = 0 Then
EnumWndProc = 1
Exit Function
End If
'Make this window a layered window
SetLayeredWindow hWnd, lParam
'bAlpha parameter is the level of transparency,
'must be in between 0 and 255
SetLayeredWindowAttributes hWnd, 0, 180, LWA_ALPHA 'Keep going
EnumWndProc = 1 'TRUE
End Function
'--end block--'
Form frmMain.frm We need three CommandButton controls on this form, named cmdIs, cmdLayered, and cmdNot. Once these controls are in place, put the following code into the code window:Option ExplicitPrivate Sub cmdIs_Click()
'Displays whether this form is a
'layered window
MsgBox IsLayeredWindow(hWnd)
End SubPrivate Sub cmdLayered_Click()
'Turns on (nearly) system-wide
'layering of windows
EnumWindows AddressOf EnumWndProc, 1
End SubPrivate Sub cmdNot_Click()
'Turns off layered windows
EnumWindows AddressOf EnumWndProc, 0
End Sub
'--end block--'