Grab'n'Drag для Windows (перетаскивание рабочей области мышью)

Option Explicit
 
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Type MSLLHOOKSTRUCT
    pt As POINTAPI
    mouseData As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type
Type SCROLLINFO
    cbSize As Long
    fMask As Long
    nMin As Long
    nMax As Long
    nPage As Long
    nPos As Long
    nTrackPos As Long
End Type
 
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Integer, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
'Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function ScrollWindowExLong Lib "user32" Alias "ScrollWindowEx" (ByVal hwnd As Long, ByVal dx As Long, ByVal dy As Long, ByVal lprcScroll As Long, ByVal lprcClip As Long, ByVal hrgnUpdate As Long, ByVal lprcUpdate As Long, ByVal fuScroll As Long) As Long
'Private Declare Function ScrollWindowExLong Lib "user32" Alias "ScrollWindowEx" (ByVal hwnd As Long, ByVal dx As Long, ByVal dy As Long, lprcScroll As Long, lprcClip As Long, ByVal hrgnUpdate As Long, lprcUpdate As Long, ByVal fuScroll As Long)
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _
        ByVal lpClassName As String, _
        ByVal nMaxCount As Long) As Long
Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetScrollInfo Lib "user32" (ByVal hwnd As Long, ByVal n As Long, lpScrollInfo As SCROLLINFO) As Long
Private Declare Function SetScrollInfo Lib "user32" (ByVal hwnd As Long, ByVal n As Long, lpcScrollInfo As SCROLLINFO, ByVal bool As Boolean) As Long
                             
Private Const WH_MOUSE_LL = &HE&
Private Const HC_ACTION = 0
Private Const LLKHF_INJECTED = &H10
Private Const LLMHF_INJECTED = 1
Private Const WM_KEYDOWN As Long = &H100
Private Const WM_KEYUP As Long = &H101
Private Const WM_SYSKEYDOWN As Long = &H104
Private Const WM_SYSKEYUP As Long = &H105
Private Const WM_MOUSEMOVE As Long = &H200
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const WM_LBUTTONUP As Long = &H202
Private Const WM_MBUTTONDOWN As Long = &H207
Private Const WM_MBUTTONUP As Long = &H208
Private Const WM_RBUTTONDOWN As Long = &H204
Private Const WM_RBUTTONUP As Long = &H205
Private Const WM_MOUSEWHEEL As Long = &H20A
 
Private Const SW_ERASE = &H4
Private Const SW_INVALIDATE = &H2
Private Const SW_SCROLLCHILDREN = &H1
 
Dim hMouseHook As Long
 
Public Sub Hook()
    hMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
    If hMouseHook = 0 Then
        MsgBox ("Mouse hook error")
    Else
        ThisWorkbook.Names("hookCell").RefersToRange = hMouseHook
    End If
End Sub
Public Sub UnHook()
    If hMouseHook Then UnhookWindowsHookEx (hMouseHook): hMouseHook = 0
End Sub
 
Private Function LowLevelMouseProc(ByVal uCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long
    Static mbOn&, lbOn&, rbOn&, prevPt As POINTAPI, cHwnd&
    Dim classname$                'переменная для имени класса
    Dim slength&                  'длина строки имени класса
    
    If hMouseHook = 0 Then 'аварийный блок
        hMouseHook = ThisWorkbook.Names("hookCell").RefersToRange 'Range("hookCell")
        UnHook
        Range("hookCell").ClearContents
        Debug.Print "Авария!"
    End If
    
    If uCode = HC_ACTION Then
        Select Case wParam
        
        Case WM_MOUSEMOVE
            If mbOn Or rbOn Then
                With lParam
                  ScrollWindowExLong cHwnd, (.pt.x - prevPt.x), (.pt.y - prevPt.y), _
                      ByVal 0&, ByVal 0&, 0&, ByVal 0&, SW_INVALIDATE 'SW_SCROLLCHILDREN Or SW_ERASE Or
                  UpdateWindow cHwnd
                  'SetScrollInfo... '????????????????
                  
                  prevPt = .pt
                End With
            End If
        
        Case WM_MBUTTONDOWN         'средняя кнопка (колесо) нажата
            cHwnd = WindowFromPoint(lParam.pt.x, lParam.pt.y)
            classname = Space(50&)
            slength = GetClassName(cHwnd, classname, 50&)
            classname = Left$(classname, slength)
'            Debug.Print classname
            Select Case classname
              Case "VbaWindow", "Edit", "Scintilla", "OIS Collection Window" ', "AVL_AVView"
                  prevPt = lParam.pt
                  mbOn = 1
            End Select
            
        Case WM_MBUTTONUP
            mbOn = 0
            
        Case WM_LBUTTONDOWN
            lbOn = 1
                        
        Case WM_LBUTTONUP
            lbOn = 0
        
        Case WM_RBUTTONDOWN
            If lbOn Then              'если нажата одновременно левая и потом пр. кн. мыши
                cHwnd = WindowFromPoint(lParam.pt.x, lParam.pt.y)
                classname = Space(50&)
                slength = GetClassName(cHwnd, classname, 50&)
                classname = Left$(classname, slength)
                Select Case classname
                  Case "EXCEL7"
                      prevPt = lParam.pt
                      rbOn = 1
                End Select
            End If
            
        Case WM_RBUTTONUP
            rbOn = 0
            
        End Select
    End If
    LowLevelMouseProc = CallNextHookEx(hMouseHook, uCode, wParam, lParam)
End Function

Option Explicit
 
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const WM_HSCROLL As Long = &H114
Private Const SB_LINELEFT As Long = 0&
Private Const SB_LINERIGHT As Long = 1&
Private Const SB_THUMBPOSITION = 4&
 
Sub scrollingmolling()
    '***
    'получение hwnd скролл-бара
    'Стандартный скрол
    SendMessageLong hwnd, WM_HSCROLL, SB_LINERIGHT, 0&
    'Скрол на определенную позицию. HSB_Pos - текущая позиция скроллбара
    'почему надо умножать на 2^16 х.з.
    SendMessageLong& hwnd, WM_HSCROLL, (HSB_Pos * 2 ^ 16) Or SB_THUMBPOSITION, 0
    '***
End Sub

Dim sINFO As SCROLLINFO
sINFO.cbSize = Len(sINFO)
sINFO.fMask = SIF_RANGE Or SIF_PAGE Or SIF_POS
GetScrollInfo RichTextBox1.hWnd, SB_VERT, sINFO
If sINFO.nPos = sINFO.nMax - sINFO.nPage Then
Debug.Print "scrollbar is at bottom"
Else
Debug.Print "scrollbar is not at the bottom"
End If

Sub afasf()
    Dim sINFO As SCROLLINFO, xy As POINTAPI, cHwnd&
    GetCursorPos xy
    cHwnd& = WindowFromPoint(xy.x, xy.y)   
    sINFO.cbSize = Len(sINFO)
    sINFO.fMask = SIF_RANGE 'Or SIF_PAGE Or SIF_POS
    GetScrollInfo cHwnd, SB_VERT, sINFO
    If sINFO.nPos = sINFO.nMax - sINFO.nPage Then
        Debug.Print "scrollbar is at bottom"
    Else
        Debug.Print "scrollbar is not at the bottom"
    End If
End Sub

lret = PostMessage(pthWnd, WM_VSCROLL, SB_LINEUP, lhWnd) ' Scroll Up

[VB]lret = PostMessage(pthWnd, WM_VSCROLL, SB_LINEDOWN, lhWnd) ' Scroll Down