2016-11-23 21 views
2

У меня есть программа vb 6, в которой форма открывается, как слайдер Power Point. Я создал текстовое поле для ввода входов клавиатуры, таких как esc, левая клавиша, правая клавиша, клавиша «вверх» или «вниз», как в MS Силовая установка. Однако при добавлении многих элементов управления в форму пользователь может щелкнуть по любому из них, а ключевой код, прикрепленный к моему элементу управления текстовыми полями (который я назвал 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 

Есть ли у кого-нибудь код, который может помочь мне получить ввод с клавиатуры без привязки к нему.

Кстати, меню очень круто, так как ввод в клавиатуру будет легко захвачен независимо от того, какой элемент управления сосредоточен. Я не хочу использовать меню в этой форме, если только он не может быть скрыт.

+2

[KeyPreview недвижимости : MSDN Visual Basic Reference] (https://msdn.microsoft.com/en-us/library/aa235137 (v = vs.60) .aspx) –

+0

, но я ничего не вижу рядом с тем, что вы указали –

+0

Кроме того, вы можете захотеть для рассмотрения использования «Select Case KeyCode», «Case 32», «cmdPlay_Click», «Case ...», «End Select». То, как вы его закодировали, * все * операторы «If» выполняются по * каждому нажатию клавиши. – Herb

ответ

2

Чтобы осуществить то, что вы хотите:

  • Существует функция, которая должна быть объявлена ​​в верхней части, как вы будете видеть в моем коде.
  • Затем напишите функцию, чтобы получить элементы управления, нажатые на вашей клавиатуре .
  • Вам нужен цикл или что-то вроде таймера с интервал 1000 использовать для вызова вашей функции

Вот измененный код, который реализует то, что вы хотели

'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 
+0

спасибо, сэр за такой приятный ответ, который работает как шарм –

Смежные вопросы