VB6 Отключить системный звуковой сигнал, когда стрелка вверх / вниз нажата внутри расширенного текстового поля?

Question

У меня есть элемент управления Rich Text Box. У него нет полос прокрутки, потому что я использую модуль колеса мыши для захвата событий колеса мыши.

Когда поле расширенного текста выбрано и колесо мыши вращается вверх / вниз, он посылает клавиши {UP} и {DOWN} в поле расширенного текста, чтобы "имитировать" эффект прокрутки.

Однако, когда вы находитесь в начале или в конце содержимого текстового поля (например, больше нечего прокручивать), звучит раздражающий звуковой сигнал системы. Мне нужно отключить это, есть идеи, как это сделать?

Уже пытался добавить этот код в событие нажатия клавиш в расширенном текстовом поле:

If KeyAscii = 38 Or KeyAscii = 40 Then
KeyAscii = 0
End If

Не работает Не знаю, почему это просто не работает, когда это должно работать.

Answer 1

Использовать KeyDown событие вместо KeyPressи отключить KeyCode только если курсор находится в первой / последней строке, чтобы полностью не отключить клавиши со стрелками (вверх / вниз).

Для начала необходимо добавить следующее в объявления:

Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Const EM_LINEFROMCHAR = &HC9
Private Const EM_GETLINECOUNT = &HBA

Private Function GetCurrentLine(Txt As RichTextBox) As Long
    GetCurrentLine = SendMessage(Txt.hWnd, EM_LINEFROMCHAR, Txt.SelStart, 0&) + 1
End Function

Private Function GetLineCount(Txt As RichTextBox) As Long
    GetLineCount = SendMessage(Txt.hWnd, EM_GETLINECOUNT, 0&, 0&)
End Function

Затем используйте KeyDown событие как описано:

Private Sub RichTextBox1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyUp Then
        If GetCurrentLine(RichTextBox1) = 1 Then KeyCode = 0
    ElseIf KeyCode = vbKeyDown Then
        If GetCurrentLine(RichTextBox1) = GetLineCount(RichTextBox1) Then KeyCode = 0
    End If
End Sub

Конечно, вам нужно заменить RichTextBox1 с именем вашего RichTextBox.

Надеюсь, это поможет:)

Answer 2

Вне функции / суб

Public Declare Function SendMessageByVal Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

В вашем суб / функции

Ret = SendMessageByVal(gRtfHwnd, EM_SETEDITSTYLE, SES_ALLOWBEEPS + SES_USECRLF, SES_ALLOWBEEPS + SES_USECRLF)

Чтобы увидеть больше, смотрите http://ambracode.com/index/show/1405175 который является некоторой копией старого поста, который я сделал в SO.