Scrollhjul-event i tekstboks

[d0ppler]

Hvordan fanger jeg/overstyrer scrollhjul-eventet for en rich text control i vb 6.0? Det skal vel være mulig med noen "enkle" API-kall, eller?

[aadnk]

Legg inn følgende kode i en tom modul:

Option Explicit

 

' Anvendes til å erstatte og kalle den nåværende vinduprosedyren.

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

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

 

' Lagrer adressen til den originale vinduprosedyren

Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long

Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

 

' Den variabel vi skal endre

Public Const GWL_WNDPROC = -4

 

' Hendelser

Public Const WM_MOUSEWHEEL = &H20A

Public Const WM_DESTROY As Long = &H2

 

' "Funksjoner"

Public Const WM_SCROLL = 277

 

Public Sub Subclass(hwnd As Long)

 

    ' Registrer den gamle adressen

    SetProp hwnd, "OldProc", GetWindowLong(hwnd, GWL_WNDPROC)

 

    ' Erstatt den nåværende adressen med vår egen

    SetWindowLong hwnd, GWL_WNDPROC, AddressOf WindowProc

   

End Sub

 

Public Sub Unsubclass(hwnd As Long)

 

    Dim oldProc As Long

   

    ' Hent den gamle adressen

    oldProc = GetProp(hwnd, "OldProc")

   

    ' Vær sikker på at vi faktisk har subclasset dette vinduet

    If oldProc <> 0 Then

 

        ' Erstatt prosedyreadressen med den gamle

        SetWindowLong hwnd, GWL_WNDPROC, oldProc

   

        ' Fjern den registrerte variabelen

        RemoveProp hwnd, "OldProc"

   

    End If

 

End Sub

 

Private Function WindowProc(ByVal hwnd As Long, ByVal message As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

   

    Dim MouseKeys As Long, Rotation As Long, Xpos As Long, Ypos As Long

    Dim oldProc As Long

   

    ' Henter den originale prosedyreadressen

    oldProc = GetProp(hwnd, "OldProc")

   

    ' Sjekk hva som anropet denne prosedyre

    Select Case message

       

    ' Musehjulet har blitt rotert

        Case WM_MOUSEWHEEL

         

            ' Last inn all gitt informasjon (ikke nødvendig)

            MouseKeys = wParam And 65535

            Rotation = wParam / 65536

            Xpos = lParam And 65535

            Ypos = lParam / 65536

 

            ' Ikke tillat skrolling

            WindowProc = -1

       

            ' Vi er ferdige

            Exit Function

           

        Case WM_DESTROY

       

            ' Vinduet destrueres - fjern overstyring

            Unsubclass hwnd

       

    End Select

   

    ' Calls the default window procedure

    WindowProc = CallWindowProc(oldProc, hwnd, message, wParam, lParam)

 

End Function

Deretter kan du benytte de to prosedyrene Subclass og Unsubclass til å erstatte den nåværende vinduprosedyren slik at WindowProc kalles i stedet:

 

Private Sub Form_Load()

 

    Subclass txtTest.hwnd

 

End Sub

 

Private Sub Form_Unload(Cancel As Integer)

 

    Unsubclass txtTest.hwnd

 

End Sub

Bemker at Unsubclass MÅ kalles for å forhindre applikasjonkrasj. Trykk derfor aldri på End-knappes.

Endret 21. mai 2006 av aadnk

[d0ppler]

tusen hjertelig takk!

beskrivende og forståelig kode

[aadnk]

Bare hyggelig.

[d0ppler]

jeg klarer nå å fange opp eventet, nydelig, men hvordan overstyrer jeg det faktum at den scroller? Selv om jeg fjerna all code innenfor Case WM_MOUSEWHEEL, så scrolla teksten for det.

 

EDIT : Og hvordan vet jeg hvilken vei man scroller?

EDIT2 : Rotation fortalte meg det..

EDIT3 : jeg klarte å overstyre handlingen også, når jeg studerte den litt nærmere

Endret 21. mai 2006 av dga01

[aadnk]

Ah, beklager. Var vel litt tidlig om morgenen, antar jeg. Jeg har nå oppdatert koden slik at den nå fjerner museskrollingen.