| Вопрос: Колесико мыши в Datagrid | Добавлено: 25.10.06 23:06 |
Автор вопроса:  Alex&r
|
| Хочу сделать скроллинг в Datagrid при помощи колесика мыши, подскажите как это лучше сделать? |
| Ответы | Всего ответов: 6 |
|
Номер ответа: 1 Автор ответа:  HACKER Разработчик Offline Client Вопросов: 236 Ответов: 8362 |
Профиль | | #1 | Добавлено: 26.10.06 03:18 |
| хукнуть мышь | ||
|
Номер ответа: 2 Автор ответа: astoro ICQ: 649109 Вопросов: 31 Ответов: 391 |
Профиль | | #2 | Добавлено: 26.10.06 07:50 |
| http://www.vbnet.ru/faq/showtopic.asp?id=436 | ||
|
Номер ответа: 3 Автор ответа: LamerOnLineICQ: 334781088 Вопросов: 108 Ответов: 2822 |
Профиль | | #3 | Добавлено: 26.10.06 11:10 |
| Есть еще утилитка хорошая от IntelliPoint. После запуска и в VB прокрутка работает. | ||
|
Номер ответа: 4 Автор ответа: GSergВопросов: 0 Ответов: 1876 
|
Профиль | | #4 | Добавлено: 26.10.06 13:33 |
| На DataGrid она не действует. | ||
|
Номер ответа: 5 Автор ответа: avdeyICQ: 219571279 Вопросов: 34 Ответов: 486 |
Профиль | | #5 | Добавлено: 26.10.06 13:48 |
| Я делал скрол в MHFlexGrid, хук на мышь, и при скроле менял RowSelected и имитировал нажатие Up и Down... Конечно не так как нормальный скрол, но работает. Могу скинуть примерчик... | ||
|
Номер ответа: 6 Автор ответа:  AKE Вопросов: 0 Ответов: 7 |
Профиль | | #6 | Добавлено: 26.10.06 22:51 |
|
Недавно сам мучался. Извини, недоделал до ума. Получилось так:
======== Module1.bas ============== Option Explicit Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _ ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 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 Private Const WM_MOUSEWHEEL = &H20A Public OldABProc As Long Private Const GWL_WNDPROC = (-4) Sub HookON(hwnd As Long) OldABProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf SwapProcAB) End Sub Sub HookOFF(hwnd As Long) SetWindowLong hwnd, GWL_WNDPROC, OldABProc End Sub Function SwapProcAB(ByVal hwnd As Long, ByVal MSG As Long, ByVal _ wParam As Long, ByVal lParam As Long) As Long  im lReturn As Long
lReturn = CallWindowProc(OldABProc, hwnd, MSG, wParam, lParam) If MSG = WM_MOUSEWHEEL Then Form1.ScrollFlex wParam SwapProcAB = lReturn End Function ======== Form1.frm =========== Option Explicit Dim nScrolRow As Integer, nScrolRowWork As Integer Sub Form_Load() im nCikl As Long
nScrolRow = 3 nScrolRowWork = nScrolRow MSFlexGrid1.Col = 1 For nCikl = 1 To 40 MSFlexGrid1.Row = nCikl MSFlexGrid1.Text = nCikl Next nCikl Call HookON(Me.hwnd) ' Включить перехват события от колеса мыши End Sub Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) Call HookOFF(Me.hwnd) ' ОТКЛЮЧИТЬ перехват события от колеса мыши Unload Form1 Exit Sub End Sub Sub ScrollFlex(nKuda As Long) ' Событие колеса мыши If nKuda > 0 Then Scroll_UP Else Scroll_Down End If Text4.Text = nKuda End Sub Private Sub Scroll_Down() ' Вниз im nRows As Long, nStepRows As Long
On Error GoTo ErrorUnload Text2.Text = "Едем вниз..." Text3.Text = " " nScrolRowWork = nScrolRow ' Восстановить кол-во рядов nRows = MSFlexGrid1.Rows nStepRows = MSFlexGrid1.TopRow + nScrolRowWork If nRows > nStepRows Then MSFlexGrid1.TopRow = MSFlexGrid1.TopRow + nScrolRowWork MSFlexGrid1.SetFocus Exit Sub ErrorUnload: Text3.Text = "Ошибка ВНИЗ..." Call Form_QueryUnload(1, 1) End Sub Private Sub Scroll_UP() ' Вверх im nNewRows As Long
On Error GoTo ErrorUnload Text2.Text = "Едем ВВЕРХ..." Text3.Text = " " nNewRows = MSFlexGrid1.TopRow - nScrolRowWork If nNewRows > 0 Then ' Если вычисленный новый ряд больше нуля MSFlexGrid1.TopRow = MSFlexGrid1.TopRow - nScrolRowWork 'Присвоить новый ряд nScrolRowWork = nScrolRow ' Восстановить кол-во рядов Else ' Если вычисленный новый ряд меньше или равен нулю If nScrolRowWork > 0 Then nScrolRowWork = nScrolRowWork - 1 ' Уменьшаем уменьшитель nNewRows = MSFlexGrid1.TopRow - nScrolRowWork If nNewRows > 0 Then ' Если вновь вычисленный новый ряд больше нуля MSFlexGrid1.TopRow = MSFlexGrid1.TopRow - nScrolRowWork 'Присвоить новый ряд Else ' Если вычисленный новый ряд меньше или равен нулю - все кончено If nNewRows = 0 Then nScrolRowWork = nScrolRow ' Восстановить кол-во рядов End If End If MSFlexGrid1.SetFocus Text1.Text = nNewRows Exit Sub ErrorUnload: Text3.Text = "Ошибка вверх..." Call Form_QueryUnload(1, 1) End Sub ========= Исходник - не помню где взял... =========== Атор: hedgehog Аналогично решал недавно для флексгрида - через субклассинг: в модуле: Public Declare Function SetWindowLong _ Lib "user32" Alias "SetWindowLongA" ( _ ByVal hwnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long 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 Private Const WM_MOUSEWHEEL = &H20A Function SwapProcAB(ByVal hwnd As Long, ByVal Msg As Long, ByVal _ wParam As Long, ByVal lParam As Long) As Long im lReturn As Long
lReturn = CallWindowProc(formname.OldABProc, hwnd, Msg, wParam, lParam) Select Case Msg Case WM_MOUSEWHEEL formname.ScrollFlex wParam End Select SwapProcAB = lReturn End Function в форме: Public OldABProc As Long Private Const GWL_WNDPROC = (-4) Private Sub Form_Load() ... OldABProc = SetWindowLong(Flex1.hwnd, GWL_WNDPROC, AddressOf SwapProcAB) End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) ... SetWindowLong Flex1.hwnd, GWL_WNDPROC, OldABProc End Sub Переделай под себя аналогично - у меня работает отлично. |
||
Страница: 1 |