如何根据目录层次建立动态菜单?(象IE的收藏夹一样)
解决方案 »
- 怎样让VB中TreeView中的多选框不可编辑
- 窗体里有webbrowser你最小化或unload该窗体,在wb加载完成后,将会使得此窗口激活(已经unload也会自动加载!)
- 求 以下 vb OpenResultset 与 Execute怎么区别?? 进者有分
- 记录查询问题?
- vb里做软件最多支持多少个串口。怎样判断串口
- 简单常见问题(立等给分哦)
- 哪里有VB 6.0 中文版语言参考手册!!!
- msFlexGrid显示记录条数的问题,在线等待!
- 大家,谁知道spread.....?
- vb 如何利用datagrid自动获取数据并按enter键修改
- 哪位高手可以帮忙???
- 哪里有用VB实现的算法的书籍下载?
MyPopUpMenu X, Y
End SubPrivate Sub MyPopUpMenu(X As Single, Y As Single)
Dim PMenu As Long, sMenu As Long
Dim returnV As Long
Dim mRect As RECT
Dim pt As POINTAPI
pt.X = X \ Screen.TwipsPerPixelX
pt.Y = Y \ Screen.TwipsPerPixelY
ClientToScreen hwnd, pt
PMenu = CreatePopupMenu() '生成一个空弹出菜单
sMenu = CreatePopupMenu()
If PMenu > 0 And sMenu > 0 Then
AppendMenu PMenu, MF_STRING, 7000, "AAAAAAAAAA(&A)"
AppendMenu PMenu, MF_STRING, 7001, "BBBBBBBBBB(&B)"
AppendMenu sMenu, MF_STRING, 7003, "CCCCCCCCCC(&C)"
AppendMenu sMenu, MF_STRING, 7004, "DDDDDDDDDDD(&D)"
AppendMenu PMenu, MF_STRING Or MF_POPUP, sMenu, "GGGGG"
returnV = TrackPopupMenu(PMenu, TPM_RETURNCMD + TPM_RIGHTBUTTON, pt.X, pt.Y, 0, hwnd, mRect) '激活弹出菜单
DestroyMenu PMenu
Select Case returnV
Case 7000 '
MsgBox "7000"
Case 7001 '
MsgBox "7001"
Case 7003
MsgBox "7003"
End Select
End IfEnd Sub-----------------------
'公共模块:
Public 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
Public Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function CreateMenu Lib "user32" () As Long
Public Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As RECT) As LongPublic Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As LongPublic Declare Function CreatePopupMenu Lib "user32" () As Long
Public Type POINTAPI
X As Long
Y As Long
End Type
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End TypePublic Const TPM_RETURNCMD = 256
Public Const TPM_RIGHTBUTTON = &H2&
Public Const TPM_BOTTOMALIGN = 32Public Const MF_STRING = &H0&
Public Const MF_POPUP = &H10&
Const MF_APPEND = &H100&
Const TPM_LEFTALIGN = &H0&
Const MF_DISABLED = &H2&
Const MF_GRAYED = &H1&
Const MF_SEPARATOR = &H800&
Const MF_STRING = &H0&
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, ByVal lprc As Any) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert 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 DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Dim hMenu As Long
Private Sub Form_Load() hMenu = CreatePopupMenu()
'Append a few menu items
AppendMenu hMenu, MF_STRING, ByVal 0&, "Hello !"
AppendMenu hMenu, MF_GRAYED Or MF_DISABLED, ByVal 0&, "Testing ..."
AppendMenu hMenu, MF_SEPARATOR, ByVal 0&, ByVal 0&
AppendMenu hMenu, MF_CHECKED, ByVal 0&, "TrackPopupMenu"
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Pt As POINTAPI
'Get the position of the mouse cursor
GetCursorPos Pt
If Button = 1 Then
'Show our popupmenu
TrackPopupMenu hMenu, TPM_LEFTALIGN, Pt.x, Pt.y, 0, Me.hwnd, ByVal 0&
Else
'Show our form's default popup menu
TrackPopupMenu GetSystemMenu(Me.hwnd, False), TPM_LEFTALIGN, Pt.x, Pt.y, 0, Me.hwnd, ByVal 0&
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
'Destroy our menu
DestroyMenu hMenu
End Sub