• 软件测试技术
  • 软件测试博客
  • 软件测试视频
  • 开源软件测试技术
  • 软件测试论坛
  • 软件测试沙龙
  • 软件测试资料下载
  • 软件测试杂志
  • 软件测试人才招聘
    暂时没有公告

字号: | 推荐给好友 上一篇 | 下一篇

制作透明的任务栏

发布: 2007-7-14 20:28 | 作者: 佚名    | 来源: 网络转载     | 查看: 21次 | 进入软件测试论坛讨论

领测软件测试网 Option Explicit

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/


关于领测软件测试网 | 领测软件测试网合作伙伴 | 广告服务 | 投稿指南 | 联系我们 | 网站地图 | 友情链接
版权所有(C) 2003-2010 TestAge(领测软件测试网)|领测国际科技(北京)有限公司|软件测试工程师培训网 All Rights Reserved
北京市海淀区中关村南大街9号北京理工科技大厦1402室 京ICP备2023014753号-2
技术支持和业务联系:info@testage.com.cn 电话:010-51297073

软件测试 | 领测国际ISTQBISTQB官网TMMiTMMi认证国际软件测试工程师认证领测软件测试网