Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const WS_EX_TRANSPARENT = &H20&
Private Const LWA_ALPHA = &H2&
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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 Declare Function SetLayeredWindowAttributes Lib "User32" (ByVal hwnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const ERROR_SUCCESS = 0&
Private Const REG_OPTION_NON_VOLATILE = 0 ' Key is preserved when system is rebooted
Private Const SYNCHRONIZE = &H100000
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_QUERY_value = &H1
Private Const KEY_SET_value = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_value Or _
KEY_SET_value Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As Any, phkResult As Long, lpdwDisposition 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 Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Function prvGetLevel() As Byte
Dim LnLevel As Byte
Dim LsCommand As String
Dim LnToken As Integer
Dim LsKey As String
Dim LsInput As String
LsCommand = Command()
LsKey = "/translevel:"
LnToken = InStr(1, LsCommand, LsKey, vbTextCompare)
If (LnToken = 0) Then
LsInput = InputBox("Enter transparency level for task bar" & vbCrLf & "1 to 255", , 100)
Else
Dim LnEnd As Integer
LnToken = (LnToken + Len(LsKey))
LsInput = Mid$(LsCommand, LnToken, 3)
End If
If (Trim$(LsInput) = 0) Then
LnLevel = 100
Else
LnLevel = Val(Left$(LsInput, 3))
End If
If (LnLevel > 255) Then LnLevel = 255
If (LnLevel < 50) Then LnLevel = 50
prvGetLevel = LnLevel
End Function
Private Sub prvMakeTransparent(LhWnd As Long, bLevel As Byte)
Dim lOldStyle As Long
lOldStyle = GetWindowLong(LhWnd, GWL_EXSTYLE)
SetWindowLong LhWnd, GWL_EXSTYLE, lOldStyle Or WS_EX_LAYERED
SetLayeredWindowAttributes LhWnd, 0, bLevel, LWA_ALPHA
End Sub
Public Sub Main()
Dim LhWnd As Long
Dim LnLevel As Byte
LnLevel = prvGetLevel
If (InStr(1, Command(), "/silent", vbTextCompare) = 0) Then
' If SetAutoStart(LnLevel) Then
' MsgBox "TransTaskBar will be loaded when OS starts.", vbOKOnly Or vbInFORMation
' End If
Else
End If
LhWnd = FindWindow("Shell_TrayWnd", vbNullString)
If (LhWnd <> 0) Then
prvMakeTransparent LhWnd, LnLevel
End If
End Sub
Public Function SetAutoStart(nLevel As Byte) As Boolean
Dim nRet As Long
Dim hKey As Long
Dim nResult As Long
Dim LsFullPath As String
With App
LsFullPath = App.Path & "\" & App.EXEName & ".exe"
End With
If (InStr(1, LsFullPath, " ") > 0) Then
LsFullPath = """" & LsFullPath & """"
End If
LsFullPath = LsFullPath & " /silent /TransLevel:" & CStr(nLevel)
' Open (or create and open) key
nRet = RegCreateKeyEx(&H80000001, "Software\Microsoft\Windows\CurrentVersion\Run", 0&, vbNullString, _
REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, ByVal 0&, hKey, nResult)
If nRet = ERROR_SUCCESS Then
' Write new value to registry
nRet = RegSetvalueEx(hKey, App.EXEName, 0&, 1&, ByVal LsFullPath, Len(LsFullPath))
Call RegCloseKey(hKey)
End If
SetAutoStart = (nRet = ERROR_SUCCESS)
End Function
资料来源:Leontti A. Ramos M.
延伸阅读
文章来源于领测软件测试网 https://www.ltesting.net/