borderAndreaVB free resources for Visual Basic developersborder
borderAndreaVB Visual Basic and VB.NET source code resources - Copyright © 1999-2016 Andrea Tincaniborder

AndreaVB | Forum | News | Downloads | Register | Help | Member List | Statistics | Search | PM | Profile

Print This Topic
Previous Topic (Taskbar color in windows xp)Next Topic (Change Windows Taskbar Color) New Topic New Poll Post Reply
AndreaVB Forum : API : Detect VSCROLL
Poster Message
M@rkS
Level: Guest


icon Detect VSCROLL  Archived to Disk

I recently had cause to try to find a way to detect when a user clicked on the scroll bar, vertical, of a Richtext box.

There is next to nothing on the net that I could find. Any suggestions?

05-04-2002 at 08:22 AM
| Quote Reply
admin
Level: Administrator


Registered: 04-04-2002
Posts: 535
icon Re: Detect VSCROLL  Archived to Disk

create a form with a rich text box and a label...

add this code to the form:

Option Explicit

Private Sub Form_Load()
    InstallSubClass RichTextBox1
End Sub

Private Sub Form_Unload(Cancel As Integer)
    RemoveSubClass RichTextBox1
End Sub


and then add this module:

Option Explicit

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 CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Type WndProc
    oldWndProc As Long
    MainHWnd As Long
End Type

Const WM_ACTIVATE = &H6
Const WM_ACTIVATEAPP = &H1C
Const WM_CLOSE = &H10
Const WM_CREATE = &H1
Const WM_DESTROY = &H2
Const WM_ENABLE = &HA
Const WM_HOTKEY = &H312
Const WM_HSCROLL = &H114
Const WM_KEYDOWN = &H100
Const WM_KEYUP = &H101
Const WM_MOUSEMOVE = &H200
Const WM_MOUSEACTIVATE = &H21
Const WM_MOVE = &H3
Const WM_MOVING = 534
Const WM_VSCROLL = &H115
Const GWL_WNDPROC = (-4)

Dim ProcData(0 To 100) As WndProc

Private Property Let OldhWndProc(hWnd As Long, NewValue As Long)
    Dim i As Integer
    
    For i = 0 To 100
        If ProcData(i).MainHWnd = hWnd Then
            ProcData(i).oldWndProc = NewValue
            Exit Property
        End If
    Next
    For i = 0 To 100
        If ProcData(i).MainHWnd = 0 Then
            ProcData(i).MainHWnd = hWnd
            ProcData(i).oldWndProc = NewValue
            Exit Property
        End If
    Next
End Property

Private Property Get OldhWndProc(hWnd As Long) As Long
    Dim i As Integer
    
    For i = 0 To 100
        If ProcData(i).MainHWnd = hWnd Then
            OldhWndProc = ProcData(i).oldWndProc
            Exit Property
        End If
    Next
End Property

Private Function MyWindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, lParam As Long) As Long
    If uMsg = WM_VSCROLL Then
        Form1.Label1.Caption = "Action: " & (wParam Mod 65536) & " Pos: " & (wParam  65536)
    End If
    MyWindowProc = CallWindowProc(OldhWndProc(hWnd), hWnd, uMsg, wParam, lParam)
End Function

Public Sub InstallSubClass(rtx As RichTextBox)
    OldhWndProc(rtx.hWnd) = SetWindowLong(rtx.hWnd, GWL_WNDPROC, AddressOf MyWindowProc)
End Sub

Public Sub RemoveSubClass(rtx As RichTextBox)
    Dim i As Long
    
    For i = 0 To 100
        If ProcData(i).MainHWnd = rtx.hWnd Then
            ProcData(i).MainHWnd = 0
            SetWindowLong rtx.hWnd, GWL_WNDPROC, ProcData(i).oldWndProc
            Exit Sub
        End If
    Next
End Sub


when you move the scroll you'll see the position and event!!

Hope this helps

AndreaVB  




[Edited by admin on 10-04-2002 at 01:11 PM GMT]

____________________________
AndreaVB

05-04-2002 at 09:48 AM
View Profile Send Email to User Show All Posts Visit Homepage | Quote Reply
M@rkS
Level: Guest

icon Re: Detect VSCROLL  Archived to Disk

Cool Thanks.

Shouldn't take much to get it to work with the control array of Richtext boxes.

05-04-2002 at 11:04 AM
| Quote Reply
Merrion
Level: VB Guru

Registered: 15-04-2002
Posts: 37
icon Re: Detect VSCROLL  Archived to Disk

You can do this using the EventVB.dll (code and dll free to download from Merrion Computing) thus:


' Form code
Dim WithEvents vbLink As EventVB.APIFunctions
Dim WithEvents vbRTFWnd As EventVB.ApiWindow

Private Sub Form_Load()

Set vbLink = New ApiFunctions

Set vbRTFWnd = New ApiWindow
vbRTFWnd.hwnd = RichText1.hwnd
vbLink.SubclassedWindows.Add vbRTFWnd

End Sub


This gives you a load of new events, one of which is VerticalScroll:


Private Sub vbRTFWnd_VerticalScroll(ByVal Message As enScrollMessage , ByVal Position As Long, Cancel As Boolean)


End Sub


Hope this helps,
  Duncan Jones

[Edited by admin on 16-04-2002 at 06:46 AM GMT]

____________________________
--8<-- ----------------------------
Free components and source code - see http://www.merrioncomputing.com/Download/index.htm for details

15-04-2002 at 09:41 PM
View Profile Send Email to User Show All Posts Visit Homepage | Quote Reply
kuku202
Level: Trainee

Registered: 10-02-2015
Posts: 1
icon Re: Detect VSCROLL

How to pause and resume documents/objects in the print queue? I am using VB 6 Pro


____________________________
kaleem

10-02-2015 at 09:39 AM
View Profile Send Email to User Show All Posts | Quote Reply
AndreaVB Forum : API : Detect VSCROLL
Previous Topic (Taskbar color in windows xp)Next Topic (Change Windows Taskbar Color) New Topic New Poll Post Reply
Surf To:


Not Logged In? Username: Password: Lost your password?
borderAndreaVB free resources for Visual Basic developersborder
borderAndreaVB Visual Basic and VB.NET source code resources - Copyright © 1999-2016 Andrea Tincaniborder