关于托盘程序的问题
我要做一个托盘程序。可是每次我做完(在保存之前)一切都正常:可以将窗口最小化到托盘区,也可以点击托盘图标重新显示窗口。可是在我保存之后(其它任何操作都不做),再运行就不行了--点击托盘图标却不能恢复窗口。为什么?程序代码如下:
Option Explicit
Const MAX_TOOLTIP As Integer = 64
Const NIF_ICON = &H2 '删除图标
Const NIF_MESSAGE = &H1
Const NIF_TIP = &H4
Const NIM_ADD = &H0 '添加图标到任务栏提示区
Const NIM_DELETE = &H2
Const WM_MOUSEMOVE = &H200
Const WM_LBUTTONDOWN = &H201
Const WM_LBUTTONUP = &H202
Const WM_LBUTTONDBLCLK = &H203
Const WM_RBUTTONDOWN = &H204
Const WM_RBUTTONUP = &H205
Const WM_RBUTTONDBLCLK = &H206
Const SW_RESTORE = 9
Const SW_HIDE = 0
Const EM_UNDO = &HC7
Private Type NOTIFYICONDATA
cbSize As Long
hwnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP
End Type
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow 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 Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
Private nfIconData As NOTIFYICONDATA
Private Sub MDIForm_Load()
Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
mnuEditTimeTable_Click
AddIcon
End Sub
Private Sub AddIcon()
nfIconData.hwnd = Me.hwnd
nfIconData.uID = Me.Icon
nfIconData.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
nfIconData.uCallbackMessage = WM_MOUSEMOVE
nfIconData.hIcon = Me.Icon.Handle
nfIconData.szTip = "时间表" & vbNullChar
nfIconData.cbSize = Len(nfIconData)
Call Shell_NotifyIcon(NIM_ADD, nfIconData)
End Sub
Private Sub LoadNewDoc()
Static lDocumentCount As Long
Dim frmD As frmDocument
lDocumentCount = lDocumentCount + 1
Set frmD = New frmDocument
frmD.Caption = "Document " & lDocumentCount
frmD.Show
End Sub
Private Sub MDIForm_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lMsg As Single
lMsg = X / Screen.TwipsPerPixelX
If lMsg = WM_RBUTTONUP Or lMsg = WM_LBUTTONUP Then Me.Visible = True
End Sub
Private Sub MDIForm_Unload(Cancel As Integer)
If Me.WindowState <> vbMinimized Then
SaveSetting App.Title, "Settings", "MainLeft", Me.Left
SaveSetting App.Title, "Settings", "MainTop", Me.Top
SaveSetting App.Title, "Settings", "MainWidth", Me.Width
SaveSetting App.Title, "Settings", "MainHeight", Me.Height
End If
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub
Private Sub mnuEditTimeTable_Click()
Dim f As New frmTimeTable
f.Show
End Sub
Private Sub mnuHideWindow_Click()
ShowWindow Me.hwnd, SW_HIDE
End Sub
Private Sub mnuShowWindow_Click()
Me.Visible = True
End Sub
Private Sub tbToolBar_ButtonClick(ByVal Button As MSComCtlLib.Button)
On Error Resume Next
Select Case Button.Key
Case "新建"
LoadNewDoc
Case "打开"
mnuFileOpen_Click
Case "保存"
mnuFileSave_Click
End Select
End Sub
Private Sub mnuHelpAbout_Click()
frmAbout.Show vbModal, Me
End Sub
Private Sub mnuHelpContents_Click()
Dim nRet As Integer
'如果这个工程没有帮助文件,显示消息给用户
'可以在“工程属性”对话框中为应用程序设置帮助文件
If Len(App.HelpFile) = 0 Then
MsgBox "无法显示帮助目录,该工程没有相关联的帮助。", vbInformation, Me.Caption
Else
On Error Resume Next
nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0)
If Err Then
MsgBox Err.Description
End If
End If
End Sub
Private Sub mnuWindowNewWindow_Click()
LoadNewDoc
End Sub
Private Sub mnuToolsOptions_Click()
frmOptions.Show vbModal, Me
End Sub
Private Sub mnuFileExit_Click()
'卸载窗体
Unload Me
End Sub
Private Sub mnuFileSaveAll_Click()
'应做:添加 'mnuFileSaveAll_Click' 代码。
MsgBox "添加 'mnuFileSaveAll_Click' 代码。"
End Sub
Private Sub mnuFileSaveAs_Click()
Dim sFile As String
If ActiveForm Is Nothing Then Exit Sub
With dlgCommonDialog
.DialogTitle = "另存为"
.CancelError = False
'ToDo: 设置 common dialog 控件的标志和属性
.Filter = "所有文件 (*.*)|*.*"
.ShowSave
If Len(.FileName) = 0 Then
Exit Sub
End If
sFile = .FileName
End With
ActiveForm.Caption = sFile
ActiveForm.rtfText.SaveFile sFile
End Sub
Private Sub mnuFileSave_Click()
Dim sFile As String
If Left$(ActiveForm.Caption, 8) = "Document" Then
With dlgCommonDialog
.DialogTitle = "保存"
.CancelError = False
'ToDo: 设置 common dialog 控件的标志和属性
.Filter = "所有文件 (*.*)|*.*"
.ShowSave
If Len(.FileName) = 0 Then
Exit Sub
End If
sFile = .FileName
End With
ActiveForm.rtfText.SaveFile sFile
Else
sFile = ActiveForm.Caption
ActiveForm.rtfText.SaveFile sFile
End If
End Sub
Private Sub mnuFileClose_Click()
'应做:添加 'mnuFileClose_Click' 代码。
MsgBox "添加 'mnuFileClose_Click' 代码。"
End Sub
Private Sub mnuFileOpen_Click()
Dim sFile As String
If ActiveForm Is Nothing Then LoadNewDoc
With dlgCommonDialog
.DialogTitle = "打开"
.CancelError = False
'ToDo: 设置 common dialog 控件的标志和属性
.Filter = "所有文件 (*.*)|*.*"
.ShowOpen
If Len(.FileName) = 0 Then
Exit Sub
End If
sFile = .FileName
End With
ActiveForm.rtfText.LoadFile sFile
ActiveForm.Caption = sFile
End Sub
Private Sub mnuFileNew_Click()
LoadNewDoc
End Sub