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