title image


Smiley immer diese OCXer...
Handmade ist doch viel cooler ;-)



Hier ein Beispielcode, wie man auf relativ einfache Art ein einfaches Kontextmenü per API erstellt. Ist natürlich, wie immer, noch ausbaufähig, sollte aber für den Normalgebrauch ausreichen.



Private Declare Function CreatePopupMenu Lib "user32" () As Long Private Declare Function DestroyMenu Lib "user32" _     (ByVal hMenu As Long) As Long Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" _     (ByVal hMenu As Long, ByVal wFlags As Long, _     ByVal wIDNewItem As Long, ByVal lpNewItem As Any) 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) As Long Private Type POINTAPI     x As Long     y As Long End Type Private Const MF_BYCOMMAND = &H0& Private Const MF_STRING = &H0& Private Const MF_POPUP = &H10& Private Const MF_SEPARATOR = &H800& Private Const MFS_ENABLED = &H0 Private Const MFS_GRAYED = &H3& Private Const MFS_CHECKED = &H8 Private Const TPM_LEFTALIGN = &H0 Private Const TPM_RIGHTALIGN = &H8 Private Const TPM_TOPALIGN = &H0 Private Const TPM_NONOTIFY = &H80 Private Const TPM_RETURNCMD = &H100 Private Const TPM_LEFTBUTTON = &H0& Private Const TPM_RIGHTBUTTON = &H2& Private Function Menu_AddItem(ByVal Caption As String, _                               ByVal ID As Long, _                               ByVal hParentMenu As Long, _                               ByVal Typ As Long, _                               ByVal Checked As Boolean, _                               ByVal Enabled As Boolean) As Long     Menu_AddItem = AppendMenu(hParentMenu, _                    Typ Or IIf(Checked, MFS_CHECKED, 0) _                    Or IIf(Enabled, MFS_ENABLED, MFS_GRAYED), _                    ID, _                    Caption) End Function Public Function MyPopup(hwnd As Long, Optional x, Optional y) As Long     Dim retval As Long     Dim hPopupMenu As Long     Dim menusel As Long     Dim point As POINTAPI     '// Diese Konstanten werden von der Funktion zurückgegeben     '// und identifizieren einen Menüpunkt eindeutig (MenuItem-ID)     Const ID_NEU& = 101     Const ID_LÖSCHEN& = 102     Const ID_BEARBEITEN& = 103     Const ID_SEP& = 104     '// Anzeigeposition bestimmen     Call GetCursorPos(point)     If IsMissing(x) Then x = point.x     If IsMissing(y) Then y = point.y     '// Popupmenü erstellen     hPopupMenu = CreatePopupMenu()     '// Menüeinträge hinzufügen     Menu_AddItem "&Neu", ID_NEU, hPopupMenu, MF_STRING, False, False     Menu_AddItem "&Bearbeiten", ID_BEARBEITEN, hPopupMenu, MF_STRING, False, True     Menu_AddItem "", ID_SEP, hPopupMenu, MF_SEPARATOR, False, True     Menu_AddItem "&Löschen", ID_LÖSCHEN, hPopupMenu, MF_STRING, True, True     '// Popupmenü anzeigen     menusel = TrackPopupMenu(hPopupMenu, _                              TPM_TOPALIGN Or TPM_LEFTALIGN Or TPM_NONOTIFY _                              Or TPM_RETURNCMD, CLng(x), CLng(y), 0, hwnd, 0)     '// Menü-Handle freigeben     Call DestroyMenu(hPopupMenu)     '// ausgewählte MenüItem-ID zurückgeben     '// wird kein Element ausgewählt, wird 0 zurückgegeben     MyPopup = menusel End Function 



Aufgerufen wird das Kontextmenü z.B. so:

Private Sub Command1_Click()

MsgBox "Sie haben folgenden Menüpunkt gewählt: " & MyPopup(Me.hwnd)

End Sub



Wenn dennoch Bedarf an einem OCX besteht, schau Dich mal auf http://www.vbaccelerator.com um.



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: