一段耐人寻味的代码
Option Explicit
Private Declare Function sendmessage Lib "user32" Alias "sendmessageA" (ByVal hwnd As Long, ByVal wmsg As Long, ByVal wparam As Long, iparam As Any) As Long
Private Const wm_syscommand = &H112
Private Const sc_move = &HF010&
Private Const sc_restore = &HF120&
Private Const sc_size = &HF000&
Private Sub form_load()
If WindowState = vbMinimized Then
LastState = vbNormal
Else
LastState = WindowState
End If
addtotray Me, mnutray
End Sub
Private Sub form_resizie()
Select Case WindowState
Case vbmininized
mnutraymaximize.Enabled = True
mnutrayminimize.Enabled = False
mnutrayrestore.Enabled = True
mnutraysize.Enabled = False
mnutraymove.Enabled = False
Case vbMaximized
mnutraymaximize.Enabled = False
mnutrayminimize.Enabled = True
mnutrayrestore.Enabled = True
mnutraysize.Enabled = False
mnutraymove.Enabled = False
Case vbNormal
mnutraymaximize.Enabled = True
mnutrayminimize.Enabled = True
mnutrayrestore.Enabled = False
mnutraysize.Enabled = True
mnutraymove.Enabled = True
End Select
If WindowState <> vbMinimized Then LastState = WindowState
End Sub
Private Sub form_unload(cancel As Integer)
removefromtray
End Sub
Private Sub mnufileexit_click()
Unload Me
End Sub
Private Sub mnutrayclose_click()
Unload Me
End Sub
Private Sub mnutraymaximize_click()
WindowState = vbMaximized
End Sub
Private Sub mnutrayminimize_click()
WindowState = vbMinimized
End Sub
Private Sub mnutraymove_click()
sendmessage hwnd, wm_syscommadn, sc_move, 0&
End Sub
Private Sub mnutrayrestore_cilck()
sendmessage hwnd, wm_syscommand, sc_restore, 0&
End Sub
Private Sub mnutraysize_click()
sendmessage hwnd, wm_syscommand, sc_size, 0&
End Sub
我按f5,它提示说
变量未定义,求解 --------------------编程问答-------------------- LastState 变量没有定,可以定义一下 或者把这句Option Explicit 去掉
Private Sub form_load()
If WindowState = vbMinimized Then
LastState = vbNormal
Else
LastState = WindowState
End If
addtotray Me, mnutray
End Sub
Private Sub form_load()
dim LastState as long
If WindowState = vbMinimized Then
LastState = vbNormal
Else
LastState = WindowState
End If
addtotray Me, mnutray
End Sub
--------------------编程问答-------------------- 按ctrl+f5 看看哪里的变量没有定义 --------------------编程问答-------------------- 我试试看
--------------------编程问答-------------------- 你的代码没copy全 --------------------编程问答-------------------- LastState是模块级别的整形或长整形变量,需在通用部分声明:Dim LastState as long
--------------------编程问答-------------------- LastState 的定义在哪呢? --------------------编程问答-------------------- Option Explicit
Private Declare 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 Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private Const WM_USER = &H400
Private Const WM_LBUTTONUP = &H202
Private Const WM_MBUTTONUP = &H208
Private Const WM_RBUTTONUP = &H205
Private Const TRAY_CALLBACK = (WM_USER + 1001&)
Private Const GWL_WNDPROC = (-4)
Private Const GWL_USERDATA = (-21)
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const NIM_ADD = &H0
Private Const NIF_MESSAGE = &H1
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Public OldWindowProc As Long
Public TheForm As Form
Public TheMenu As Menu
Private Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Private TheData As NOTIFYICONDATA
'新的窗口程序,它将取代原来的窗口程序
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 '如果用户单击了托盘图标
If lParam = WM_LBUTTONUP Then ' 单击左键,恢复窗体
TheForm.WindowState = 0
End If
If lParam = WM_RBUTTONUP Then '单击右键,弹出快捷菜单
TheForm.PopupMenu TheMenu
Exit Function
End If
End If
'将其他消息传递给原来的窗口程序
NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)
End Function
Public Sub AddToTray(frm As Form, mnu As Menu) '将程序图标添加到系统托盘区
'保存变量以供其他处引用
Set TheForm = frm
Set TheMenu = mnu
'装载新的窗口程序
OldWindowProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
' 将程序图标添加到系统托盘区
With TheData
.uID = 0
.hwnd = frm.hwnd
.cbSize = Len(TheData)
.hIcon = frm.Icon.Handle
.uFlags = NIF_ICON + NIF_TIP + NIF_MESSAGE
.uCallbackMessage = TRAY_CALLBACK
.uFlags = .uFlags Or NIF_MESSAGE
.cbSize = Len(TheData)
End With
Shell_NotifyIcon NIM_ADD, TheData
End Sub
Public Sub RemoveFromTray() '将图标从系统托盘区中删除
TheData.uFlags = 0
Shell_NotifyIcon NIM_DELETE, TheData
SetWindowLong TheForm.hwnd, GWL_WNDPROC, OldWindowProc ' 恢复原来的窗口程序 .
End Sub
Public Sub SetTrayTip(tip As String) '设置图标的提示信息
With TheData
.szTip = tip & vbNullChar
.uFlags = NIF_TIP
End With
Shell_NotifyIcon NIM_MODIFY, TheData
End Sub
Private Sub Form_Load()
AddToTray Me, mnuTray '调用添加托盘图标子程序
SetTrayTip "123" '调用在托盘图标上显示提示的子程序"
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
RemoveFromTray '在窗体退出后,删除托盘中的图标
End Sub
这是全部代码,还是显示未定义mnutray --------------------编程问答-------------------- 代码还不完整。 --------------------编程问答-------------------- 我这是拷贝的实例,代码不全的地方求指点,还有函数定义不怎么清楚,望达人指点 --------------------编程问答-------------------- mnutray似乎是一个托盘控件或类实例之类的东东,不存在,应添加。 --------------------编程问答-------------------- 那位大哥有做过的实例,请发我邮箱一个,谢谢
996985138@qq.com --------------------编程问答-------------------- mnutray 是主窗体内一个隐藏的 Pop 菜单,它下面有一系列的子菜单。
比如 退出(结束程序)、显示窗口、最小化(隐藏)等等。
--------------------编程问答-------------------- 你的 7F 的代码也是不完整的。
--------------------编程问答-------------------- 不知你是否是想做托盘图标的弹出,删除之类的呢,是的话,讲下,我有这种例子 --------------------编程问答-------------------- 楼主请全编译运行:ctrl+F5
系统会先检查在运行。
补充:VB , 基础类