VB6之调整任务栏按钮的位置

好无聊，睡前一更~

XP的任务栏没办法像win7那样随意拖动交换顺序，偶觉不爽，遂写程序搞之。这个不算什么新东西，参考了很多别人写的东东。

程序启动后，会在右下角托盘区显示钢铁侠的图标。右键击之，可选择退出程序全局范围内，使用快捷键Ctrl+方向键左（或者右）即可调整任务栏的按钮（即程序）的位置。

由于我在调试的时候使用了很多debug.print，觉得有碍观瞻的童鞋可以删除之。点我下载源文件！

有图才有真相：



这里仅贴出主要实现的模块：

'主要实现模块
'code by lichmama@cnblogs.com
Private Type TOOLBAR_BUTTONGROUPINFO
AppTitle As String
ToolTip As String
hWnd As Long 'parent hwnd
btnId(1) As Long
btnIndex(1) As Long
End Type

Private Function GetToolbarHwnd() As Long
Dim tbHwnd As Long
Dim ClassName As Variant

For Each ClassName In Array("Shell_TrayWnd", _
"ReBarWindow32", _
"MSTaskSwWClass", _
"ToolbarWindow32")
tbHwnd = FindWindowEx(tbHwnd, 0&, ClassName, vbNullString)
Next
GetToolbarHwnd = tbHwnd
End Function

Private Sub GetToolbarInfo(ByRef tb() As TOOLBAR_BUTTONGROUPINFO)
Dim tbHwnd As Long
Dim BtnCount As Long
Dim pid As Long
Dim hp As Long
Dim pmem As Long

tbHwnd = GetToolbarHwnd()
BtnCount = SendMessage(tbHwnd, TB_BUTTONCOUNT, 0&, 0&)
Call GetWindowThreadProcessId(tbHwnd, pid)
hp = OpenProcess(PROCESS_ALL_ACCESS Or PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, pid)
pmem = VirtualAllocEx(hp, ByVal 0&, ByVal 4096&, MEM_COMMIT, PAGE_READWRITE)

Dim i As Long
Dim btnId As Long
Dim pbuff As Long
Dim lpbuff(1024) As Byte
Dim pbtnHwnd As Long
Dim btnHwnd As Long

For i = 0 To BtnCount - 1

Call SendMessage(tbHwnd, TB_GETBUTTON, i, ByVal pmem)
'get button-id
Call ReadProcessMemory(hp, ByVal pmem + 4, ByVal VarPtr(btnId), ByVal 4&, ByVal 0&)

'get the tooltip or program-title of button
Call ReadProcessMemory(hp, ByVal pmem + 16, ByVal VarPtr(pbuff), ByVal 4&, ByVal 0&)
Call ReadProcessMemory(hp, ByVal pbuff, ByVal VarPtr(lpbuff(0)), ByVal 1024&, 0&)

'get hwnd of button-parent-window
Call ReadProcessMemory(hp, ByVal pmem + 12, ByVal VarPtr(pbtnHwnd), ByVal 4, ByVal 0&)
Call ReadProcessMemory(hp, ByVal pbtnHwnd, ByVal VarPtr(btnHwnd), ByVal 4, ByVal 0&)

Debug.Print BtnCount, i, btnId, Hex(btnHwnd), Left(lpbuff, InStr(lpbuff, Chr(0)))
If i Mod 2 = 0 Then
ReDim Preserve tb(i \ 2) As TOOLBAR_BUTTONGROUPINFO
End If
If btnHwnd = 0 Then
With tb(i \ 2)
.AppTitle = Left(lpbuff, InStr(lpbuff, Chr(0)))
.btnId(0) = btnId
.btnIndex(0) = i
End With
Else
With tb(i \ 2)
.btnId(1) = btnId
.btnIndex(1) = i
.hWnd = btnHwnd
.ToolTip = Left(lpbuff, InStr(lpbuff, Chr(0)))
End With
End If

Next

Call VirtualFreeEx(hp, ByVal pmem, ByVal 4096&, MEM_RELEASE)
Call CloseHandle(hp)
End Sub

Private Sub MoveToolbarButton(ByVal CurrentIndex As Long, _
ByVal Position As Long, _
Optional Direction = 0)

Dim tbHwnd As Long
tbHwnd = GetToolbarHwnd()

'move right
If Direction = 0 Then
Call SendMessage(tbHwnd, TB_MOVEBUTTON, CurrentIndex, ByVal (CurrentIndex + Position * 3))
Call SendMessage(tbHwnd, TB_MOVEBUTTON, CurrentIndex, ByVal (CurrentIndex + Position * 3))
'move left
ElseIf Direction = 1 Then
Call SendMessage(tbHwnd, TB_MOVEBUTTON, CurrentIndex, ByVal (CurrentIndex - Position * 2))
CurrentIndex = CurrentIndex + 1
Call SendMessage(tbHwnd, TB_MOVEBUTTON, CurrentIndex, ByVal (CurrentIndex - Position * 2))
End If
End Sub

Private Sub MoveButton(Optional Direction As Long)
Dim tb() As TOOLBAR_BUTTONGROUPINFO
Call GetToolbarInfo(tb)
If Direction = 0 Then
Call MoveToolbarButton(tb(0).btnIndex(0), UBound(tb), 0)
ElseIf Direction = 1 Then
Call MoveToolbarButton(tb(UBound(tb)).btnIndex(0), UBound(tb), 1)
End If
Erase tb
End Sub

Public Function CallbackWndProc(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

If wMsg = WM_HOTKEY Then
If wParam = HotKeyId1 Then
Debug.Print "move top right side"
Call MoveButton(0)
ElseIf wParam = HotKeyId2 Then
Debug.Print "move top left side"
Call MoveButton(1)
End If
ElseIf wMsg = WM_NOTIFYICON Then
If lParam = WM_RBUTTONUP Then
Debug.Print "Right Button Clicked"
Form1.PopupMenu Form1.TrayMenu
ElseIf lParam = WM_LBUTTONUP Then
Debug.Print "Left Button Clicked"
End If
End If
CallbackWndProc = CallWindowProc(lpPrevWndFunc, hWnd, wMsg, wParam, lParam)
End Function

Public Function LoadIconFromRes() As Long
'该功能的实现参考了以下2个链接
'@http://bbs.csdn.net/topics/360099153
'@http://blog.csdn.net/modest/article/details/2468937

Dim lpIE As ICONDIRENTRY
Dim buff() As Byte

buff = LoadResData(101, "ICON")
'For i = 0 To buff(4) - 1
'    Call CopyMemory(lpIE, buff(6 + i * Len(lpIE)), Len(lpIE))
'    Debug.Print lpIE.bWidth
'Next
Call CopyMemory(lpIE, buff(6), Len(lpIE))
LoadIconFromRes = CreateIconFromResourceEx(buff(lpIE.dwImageOffset), lpIE.dwBytesInRes, -1, &H30000, 32&, 32&, 0&)
Erase buff
End Function

Public Sub SetNotifyIcon()
With notify
.cbSize = Len(notify)
.hIcon = LoadIconFromRes()
.hWnd = Form1.hWnd
.szTip = "ToolbarSwitcher ver/0.1" & vbCrLf & _
"Code by lichmama@cnblogs.com" & Chr(0)
.uCallbackMessage = WM_NOTIFYICON
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uID = 1111&
End With
Call Shell_NotifyIcon(NIM_ADD, notify)
End Sub

Public Sub RemoveNotifyIcon()
Call Shell_NotifyIcon(NIM_DELETE, notify)
End Sub