1 ‘主要实现模块  2 ‘code by lichmama@cnblogs.com  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 If100 End Sub101 102 Private Sub MoveButton(Optional Direction As Long)103     Dim tb() As TOOLBAR_BUTTONGROUPINFO104     Call GetToolbarInfo(tb)105     If Direction = 0 Then106         Call MoveToolbarButton(tb(0).btnIndex(0), UBound(tb), 0)107     ElseIf Direction = 1 Then108         Call MoveToolbarButton(tb(UBound(tb)).btnIndex(0), UBound(tb), 1)109     End If110     Erase tb111 End Sub112 113 Public Function CallbackWndProc(ByVal hWnd As Long, _114     ByVal wMsg As Long, _115     ByVal wParam As Long, _116     ByVal lParam As Long) As Long117 118     If wMsg = WM_HOTKEY Then119         If wParam = HotKeyId1 Then120             Debug.Print "move top right side"121             Call MoveButton(0)122         ElseIf wParam = HotKeyId2 Then123             Debug.Print "move top left side"124             Call MoveButton(1)125         End If126     ElseIf wMsg = WM_NOTIFYICON Then127         If lParam = WM_RBUTTONUP Then128             Debug.Print "Right Button Clicked"129             Form1.PopupMenu Form1.TrayMenu130         ElseIf lParam = WM_LBUTTONUP Then131             Debug.Print "Left Button Clicked"132         End If133     End If134     CallbackWndProc = CallWindowProc(lpPrevWndFunc, hWnd, wMsg, wParam, lParam)135 End Function136 137 Public Function LoadIconFromRes() As Long138 ‘该功能的实现参考了以下2个链接139 ‘@http://bbs.csdn.net/topics/360099153140 ‘@http://blog.csdn.net/modest/article/details/2468937141 142     Dim lpIE As ICONDIRENTRY143     Dim buff() As Byte144     145     buff = LoadResData(101, "ICON")146     ‘For i = 0 To buff(4) - 1147     ‘    Call CopyMemory(lpIE, buff(6 + i * Len(lpIE)), Len(lpIE))148     ‘    Debug.Print lpIE.bWidth149     ‘Next150     Call CopyMemory(lpIE, buff(6), Len(lpIE))151     LoadIconFromRes = CreateIconFromResourceEx(buff(lpIE.dwImageOffset), lpIE.dwBytesInRes, -1, &H30000, 32&, 32&, 0&)152     Erase buff153 End Function154 155 Public Sub SetNotifyIcon()156     With notify157         .cbSize = Len(notify)158         .hIcon = LoadIconFromRes()159         .hWnd = Form1.hWnd160         .szTip = "ToolbarSwitcher ver/0.1" & vbCrLf & _161             "Code by lichmama@cnblogs.com" & Chr(0)162         .uCallbackMessage = WM_NOTIFYICON163         .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP164         .uID = 1111&165     End With166     Call Shell_NotifyIcon(NIM_ADD, notify)167 End Sub168 169 Public Sub RemoveNotifyIcon()170     Call Shell_NotifyIcon(NIM_DELETE, notify)171 End Sub