LeMS_Studios Ответов: 1

Создать полосу меню выпадающем коллекции из каталогов

Я пытаюсь создать меню, которое создает новые пункты меню для каждого каталога и файлов в определенном каталоге. Каждый пункт меню, который является файлами, откроет соответствующий файл. Это будет похоже на меню Пуск Windows.

Что я уже пробовал:

До сих пор у меня есть следующий код:
Dim lst As New List(Of String), intIndex As Integer 
For Each tmp In GetDirectories("C:\", "*", IO.SearchOption.AllDirectories)
 If GetDirectories(tmp, "*", IO.SearchOption.AllDirectories).Count = 0 Then lst.Add(tmp.Substring(("C:\").Length)) 'Gets a list of all the directories that aren't parent directories and removes the root directory 
Next
For Each itm In lst
 Dim tsi As ToolStripDropDownItem = MenuStrip1
 For Each folder In Split(itm, "\")
  intIndex = 0
  If tsi.DropDownItems.ContainsKey(folder) = False Then 'Checks if the menu already as a existing item for the directory from a previous run of loop
   tsi.DropDownItems.Add(folder) 'Adds menu item
   tsi.DropDownItems(intIndex).Name = folder 'Specify name of menu item
   If GetFiles(DrivePath & "WINDOWS\Start Menu\Programs\" & itm.Substring(0, itm.IndexOf(folder) + folder.Length)).Count > 0 Then 'If the directory has files in it then it will add them
    tsi = tsi.DropDownItems(intIndex) 'makes the menu item that was just created the menu item variable 
    For Each file In GetFiles(DrivePath & "WINDOWS\Start Menu\Programs\" & itm) 'Loops through
     Dim index As Integer = 0
     tsi.DropDownItems.Add(IO.Path.GetFileNameWithoutExtension(file)) 'Adds files to drop down of new menu item
     tsi.DropDownItems(index).Name = folder 'Specify name of menu item
     index += 1
    Next
   End If
   intIndex += 1
  End If
 Next
Next

Отступы изменены, чтобы лучше вписаться в веб-браузер.
Я еще не включил обработчик событий для каждого пункта меню, который является файлом, но я знаю, как это сделать, поэтому добавлю его позже.
Надеюсь, мой код можно понять.

Richard MacCutchan

Почему бы не использовать элемент управления TreeView?

LeMS_Studios

Насколько я могу судить, я не мог использовать для этого TreeView. Я использую это в игре, которую я делаю, где его 1998 год, и у вас есть windows 95, и вы находите программное обеспечение для путешествий во времени и путешествуете в разные периоды времени с разными операционными системами. У оригинального разработчика игры было предварительно встроено меню "Пуск" (в поддельной среде Windows 95), но я бы хотел, чтобы меню "Пуск" создавалось настоящими папками и ярлыками.

W.G.C.

Что же здесь не работает?

LeMS_Studios

В настоящее время некоторые каталоги добавляются несколько раз, и все подменю являются подменю первого пункта родительского меню. Вот ссылка на изображение сравнения:
https://postimg.cc/MMn5DPYy
Изображение слева-это то, как оно выглядит в настоящее время, а справа-то, как выглядела предыдущая версия игры.
Надеюсь, это поможет!

1 Ответов

Рейтинг:
6

W.G.C. 

Option Explicit On
Option Strict On
Option Infer Off
Public Class frmDirectoryMenuTest
	' This assumes that there is a form with a MenuStrip named 
	' MenuStrip1 with a ToolStripMenuItem named tsmiRootItem
	Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
		Dim RootPath As String
		RootPath = "C:\"
		BuildMenuFromPathData(RootPath, tsmiRootItem)
	End Sub
	''' <summary>
	''' Builds a menu item tree from files and directories in a specified root path
	''' </summary>
	''' <param name="RootPath">The top-level path that the tree should start from</param>
	''' <param name="MenuParent">The ToolStripItem that the menu tree will be added to.  The text will also be set to the name if the directory.</param>
	''' <returns>True if no error occured, false otherwise.</returns>
	Private Function BuildMenuFromPathData(RootPath As String, MenuParent As ToolStripItem) As Boolean
		Dim DirList As List(Of String), Dir As String
		Dim SubDir As String, File As String
		Dim CurrentDirectoryMenuItem As ToolStripItem

		Try
			If RootPath.EndsWith(IO.Path.DirectorySeparatorChar) Then MenuParent.Text = IO.Path.GetFileName(RootPath.Remove(RootPath.Length - 1, 1)) Else MenuParent.Text = IO.Path.GetFileName(RootPath)
			DirList = ListDirs(RootPath)
			For Each Dir In DirList
				CurrentDirectoryMenuItem = CreateToolStripDropDownItem(IO.Path.GetFileName(Dir), MenuParent)
				For Each SubDir In ListDirs(Dir)
					BuildMenuFromPathData(SubDir, CreateToolStripDropDownItem(SubDir, CurrentDirectoryMenuItem))
				Next
				CreateToolStripDropDownItems(ListFiles(Dir), CurrentDirectoryMenuItem)
			Next
			CreateToolStripDropDownItems(ListFiles(RootPath), MenuParent)
			Return True
		Catch ex As Exception
			Return False
		End Try
	End Function
	''' <summary>
	''' Adds a new ToolStripMenuItem to the specified parent item
	''' </summary>
	''' <param name="Text">The new item's label text.</param>
	''' <param name="ParentItem">The parent item that the new item will be added to</param>
	''' <returns>The new item as a ToolStripItem</returns>
	Private Function CreateToolStripDropDownItem(Text As String, ParentItem As ToolStripItem) As ToolStripItem
		If ParentItem Is Nothing Then Return Nothing Else Return DirectCast(DirectCast(ParentItem, ToolStripMenuItem).DropDownItems.Add(Text), ToolStripItem)
	End Function
	''' <summary>
	''' Adds new ToolStripMenuItems to the specified parent item
	''' </summary>
	''' <param name="ItemTexts">A list of label texts for the new items</param>
	''' <param name="ParentItem">The parent item that the new item will be added to</param>
	''' <returns>The parent item</returns>
	Private Function CreateToolStripDropDownItems(ItemTexts As List(Of String), ParentItem As ToolStripItem) As ToolStripItem
		If ItemTexts Is Nothing OrElse ParentItem Is Nothing Then Return ParentItem
		For Each ItemText As String In ItemTexts
			DirectCast(ParentItem, ToolStripMenuItem).DropDownItems.Add(ItemText)
		Next
		Return ParentItem
	End Function
	''' <summary>
	''' Returns a list of directories in a directory.
	''' </summary>
	''' <param name="Path">Path to enumerate</param>
	''' <returns>A list of directory paths</returns>
	Private Function ListDirs(Path As String) As List(Of String) 'Dictionary(Of String, String)
		Dim DirList As New List(Of String) 'Dictionary(Of String, String)
		Dim Index As Integer
		Dim Dir As IO.DirectoryInfo, Dirs As IO.DirectoryInfo()
		Try
			Dir = New IO.DirectoryInfo(Path)
			Dirs = Dir.GetDirectories("*.*", IO.SearchOption.TopDirectoryOnly)
			For Index = 0 To Dirs.Length - 1
				'DirList.Add(Dirs(Index).FullName, IO.Path.GetFileName(Dirs(Index).FullName))
				DirList.Add(Dirs(Index).FullName)
			Next
			Return DirList
		Catch ex As Exception
			Return Nothing
		End Try
	End Function
	''' <summary>
	''' Returns a list of files in a directory.
	''' </summary>
	''' <param name="Path">Path to enumerate</param>
	''' <returns>A list of file paths</returns>
	Private Function ListFiles(Path As String) As List(Of String)
		Dim FileList As New List(Of String)
		Dim File As IO.DirectoryInfo, Files As IO.FileInfo()
		Try
			File = New IO.DirectoryInfo(Path)
			Files = File.GetFiles("*.*", IO.SearchOption.TopDirectoryOnly)
			FileList.AddRange(Files.Select(Function(Info) Info.Name))
			Return FileList
		Catch ex As Exception
			Return Nothing
		End Try
	End Function
End Class