Popup-Menü zur Laufzeit erzeugen inkl. Icon (VBA / VB)

18/12/2011 - 20:27 von Stefan Dase | Report spam
Hallo allerseits,

ich quàle mich seit ein paar Stunden mit folgender Anforderung, zur
Laufzeit ein Popup-Menü für ein TreeView zu erstellen. Dieses soll auf
Rechtssklick mit der Maus angezeigt werden und bei bestimmten
Menüeintràgen auch ein Icon anzeigen, z.B. ein "X"-Symbol zum Löschen.
Diese Icons wollte ich mittels ImageList übergeben.

Das Erzeugen des Popus ist mir mithilfe dieser Anleitung schon gut gelungen:
http://www.vbarchiv.net/tipps/tipp_...r-api.html

Nur irgendwie finde ich den Dreh zum Einfügen des Bildes nicht. Laut
MSDN-Dokumentation kann ich ein Handle zu einem Bitmap über die 12.
Eigenschaft des MENUINFO-Types übergeben, nur dieser hat im Beispiel nur
11. Eigenschaften!

Kann mich jemand den Weg weisen oder ein paar Quellen angeben, die
zeigen, wie das mit VB/VBA geht?

X-Post in de.comp.datenbanken.ms-access und de.comp.lang.vb mit F-Up in
de.comp.lang.vb.

Vielen Dank,
Stefan



Hier der momentane Code:

Klassenmodul clsPopupMenu

Private Declare Function CreatePopupMenu Lib "user32.dll" () As Long

Private Declare Function DestroyMenu Lib "user32.dll" ( _
ByVal hMenu As Long) As Long

Private Declare Function InsertMenuItem Lib "user32.dll" _
Alias "InsertMenuItemA" ( _
ByVal hMenu As Long, _
ByVal uItem As Long, _
ByVal fByPosition As Long, _
lpmii As MENUITEMINFO) As Long

Private Declare Function TrackPopupMenu Lib "user32.dll" ( _
ByVal hMenu As Long, _
ByVal uFlags As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nReserved As Long, _
ByVal hWnd As Long, _
ByVal prcRect As Long) As Long

Private Declare Function GetCursorPos& Lib "user32" (lpPoint As POINTAPI)

Private Type POINTAPI
x As Long
y As Long
End Type

Private Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type

' MENUITEMINFO fMask-Konstanten
' =
' Benutzt die fState Optionen
Private Const MIIM_STATE = &H1

' Benutzt die wID Option
Private Const MIIM_ID = &H2

' Benutzt die hSubMenu Option
Private Const MIIM_SUBMENU = &H4

' Benutzt die hbmpChecked und hbmpUnchecked Optionen
Private Const MIIM_CHECKMARKS = &H8

' Benutzt die dwItemDate Option
Private Const MIIM_DATA = &H20

' Benutzt die dwTypeData Option
Private Const MIIM_TYPE = &H10


' MENUITEMINFO fType-Konstanten
' =
' Zeigt ein Bitmap im Menü an. Der Handle des Bitmaps muss in
' dwTypeData übergeben werden und cch wird ignoriert.
' Kann nicht mit MFT_SEPARATOR oder MFT_STRING kombiniert
' werden.
Private Const MFT_BITMAP = &H4

' Plaziert das Menü in eine neuen Zeile oder Spalte und
' zeichnet über und unter dem Eintrag einen Separator
Private Const MFT_MENUBARBREAK = &H20

' Identisch mit MFT_MENUBARBREAK nur ohne Separator
Private Const MFT_MENUBREAK = &H40

' Überlàsst das Neuzeichnen des Menüs dem Fenster
Private Const MFT_OWNERDRAW = &H100

' Zeigt einen Radiobutton als Checked/Unchecked an
Private Const MFT_RADIOCHECK = &H200

' Richtet ein Menü rechtsbündig aus
Private Const MFT_RIGHTJUSTIFY = &H4000

' (Win 9x, 2000) Die Menüs plazieren sich rechts voneinander,
' der Text von rechts nach links unterstützt
Private Const MFT_RIGHTORDER = &H2000

' Zeichnet eine horizontale Linie, dwTypeData und cch werden
' ignoriert.
' Kann nicht mit MFT_BITMAP oder MFT_STRING kombiniert werden
Private Const MFT_SEPARATOR = &H800

