|
|
Текстовое Поле (MultiLine TextBox) - Вертикальная прокрутка колесом мышки (API) от CARDA Consultants Inc. (+ пример)
Модуль:
Option Compare Database
Option Explicit
Private Const sModName = "mod_ScrollingTextBox"
Public Const WM_VSCROLL = &H115
Public Const WM_HSCROLL = &H114
Public Const SB_LINEUP = 0
Public Const SB_LINEDOWN = 1
Public Const SB_PAGEUP = 2
Public Const SB_PAGEDOWN = 3
Public Declare PtrSafe Function apiGetFocus Lib "user32" Alias "GetFocus" _
() As Long
Public Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Integer, _
ByVal lParam As Any) As Long
Option Compare Database
Option Explicit
Private Const sModName = "Form_frm_DB_AboutEULA"
Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
On Error GoTo Error_Handler
Dim i As Long
If ActiveControl.ControlType = acTextBox Then
For i = 1 To Abs(Count)
SendMessage apiGetFocus, WM_VSCROLL, IIf(Count < 0, SB_LINEUP, SB_LINEDOWN), 0&
Next
End If
Error_Handler_Exit:
On Error Resume Next
Exit Sub
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: " & sModName & "\Form_MouseWheel" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Sub
MSA-2003 x86 + x64 ( 230 kB) Пример
|
|