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

  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 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 lichmama@cnblogs.com" & 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