Menü mit _KeyDown() -Event für Strg und Shift


Das Menü in VB besitzt leider kein _KeyDown() -Event für Strg und Shift. Hier nun ein Script mit dem Sie diesen Fehler für die Shift-Tasten ausbügeln können.
Laden Sie sich die Zip-Datei mit VB 6 Source Code hinunter und probieren Sie es mal aus.

Projekt - Download
© FienauBerlin   Web-ComputerEcke.de
 

Quell-Code
Option Explicit
 
Private Declare Function GetAsyncKeyState Lib _
   "user32.dll" (ByVal nVirtKey As Long) As Integer
 
Private Const KeyPressed As Integer = -32767
 
Dim sShift As Boolean, sStrg As Boolean

Private Sub a_Click() tmrHotKey.Enabled = True End Sub
Private Sub Label5_Click() tmrHotKey.Enabled = True PopupMenu b End Sub
'Hier fehl das mnu_KeyDown(KeyCode As Integer, Shift As Integer) Private Sub mnu_Click() Call Anwendung End Sub
Private Sub tmrHotKey_Timer() Dim HotKey1 As Long Dim HotKey2 As Long HotKey1 = vbKeyShift HotKey2 = vbKeyControl If GetAsyncKeyState(HotKey1) = KeyPressed Then sShift = True sStrg = False ElseIf GetAsyncKeyState(HotKey2) = KeyPressed Then sStrg = True sShift = False End If End Sub
Private Sub Anwendung() If sShift Then Me.BackColor = vbGreen Label4.BackColor = vbGreen '... Sonstiges ElseIf sStrg Then Me.BackColor = vbYellow Label4.BackColor = vbYellow '... Sonstiges Else Me.BackColor = vbRed Label4.BackColor = vbRed '... Sonstiges End If tmrHotKey.Enabled = False sShift = False sStrg = False End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyShift Then sShift = True ElseIf KeyCode = vbKeyControl Then sStrg = True End If End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) sShift = False sStrg = False End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _ X As Single, Y As Single) tmrHotKey.Enabled = False Me.BackColor = &H8000000F Label4.BackColor = &H8000000F End Sub
'******************************* INTERN ***************************** Private Sub mnu2_Click() Call Anwendung End Sub
Private Sub pop_Click() mnu_Click End Sub
Private Sub Label4_Click() Me.BackColor = &H8000000F Label4.BackColor = &H8000000F End Sub
Private Sub Timer1_Timer() Label1.Caption = "Shift: " & sShift Label2.Caption = "Strg: " & sStrg Label3.Caption = "Timer: " & tmrHotKey.Enabled End Sub