vba - 以连续形式控制 ms Access 滚动条

Question

我正在以连续的形式实现拖放模拟。

基本上它的工作方式是，旁边有一个人列表，用户可以将一个人从列表拖到一个字段，(这是一个座位列表，有 Seat1，Seat2，seat3 等字段...... ，每一排座位都是一条新记录)。

对于基本的拖放功能，我正在使用此链接 Drag And Drop 中的说明，而且效果很好。

现在这是我的问题，要知道用户在哪条记录上移动鼠标，我需要计算鼠标的位置除以详细信息部分，这样当表单没有向下滚动时它运行良好，但是当表单向下滚动时，我需要首先知道表单向下滚动了多少，这只能通过 Windows API 来完成。

所以我发现 www.lebans.com/conformscurcontrol.htm 有我需要的代码，但它只在旧版本的 ms access 中有效，在新版本中中断的代码是，他正在检查一个窗口类名称“scrollbar”并在其上调用 GetScrollInfo API，但在较新的版本中没有名为“scrollbar”的类，但有一个名为 NUIScrollbar 的类 See Here ，但即使将其更改为此名称，我也不会返回有效的滚动条类 (LPSCROLLINFO)。

这是 Stephen Lebans 的代码

Public Function fGetScrollBarPos(frm As Form) As Long
' Return ScrollBar Thumb position
' for the Vertical Scrollbar attached to the
' Form passed to this Function.

Dim hWndSB As Long
Dim lngRet As Long
Dim sinfo As SCROLLINFO

    ' Init SCROLLINFO structure
    sinfo.fMask = SIF_ALL
    sinfo.cbSize = Len(sinfo)
    sinfo.nPos = 0
    sinfo.nTrackPos = 0

    ' Call function to get handle to
    ' ScrollBar control if it is visible
    hWndSB = fIsScrollBar(frm)
    If hWndSB = -1 Then
        fGetScrollBarPos = False
        Exit Function
    End If

    ' Get the window's ScrollBar position
    lngRet = apiGetScrollInfo(hWndSB, SB_CTL, sinfo)
    'Debug.Print "nPos:" & sInfo.nPos & "  nPage:" & sInfo.nPage & "  nMax:" & sInfo.nMax
    fGetScrollBarPos = sinfo.nPos + 1

End Function

Private Function fIsScrollBar(frm As Form) As Long
' Get ScrollBar's hWnd
Dim hWnd_VSB As Long
Dim hWnd As Long

hWnd = frm.hWnd

    ' Let's get first Child Window of the FORM
    hWnd_VSB = apiGetWindow(hWnd, GW_CHILD)

    ' Let's walk through every sibling window of the Form
    Do
        ' Thanks to Terry Kreft for explaining
        ' why the apiGetParent acll is not required.
        ' Terry is in a Class by himself! :-)
        'If apiGetParent(hWnd_VSB) <> hWnd Then Exit Do

这是古老的和平

        If fGetClassName(hWnd_VSB) = "scrollBar" Then
            If apiGetWindowLong(hWnd_VSB, GWL_STYLE) And SBS_VERT Then
                fIsScrollBar = hWnd_VSB
                Exit Function
            End If
        End If

这就是我尝试替换它的方式

        If fGetClassName(hWnd_VSB) = "NUIScrollbar" Then
            If apiGetWindowLong(hWnd_VSB, GWL_STYLE) And 1107296256 Then
                fIsScrollBar = hWnd_VSB
                Exit Function
            End If
        End If

继续函数

    ' Let's get the NEXT SIBLING Window
    hWnd_VSB = apiGetWindow(hWnd_VSB, GW_HWNDNEXT)

    ' Let's Start the process from the Top again
    ' Really just an error check
    Loop While hWnd_VSB <> 0

    ' SORRY - NO Vertical ScrollBar control
    ' is currently visible for this Form
    fIsScrollBar = -1
End Function


' From Dev Ashish's Site
' The Access Web
' http://www.mvps.org/access/

'******* Code Start *********
Private Function fGetClassName(hWnd As Long)
Dim strBuffer As String
Dim lngLen As Long
Const MAX_LEN = 255
    strBuffer = Space$(MAX_LEN)
    lngLen = apiGetClassName(hWnd, strBuffer, MAX_LEN)
    If lngLen > 0 Then fGetClassName = Left$(strBuffer, lngLen)
End Function
'******* Code End *********

希望我说得够清楚，感谢任何帮助。

Answer 1

遇到同样的问题，以下似乎有效:

Public Const SB_HORZ As Long = 0                ' &H0 (32 bit)
Public Const SB_VERT As Long = 1                ' &H1 (32 bit)
Public Const SB_CTL As Long = 2
Public Const SB_BOTH As Long = 3
Public Const SB_HORZ64_0 As Long = 1107296256   ' &H42000000 (64 bit - invisible)
Public Const SB_VERT64_0 As Long = 1107296257   ' &H42000001 (64 bit - invisible)
Public Const SB_HORZ64_1 As Long = 1375731712   ' &H52000000 (64 bit - visible)
Public Const SB_VERT64_1 As Long = 1375731713   ' &H52000001 (64 bit - visible)
...
eWindowStyle = GetWindowLong(ehWnd, GWL_STYLE)
Select Case eWindowStyle
Case SB_HORZ, SB_HORZ64_0, SB_HORZ64_1
    ' *** Horizontal
    wWinAPIhWndScrollbarHorz = ehWnd
Case SB_VERT, SB_VERT64_0, SB_VERT64_1
    ' *** Vertikal
    wWinAPIhWndScrollbarVert = ehWnd
End Select
...