Lav en menu med submenu på runtime

Ha!! Det ved jeg lige præcis hvordan man gør!

Jeg har lavet en klasse der kan dette!!

Det virker kanon!!

Giv mig din email så sende jeg det til dig med et eksempel!!!

Men!! Det kunne godt være du lige skulle hæve antallet af point da det er forholdsvis meget kode! Stik mig 100 point så ikke jeg føler mig helt til grin!

Sagde jeg det skulle være i VB5 ????
Det er sq en forudsætning for at jeg giver point ! ;o)


Hvis koden virker i VB5 er pointene dine :)

Øhhhhhhhh!! Aner det ikke!

Jeg ser om jeg kan nå at lave et eksempel til dig du kan prøve men smid lige din mail

OKI:

christian.schodt@carlsen.nu

er hermed sendt!

whuups har sq lige haft ferie, sååååå det..
Det var sq ikke lige det jeg havde tænkt mig, du kan få 50 point hvis du giver et svar :)

Hvad havde du så tænkt dig????

Nolle K, du får pointene, jeg havde sq helt glemt dig.

Beklager den lange svartid

mvh.

Christian

I orden!!!

Nolle K, du bliver sq nødt til at komme med et svar, hvis du vil have pointene :o)


mvh.

Christian

Nolle K, du har ca. til på mandag, svare du ikke miser du sq pointene. :(

OK!! Rolig Mulle!

Lav en klasse!! Kald denne clsMenu

Option Explicit

Public Enum wFlags
  wString = MF_STRING
  wSeparator = MF_SEPARATOR
End Enum

Private m_Caption As String
Private m_wFlags As wFlags
Private m_Enabled As Boolean
Private m_MenuIndex As Long
Private m_Visible As Boolean
Private m_Checked As Boolean

Private m_SubMenu As New clsMenus

Public Property Get Caption() As String
  Caption = m_Caption
End Property

Public Property Let Caption(ByVal vNewValue As String)
  m_Caption = vNewValue
End Property

Public Property Get wFlags() As wFlags
  wFlags = m_wFlags
End Property

Public Property Let wFlags(ByVal vNewValue As wFlags)
  m_wFlags = vNewValue
End Property

Public Property Get SubMenu() As clsMenus
  Set SubMenu = m_SubMenu
End Property

Private Sub Class_Initialize()
  Enabled = True
  Visible = True
End Sub

Private Sub Class_Terminate()
  Set m_SubMenu = Nothing
End Sub

Public Property Get Enabled() As Boolean
  Enabled = m_Enabled
End Property

Public Property Let Enabled(ByVal vNewValue As Boolean)
  m_Enabled = vNewValue
End Property

Public Property Get MenuIndex() As Long
  MenuIndex = m_MenuIndex
End Property

Public Property Let MenuIndex(ByVal vNewValue As Long)
  m_MenuIndex = vNewValue
End Property

Public Property Get Visible() As Boolean
  Visible = m_Visible
End Property

Public Property Let Visible(ByVal vNewValue As Boolean)
  m_Visible = vNewValue
End Property

Public Property Get Checked() As Boolean
  Checked = m_Checked
End Property

Public Property Let Checked(ByVal vNewValue As Boolean)
  m_Checked = vNewValue
End Property


Lav en klasse til og kald denne clsMenus

\'local variable to hold collection
Option Explicit

Private mCol As Collection

Private m_hMenu As Long

Public Function Add(MenuIndex As Long, pFlags As wFlags, Optional Caption As String = \"\", Optional Before As Variant, Optional After As Variant) As clsMenu
    \'create a new object
    Dim objNewMember As clsMenu
    Set objNewMember = New clsMenu

    \'set the properties passed into the method
    objNewMember.wFlags = pFlags
    objNewMember.Caption = Caption
    objNewMember.MenuIndex = MenuIndex
   
    If (pFlags <> wSeparator) Then
      mCol.Add objNewMember, CStr(MenuIndex), Before, After
    Else
      mCol.Add objNewMember, , Before, After
    End If
    \'return the object created
    Set Add = objNewMember
    Set objNewMember = Nothing
End Function

Public Property Get Item(vntIndexKey As Variant) As clsMenu
    \'used when referencing an element in the collection
    \'vntIndexKey contains either the Index or Key to the collection,
    \'this is why it is declared as a Variant
    \'Syntax: Set foo = x.Item(xyz) or Set foo = x.Item(5)
  Set Item = mCol(CStr(vntIndexKey))
End Property



Public Property Get Count() As Long
    \'used when retrieving the number of elements in the
    \'collection. Syntax: Debug.Print x.Count
    Count = mCol.Count
End Property


Public Sub Remove(vntIndexKey As Variant)
    \'used when removing an element from the collection
    \'vntIndexKey contains either the Index or Key, which is why
    \'it is declared as a Variant
    \'Syntax: x.Remove(xyz)


    mCol.Remove vntIndexKey
End Sub

Public Sub RemoveAll()
    \'used when removing an element from the collection
    \'vntIndexKey contains either the Index or Key, which is why
    \'it is declared as a Variant
    \'Syntax: x.Remove(xyz)
  Set mCol = Nothing
  Set mCol = New Collection

   
End Sub




Public Property Get NewEnum() As IUnknown
    \'this property allows you to enumerate
    \'this collection with the For...Each syntax
    Set NewEnum = mCol.[_NewEnum]
End Property


Public Function PopUp() As Long
 
  Dim iMenu As Long
  Dim hMenu As Long

  Dim p As POINTAPI
       
  \' get the current cursor pos in screen coordinates
  GetCursorPos p
 
  hMenu = DoThePopUpMenu(Me)

  iMenu = TrackPopupMenu(hMenu, TPM_LEFTBUTTON + TPM_LEFTALIGN + TPM_RETURNCMD, p.X, p.Y, 0, GetForegroundWindow(), 0)
 
  \'release and destroy the menu (for sanity)
  DestroyMenu hMenu
  m_hMenu = 0
 

  PopUp = iMenu
   
End Function

Private Function DoThePopUpMenu(MenuCol As clsMenus) As Long
 
  Dim hMenu As Long
  Dim iMenu As Long
  Dim MenuItem As clsMenu
  Dim wFlags As Long
  Dim PopUp As Boolean
     
 
  \' create an empty popup menu or get the one we have to attach to if PopUp
  hMenu = IIf(MenuCol.PopUpMenu, MenuCol.PopUpMenu, CreatePopupMenu())
 
  For Each MenuItem In MenuCol
    PopUp = False
   
    With MenuItem
      If (.Visible) Then
        If (.SubMenu.Count > 0 And .SubMenu.IsVisible) Then
          PopUp = True
          \'Create The empty Popup Menu
          iMenu = CreatePopupMenu()
          .SubMenu.PopUpMenu = iMenu
        Else
          iMenu = .MenuIndex
        End If
       
        AppendMenu hMenu, GetFlags(MenuItem, PopUp), iMenu, .Caption
        If (.SubMenu.Count > 0) Then
          \'Do the SubMenu
          DoThePopUpMenu .SubMenu
        End If
      End If
    End With
  Next
 
  PopUpMenu = hMenu
 
  DoThePopUpMenu = hMenu

End Function

Private Function GetFlags(MenuItem As clsMenu, PopUp As Boolean) As Long
  With MenuItem
    If (Not PopUp) Then
      GetFlags = .wFlags
    Else
      GetFlags = MF_POPUP
    End If
    If (Not (GetFlags And MF_SEPARATOR)) Then
      GetFlags = GetFlags Or IIf(.Enabled, MF_ENABLED, MF_GRAYED Or MF_DISABLED) Or IIf(.Checked, MF_CHECKED, 0)
    End If
  End With
End Function
   
Public Property Get PopUpMenu() As Long
  PopUpMenu = m_hMenu
End Property

Public Property Let PopUpMenu(vNewValue As Long)
  If (m_hMenu) Then
    DestroyMenu m_hMenu
  End If
  m_hMenu = vNewValue
End Property

Public Property Get IsVisible() As Boolean
  Dim MenuItem As clsMenu
 
  For Each MenuItem In Me
    If (MenuItem.Visible) Then
      IsVisible = True
      Exit Function
    End If
  Next
End Property


Private Sub Class_Initialize()
  \'creates the collection when this class is created
  Set mCol = New Collection
  m_hMenu = 0
End Sub

Private Sub Class_Terminate()
  If (m_hMenu) Then
    DestroyMenu m_hMenu
  End If
  \'destroys collection when this class is terminated
  Set mCol = Nothing
End Sub

Når du har gemt de to filer går du ind og editerer den fil, der indeholder clsMenus og søger  på

Public Property Get NewEnum() As IUnknown

Lige under denne linie skriver du følgende

Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = \"40\"

Herefter søger du på

Public Property Get Item(vntIndexKey As Variant) As clsMenu

Under denne linie skriver du

Attribute Item.VB_UserMemId = 0

Dette skal gøres fordi VB er noget værre LORT! Men sådan er det! Desværre det eneste alternativ, der hvor jeg arbejder!!

Ex.

Dim m_popUpMenu as New clsMenus

  With m_PopUpMenu
      .Add mnuNew, wString, \"New\"
      .Add mnuEdit, wString, \"Edit\"
     
      .Add mnuCopy, wString, \"Copy\"
      .Add mnuAddTab, wString, \"Add tab\", , , , , , True
      .Add mnuRemoveTab, wString, \"Remove tab\", , , , , , True
       
      If (DefType <> dtProduction) Then
        .Add mnuSeparator, wSeparator
      End If
      .Add mnuBackup, wString, \"Backup\"   
      .Add mnuRestore, wString, \"Restore\"       
      .Add mnuPrint, wString, \"Print\"
     
      .Add mnuSeparator, wSeparator
     
      .Add mnuDelete, wString, \"Delete\"           
      .Add mnuProperties, wString, \"Properties\"
     
      .Add mnuSeparator, wSeparator
      .Add mnuClose, wString, \"Close\"
    End With
  End If


Den første parameter er konstanter jeg har defineret et eller andet sted i et modul eller noget!

Hvis du skal have submenuer gør du følgende

m_popMneu(mnuAddTab).SubMneu.Add mnuTab1, wString, \"Tab1\"

Du viser menuen ved at skrive m_popupMenu.Popup

Mange tak for det Nolle_K.....
Så tror jeg sq heller ikke jeg har brug for mere hjælp :o)

hehe, vil du ikke meget gerne \"svare\" på mit spgm. så du kan få dine velfortjente point :)

mvh.

Christian

Selvtak og
Jo Klart!!

Så kom jeg sq endelig af med pointene :)