form1.frm

很好的教程原代码！

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3840
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   6960
   LinkTopic       =   "Form1"
   ScaleHeight     =   3840
   ScaleWidth      =   6960
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "清除历史记录"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   2520
      TabIndex        =   1
      Top             =   1680
      Width           =   2295
   End
   Begin VB.CommandButton Command1 
      Caption         =   "退 出"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   3000
      TabIndex        =   0
      Top             =   2760
      Width           =   1215
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   5400
      Top             =   2400
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Menu mFile 
      Caption         =   "文件"
      Begin VB.Menu mOpen 
         Caption         =   "打开"
      End
      Begin VB.Menu l1 
         Caption         =   "-"
      End
      Begin VB.Menu mLastFile 
         Caption         =   "无历史文件"
         Index           =   0
      End
      Begin VB.Menu mLastFile 
         Caption         =   "2"
         Index           =   1
         Visible         =   0   'False
      End
      Begin VB.Menu mLastFile 
         Caption         =   "3"
         Index           =   2
         Visible         =   0   'False
      End
      Begin VB.Menu mLastFile 
         Caption         =   "4"
         Index           =   3
         Visible         =   0   'False
      End
      Begin VB.Menu l2 
         Caption         =   "-"
      End
      Begin VB.Menu mExit 
         Caption         =   "退出"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim A_Name As String
Dim S_Name As String
Const MaxRFiles = 4
Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Command2_Click()
    ClearRecentFiles
End Sub

Private Sub Form_Load()
    A_Name = "Demo"
    S_Name = "RFile"
    ReadRecentFiles
End Sub

Private Sub mExit_Click()
    Unload Me
End Sub

Private Sub mLastFile_Click(Index As Integer)
    UpdateRecentFiles Index
End Sub

Private Sub mOpen_Click()
    Dim fIndex As Integer
    '
    '如果用户选择取消将引发错误
    CommonDialog1.CancelError = True
    CommonDialog1.DialogTitle = "打开文件"
    CommonDialog1.FileName = ""
    CommonDialog1.Filter = "Executables(*.*)|*.*"
    CommonDialog1.FilterIndex = 1
    CommonDialog1.Flags = cdlOFNCreatePrompt + cdlOFNHideReadOnly
    '显示打开文件通用对话框
    CommonDialog1.ShowOpen
    If Err = cdlCancel Then ' 用户选择了Cancel
    '在这里添加当用户选择Cancel时给用户的提示
    Else
      fIndex = InRecentFiles(CommonDialog1.FileName)
      If fIndex > MaxRFiles Then
          WriteRecentFiles CommonDialog1.FileName
      Else
          UpdateRecentFiles fIndex
      End If
    End If
End Sub

Private Sub WriteRecentFiles(FileName As String)
    Dim fileptr As Integer
    If Len(Trim(FileName)) Then
        fileptr = Val(GetSetting(A_Name, S_Name, "FirstFile", "0"))
        fileptr = IIf(fileptr - 1 >= 0, fileptr - 1, MaxRFiles - 1)
        SaveSetting A_Name, S_Name, "FirstFile", fileptr & ""
        SaveSetting A_Name, S_Name, "File" & fileptr, FileName
        ReadRecentFiles
    End If
End Sub

Private Sub ReadRecentFiles()
    Dim i As Integer
    Dim fileptr As Integer
    Dim rFile As String
    Dim rCount As Integer
    '第一个文件的位置
    fileptr = Val(GetSetting(A_Name, S_Name, "FirstFile", "0"))
    rFile = GetSetting(A_Name, S_Name, "File" & fileptr, "")
    rCount = 0
    Do While Len(rFile) And rCount < MaxRFiles
        mLastFile(rCount).Caption = "&" & (rCount + 1) & " " & rFile
        mLastFile(rCount).Visible = True
        fileptr = IIf(fileptr + 1 < MaxRFiles, fileptr + 1, 0)
        rFile = GetSetting(A_Name, S_Name, "File" & fileptr, "")
        rCount = rCount + 1
    Loop
    If rCount = 0 Then
        mLastFile(rCount).Visible = True
        mLastFile(rCount).Caption = "无历史文件"
        rCount = 1
    End If
    For i = rCount To MaxRFiles - 1
        mLastFile(i).Visible = False
    Next
End Sub

Private Function InRecentFiles(strFile As String) As Integer
    Dim i As Integer
    Dim bFound As Boolean

    For i = 0 To MaxRFiles - 1
        If mLastFile(i).Visible And strFile = Mid$(mLastFile(i).Caption, 4) Then
            InRecentFiles = i
            Exit Function
        End If
    Next
    InRecentFiles = MaxRFiles + 1
End Function

Public Sub ClearRecentFiles()
    On Error Resume Next
    Dim i As Integer
    DeleteSetting A_Name, S_Name, "FirstFile"
    For i = 0 To MaxRFiles
        DeleteSetting A_Name, S_Name, "File" & i
    Next
    mLastFile(0).Visible = True
    mLastFile(0).Caption = "无历史文件"
    For i = 1 To MaxRFiles - 1
        mLastFile(i).Visible = False
    Next
End Sub

Public Sub UpdateRecentFiles(fIndex As Integer)
    Dim i As Integer
    Dim fileptr As Integer, FirstPtr As Integer
    Dim FilePtr1 As Integer
    Dim rFile As String, OldFile As String
    Dim rCount As Integer
    If fIndex = 0 Then Exit Sub
    '第一个文件的位置
    FirstPtr = Val(GetSetting(A_Name, S_Name, "FirstFile", "0"))
    If fIndex = MaxRFiles - 1 Then
        FirstPtr = IIf(FirstPtr - 1 >= 0, FirstPtr - 1, MaxRFiles - 1)
        SaveSetting A_Name, S_Name, "FirstFile", CStr(FirstPtr)
        ReadRecentFiles
        Exit Sub
    End If
    fileptr = fIndex + FirstPtr
    If fileptr >= MaxRFiles Then fileptr = fileptr - MaxRFiles
    OldFile = GetSetting(A_Name, S_Name, "File" & fileptr, "")
    FilePtr1 = IIf(fileptr - 1 >= 0, fileptr - 1, MaxRFiles - 1)
    rFile = GetSetting(A_Name, S_Name, "File" & FilePtr1, "")
    
    Do While FirstPtr <> fileptr And Len(rFile) > 0
        SaveSetting A_Name, S_Name, "File" & fileptr, rFile
        fileptr = FilePtr1
        FilePtr1 = IIf(fileptr - 1 >= 0, fileptr - 1, MaxRFiles - 1)
        rFile = GetSetting(A_Name, S_Name, "File" & FilePtr1, "")
    Loop
    '
    SaveSetting A_Name, S_Name, "File" & FirstPtr, OldFile
    ReadRecentFiles
End Sub