请教高手:如何实现用代码创建的菜单事件,谢谢!!!

msdn165168 高中 2008-01-08 08:19:46
请教高手:如何实现用代码创建的菜单事件,谢谢!!!

模块:

Option Explicit

Private Const MF_BYPOSITION = &H400&
Private Const MF_APPEND = &H100&
Private Const MF_BYCOMMAND = &H0&
Private Const MF_CHANGE = &H80&
Private Const MF_CHECKED = &H8&
Private Const MF_DELETE = &H200&
Private Const MF_DISABLED = &H2&
Private Const MF_ENABLED = &H0&
Private Const MF_GRAYED = &H1&
Private Const MF_HILITE = &H80&
Private Const MF_HSZ_INFO = &H1000000
Private Const MF_INSERT = &H0&
Private Const MF_LINKS = &H20000000
Private Const MF_MASK = &HFF000000
Private Const MF_MENUBARBREAK = &H20&
Private Const MF_MENUBREAK = &H40&
Private Const MF_MOUSESELECT = &H8000&
Private Const MF_OWNERDRAW = &H100&
Private Const MF_POPUP = &H10&
Private Const MF_POSTMSGS = &H4000000
Private Const MF_REMOVE = &H1000&
Private Const MF_SENDMSGS = &H2000000
Private Const MF_SEPARATOR = &H800&
Private Const MF_STRING = &H0&
Private Const MF_SYSMENU = &H2000&
Private Const MF_UNCHECKED = &H0&
Private Const MF_UNHILITE = &H0&
Private Const MF_USECHECKBITMAPS = &H200&


Public Const TPM_LEFTALIGN = &H0&
Public Const GWL_WNDPROC = (-4)

Private Const WM_MENUSELECT = &H11F
Private Const WM_MENUCOMMAND = &H126
Private Const WM_SYSCOMMAND = &H112
Private Const WM_COMMAND = &H111

Public Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag 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 GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function InsertMenu Lib "user32" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) 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 String)
Private Declare Function CheckMenuRadioItem Lib "user32" (ByVal hMenu As Long, ByVal un1 As Long, ByVal un2 As Long, ByVal un3 As Long, ByVal un4 As Long) As Long
Private Declare Function CheckMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDCheckItem As Long, ByVal wCheck As Long) As Long
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Public Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) 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, ByVal lprc As Any) As Long
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public lpPrevWndProc As Long
Public gHW As Long
Public hMenu As Long
Public hSysMenu As Long
Public NEWMEUN As String



Public Sub CreateMenu(frm As Form, LOADPAT As String)

Dim nCnt, i As Long
Dim sMenu As Long
Dim mSubMenuName As String



hMenu = CreatePopupMenu()
sMenu = CreatePopupMenu()

AppendMenu hMenu, MF_STRING Or MF_POPUP, sMenu, "ZBXZ"
Open LOADPAT For Input As #1
i = 0
Do While Not EOF(1)
Line Input #1, mSubMenuName
If Len(Trim(mSubMenuName)) > 0 Then
i = i + 1
AppendMenu sMenu, MF_STRING, i - 1, mSubMenuName

End If
Loop

Close #1


End Sub


Public Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim ret As Long
Dim menuCaption As String

Msg = WM_COMMAND ''响应其他菜单
'' Get the menu caption
menuCaption = Space$(256)
ret = GetMenuString(hMenu, wParam, menuCaption, Len(menuCaption), 0)
menuCaption = Left$(menuCaption, ret)



WindowProc = CallWindowProc(lpPrevWndProc, hwnd, Msg, wParam, lParam)
End Function


窗体:

Private Sub Form_Load()
gHW = Me.hwnd
Hook
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unhook
DestroyMenu hMenu
End Sub

Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Pt As POINTAPI
Call CreateMenu(Me, App.Path & "\CA.TXT")
GetCursorPos Pt
If Button = 2 Then
TrackPopupMenu hMenu, TPM_LEFTALIGN, Pt.x, Pt.y, 0, Me.hwnd, ByVal 0&

想在这里执行JXSTJS3
MsgBox WM_COMMAND

End If

End Sub
Sub Hook()
''加载Hook
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Sub Unhook()
''卸载Hook
SetWindowLong gHW, GWL_WNDPROC, lpPrevWndProc
End Sub


求教如何在Picture2_MouseDown里执行创建的菜单命定
命定为执行下面的过程


Sub JXSTJS3(AvangeTs As Long)
Dim i, j As Long
Dim MaxJL As Long
ReDim jxzs3(UBound(hq))
For i = 1 To UBound(hq)
If i >= AvangeTs Then 'AvangeTs Then
MaxJL = 0
For j = i To i - AvangeTs + 1 Step -1
MaxJL = MaxJL + hq(j).s1j
Next
jxzs3(i) = MaxJL / AvangeTs
End If
Next
End Sub
...全文
41 点赞 收藏 3
写回复
3 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
ahbc123 2008-01-10
Public Function WindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim ret As Long
Dim menuCaption As String

Msg = WM_COMMAND ''响应其他菜单
'' Get the menu caption
menuCaption = Space$(256)
ret = GetMenuString(hMenu, wParam, menuCaption, Len(menuCaption), 0)
menuCaption = Left$(menuCaption, ret)

窗体名称.JXSTJS3

WindowProc = CallWindowProc(lpPrevWndProc, hwnd, Msg, wParam, lParam)
End Function
回复
msdn165168 2008-01-09
谢谢!!!

问题是:创建菜单已完成,该如何想应菜单命定


在模块WindowProc里能得到创建的每个菜单名称(点击新创建的菜单),可我想在窗体中实现得到创建的每个菜单名称(或执行相应的命定),该如何做,还请高手帮助,谢谢!!!
回复
东方之珠 2008-01-08
用代码创建菜单,这叫动态菜单,网上有很多,帮你找一个吧!
http://www.7880.com/info/2005/04/29/article-13483.html
http://topic.csdn.net/t/20031006/16/2328266.html

回复
发动态
发帖子
VB基础类
创建于2007-09-28

7453

社区成员

VB 基础类
申请成为版主
社区公告
暂无公告