请教高手:如何实现用代码创建的菜单事件,谢谢!!!
请教高手:如何实现用代码创建的菜单事件,谢谢!!!
模块:
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