分享
 
 
 

制作透明的任务栏

王朝厨房·作者佚名  2007-01-04
窄屏简体版  字體: |||超大  

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.

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有