下载频道> 资源分类> 编程语言> VB源码> 在菜单中显示最近打开的文件记录VB源码程序

标题：在菜单中显示最近打开的文件记录VB源码程序
分享到：

所属分类: VB源码 资源类型： 文件大小: 3.36 KB 上传时间: 2016-01-20 23:33:02 下载次数: 11 资源积分：1分 提 供 者: vb源码代做 20160120113246504
内容：
在菜单中显示最近打开的文件记录VB源码程序，程序员在编程的过程中可以参考学习使用，希望对IT程序员有用，此源码程序简单易懂、方便阅读，有很好的学习价值！
部分代码如下：
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   1425
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   3990
   LinkTopic       =   "Form1"
   ScaleHeight     =   1425
   ScaleWidth      =   3990
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "清除历史记录"
      Height          =   495
      Left            =   120
      TabIndex        =   1
      Top             =   600
      Width           =   1815
   End
   Begin VB.CommandButton Command1 
      Caption         =   "退 出"
      Height          =   495
      Left            =   2280
      TabIndex        =   0
      Top             =   600
      Width           =   1215
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   1200
      Top             =   0
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   327681
   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 Command3_Click()
Text1 = GetSetting(A_Name, S_Name, "File0", "")
Text2 = GetSetting(A_Name, S_Name, "File1", "")
Text3 = GetSetting(A_Name, S_Name, "File2", "")
Text4 = GetSetting(A_Name, S_Name, "File3", "")
Text5 = GetSetting(A_Name, S_Name, "FirstFile", "")
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
 
On Error Resume Next
 
CommonDialog1.CancelError = True ' Causes a trappable error to occur when the user hits the 'Cancel' button
CommonDialog1.DialogTitle = "打开文件"
CommonDialog1.FileName = ""
CommonDialog1.Filter = "Executables(*.*)|*.*"
CommonDialog1.FilterIndex = 1
CommonDialog1.Flags = cdlOFNCreatePrompt + cdlOFNHideReadOnly
 
CommonDialog1.ShowOpen
If Err = cdlCancel Then ' 'Cancel' button was hit
' Add your own code here when the user hits the 'Cancel' button
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
 
    'Look for the file specified in strFile
    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"))
    'FirstPtr = IIf(FirstPtr - 1 >= 0, FirstPtr - 1, MaxRFiles - 1)
    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)
    'FilePtr1 = IIf(fileptr + 1 < MaxRFiles, fileptr + 1, 0)
    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)
      'FilePtr1 = IIf(fileptr + 1 < MaxRFiles, fileptr + 1, 0)
      rFile = GetSetting(A_Name, S_Name, "File" & FilePtr1, "")
    Loop
    
    SaveSetting A_Name, S_Name, "File" & FirstPtr, OldFile
    'SaveSetting A_Name, S_Name, "FirstFile", CStr(fileptr)
    ReadRecentFiles
'    WriteRecentFiles OldFile
 
End Sub
 

文件列表（点击上边下载按钮，如果是垃圾文件请在下面评价差评或者投诉）:

在菜单中显示最近打开的文件记录VB源码程序/
在菜单中显示最近打开的文件记录VB源码程序/Form1.frm
在菜单中显示最近打开的文件记录VB源码程序/MSSCCPRJ.SCC
在菜单中显示最近打开的文件记录VB源码程序/工程1.vbp
在菜单中显示最近打开的文件记录VB源码程序/工程1.vbw

关键词： 源码 菜单 文件

相关推荐

编程语言下载排行

Top_arrow
回到顶部

友情链接

matlab源码 网站源码 编程语言 网络编程 手机通讯编程 KUNAG 官网 KUNAG 电商 更多
联系方式| 版权声明| 招聘信息| 广告服务| 银行汇款| 法律顾问| 兼职技术| 付款方式| 关于我们|
网站客服网站客服 程序员兼职招聘 程序员兼职招聘
沪ICP备19040327号-3
公安备案号：沪公网安备 31011802003874号
库纳格流体控制系统（上海）有限公司 版权所有
Copyright © 1999-2014, GUSUCODE.COM, All Rights Reserved