控制ms以连续形式访问滚动条

时间:2016-09-02 18:02:53

标签: windows vba winapi access-vba scrollbar

我以连续的形式实施拖放模拟。

基本上它的工作方式是,侧面有人员列表,用户可以将一个人从列表拖到一个字段,(这是一个座位列表,包括Seat1,Seat2,seat3 ......等字段... ,每个座位行都是新记录。)

对于基本的拖放功能,我使用此链接Drag And Drop中的说明,它运行良好。

现在这是我的问题,要知道用户正在移动鼠标的哪条记录我需要计算鼠标的位置除以细节部分,因此表格不会向下滚动它工作得很好,但是当表单向下滚动时,我首先需要知道表单有多少,这只能通过Windows API实现。

所以我发现www.lebans.com/conformscurcontrol.htm完全具有我需要的代码,但这只适用于旧版本的ms访问,在新版本中突破的代码是,他正在检查窗口类名称"滚动条"并在其上调用GetScrollInfo API,但在较新的版本中没有名为"滚动条"的类,但是还有一个名为NUIScrollbar See Here的类,但即使将其更改为此名称,我也不会#39;取回有效的滚动条类(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 *********

希望我足够清楚,任何帮助都会受到赞赏。

1 个答案:

答案 0 :(得分: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
...