比较难的问题，各位老大请帮我---在线等待

Question

Option Explicit
Dim A_Name As String
Dim S_Name As String
Const MaxRFiles = 4
Private Sub Command1_Click()
  Unload Me
End SubPrivate Sub Command2_Click()
  ClearRecentFiles
End Sub
Private Sub Form_Load()
  A_Name = "Demo"
  S_Name = "RFile"
  ReadRecentFiles
End SubPrivate Sub mExit_Click()
 Unload Me
End SubPrivate Sub mLastFile_Click(Index As Integer)
  UpdateRecentFiles Index
End SubPrivate Sub mOpen_Click()
    Dim fIndex As Integer
    On Error Resume Next
    
    ' Causes a trappable error to occur when the user hits the 'Cancel' button
    'open file with commondialog1
    CommonDialog1.CancelError = True
    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 SubPrivate 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 SubPrivate 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 FunctionPublic 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 SubPublic 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

Answer 1

再给你一段代码：
Private Sub cmdFill_Click()
fillMenu ' Add all items in file list
End Sub
Sub fillMenu()          ' This sub adds all items in the filelist to the menu and removes the file extension
Dim tempName As String  ' Temporarely stores each listitem in the loop below
emptyMenu               ' Make sure the menu is empty when we startFor i = 1 To File1.ListCount ' Loop from menuItem #1 to the number of items in file listLoad mnuFilesInDir(i)        ' Load a new menuitemtempName = File1.List(i - 1) ' Set tempname equal to the current file name in the list   mnuFilesInDir(i).Caption = Left(tempName, Len(tempName) - 4)  ' Set the caption of this menu item equal to
                                                                 ' the tempName, but remove the .*** extension
                                                                 ' by starting from the Left in tempName,
                                                                 ' counting the length (Len) of the string and
                                                                 ' then remove the 4 last characters (-4).Next i                       ' Resume to next item
mnuFilesInDir(0).Visible = False ' Set the divider in menu to invisible.
                                 ' This menuitem was created at design time
                                 ' and can not be loaded/unloaded during run
                                 ' time. It is however needed to initialize
                                 ' the array of menu items, and that's why
                                 ' I added it at design time.
End Sub它将列表框中的内容加到菜单中

Answer 2

to xxlroad(土八路) :老大，你的程序有注释的吗？呵呵，如果有再发一次，呵呵
to  ityaa() ：能不能详细点呢。
to easypower(阿里巴巴) :我要像IE的收藏夹一样，立即就能看得到的。

Answer 3

同时菜单要能出发click事件，我怎么实现呢，各位老大

Answer 4

不可能发出click事件
因为菜单数组只能是单层的
要想建立多层的菜单
必须用API函数创建（最好买本书看看，这样的代码很长）
但由于VB只会解释菜单编辑器中的菜单ID
所以无法触发click事件
只有自己响应WM_COMMAND消息其实收藏夹菜单并不是菜单
它是用窗体模拟的
每层“菜单”弹出时
都查找收藏夹一次
并画出“菜单项”