DataGrid и колесико мышки

[Summer.05]

Скажите, пожалуйста, можно ли управлять посредством вращения колесика мышки перемещением строк в DataGrid?

Если можно, то КАК?

Спасибо!

[GSerg]

Поиском по форуму. Я выкладывал код.

[Summer.05]

GSerg
Прости, но найти не удалось.
Может быть, не так искал?
Дашь наводку?

[Antonariy]

Код: Выделить всё

'в модуле
Option Explicit

Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Const GWL_WNDPROC = -4

Public lpPrevWndProc As Long

Public gList As DataGrid

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error Resume Next
    If uMsg = 522 Then
        If Abs(wParam) = 7864320 Then
            gList.Scroll 0, -(wParam / Abs(wParam))
        Else
            gList.Scroll 0, -(wParam / Abs(wParam)) * 10
        End If
    End If
    WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Function

'в форме
Sub Form_Load()
    Set gList = dgList
    lpPrevWndProc = SetWindowLong(dgList.hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Sub Form_Unload
    SetWindowLong dgList.hwnd, GWL_WNDPROC, lpPrevWndProc
End Sub



Для большей универсализации можно отказаться от lpPrevWndProc и gList, а передавать ее и ObjPtr(gList) через SendMessage в оконную процедуру и хранить в статических переменных. И еще одним SendMessage подавать команду на восстановление старой процедуры.
PS: Забыли AddressOf добавить в список ключевых слов

[Summer.05]

Antonariy
Спасибо, Повелитель!

[Antonariy]

Собственно, вот оно:

Код: Выделить всё

Option Explicit
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const GWL_WNDPROC = -4
Private Const WM_USER = &H400
Private Const WM_SETPREVPTR = WM_USER + 1
Private Const WM_SETGRID = WM_USER + 2
Private Const WM_RESTORE = WM_USER + 3

Public Sub AddScroll(Grid As DataGrid)
Dim p As Long
    p = SetWindowLong(Grid.hwnd, GWL_WNDPROC, AddressOf WindowProc)
    SendMessage Grid.hwnd, WM_SETPREVPTR, p, 0
    SendMessage Grid.hwnd, WM_SETGRID, ObjPtr(Grid), 0
End Sub

Public Sub RemoveScroll(Grid As DataGrid)
    SendMessage Grid.hwnd, WM_RESTORE, 0, 0
End Sub

Private Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Static lpPrevWndProc As Long
Static GridPtr As Long
Dim gList As Object
    If lpPrevWndProc = 0 And uMsg < WM_USER Then Exit Function
    Select Case uMsg
        Case 522
            If GridPtr <> 0 Then
                Set gList = ObjFromPtr(GridPtr)
                If Abs(wParam) = 7864320 Then
                    gList.Scroll 0, -(wParam / Abs(wParam))
                Else
                    gList.Scroll 0, -(wParam / Abs(wParam)) * 10
                End If
            End If
        Case WM_SETPREVPTR
            lpPrevWndProc = wParam
        Case WM_SETGRID
            GridPtr = wParam
        Case WM_RESTORE
            SetWindowLong hw, GWL_WNDPROC, lpPrevWndProc
    End Select
    WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Function

Private Function ObjFromPtr(lObjPtr As Long) As Object
Dim LoTmp As Object
    If lObjPtr <> 0 Then
        CopyMemory LoTmp, lObjPtr, 4
        Set ObjFromPtr = LoTmp
        CopyMemory LoTmp, 0&, 4
    End If
End Function

А можно еще более упростить, отказавшись от RemoveScroll и восстанавливая старую процедуру по WM_CLOSE.

[Summer.05]

Antonariy
Попробу и доложу!
Спсибо за отзывчивость и внимание!

[GSerg]

К сожалению, немного некорректный код...
Дельту надо накапливать (см. MSDN), потому что в будущих девайсах точность её поступления может быть слишком высока, чтобы крутить сразу.

http://bbs.vbstreets.ru/viewtopic.php?p=6604560#6604560

[Antonariy]

Код посмотрел, но не понял причем тут дельта. Поворот колеса на один "зубчик" дает одно событие 522, грид скроллится на одну строку. Хочешь сказать, что в будущих девайсах один "зубчик" может дать несколько событий? И можно ссылку?

[GSerg]

Ссылка.

The wheel rotation will be a multiple of WHEEL_DELTA, which is set at 120. This is the threshold for action to be taken, and one such action (for example, scrolling one increment) should occur for each delta.

The delta was set to 120 to allow Microsoft or other vendors to build finer-resolution wheels in the future, including perhaps a freely-rotating wheel with no notches. The expectation is that such a device would send more messages per rotation, but with a smaller value in each message. To support this possibility, you should either add the incoming delta values until WHEEL_DELTA is reached (so for a delta-rotation you get the same response), or scroll partial lines in response to the more frequent messages. You could also choose your scroll granularity and accumulate deltas until it is reached.