我加了托盘以后刷新form会导致cpu100托盘OrgWinRet GetWindowLong(Me.hWnd, GWL_WNDPROC)With myData
我加了托盘以后刷新form会导致cpu100
'托盘
'OrgWinRet = GetWindowLong(Me.hWnd, GWL_WNDPROC)
'With myData
' .cbSize = Len(myData)
' .hWnd = Me.hWnd
' .uID = vbNull
' .uFlags = NIF_ICON Or NIF_TIP Or NIF_INFO Or NIF_MESSAGE
' .uCallbackMessage = TRAY_CALLBACK '托盘图标发生事件时所产生的消息。
' .hIcon = Me.Icon '图标。类型为StdPicture。所以可以设置为picturebox中的图片
' .szTip = Form1.Caption & "" & vbNullChar 'tooltip文字
' .dwState = 0
' .dwStateMask = 0
'End With
'Shell_NotifyIcon NIM_ADD, myData
'glWinRet = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf CallbackMsgs)
form中我加了托盘，然后我Call Form_Load就会导致程序cpu100，这是为什么呢？
[解决办法]
用下面这个代码，放到模块里
- VB code
Public OldWindowProc As LongPublic TheForm As FormPublic TheMenu As MenuDeclare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongDeclare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongDeclare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongPublic Const WM_USER = &H400Public Const WM_LBUTTONUP = &H202Public Const WM_MBUTTONUP = &H208Public Const WM_RBUTTONUP = &H205Public Const TRAY_CALLBACK = (WM_USER + 1001&)Public Const GWL_WNDPROC = (-4)Public Const GWL_USERDATA = (-21)Public Const NIF_ICON = &H2Public Const NIF_TIP = &H4Public Const NIM_ADD = &H0Public Const NIF_MESSAGE = &H1Public Const NIM_MODIFY = &H1Public Const NIM_DELETE = &H2Public Type NOTIFYICONDATA cbSize As Long hwnd As Long uID As Long uFlags As Long uCallbackMessage As Long hIcon As Long szTip As String * 64End TypePrivate TheData As NOTIFYICONDATA' *********************************************' The replacement window proc.' *********************************************Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If Msg = TRAY_CALLBACK Then ' The user clicked on the tray icon. ' Look for click events. If lParam = WM_LBUTTONUP Then ' On left click, show the form. If TheForm.WindowState = vbMinimized Then _ TheForm.WindowState = TheForm.LastState TheForm.SetFocus Exit Function End If If lParam = WM_RBUTTONUP Then ' On right click, show the menu. TheForm.PopupMenu TheMenu Exit Function End If End If ' Send other messages to the original ' window proc. NewWindowProc = CallWindowProc( _ OldWindowProc, hwnd, Msg, _ wParam, lParam)End Function' *********************************************' Add the form's icon to the tray.' *********************************************Public Sub AddToTray(frm As Form, mnu As Menu) ' ShowInTaskbar must be set to False at ' design time because it is read-only at ' run time. ' Save the form and menu for later use. Set TheForm = frm Set TheMenu = mnu ' Install the new WindowProc. OldWindowProc = SetWindowLong(frm.hwnd, _ GWL_WNDPROC, AddressOf NewWindowProc) ' Install the form's icon in the tray. With TheData .uID = 0 .hwnd = frm.hwnd .cbSize = Len(TheData) .hIcon = frm.Icon.Handle .uFlags = NIF_ICON .uCallbackMessage = TRAY_CALLBACK .uFlags = .uFlags Or NIF_MESSAGE .cbSize = Len(TheData) End With Shell_NotifyIcon NIM_ADD, TheDataEnd Sub' *********************************************' Remove the icon from the system tray.' *********************************************Public Sub RemoveFromTray() ' Remove the icon from the tray. With TheData .uFlags = 0 End With Shell_NotifyIcon NIM_DELETE, TheData ' Restore the original window proc. SetWindowLong TheForm.hwnd, GWL_WNDPROC, _ OldWindowProcEnd Sub' *********************************************' Set a new tray tip.' *********************************************Public Sub SetTrayTip(tip As String) With TheData .szTip = tip & vbNullChar .uFlags = NIF_TIP End With Shell_NotifyIcon NIM_MODIFY, TheDataEnd Sub' *********************************************' Set a new tray icon.' *********************************************Public Sub SetTrayIcon(pic As Picture) ' Do nothing if the picture is not an icon. If pic.Type <> vbPicTypeIcon Then Exit Sub ' Update the tray icon. With TheData .hIcon = pic.Handle .uFlags = NIF_ICON End With Shell_NotifyIcon NIM_MODIFY, TheDataEnd Sub
[解决办法]
那不应该啊，我这里用的好好的
你用API浏览器把函数和参数复制一遍看看
[解决办法]
http://www.m5home.com/blog/article.asp?id=407
试试这里面我封装好的托盘类.
你只需要添加cTray.cls到你的工程,然后在窗体中添加如下代码:
- VB code
Dim WithEvents objTray As cTray '托盘图标Private Sub Form_Load() Set objTray = New cTray With objTray .AddTrayIcon Picture1 '添加一个图片框,用于事件返回,免去子类化 .SetTrayIcon Me.Icon .SetTrayTip Me.Tag End Withend subPrivate Sub objTray_MouseClick(ByVal Button As Long, ByVal DBClick As Boolean) '托盘事件返回 'Button: 鼠标的按键 'DBClick: T为双击,F为单击 Select Case Button Case vbLeftButton '左键单/双击 Debug.Print "vbLeftButton " & IIf(DBClick = False, "Click", "DBClick") Case vbRightButton '右键单/双击 Debug.Print "vbRightButton " & IIf(DBClick = False, "Click", "DBClick") Case vbMiddleButton '中键单/双击 Debug.Print "vbMiddleButton " & IIf(DBClick = False, "Click", "DBClick") End SelectEnd Sub