vb右键菜单

2024年3月21日发(作者：)

我试了一下，可以用回调函数（并非本论坛无高手，而是高手们都对VB不感冒）

以下是代码：有一点小缺憾，就是在TEXT文本框中，系统本身有右键菜单，所有要调用自

己的右键菜单，需要双击（点击两下）右键，才能看到自己的菜单。第一次出来的是系统

右键菜单。

需要自己先建立一个右键菜单，命名为menu1

'********************* 本段代码放在 Form1

Private Sub Form_Activate()

SetTimer , 0, 1, AddressOf TimerProc

End Sub

Private Sub Form_Load()

hDC1 = GetActiveWindow

End Sub

Private Sub Form_Unload(Cancel As Integer)

KillTimer , 0

End Sub

Private Sub Text1_Change()

PopupMenu menu1

End Sub

'*************** 本段代码放在

Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long,

ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long)

As Long

Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Declare Function GetActiveWindow Lib "user32" () As Long

Global Cnt&, sSave$, sOld$, Ret$, Tel&

Global hDC1 As Long

Function GetPressedKey() As String

For Cnt = 1 To 128

If GetAsyncKeyState(Cnt) <> 0 Then

GetPressedKey = Cnt 'Chr$(Cnt)

Exit For

End If

Next Cnt

End Function

Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long,

ByVal lpTimerFunc As Long)

Ret = GetPressedKey

'sSave = ""

If Ret <> sOld Then

sOld = Ret

Dim hdc2 As Long

hdc2 = GetActiveWindow

If Ret = "2" And hdc2 = hDC1 Then

If = "0" Then

= "1"

Else

= "0"

End If

End If

End If

End Sub