' Der Menü-Eintrag wird mit einem String gefüllt
' deTypeData ist der String, der angezeigt werden soll und
' cch die Lànge des Strings.
' Kann nicht mit MFT_BITMAP oder MFT_SEPARATOR kombiniert
' werden.
Private Const MFT_STRING = &H0


' MENUITEMINFO fState-Konstanten
' ==
' MenuItem ist Markiert
Private Const MFS_CHECKED = &H8

' MenuItem ist die Standard-Auswahl
Private Const MFS_DEFAULT = &H1000

' MenuItem ist Disabled
Private Const MFS_DISABLED = &H2

' MenuItem ist Enabled
Private Const MFS_ENABLED = &H0

' MenuItem ist Grau und Disabled
Private Const MFS_GRAYED = &H1

' MenuItem hat die Selektierung
Private Const MFS_HILITE = &H80

' MenuItem ist nicht markiert
Private Const MFS_UNCHECKED = &H0

' MenuItem hat nicht die Selektierung
Private Const MFS_UNHILITE = &H0


' TrackPopupmenu uFlags-Konstanten
' =
' Positioniert das Menü horizontal in der Mitte von x
Private Const TPM_CENTERALIGN = &H4

' Positioniert das Menü horizontal mit dem linken Rand auf x
Private Const TPM_LEFTALIGN = &H0

' Positioniert das Menü Horizontal mit dem rechten Rand auf x
Private Const TPM_RIGHTALIGN = &H8

' Positioniert das Menü mit dem unteren Rand auf y
Private Const TPM_BOTTOMALIGN = &H20

' Positioniert das Menü mit dem oberen Rand auf y
Private Const TPM_TOPALIGN = &H0

' Positioniert das Menü vertikal in der Mitte von y
Private Const TPM_VCENTERALIGN = &H10

' Sendet bei Ereignissen kein WM_COMMAND an das Elternfenster
Private Const TPM_NONOTIFY = &H80

' ID des Menüs, welches gewàhlt wurde
Private Const TPM_RETURNCMD = &H100

' Erlaubt dem Benutzer nur das Markieren der Eintràge über
' die linke Maustaste und der Tastatur
Private Const TPM_LEFTBUTTON = &H0

' Erlaubt dem Benutzer die Eintràge mit jedem Mausbutton
' zu wàhlen und der Tastatur
Private Const TPM_RIGHTBUTTON = &H2

Private m_aMenuItem() As MENUITEMINFO
Private m_aMenuItemKey() As String
Private m_iPopupMenu As Long
Private m_iCountItems As Long

Public Function insertCommandItem(Key As String, ItemText As String) As
Boolean

Dim iRetval As Long

m_iCountItems = m_iCountItems + 1

ReDim Preserve m_aMenuItem(1 To m_iCountItems)
ReDim Preserve m_aMenuItemKey(1 To m_iCountItems)

'save key
m_aMenuItemKey(m_iCountItems) = Key

'create menu item
If Key = "-" Then
With m_aMenuItem(m_iCountItems)
.cbSize = Len(m_aMenuItem(m_iCountItems))
.fMask = MIIM_TYPE Or MIIM_ID
.fState = MFS_DEFAULT Or MFS_HILITE
.fType = MFT_SEPARATOR
.wID = m_iCountItems
End With
Else
With m_aMenuItem(m_iCountItems)
.cbSize = Len(m_aMenuItem(m_iCountItems))
.dwTypeData = ItemText
.cch = Len(Trim$(.dwTypeData))
.fMask = MIIM_TYPE Or MIIM_ID
.fState = MFS_DEFAULT Or MFS_HILITE
.fType = MFT_STRING
.wID = m_iCountItems
End With
End If

iRetval = InsertMenuItem(m_iPopupMenu, 0&, 0&,
m_aMenuItem(m_iCountItems))

If iRetval = 0 Then
Debug.Print "Fehler beim Hinzufügen: (Einfügen)."
End If

End Function

Public Function showPopupMenu(ObjectHandle As Long) As String

Dim PT As POINTAPI
Dim iFlags As Long
Dim iRetval As Long

On Error GoTo showPopupMenu_Error

GetCursorPos PT
iFlags = TPM_LEFTBUTTON Or TPM_TOPALIGN Or TPM_NONOTIFY Or
TPM_RETURNCMD

