 |
|
 |
admin
Level: Administrator
Registered: 04-04-2002
Posts: 530
|
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 |
|
|
Merrion
Level: VB Guru
Registered: 15-04-2002
Posts: 37
|
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 |
|
|
|
|
 |
|
