您所在位置：主题：文件菜单下增加书签项的代码
一江秋水
[专家分：9680] 发布于 2021-09-26 15:59:12
如果在你自编程序的“文件”菜单下，增加几个你曾经打开过的文件名（也就是书签），是不是显得更专业一些？而且也给使用者带来了方便，何乐而不为也。
新建一个工程，在窗体上添加一个文本框，再打开菜单编辑器。一级菜单的标题为“文件”，名称随意。二级菜单有7项，第一项标题为“打开”，名称为“open”。第二项标题为“-”（减号），名称为“p1”，这个菜单项用于分隔。第三至第七项的标题均为空（这些标题将会在程序运行当中添加上去作为书签），名称均为“once”，其索引从0－4（注：我只设置了5个项，你可以根据需要增减），且均为不可见。
代码如下：
Option Explicit
Dim openName As String '打开文件名
Dim items(4) As String '项目名
Dim BJdialog As Boolean '跳过对话框标记
Private Sub Form_Load()
loadItems
End Sub
Private Sub open_Click()
On Error GoTo 100
Dim st As String, z As String, Dlg As Object
If Not BJdialog Then
Set Dlg = CreateObject("MSComDlg.CommonDialog")
With Dlg
.DialogTitle = "打开"
.Flags = &H1000
.CancelError = True
.Filter = "txt文件|*.txt"
.showopen
openName = .FileName
End With
End If
Open openName For Input As #1
Do Until EOF(1)
Line Input #1, z
st = st & z & vbCrLf
Loop
Close #1
Text1.Text = st
adjust
100
End Sub
Private Sub loadItems()
On Error GoTo 100
Dim i As Integer, st As String
Open App.Path & "\bookmark.txt" For Input As #1
Do Until EOF(1) And i < 5
Line Input #1, st
If Len(st) > 5 Then
If Len(Dir(st)) Then
items(i) = st
once(i).Caption = Dir(st)
once(i).Visible = True
i = i + 1
End If
End If
Loop
100
Close
End Sub
Private Sub once_Click(Index As Integer)
openName = items(Index)
BJdialog = True
open_Click
BJdialog = False
End Sub
Private Sub adjust()
Dim i As Integer, st As String
For i = 0 To 4
If items(i) = openName Then Exit Sub '如果有同名书签退出
Next
st = Dir(openName)
For i = 0 To 4
If Len(items(i)) < 4 Then '如果有空书签
items(i) = openName
once(i).Caption = st
once(i).Visible = True '设为可见
Exit For
End If
Next
If i < 5 Then Exit Sub
For i = 0 To 3 '如果没有空书签，顺序上移
items(i) = items(i + 1): once(i).Caption = once(i + 1).Caption
Next
items(4) = openName: once(4).Caption = st
End Sub
Private Sub readItems()
On Error GoTo 100
Dim st As String
st = Join(items, vbCrLf)
Open App.Path & "\bookmark.txt" For Output As #2
Print #2, st
100
Close
End Sub
Private Sub Form_Unload(Cancel As Integer)
readItems
End Sub
下面简单分析一下adjust()过程。
首先检查是否有同名书签（包括路径），如有则退出。
再检查是否有空书签（因为要是文件被从磁盘上删除了，反映在这里就成了空书签），如果有，那么新添加的书签就替代了空书签。
如果没有空书签而且项目已满，那么去掉第1个书签，其它4项顺序上移，新添加的书签作为第5个书签。
本代码在win7旗舰版上通过，未在其它版本测试。
新建一个工程，在窗体上添加一个文本框，再打开菜单编辑器。一级菜单的标题为“文件”，名称随意。二级菜单有7项，第一项标题为“打开”，名称为“open”。第二项标题为“-”（减号），名称为“p1”，这个菜单项用于分隔。第三至第七项的标题均为空（这些标题将会在程序运行当中添加上去作为书签），名称均为“once”，其索引从0－4（注：我只设置了5个项，你可以根据需要增减），且均为不可见。
代码如下：
Option Explicit
Dim openName As String '打开文件名
Dim items(4) As String '项目名
Dim BJdialog As Boolean '跳过对话框标记
Private Sub Form_Load()
loadItems
End Sub
Private Sub open_Click()
On Error GoTo 100
Dim st As String, z As String, Dlg As Object
If Not BJdialog Then
Set Dlg = CreateObject("MSComDlg.CommonDialog")
With Dlg
.DialogTitle = "打开"
.Flags = &H1000
.CancelError = True
.Filter = "txt文件|*.txt"
.showopen
openName = .FileName
End With
End If
Open openName For Input As #1
Do Until EOF(1)
Line Input #1, z
st = st & z & vbCrLf
Loop
Close #1
Text1.Text = st
adjust
100
End Sub
Private Sub loadItems()
On Error GoTo 100
Dim i As Integer, st As String
Open App.Path & "\bookmark.txt" For Input As #1
Do Until EOF(1) And i < 5
Line Input #1, st
If Len(st) > 5 Then
If Len(Dir(st)) Then
items(i) = st
once(i).Caption = Dir(st)
once(i).Visible = True
i = i + 1
End If
End If
Loop
100
Close
End Sub
Private Sub once_Click(Index As Integer)
openName = items(Index)
BJdialog = True
open_Click
BJdialog = False
End Sub
Private Sub adjust()
Dim i As Integer, st As String
For i = 0 To 4
If items(i) = openName Then Exit Sub '如果有同名书签退出
Next
st = Dir(openName)
For i = 0 To 4
If Len(items(i)) < 4 Then '如果有空书签
items(i) = openName
once(i).Caption = st
once(i).Visible = True '设为可见
Exit For
End If
Next
If i < 5 Then Exit Sub
For i = 0 To 3 '如果没有空书签，顺序上移
items(i) = items(i + 1): once(i).Caption = once(i + 1).Caption
Next
items(4) = openName: once(4).Caption = st
End Sub
Private Sub readItems()
On Error GoTo 100
Dim st As String
st = Join(items, vbCrLf)
Open App.Path & "\bookmark.txt" For Output As #2
Print #2, st
100
Close
End Sub
Private Sub Form_Unload(Cancel As Integer)
readItems
End Sub
下面简单分析一下adjust()过程。
首先检查是否有同名书签（包括路径），如有则退出。
再检查是否有空书签（因为要是文件被从磁盘上删除了，反映在这里就成了空书签），如果有，那么新添加的书签就替代了空书签。
如果没有空书签而且项目已满，那么去掉第1个书签，其它4项顺序上移，新添加的书签作为第5个书签。
本代码在win7旗舰版上通过，未在其它版本测试。