好无聊，睡前一更~
XP的任务栏没办法像win7那样随意拖动交换顺序，偶觉不爽，遂写程序搞之。这个不算什么新东西，参考了很多别人写的东东。
程序启动后，会在右下角托盘区显示钢铁侠的图标。右键击之，可选择退出程序全局范围内，使用快捷键Ctrl+方向键左（或者右）即可调整任务栏的按钮（即程序）的位置。
由于我在调试的时候使用了很多debug.print，觉得有碍观瞻的童鞋可以删除之。点我下载源文件！
有图才有真相：
这里仅贴出主要实现的模块：
1 ‘主要实现模块
2 ‘code by [email protected]
3 Private Type TOOLBAR_BUTTONGROUPINFO
4 AppTitle As String
5 ToolTip As String
6 hWnd As Long ‘parent hwnd
7 btnId(1) As Long
8 btnIndex(1) As Long
9 End Type
10
11 Private Function GetToolbarHwnd() As Long
12 Dim tbHwnd As Long
13 Dim ClassName As Variant
14
15 For Each ClassName In Array("Shell_TrayWnd", _
16 "ReBarWindow32", _
17 "MSTaskSwWClass", _
18 "ToolbarWindow32")
19 tbHwnd = FindWindowEx(tbHwnd, 0&, ClassName, vbNullString)
20 Next
21 GetToolbarHwnd = tbHwnd
22 End Function
23
24 Private Sub GetToolbarInfo(ByRef tb() As TOOLBAR_BUTTONGROUPINFO)
25 Dim tbHwnd As Long
26 Dim BtnCount As Long
27 Dim pid As Long
28 Dim hp As Long
29 Dim pmem As Long
30
31 tbHwnd = GetToolbarHwnd()
32 BtnCount = SendMessage(tbHwnd, TB_BUTTONCOUNT, 0&, 0&)
33 Call GetWindowThreadProcessId(tbHwnd, pid)
34 hp = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pid)
35 pmem = VirtualAllocEx(hp, ByVal 0&, ByVal 4096&, MEM_COMMIT, PAGE_READWRITE)
36
37 Dim i As Long
38 Dim btnId As Long
39 Dim pbuff As Long
40 Dim lpbuff(1024) As Byte
41 Dim pbtnHwnd As Long
42 Dim btnHwnd As Long
43
44 For i = 0 To BtnCount - 1
45
46 Call SendMessage(tbHwnd, TB_GETBUTTON, i, ByVal pmem)
47 ‘get button-id
48 Call ReadProcessMemory(hp, ByVal pmem + 4, ByVal VarPtr(btnId), ByVal 4&, ByVal 0&)
49
50 ‘get the tooltip or program-title of button
51 Call ReadProcessMemory(hp, ByVal pmem + 16, ByVal VarPtr(pbuff), ByVal 4&, ByVal 0&)
52 Call ReadProcessMemory(hp, ByVal pbuff, ByVal VarPtr(lpbuff(0)), ByVal 1024&, 0&)
53
54 ‘get hwnd of button-parent-window
55 Call ReadProcessMemory(hp, ByVal pmem + 12, ByVal VarPtr(pbtnHwnd), ByVal 4, ByVal 0&)
56 Call ReadProcessMemory(hp, ByVal pbtnHwnd, ByVal VarPtr(btnHwnd), ByVal 4, ByVal 0&)
57
58 Debug.Print BtnCount, i, btnId, Hex(btnHwnd), Left(lpbuff, InStr(lpbuff, Chr(0)))
59 If i Mod 2 = 0 Then
60 ReDim Preserve tb(i \ 2) As TOOLBAR_BUTTONGROUPINFO
61 End If
62 If btnHwnd = 0 Then
63 With tb(i \ 2)
64 .AppTitle = Left(lpbuff, InStr(lpbuff, Chr(0)))
65 .btnId(0) = btnId
66 .btnIndex(0) = i
67 End With
68 Else
69 With tb(i \ 2)
70 .btnId(1) = btnId
71 .btnIndex(1) = i
72 .hWnd = btnHwnd
73 .ToolTip = Left(lpbuff, InStr(lpbuff, Chr(0)))
74 End With
75 End If
76
77 Next
78
79 Call VirtualFreeEx(hp, ByVal pmem, ByVal 4096&, MEM_RELEASE)
80 Call CloseHandle(hp)
81 End Sub
82
83 Private Sub MoveToolbarButton(ByVal CurrentIndex As Long, _
84 ByVal Position As Long, _
85 Optional Direction = 0)
86
87 Dim tbHwnd As Long
88 tbHwnd = GetToolbarHwnd()
89
90 ‘move right
91 If Direction = 0 Then
92 Call SendMessage(tbHwnd, TB_MOVEBUTTON, CurrentIndex, ByVal (CurrentIndex + Position * 3))
93 Call SendMessage(tbHwnd, TB_MOVEBUTTON, CurrentIndex, ByVal (CurrentIndex + Position * 3))
94 ‘move left
95 ElseIf Direction = 1 Then
96 Call SendMessage(tbHwnd, TB_MOVEBUTTON, CurrentIndex, ByVal (CurrentIndex - Position * 2))
97 CurrentIndex = CurrentIndex + 1
98 Call SendMessage(tbHwnd, TB_MOVEBUTTON, CurrentIndex, ByVal (CurrentIndex - Position * 2))
99 End If
100 End Sub
101
102 Private Sub MoveButton(Optional Direction As Long)
103 Dim tb() As TOOLBAR_BUTTONGROUPINFO
104 Call GetToolbarInfo(tb)
105 If Direction = 0 Then
106 Call MoveToolbarButton(tb(0).btnIndex(0), UBound(tb), 0)
107 ElseIf Direction = 1 Then
108 Call MoveToolbarButton(tb(UBound(tb)).btnIndex(0), UBound(tb), 1)
109 End If
110 Erase tb
111 End Sub
112
113 Public Function CallbackWndProc(ByVal hWnd As Long, _
114 ByVal wMsg As Long, _
115 ByVal wParam As Long, _
116 ByVal lParam As Long) As Long
117
118 If wMsg = WM_HOTKEY Then
119 If wParam = HotKeyId1 Then
120 Debug.Print "move top right side"
121 Call MoveButton(0)
122 ElseIf wParam = HotKeyId2 Then
123 Debug.Print "move top left side"
124 Call MoveButton(1)
125 End If
126 ElseIf wMsg = WM_NOTIFYICON Then
127 If lParam = WM_RBUTTONUP Then
128 Debug.Print "Right Button Clicked"
129 Form1.PopupMenu Form1.TrayMenu
130 ElseIf lParam = WM_LBUTTONUP Then
131 Debug.Print "Left Button Clicked"
132 End If
133 End If
134 CallbackWndProc = CallWindowProc(lpPrevWndFunc, hWnd, wMsg, wParam, lParam)
135 End Function
136
137 Public Function LoadIconFromRes() As Long
138 ‘该功能的实现参考了以下2个链接
139 ‘@http://bbs.csdn.net/topics/360099153
140 ‘@http://blog.csdn.net/modest/article/details/2468937
141
142 Dim lpIE As ICONDIRENTRY
143 Dim buff() As Byte
144
145 buff = LoadResData(101, "ICON")
146 ‘For i = 0 To buff(4) - 1
147 ‘ Call CopyMemory(lpIE, buff(6 + i * Len(lpIE)), Len(lpIE))
148 ‘ Debug.Print lpIE.bWidth
149 ‘Next
150 Call CopyMemory(lpIE, buff(6), Len(lpIE))
151 LoadIconFromRes = CreateIconFromResourceEx(buff(lpIE.dwImageOffset), lpIE.dwBytesInRes, -1, &H30000, 32&, 32&, 0&)
152 Erase buff
153 End Function
154
155 Public Sub SetNotifyIcon()
156 With notify
157 .cbSize = Len(notify)
158 .hIcon = LoadIconFromRes()
159 .hWnd = Form1.hWnd
160 .szTip = "ToolbarSwitcher ver/0.1" & vbCrLf & _
161 "Code by [email protected]" & Chr(0)
162 .uCallbackMessage = WM_NOTIFYICON
163 .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
164 .uID = 1111&
165 End With
166 Call Shell_NotifyIcon(NIM_ADD, notify)
167 End Sub
168
169 Public Sub RemoveNotifyIcon()
170 Call Shell_NotifyIcon(NIM_DELETE, notify)
171 End Sub
VB6之调整任务栏按钮的位置
时间： 2024-11-05 20:47:52