iRetval = TrackPopupMenu(m_iPopupMenu, iFlags, PT.x, PT.y, 0&,
ObjectHandle, 0&)

showPopupMenu = m_aMenuItemKey(iRetval)

showPopupMenu_Exit:
Exit Function

showPopupMenu_Error:
showPopupMenu = ""
'tdb.: error handler
Resume showPopupMenu_Exit

End Function

Private Sub Class_Initialize()
m_iPopupMenu = CreatePopupMenu()
End Sub

Private Sub Class_Terminate()
DestroyMenu m_iPopupMenu
End Sub

Aufruf aus einem anderen Klassenmodul:

Private Function getPopupResult(ByRef oNode As MSComctlLib.Node) As String

Dim objPopupMenu As clsPopupMenu

On Error GoTo getPopupResult_Error

Set objPopupMenu = New clsPopupMenu

Select Case oNode.Tag
Case "Folder"
objPopupMenu.insertCommandItem "OpenFolder", "Ordner im
Explorer öffnen"

Case "File"
objPopupMenu.insertCommandItem "OpenFile", "Datei öffnen"
objPopupMenu.insertCommandItem "DeleteFile", "Datei löschen"

Case Else
GoTo getPopupResult_Exit
End Select

getPopupResult = objPopupMenu.showPopupMenu(m_oTreeView.hWnd)

getPopupResult_Exit:
Set objPopupMenu = Nothing
Exit Function

getPopupResult_Error:
'tdb.: error handler
Resume getPopupResult_Exit


End Function
 

Lesen sie die antworten

#1 Martin KoWi
19/12/2011 - 20:33 | Warnen spam
Hi,

ohne Aufwand könntest du zb. die Checkmarks dazu missbrauchen.
andere Varianten bràuchten dafür mehr Umbau.

Dazu musst du nur bei der MENUITEMINFO àndern:
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_CHECKMARKS

Also zb. der Funktion insertCommandItem einen zus. (optionalen)
Parameter lIcon(Handle) geben:

Public Function insertCommandItem(Key As String, ItemText As String,
Optional lIcon As Long) As Boolean


'dann kannst du schon mit Image-Handles hinzufügen:
With m_aMenuItem(m_iCountItems)
.cbSize = Len(m_aMenuItem(m_iCountItems))
.dwTypeData = ItemText
.cch = Len(Trim$(.dwTypeData))
.fMask = MIIM_TYPE Or MIIM_ID Or MIIM_CHECKMARKS '+ checkmarks!
.fState = MFS_DEFAULT Or MFS_HILITE
.fType = MFT_STRING
.wID = m_iCountItems
.hbmpUnchecked = lIcon 'IconHandle
.hbmpChecked = lIcon 'IconHandle
End With

Menüpunkt mit Icon hinzufügen:
objPopupMenu.insertCommandItem "OpenFile", "Datei öffnen",
ImageList.ListImages(1).Picture.Handle

schöen gruß,
martin.


Am 18.12.2011 20:27, schrieb Stefan Dase:
Hallo allerseits,

ich quàle mich seit ein paar Stunden mit folgender Anforderung, zur
Laufzeit ein Popup-Menü für ein TreeView zu erstellen. Dieses soll auf
Rechtssklick mit der Maus angezeigt werden und bei bestimmten
Menüeintràgen auch ein Icon anzeigen, z.B. ein "X"-Symbol zum Löschen.
Diese Icons wollte ich mittels ImageList übergeben.

Das Erzeugen des Popus ist mir mithilfe dieser Anleitung schon gut
gelungen:
http://www.vbarchiv.net/tipps/tipp_...r-api.html

Nur irgendwie finde ich den Dreh zum Einfügen des Bildes nicht. Laut
MSDN-Dokumentation kann ich ein Handle zu einem Bitmap über die 12.
Eigenschaft des MENUINFO-Types übergeben, nur dieser hat im Beispiel nur
11. Eigenschaften!

Kann mich jemand den Weg weisen oder ein paar Quellen angeben, die
zeigen, wie das mit VB/VBA geht?

X-Post in de.comp.datenbanken.ms-access und de.comp.lang.vb mit F-Up in
de.comp.lang.vb.

Vielen Dank,
Stefan



Hier der momentane Code:

Klassenmodul clsPopupMenu

Private Declare Function CreatePopupMenu Lib "user32.dll" () As Long

