VBA, MS Access MS Access в примерах

Текстовое Поле (MultiLine TextBox) - Вертикальная прокрутка колесом мышки (API) от CARDA Consultants Inc. (+ пример)

Модуль:
mod_ScrollingTextBox:

'***************************************************************************************
' Module    : mod_ScrollingTextBox
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Copyright : Please note that U.O.S. all the content herein considered to be
'             intellectual property (copyrighted material).
'             The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'***************************************************************************************

Option Compare Database
Option Explicit

Private Const sModName = "mod_ScrollingTextBox"

'Scrolling Constants
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




Модуль Формы:

'***************************************************************************************
' Module    : Form_frm_DB_AboutEULA
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Copyright : Please note that U.O.S. all the content herein considered to be
'             intellectual property (copyrighted material).
'             The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'***************************************************************************************

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&
            'The following line would flip the scrolling direction of the mousewheel
'            SendMessage CtlHwnd, WM_VSCROLL, IIf(Count < 0, SB_LINEDOWN, SB_LINEUP), 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


Picture




Скачать

MSA-2003 x86 + x64 ( 230 kB) Пример


Назад ToTop
L.E. 01.07.2022
Рейтинг@Mail.ru