VBNet - Форум - Мастера субклассинга, спасайте снова

Вопрос: Мастера субклассинга, спасайте снова Добавлено: 07.07.03 15:59

Автор вопроса: hedgehog | Web-сайт: ezh.ru | ICQ: 175571327

Некоторое время назад искал решение по обработке скроллинга колесиком флексгрида. Решение тогда нашлось, особое спасибо CyRax. Вот только работает у меня это только на один контрол. Это хозяйство пытаюсь встроить в свой контрол. Даже если контролы на разных тестовых формах, скроллится только один. Что делаю не так? Код прилагаю :
модуль:
Option Explicit
Public OldProc As Long
Public Const WM_MOUSEWHEEL = &H20A
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
Public Flex As MSFlexGrid
Public Function SwapProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal _
        wParam As Long, ByVal lParam As Long) As Long
    Dim lReturn As Long
    lReturn = CallWindowProc(OldProc, hwnd, Msg, wParam, lParam)
    Select Case Msg
        Case WM_MOUSEWHEEL
            ScrollFlex wParam, hwnd
    End Select
    SwapProc = lReturn
End Function
Public Sub ScrollFlex(ByVal Direction As Long, ByVal hwnd As Long)
    Dim x As Integer

    x = IIf(Direction < 0, Flex.TopRow + 4, Flex.TopRow - 4)
    If x < Flex.FixedRows Then x = Flex.FixedRows
    If x > Flex.Rows - 1 Then x = Flex.Rows - 1
    Flex.TopRow = x
End Sub
контрол:
Private Sub UserControl_Initialize()
    Set Flex = MSFlexGrid1
    OldProc = SetWindowLong(Flex.hwnd, GWL_WNDPROC, AddressOf SwapProc)
End Sub
Private Sub UserControl_Terminate()
    SetWindowLong MSFlexGrid1.hwnd, GWL_WNDPROC, OldProc
    Set Flex = Nothing
End Sub

Ответить

Ответы Всего ответов: 2

Номер ответа: 1
Автор ответа:

mkf

Вопросов: 0
Ответов: 1

Профиль | | #1

Добавлено: 14.07.03 11:56

Посмотри по этой ссылке:

http://www.vbmania.ru/vbmag/1/subclassing.shtml

По крайней мере для разных форм помогает (проверено)

Ответить

Номер ответа: 2
Автор ответа:

hedgehog

ICQ: 175571327

Вопросов: 15
Ответов: 207

Web-сайт: ezh.ru
Профиль | | #2

Добавлено: 14.07.03 15:42

2 mkf

спасибо за ссылку - статья и контрол довольно занятные - буду юзать.

единственно, не хотелось мне использовать дополнительные контролы и библиотеки при сборке своего контрола, чтобы он был вполне самодостаточным. Впрочем, проблему я уже решил более менее и похоже аналогичным путем, как в этом контроле реализовано - я сейчас включаю перехват при получении фокуса и при этом проверяю наличие адреса старой процедуры и если он есть присваиваю его как это делается при выходе. Ну и при выходе конечно тоже проверяю и возвращаю. Выглядит кривовато, но на самом деле работает

Ответить

Страница: 1 |