Private Declare Function DestroyMenu Lib "user32.dll" ( _
ByVal hMenu As Long) As Long

Private Declare Function InsertMenuItem Lib "user32.dll" _
Alias "InsertMenuItemA" ( _
ByVal hMenu As Long, _
ByVal uItem As Long, _
ByVal fByPosition As Long, _
lpmii As MENUITEMINFO) As Long

Private Declare Function TrackPopupMenu Lib "user32.dll" ( _
ByVal hMenu As Long, _
ByVal uFlags As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nReserved As Long, _
ByVal hWnd As Long, _
ByVal prcRect As Long) As Long

Private Declare Function GetCursorPos& Lib "user32" (lpPoint As POINTAPI)

Private Type POINTAPI
x As Long
y As Long
End Type

Private Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type

' MENUITEMINFO fMask-Konstanten
' =>
' Benutzt die fState Optionen
Private Const MIIM_STATE = &H1

' Benutzt die wID Option
Private Const MIIM_ID = &H2

' Benutzt die hSubMenu Option
Private Const MIIM_SUBMENU = &H4

' Benutzt die hbmpChecked und hbmpUnchecked Optionen
Private Const MIIM_CHECKMARKS = &H8

' Benutzt die dwItemDate Option
Private Const MIIM_DATA = &H20

' Benutzt die dwTypeData Option
Private Const MIIM_TYPE = &H10


' MENUITEMINFO fType-Konstanten
' =>
' Zeigt ein Bitmap im Menü an. Der Handle des Bitmaps muss in
' dwTypeData übergeben werden und cch wird ignoriert.
' Kann nicht mit MFT_SEPARATOR oder MFT_STRING kombiniert
' werden.
Private Const MFT_BITMAP = &H4

' Plaziert das Menü in eine neuen Zeile oder Spalte und
' zeichnet über und unter dem Eintrag einen Separator
Private Const MFT_MENUBARBREAK = &H20

' Identisch mit MFT_MENUBARBREAK nur ohne Separator
Private Const MFT_MENUBREAK = &H40

' Überlàsst das Neuzeichnen des Menüs dem Fenster
Private Const MFT_OWNERDRAW = &H100

' Zeigt einen Radiobutton als Checked/Unchecked an
Private Const MFT_RADIOCHECK = &H200

' Richtet ein Menü rechtsbündig aus
Private Const MFT_RIGHTJUSTIFY = &H4000

' (Win 9x, 2000) Die Menüs plazieren sich rechts voneinander,
' der Text von rechts nach links unterstützt
Private Const MFT_RIGHTORDER = &H2000

' Zeichnet eine horizontale Linie, dwTypeData und cch werden
' ignoriert.
' Kann nicht mit MFT_BITMAP oder MFT_STRING kombiniert werden
Private Const MFT_SEPARATOR = &H800

' Der Menü-Eintrag wird mit einem String gefüllt
' deTypeData ist der String, der angezeigt werden soll und
' cch die Lànge des Strings.
' Kann nicht mit MFT_BITMAP oder MFT_SEPARATOR kombiniert
' werden.
Private Const MFT_STRING = &H0


' MENUITEMINFO fState-Konstanten
' ==>
' MenuItem ist Markiert
Private Const MFS_CHECKED = &H8

' MenuItem ist die Standard-Auswahl
Private Const MFS_DEFAULT = &H1000

' MenuItem ist Disabled
Private Const MFS_DISABLED = &H2

' MenuItem ist Enabled
Private Const MFS_ENABLED = &H0

' MenuItem ist Grau und Disabled
Private Const MFS_GRAYED = &H1

' MenuItem hat die Selektierung
Private Const MFS_HILITE = &H80

' MenuItem ist nicht markiert
Private Const MFS_UNCHECKED = &H0

' MenuItem hat nicht die Selektierung
Private Const MFS_UNHILITE = &H0


' TrackPopupmenu uFlags-Konstanten
' =>
' Positioniert das Menü horizontal in der Mitte von x
Private Const TPM_CENTERALIGN = &H4

' Positioniert das Menü horizontal mit dem linken Rand auf x
Private Const TPM_LEFTALIGN = &H0

' Positioniert das Menü Horizontal mit dem rechten Rand auf x
Private Const TPM_RIGHTALIGN = &H8

