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

好无聊，睡前一更~

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

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

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

有图才有真相：

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

 '主要实现模块
 'code by [e-mail]
 Private Type TOOLBAR_BUTTONGROUPINFO
     AppTitle As String
     ToolTip As String
     hWnd As Long 'parent hwnd
     btnId() As Long
     btnIndex() 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, &, 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, &, &)
     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 &, ByVal &, MEM_COMMIT, PAGE_READWRITE)

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

     For i =  To BtnCount - 

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

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

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

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

     Next

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

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

     Dim tbHwnd As Long
     tbHwnd = GetToolbarHwnd()

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

 Private Sub MoveButton(Optional Direction As Long)
     Dim tb() As TOOLBAR_BUTTONGROUPINFO
     Call GetToolbarInfo(tb)
     If Direction =  Then
         Call MoveToolbarButton(tb().btnIndex(), UBound(tb), )
     ElseIf Direction =  Then
         Call MoveToolbarButton(tb(UBound(tb)).btnIndex(), UBound(tb), )
     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()
         ElseIf wParam = HotKeyId2 Then
             Debug.Print "move top left side"
             Call MoveButton()
         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.****.net/topics/360099153
 '@http://blog.****.net/modest/article/details/2468937

     Dim lpIE As ICONDIRENTRY
     Dim buff() As Byte

     buff = LoadResData(, "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(), Len(lpIE))
     LoadIconFromRes = CreateIconFromResourceEx(buff(lpIE.dwImageOffset), lpIE.dwBytesInRes, -, &H30000, &, &, &)
     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 [e-mail]" & Chr()
         .uCallbackMessage = WM_NOTIFYICON
         .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
         .uID = &
     End With
     Call Shell_NotifyIcon(NIM_ADD, notify)
 End Sub

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