Under the File menu on nearly every application (that opens files) is a list of
the four most recently-used files (usually right above the Exit option). Modify
your information tracker to implement such a feature. This is not trivial -- there
are lots of things to consider.
For example, you’ll need a file to store the last four file names. You
need to open that file and initialize the corresponding menu entries when you
run the application -- you need to rewrite that file when you exit the application.
You need logic to re-order file names when a new file is opened or saved. You
need logic to establish new menu items as new files are used. You’ll need
additional error-trapping in the open procedure, in case a file selected from
the menu no longer exists. Like I said, a lot to consider here.
My Solution:
These new menu items immediately precede the existing Exit menu item:
Menu mnuFileRecent:
Caption = [Blank]
Index = 0, 1, 2, 3 (a control array)
Visible = False
Menu mnuFileBar:
Caption = -
Visible = False
Code Modifications (new code is bold and italicized):
General Declarations:
Option Explicit
Dim Dates(1000) As Date
Dim Weights(1000) As String
Dim NumWts As Integer
Dim NFiles As Integer, RFile(3) As String, MenuOpen As Integer, FNmenu As String
Rfile Update General Procedure:
Sub RFile_Update(NewFile As String)
‘Routine to place newest file name in proper order
‘in menu structure
Dim I As Integer, J As Integer, InList As Integer
'Convert name to all upper case letters
NewFile = UCase(NewFile)
'See if file is already in list
InList = 0
For I = 0 To NFiles - 1
If RFile(I) = NewFile Then InList = 1: Exit For
Next I
'If file not in list, increment number of items with
'a maximum of 4. Then, move others down, then place
'new name at top of list
If InList = 0 Then
NFiles = NFiles + 1
If NFiles > 4 Then
NFiles = 4
Else
If NFiles = 1 Then mnuFileBar.Visible = True
mnuFileRecent(NFiles - 1).Visible = True
End If
If NFiles <> 1 Then
For I = NFiles - 1 To 1 Step -1
RFile(I) = RFile(I - 1)
Next I
End If
RFile(0) = NewFile
Else
'If file already in list, put name at top and shift
'others accordingly
If I <> 0 Then
For J = I - 1 To 0 Step -1
RFile(J + 1) = RFile(J)
Next J
RFile(0) = NewFile
End If
End If
'Set menu captions according to new list
For I = 0 To NFiles - 1
mnuFileRecent(I).Caption = "&" + Format(I + 1, "# ") +
RFile(I)
Next I
End Sub
Form Load Event:
Private Sub Form_Load()
Dim I As Integer
'Open .ini file and load in recent file names
Open "weight.ini" For Input As #1
NFiles = 0: MenuOpen = 0
For I = 0 To 3
Input #1, RFile(I)
If RFile(I) <> "" Then
NFiles = NFiles + 1
mnuFileBar.Visible = True
mnuFileRecent(I).Caption = "&" + Format(I + 1, "# ") +
RFile(I)
mnuFileRecent(I).Visible = True
End If
Next I
Close 1
frmWeight.Show
Call Init
End Sub
mnuFileExit Click Event:
Private Sub mnuFileExit_Click()
'Make sure user really wants to exit
Dim Response As Integer, I As Integer
Response = MsgBox("Are you sure you want to exit the weight program?",
vbYesNo + vbCritical + vbDefaultButton2, "Exit Editor")
If Response = vbNo Then
Exit Sub
Else
'Write out .ini file when done
Open "weight.ini" For Output As #1
For I = 0 To 3
Write #1, RFile(I)
Next I
Close 1
End
End If
End Sub
mnuFileOpen Click Event:
Private Sub mnuFileOpen_Click()
Dim I As Integer
Dim Today As Date
Dim Response As Integer
Dim File_To_Open As String
Response = MsgBox("Are you sure you want to open a new file?", vbYesNo
+ vbQuestion, "New File")
If Response = vbNo Then Exit Sub
If MenuOpen = 0 Then
cdlFiles.Filter = "Files (*.wgt)|*.wgt"
cdlFiles.DefaultExt = "wgt"
cdlFiles.DialogTitle = "Open File"
cdlFiles.Flags = cdlOFNFileMustExist + cdlOFNPathMustExist
On Error GoTo No_Open
cdlFiles.ShowOpen
File_To_Open = cdlFiles.filename
Else
File_To_Open = FNmenu
End If
MenuOpen = 0
On Error GoTo BadOpen
Open File_To_Open For Input As #1
lblFile.Caption = File_To_Open
Input #1, NumWts
For I = 1 To NumWts
Input #1, Dates(I), Weights(I)
Next I
Close 1
Call RFile_Update(File_To_Open)
Today = Format(Now, "mm/dd/yy")
If Today <> Dates(NumWts) Then
NumWts = NumWts + 1
Dates(NumWts) = Today
Weights(NumWts) = ""
End If
vsbControl.Max = NumWts
vsbControl.Value = NumWts
lblDate.Caption = Dates(NumWts)
txtWeight.Text = Weights(NumWts)
Exit Sub
No_Open:
Resume ExitLine
ExitLine:
Exit Sub
BadOpen:
Select Case MsgBox(Error(Err.Number), vbCritical + vbRetryCancel,
"File Open Error")
Case vbRetry
Resume
Case vbCancel
Resume No_Open
End Select
End Sub
mnuFileRecent Click Event:
Private Sub mnuFileRecent_Click(Index As Integer)
FNmenu = RFile(Index): MenuOpen = 1
Call mnuFileOpen_Click
End Sub
mnuFileSave Click Event:
Private Sub mnuFileSave_Click()
Dim I As Integer
cdlFiles.Filter = "Files (*.wgt)|*.wgt"
cdlFiles.DefaultExt = "wgt"
cdlFiles.DialogTitle = "Save File"
cdlFiles.Flags = cdlOFNOverwritePrompt + cdlOFNPathMustExist
On Error GoTo No_Save
cdlFiles.ShowSave
Open cdlFiles.filename For Output As #1
lblFile.Caption = cdlFiles.filename
Write #1, NumWts
For I = 1 To NumWts
Write #1, Dates(I), Weights(I)
Next I
Close 1
Call RFile_Update(cdlFiles.filename)
Exit Sub
No_Save:
Resume ExitLine
ExitLine:
Exit Sub
End Sub