' Positioniert das Menü mit dem unteren Rand auf y
Private Const TPM_BOTTOMALIGN = &H20

' Positioniert das Menü mit dem oberen Rand auf y
Private Const TPM_TOPALIGN = &H0

' Positioniert das Menü vertikal in der Mitte von y
Private Const TPM_VCENTERALIGN = &H10

' Sendet bei Ereignissen kein WM_COMMAND an das Elternfenster
Private Const TPM_NONOTIFY = &H80

' ID des Menüs, welches gewàhlt wurde
Private Const TPM_RETURNCMD = &H100

' Erlaubt dem Benutzer nur das Markieren der Eintràge über
' die linke Maustaste und der Tastatur
Private Const TPM_LEFTBUTTON = &H0

' Erlaubt dem Benutzer die Eintràge mit jedem Mausbutton
' zu wàhlen und der Tastatur
Private Const TPM_RIGHTBUTTON = &H2

Private m_aMenuItem() As MENUITEMINFO
Private m_aMenuItemKey() As String
Private m_iPopupMenu As Long
Private m_iCountItems As Long

Public Function insertCommandItem(Key As String, ItemText As String) As
Boolean

Dim iRetval As Long

m_iCountItems = m_iCountItems + 1

ReDim Preserve m_aMenuItem(1 To m_iCountItems)
ReDim Preserve m_aMenuItemKey(1 To m_iCountItems)

'save key
m_aMenuItemKey(m_iCountItems) = Key

'create menu item
If Key = "-" Then
With m_aMenuItem(m_iCountItems)
.cbSize = Len(m_aMenuItem(m_iCountItems))
.fMask = MIIM_TYPE Or MIIM_ID
.fState = MFS_DEFAULT Or MFS_HILITE
.fType = MFT_SEPARATOR
.wID = m_iCountItems
End With
Else
With m_aMenuItem(m_iCountItems)
.cbSize = Len(m_aMenuItem(m_iCountItems))
.dwTypeData = ItemText
.cch = Len(Trim$(.dwTypeData))
.fMask = MIIM_TYPE Or MIIM_ID
.fState = MFS_DEFAULT Or MFS_HILITE
.fType = MFT_STRING
.wID = m_iCountItems
End With
End If

iRetval = InsertMenuItem(m_iPopupMenu, 0&, 0&, m_aMenuItem(m_iCountItems))

If iRetval = 0 Then
Debug.Print "Fehler beim Hinzufügen: (Einfügen)."
End If

End Function

Public Function showPopupMenu(ObjectHandle As Long) As String

Dim PT As POINTAPI
Dim iFlags As Long
Dim iRetval As Long

On Error GoTo showPopupMenu_Error

GetCursorPos PT
iFlags = TPM_LEFTBUTTON Or TPM_TOPALIGN Or TPM_NONOTIFY Or TPM_RETURNCMD

iRetval = TrackPopupMenu(m_iPopupMenu, iFlags, PT.x, PT.y, 0&,
ObjectHandle, 0&)

showPopupMenu = m_aMenuItemKey(iRetval)

showPopupMenu_Exit:
Exit Function

showPopupMenu_Error:
showPopupMenu = ""
'tdb.: error handler
Resume showPopupMenu_Exit

End Function

Private Sub Class_Initialize()
m_iPopupMenu = CreatePopupMenu()
End Sub

Private Sub Class_Terminate()
DestroyMenu m_iPopupMenu
End Sub

Aufruf aus einem anderen Klassenmodul:

Private Function getPopupResult(ByRef oNode As MSComctlLib.Node) As String

Dim objPopupMenu As clsPopupMenu

On Error GoTo getPopupResult_Error

Set objPopupMenu = New clsPopupMenu

Select Case oNode.Tag
Case "Folder"
objPopupMenu.insertCommandItem "OpenFolder", "Ordner im Explorer öffnen"

Case "File"
objPopupMenu.insertCommandItem "OpenFile", "Datei öffnen"
objPopupMenu.insertCommandItem "DeleteFile", "Datei löschen"

Case Else
GoTo getPopupResult_Exit
End Select

getPopupResult = objPopupMenu.showPopupMenu(m_oTreeView.hWnd)

getPopupResult_Exit:
Set objPopupMenu = Nothing
Exit Function

getPopupResult_Error:
'tdb.: error handler
Resume getPopupResult_Exit


End Function

Ähnliche fragen