Start Menu

How would i create the start menu in a program? i want to be able to click on an Icon, and have the entire "Programs" section of the start menu pop up.

Thanks Much.

edit: If it helps any, the registry entry for the location of the Start Menu is:
"HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"

Thanks again...


[Edited by Zaei on 09-14-2000 at 10:04 PM]

[da_silvy]

this example gets all the base directories of the start menu
on the form add a menu
have the main menu with a name of mnuPrograms
and a child to the menu named mnuFolders

code for a command button

Private Sub Command1_Click()
Dim Start As String
Start = GetStartMenu & "\Programs"
GetAllFolders Start
For i = 1 To Found - 1
If i = 1 Then GoTo stuff:
Load mnuFolders(i - 1)
stuff:
mnuFolders(i - 1).Visible = True
mnuFolders(i - 1).Caption = fArray(i)
Next i
mnuPrograms.Visible = True
End Sub

in a module

Option Explicit
Public filesArray
Public filesFound
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Public Const REG_SZ = 1 'Unicode nul terminated string
Public Const REG_BINARY = 3 'Free form binary
Public Const REG_DWORD = 4 '32-bit number
Public Const ERROR_SUCCESS = 0&

Public Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long

Public Declare Function RegDeleteValue Lib "advapi32.dll" _
Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal _
lpValueName As String) As Long

Public Declare Function RegOpenKey Lib "advapi32.dll" _
Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey _
As String, phkResult As Long) As Long

Public Declare Function RegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName _
As String, ByVal lpReserved As Long, lpType As Long, lpData _
As Any, lpcbData As Long) As Long

Public Declare Function RegSetValueEx Lib "advapi32.dll" _
Alias "RegSetValueExA" (ByVal hKey As Long, ByVal _
lpValueName As String, ByVal Reserved As Long, ByVal _
dwType As Long, lpData As Any, ByVal cbData As Long) As Long
  
  Public Const MAX_PATH = 260
    

  Public Const DRIVE_REMOVABLE = 2
  Public Const DRIVE_FIXED = 3
  Public Const DRIVE_REMOTE = 4
  Public Const DRIVE_CDROM = 5
  Public Const DRIVE_RAMDISK = 6
  
  Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
  End Type
  
  Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
  End Type

Public Declare Function GetLogicalDriveStrings _
   Lib "kernel32" Alias "GetLogicalDriveStringsA" _
   (ByVal nBufferLength As Long, _
    ByVal lpBuffer As String) As Long

Public Declare Function FindFirstFile _
   Lib "kernel32" Alias "FindFirstFileA" _
   (ByVal lpFileName As String, _
    lpFindFileData As WIN32_FIND_DATA) As Long

Public Declare Function FindNextFile _
   Lib "kernel32" Alias "FindNextFileA" _
   (ByVal hFindFile As Long, _
    lpFindFileData As WIN32_FIND_DATA) As Long

Public Declare Function FindClose _
  Lib "kernel32" (ByVal hFindFile As Long) As Long
 
'flags for the user options
Public displayExpanded As Boolean
Public displaySorted As Boolean
Public NoOfDrives As Integer
Public fArray
Public Found As Integer


Public Function TrimNull(startstr As String) As String

  Dim pos As Integer

  pos = InStr(startstr, Chr$(0))
  
  If pos Then
      TrimNull = Left$(startstr, pos - 1)
      Exit Function
  End If
  
 'if this far, there was no Chr$(0), so return the string
  TrimNull = startstr
  
End Function
Public Sub GetAllFolders(baseDir As String)
   On Error Resume Next
  Dim WFD As WIN32_FIND_DATA
  Dim hFile As Long
  
  Dim sFile As String
  Dim sPath As String
   
  Dim i As Integer
  Dim r As Long
  
    

  hFile = FindFirstFile(baseDir & "\*.*" & Chr$(0), WFD)
   
 
  Found = 0
  ReDim fArray(200)
  
  If hFile <> -1 Then
    sFile = TrimNull(WFD.cFileName)
    
    WFD.dwFileAttributes = vbDirectory
    
    While FindNextFile(hFile, WFD)
    
      sFile = TrimNull(WFD.cFileName)
        
        
     'ignore the 2 standard root entries
      If (sFile <> ".") And (sFile <> "..") Then
      
          
          If (WFD.dwFileAttributes And vbDirectory) Then
            
            Found = Found + 1
            'if found is at 200, then add some more array elements
            If Found Mod 200 = 0 Then ReDim Preserve fArray(Found + 200)
            
            fArray(Found) = sFile
           
          End If
      
      End If

  
    Wend
    End If
    
 'trim down the array to equal the elements found
  ReDim Preserve fArray(Found)
   
 'add the folders to the treeview

End Sub

Public Function GetSettingString(hKey As Long, _
strPath As String, strValue As String, Optional _
Default As String) As String
Dim hCurKey As Long
Dim lResult As Long
Dim lValueType As Long
Dim strBuffer As String
Dim lDataBufferSize As Long
Dim intZeroPos As Integer
Dim lRegResult As Long

'Set up default value
If Not IsEmpty(Default) Then
GetSettingString = Default
Else
GetSettingString = ""
End If

lRegResult = RegOpenKey(hKey, strPath, hCurKey)
lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, _
lValueType, ByVal 0&, lDataBufferSize)

If lRegResult = ERROR_SUCCESS Then

If lValueType = REG_SZ Then

strBuffer = String(lDataBufferSize, " ")
lResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, _
ByVal strBuffer, lDataBufferSize)

intZeroPos = InStr(strBuffer, Chr$(0))
If intZeroPos > 0 Then
GetSettingString = Left$(strBuffer, intZeroPos - 1)
Else
GetSettingString = strBuffer
End If

End If

Else
'there is a problem
End If

lRegResult = RegCloseKey(hCurKey)
End Function
Function GetStartMenu() As String
GetStartMenu = GetSettingString(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", "Start Menu")
End Function

[da_silvy]

so my code worked all right?

[Edited by da_silvy on 09-15-2000 at 11:16 PM]

sure thing... just need to get the files, and such...

[da_silvy]

that's good

Help... i need to get the files... ack... doesnt seem to
be going anywhere... hopefully you gurus will know =)

[da_silvy]

a routine to get all files in a directory

Function GetAllFiles(baseDir As String)
On Error Resume Next
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long

Dim sFile As String
Dim sPath As String

Dim i As Integer
Dim r As Long



hFile = FindFirstFile(baseDir & "\*.*" & Chr$(0), WFD)


Found = -1
ReDim fArray(200)

If hFile <> -1 Then
sFile = TrimNull(WFD.cFileName)

'WFD.dwFileAttributes = vbDirectory

While FindNextFile(hFile, WFD)

sFile = TrimNull(WFD.cFileName)


'ignore the 2 standard root entries
If (sFile <> ".") And (sFile <> "..") Then

Found = Found + 1
'if found is at 200, then add some more array
'elements
If Found Mod 200 = 0 Then ReDim Preserve _
fArray(Found + 200)
If Right(sFile, 4) = ".lnk" Then _
sFile = Left(sFile, Len(sFile) - 4)

fArray(Found) = sFile
Debug.Print fArray(Found)
End If



Wend
End If

'trim down the array to equal the elements found
ReDim Preserve fArray(Found)
End Function

to call this function:

GetAllFiles GetStartMenu

thanks alot, that code works as well. now all i need is
something to tie it all together, and a little bit of info
on the CreateProcess API call. thanks a ton

[da_silvy]

what do you need the createprocess for?