超然 发表于 2009-4-29 14:20:04

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

以下是代码:有一点小缺憾,就是在TEXT文本框中,系统本身有右键菜单,所有要调用自己的右键菜单,需要双击(点击两下)右键,才能看到自己的菜单。第一次出来的是系统右键菜单。

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

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

Private Sub Form_Activate()
SetTimer Me.hwnd, 0, 1, AddressOf TimerProc
End Sub

Private Sub Form_Load()
Form1.Show
hDC1 = GetActiveWindow
End Sub

Private Sub Form_Unload(Cancel As Integer)
KillTimer Me.hwnd, 0
End Sub

Private Sub Text1_Change()
PopupMenu menu1
End Sub
'*************** 本段代码放在 Module1.bas
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 Form1.Text1.Text = "0" Then
    Form1.Text1.Text = "1"
Else
    Form1.Text1.Text = "0"
End If

End If
End If
End Sub

[ 本帖最后由 超然 于 2009-4-29 14:30 编辑 ]
页: 1 [2]
查看完整版本: 请教高手VB右键菜单问题(莫非论坛无高手?)