-
Notifications
You must be signed in to change notification settings - Fork 2
/
Layer.bas
135 lines (111 loc) · 3.96 KB
/
Layer.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
Attribute VB_Name = "Module8"
Option Explicit
'**************************************
' Name: Windows 2000 Layered Windows, ak
' a Translucent Windows or Alpha Blended W
' indows (fully movable etc)
' Description:This code utilizes Windows
' 2000's layered window effect, (commonly
' referred to as alpha blended windows or
' translucent windows) described at http:/
' /msdn.microsoft.com/library/techart/laye
' rwin.htm. You must have Windows 2000 for
' this code to work.
' By: Rom
'
'This code is copyrighted and has' limited warranties.Please see http://w
' ww.Planet-Source-Code.com/vb/scripts/Sho
' wCode.asp?txtCodeId=8901&lngWId=1'for details.'**************************************
'Win2k layered windows module
'
'This information was found at
'http://msdn.microsoft.com/library/techa
' rt/layerwin.htm
'and other parts of msdn.
'
'If you want to check if a window is alr
' eady layered,
'CheckLayered(hwnd) will return true or
' false
'
'To make a window layered, just use SetL
' ayered,
'where hwnd is the handle of window, and
' bAlpha
'is the amount of transparency (e.g. 0 =
' invisible,
'255 = opaque), and if True is passed to
' SetAs
'it will make the window layered, if Fal
' se is
'passed then it will get rid of the laye
' red property.
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 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 FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type SIZE
cx As Long
cy As Long
End Type
Private Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)
Private Const AC_SRC_OVER = &H0
Private Const AC_SRC_ALPHA = &H1
Private Const AC_SRC_NO_PREMULT_ALPHA = &H1
Private Const AC_SRC_NO_ALPHA = &H2
Private Const AC_DST_NO_PREMULT_ALPHA = &H10
Private Const AC_DST_NO_ALPHA = &H20
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 lret As Long
Function CheckLayered(ByVal hWnd As Long) As Boolean
lret = GetWindowLong(hWnd, GWL_EXSTYLE)
If (lret And WS_EX_LAYERED) = WS_EX_LAYERED Then
CheckLayered = True
Else
CheckLayered = False
End If
End Function
Sub SetLayered(ByVal hWnd As Long, SetAs As Boolean)
Dim cOS As New clsOS
Dim bAlpha As Byte
Dim ret As String
If InStr(windows, "95") Then
Exit Sub
ElseIf InStr(windows, "98") Then
Exit Sub
ElseIf InStr(windows, "Me") Then
Exit Sub
End If
lret = GetWindowLong(hWnd, GWL_EXSTYLE)
If SetAs = True Then
lret = lret Or WS_EX_LAYERED
Else
lret = lret And Not WS_EX_LAYERED
End If
ret = util.LeeIni(IniPath, "misc", "alpha")
If Len(ret) > 0 Then
bAlpha = CByte(ret)
Else
bAlpha = 150
End If
SetWindowLong hWnd, GWL_EXSTYLE, lret
SetLayeredWindowAttributes hWnd, 0, bAlpha, LWA_ALPHA
Set cOS = Nothing
End Sub