• <ruby id="5koa6"></ruby>
    <ruby id="5koa6"><option id="5koa6"><thead id="5koa6"></thead></option></ruby>

    <progress id="5koa6"></progress>

  • <strong id="5koa6"></strong>
    • 軟件測試技術
    • 軟件測試博客
    • 軟件測試視頻
    • 開源軟件測試技術
    • 軟件測試論壇
    • 軟件測試沙龍
    • 軟件測試資料下載
    • 軟件測試雜志
    • 軟件測試人才招聘
      暫時沒有公告

    字號: | 推薦給好友 上一篇 | 下一篇

    制作透明的任務欄

    發布: 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. 

    延伸閱讀

    文章來源于領測軟件測試網 http://www.kjueaiud.com/


    關于領測軟件測試網 | 領測軟件測試網合作伙伴 | 廣告服務 | 投稿指南 | 聯系我們 | 網站地圖 | 友情鏈接
    版權所有(C) 2003-2010 TestAge(領測軟件測試網)|領測國際科技(北京)有限公司|軟件測試工程師培訓網 All Rights Reserved
    北京市海淀區中關村南大街9號北京理工科技大廈1402室 京ICP備2023014753號-2
    技術支持和業務聯系:info@testage.com.cn 電話:010-51297073

    軟件測試 | 領測國際ISTQBISTQB官網TMMiTMMi認證國際軟件測試工程師認證領測軟件測試網

    老湿亚洲永久精品ww47香蕉图片_日韩欧美中文字幕北美法律_国产AV永久无码天堂影院_久久婷婷综合色丁香五月

  • <ruby id="5koa6"></ruby>
    <ruby id="5koa6"><option id="5koa6"><thead id="5koa6"></thead></option></ruby>

    <progress id="5koa6"></progress>

  • <strong id="5koa6"></strong>