“日积月累”窗口的制作
许多应用程序进入操作窗口以后将显示一个“日积月累(Tips of day)”。 界面如下图所示。
![](http://www.chneic.sh.cn/education/Five/jiaoshi1/wo/vb/wj3.gif)
这种“日积月累”窗口能给用户一些操作提示,帮助用户迅速掌握软件使用,由于不同的软件其功能不同,操作方法也不同,因而它的“日积月累”也不同,这种“日积月累”都存于一个文本文件中,文本的内容是每一项表示一条“积累”。
打开工程中添加窗体的对话框后选择。下图是添加“日积月累”窗口的页面(还有其他窗体可用同样的操作方法),可以用MDI多文档界面处理,将“日积月累”作为子窗体,在主窗体MDIForm1的_Load()事件中加载frmTip.Show,并且在工程属性中将启动对象设置为MDIForm1。
![](http://www.chneic.sh.cn/education/Five/jiaoshi1/wo/vb/wj4.gif)
代码如下:(代码系统生成,贴在这里帮助我们学习文件操作的方法)
Option Explicit
'内存中的提示数据库。
Dim Tips As New Collection
'提示文件名称
Const TIP_FILE = "yu.TXT"
'当前正在显示的提示集合的索引。
Dim CurrentTip As Long
Private Sub DoNextTip()
'随机选择一条提示。
CurrentTip = Int((Tips.Count * Rnd) + 1)
'或者,您可以按顺序遍历提示
'CurrentTip = CurrentTip + 1
'If Tips.Count < CurrentTip Then
'CurrentTip = 1
'End If
'显示它。
frmTip.DisplayCurrentTip
End Sub
Function LoadTips(sFile As String) As Boolean
Dim NextTip As String '从文件中读出的每条提示。
Dim InFile As Integer '文件的描述符。
'包含下一个自由文件描述符。
InFile = FreeFile
确定为指定文件。
If sFile = "" Then
LoadTips = False
Exit Function
End If
'在打开前确保文件存在。
If Dir(sFile) = "" Then
LoadTips = False
Exit Function
End If
'从文本文件中读取集合。
Open sFile For Input As InFile
While Not EOF(InFile)
Line Input #InFile, NextTip
Tips.Add NextTip
Wend
Close InFile
'随机显示一条提示。
DoNextTip
LoadTips = True
End Function
Private Sub chkLoadTipsAtStartup_Click()
'保存在下次启动时是否显示此窗体
SaveSetting App.EXEName, "Options", "在启动时显示提示", chkLoadTipsAtStartup.Value
End Sub
Private Sub cmdNextTip_Click()
DoNextTip
End Sub
Private Sub cmdOK_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim ShowAtStartup As Long
'察看在启动时是否将被显示
ShowAtStartup = GetSetting(App.EXEName, "Options", "在启动时显示提示", 1)
If ShowAtStartup = 0 Then
Unload Me
Exit Sub
End If
'设置复选框,强行将值写回到注册表
Me.chkLoadTipsAtStartup.Value = vbChecked
'随机寻找
Randomize
'读取提示文件并且随机显示一条提示。
If LoadTips(App.Path & "/" & TIP_FILE) = False Then
lblTipText.Caption = "文件 " & TIP_FILE & " 没有被找到吗? " & vbCrLf & vbCrLf & _
"创建文本文件名为 " & TIP_FILE & " 使用记事本每行写一条提示。 " & _
"然后将它存放在应用程序所在的目录 "
End If
End Sub
Public Sub DisplayCurrentTip()
If Tips.Count > 0 Then
lblTipText.Caption = Tips.Item(CurrentTip)
End If
End Sub
'内存中的提示数据库。
Dim Tips As New Collection
'提示文件名称
Const TIP_FILE = "yu.TXT"
'当前正在显示的提示集合的索引。
Dim CurrentTip As Long
Private Sub DoNextTip()
'随机选择一条提示。
CurrentTip = Int((Tips.Count * Rnd) + 1)
'或者,您可以按顺序遍历提示
'CurrentTip = CurrentTip + 1
'If Tips.Count < CurrentTip Then
'CurrentTip = 1
'End If
'显示它。
frmTip.DisplayCurrentTip
End Sub
Function LoadTips(sFile As String) As Boolean
Dim NextTip As String '从文件中读出的每条提示。
Dim InFile As Integer '文件的描述符。
'包含下一个自由文件描述符。
InFile = FreeFile
确定为指定文件。
If sFile = "" Then
LoadTips = False
Exit Function
End If
'在打开前确保文件存在。
If Dir(sFile) = "" Then
LoadTips = False
Exit Function
End If
'从文本文件中读取集合。
Open sFile For Input As InFile
While Not EOF(InFile)
Line Input #InFile, NextTip
Tips.Add NextTip
Wend
Close InFile
'随机显示一条提示。
DoNextTip
LoadTips = True
End Function
Private Sub chkLoadTipsAtStartup_Click()
'保存在下次启动时是否显示此窗体
SaveSetting App.EXEName, "Options", "在启动时显示提示", chkLoadTipsAtStartup.Value
End Sub
Private Sub cmdNextTip_Click()
DoNextTip
End Sub
Private Sub cmdOK_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim ShowAtStartup As Long
'察看在启动时是否将被显示
ShowAtStartup = GetSetting(App.EXEName, "Options", "在启动时显示提示", 1)
If ShowAtStartup = 0 Then
Unload Me
Exit Sub
End If
'设置复选框,强行将值写回到注册表
Me.chkLoadTipsAtStartup.Value = vbChecked
'随机寻找
Randomize
'读取提示文件并且随机显示一条提示。
If LoadTips(App.Path & "/" & TIP_FILE) = False Then
lblTipText.Caption = "文件 " & TIP_FILE & " 没有被找到吗? " & vbCrLf & vbCrLf & _
"创建文本文件名为 " & TIP_FILE & " 使用记事本每行写一条提示。 " & _
"然后将它存放在应用程序所在的目录 "
End If
End Sub
Public Sub DisplayCurrentTip()
If Tips.Count > 0 Then
lblTipText.Caption = Tips.Item(CurrentTip)
End If
End Sub