我有一个vb 6程序,其中表单打开就像一个电源点幻灯片我创建了一个文本框,用于获取键盘输入,如esc,左键,右键,上键或下键,就像在MS Powerpoint中一样。然而,当向表单添加许多控件时,用户可能会点击它们中的任何一个以及附加到我的文本框控件(我称之为cmdline)的键码,除非我向其他控件添加另一个代码以强制将光标的焦点强加到cmdline
Private Sub cmdline_KeyDown(KeyCode As Integer, Shift As Integer)
'Space Key
If KeyCode = 32 Then
cmdPlay_Click
End If
'Page Up Key
If KeyCode = 33 Then
showFirstStanza
End If
'Page Down Key
If KeyCode = 34 Then
showLastStanza
End If
'End Key
If KeyCode = 35 Then
showLastStanza
End If
'Home Key
If KeyCode = 36 Then
showFirstStanza
End If
'Left key
If KeyCode = 37 Then
SavedThis = SaveSettings("projection_font_size", SiteSettings("projection_font_size") - 2)
lblSongText.FontSize = SiteSettings("projection_font_size")
End If
'Up Key
If KeyCode = 38 Then
cmdPrev_Click
End If
'Right Arrow
If KeyCode = 39 Then
SavedThis = SaveSettings("projection_font_size", SiteSettings("projection_font_size") + 2)
lblSongText.FontSize = SiteSettings("projection_font_size")
End If
'Down Arrow
If KeyCode = 40 Then
cmdNext_Click
End If
'Key C
If KeyCode = 67 Then
fonttypez = fonttypez - 1
Select Case fonttypez
Case 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14
font_type_tosave
Case Else
fonttypez = 13
font_type_tosave
End Select
font_type_int
lblSongText.FontName = SiteSettings("projection_font_type")
End If
'Key V
If KeyCode = 86 Then
fonttypez = fonttypez + 1
Select Case fonttypez
Case 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14
font_type_tosave
Case Else
fonttypez = 13
font_type_tosave
End Select
font_type_int
lblSongText.FontName = SiteSettings("projection_font_type")
End If
'Key X
If KeyCode = 88 Then
kala = kala + 1
Select Case kala
Case 1, 2, 3, 4, 5, 6, 7, 8
SavedThis = SaveSettings("preffered_theme", kala)
Case Else
kala = 1
SavedThis = SaveSettings("preffered_theme", kala)
End Select
SetProjectionTheme
End If
'Key Z
If KeyCode = 90 Then
kala = kala - 1
Select Case kala
Case 1, 2, 3, 4, 5, 6, 7, 8
SavedThis = SaveSettings("preffered_theme", kala)
Case Else
kala = 1
SavedThis = SaveSettings("preffered_theme", kala)
End Select
SetProjectionTheme
End If
'Add Key
If KeyCode = 107 Then
SavedThis = SaveSettings("projection_font_size", SiteSettings("projection_font_size") + 2)
lblSongText.FontSize = SiteSettings("projection_font_size")
End If
'Subtract Key
If KeyCode = 109 Then
SavedThis = SaveSettings("projection_font_size", SiteSettings("projection_font_size") - 2)
lblSongText.FontSize = SiteSettings("projection_font_size")
End If
End Sub
是否有人有一个代码可以帮助我获得键盘输入而无需附加控件。
顺便说一下,使用菜单非常酷,因为无论聚焦哪个控件,都可以轻松捕捉键盘输入。我不想使用此表单上的菜单,除非它可以被隐藏。
答案 0 :(得分:2)
实现您想要的目标:
以下是实现您想要的修改代码
'declare this function at the top of your form:
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Function getControls()
'Space Key
If GetAsyncKeyState(vbKeySpace) <> 0 Then 'code 32
cmdPlay_Click
End If
'Page Up Key
If GetAsyncKeyState(vbKeyPageUp) <> 0 Then 'code 33
showFirstStanza
End If
'Page Down Key
If GetAsyncKeyState(vbKeyPageDown) <> 0 Then 'code 34
showLastStanza
End If
'End Key
If GetAsyncKeyState(vbKeyEnd) <> 0 Then 'code 35
showLastStanza
End If
'Home Key
If GetAsyncKeyState(vbKeyHome) <> 0 Then 'code 36
showFirstStanza
End If
'Left key
If GetAsyncKeyState(vbKeyLeft) <> 0 Then 'code 37
SavedThis = SaveSettings("projection_font_size", SiteSettings("projection_font_size") - 2)
lblSongText.FontSize = SiteSettings("projection_font_size")
End If
'Up Key
If GetAsyncKeyState(vbKeyUp) <> 0 Then 'code 38
cmdPrev_Click
End If
'Right Arrow
If GetAsyncKeyState(vbKeyRight) <> 0 Then 'code 39
SavedThis = SaveSettings("projection_font_size", SiteSettings("projection_font_size") + 2)
lblSongText.FontSize = SiteSettings("projection_font_size")
End If
'Down Arrow
If GetAsyncKeyState(vbKeyDown) <> 0 Then 'code 40
cmdNext_Click
End If
'Key C
If GetAsyncKeyState(vbKeyC) <> 0 Then 'code 67
fonttypez = fonttypez - 1
Select Case fonttypez
Case 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14
font_type_tosave
Case Else
fonttypez = 13
font_type_tosave
End Select
font_type_int
lblSongText.FontName = SiteSettings("projection_font_type")
End If
'Key V
If GetAsyncKeyState(vbKeyV) <> 0 Then 'code 87
fonttypez = fonttypez + 1
Select Case fonttypez
Case 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14
font_type_tosave
Case Else
fonttypez = 13
font_type_tosave
End Select
font_type_int
lblSongText.FontName = SiteSettings("projection_font_type")
End If
'Key X
If GetAsyncKeyState(vbKeyX) <> 0 Then 'code 88
kala = kala + 1
Select Case kala
Case 1, 2, 3, 4, 5, 6, 7, 8
SavedThis = SaveSettings("preffered_theme", kala)
Case Else
kala = 1
SavedThis = SaveSettings("preffered_theme", kala)
End Select
SetProjectionTheme
End If
'Key Z
If GetAsyncKeyState(vbKeyZ) <> 0 Then 'code 90
kala = kala - 1
Select Case kala
Case 1, 2, 3, 4, 5, 6, 7, 8
SavedThis = SaveSettings("preffered_theme", kala)
Case Else
kala = 1
SavedThis = SaveSettings("preffered_theme", kala)
End Select
SetProjectionTheme
End If
'Add Key
If GetAsyncKeyState(vbKeyAdd) <> 0 Then 'code 107
SavedThis = SaveSettings("projection_font_size", SiteSettings("projection_font_size") + 2)
lblSongText.FontSize = SiteSettings("projection_font_size")
End If
'Subtract Key
If GetAsyncKeyState(vbKeySubtract) <> 0 Then 'code 109
SavedThis = SaveSettings("projection_font_size", SiteSettings("projection_font_size") - 2)
lblSongText.FontSize = SiteSettings("projection_font_size")
End If
'ESCAPE KEY
If GetAsyncKeyState(vbKeyEscape) <> 0 Then
Unload Me
End If
End Function
Private Sub trmListen_Timer()
Call getControls
End Sub