popup meny og bordersyle 0

[Jonas]

Hallo

 

Når formen har borderstyle på 0 og jeg skal ha en popup meny når jeg høyreklikker et sted, blir bare borderstylen automatisk 1. Hvis jeg tar den tilbake på 0 skjer det ingen ting.. Alle de andre funker. Finnes det noe løsning eller kan jeg ikke ha noe popup?

Endret 12. april 2004 av Jonas

[aadnk]

Du kan jo lage menyen selv, med Windows API. Se f.eks på dette eksempelet:

 

Option Explicit

Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function TrackPopupMenuEx Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal HWnd As Long, ByVal lptpm As Any) 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 DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Any) As Long
Private Declare Function CheckMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDCheckItem As Long, ByVal wCheck As Long) As Long

Const MF_UNCHECKED = &H0&
Const MF_CHECKED = &H8&
Const MF_APPEND = &H100&
Const MF_DISABLED = &H2&
Const MF_GRAYED = &H1&
Const MF_SEPARATOR = &H800&
Const MF_STRING = &H0&

Const MIIM_TYPE = &H10
Const MIIM_SUBMENU = &H4

Const TPM_LEFTALIGN = &H0&
Const TPM_RETURNCMD = &H100&
Const TPM_RIGHTBUTTON = &H2&

Private Type POINTAPI
x As Long
y As Long
End Type

Dim hMenu As Long

Private Sub Form_Load()

hMenu = CreatePopupMenu()
AppendMenu hMenu, MF_STRING, 1, "Hello !"
AppendMenu hMenu, MF_GRAYED Or MF_DISABLED, 2, "Testing ..."
AppendMenu hMenu, MF_SEPARATOR, 3, ByVal 0&
AppendMenu hMenu, MF_CHECKED, 4, "TrackPopupMenu"

End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

Dim Pt As POINTAPI
Dim ret As Long

GetCursorPos Pt
ret = TrackPopupMenuEx(hMenu, TPM_LEFTALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, Pt.x, Pt.y, Me.HWnd, ByVal 0&)
CallMenuFunction ret

End Sub

Public Sub CallMenuFunction(ByVal MenuID As Long)

Select Case MenuID
Case 1
   MsgBox "Hello to you!", vbInformation, "Hello!"
   
Case 4
   
   If CheckMenuItem(hMenu, 4, MF_CHECKED) = MF_CHECKED Then
       CheckMenuItem hMenu, 4, MF_UNCHECKED
   End If
   
End Select

End Sub

Private Sub Form_Unload(Cancel As Integer)

DestroyMenu hMenu

End Sub