如何才能让 RichTextBox 具有 ScrollBar 事件

[bobogg]

请问

如何才能让 RichTextBox 具有 ScrollBar 事件

我需要 水平ScrollBar 的事件 响应

谢谢

[帝企鹅已被占用]

抄来的。
routinesOption Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any _
) 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, _
ByVal lParam As Long _
) As Long

Private Type POINTAPI
x As Long
y As Long
End Type

Private Const WM_USER = &H400
Private Const EN_HSCROLL = &H601
Private Const EN_VSCROLL = &H602
Private Const EN_CHANGE = &H300
Private Const EN_UPDATE = &H400
Private Const EM_SETEVENTMASK = (WM_USER + 69)
Private Const ENM_SCROLL = &H4
Private Const EM_GETSCROLLPOS = (WM_USER + 221)
Private Const EM_SETSCROLLPOS = (WM_USER + 222)
Private Const WM_COMMAND = &H111
Private Const WM_VSCROLL = &H115
Private Const WM_HSCROLL = &H114

'Must be declared in BAS file not FRM file.
Public frmSubClass As CSubclass
Public RTBsubClass As CSubclass

Public Function NewFrmWndProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
'This is where the messages for our Form will arrive
Dim ScrollPos As POINTAPI
If uMsg = WM_COMMAND Then
Select Case Int(wParam \ &H10000)
Case EN_VSCROLL
Debug.Print Timer, "EN_VSCROLL",
SendMessage frmRTB.RTB.hWnd, EM_GETSCROLLPOS, 0, ScrollPos
Debug.Print ScrollPos.y
Case Else
End Select
End If
NewFrmWndProc = CallWindowProc(frmSubClass.OrigWndProc, hWnd, uMsg, wParam, lParam)
End Function

Public Function NewRTBWndProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
'This is where the messages for our RichTExtBox will arrive
Dim ScrollPos As POINTAPI
If uMsg = WM_VSCROLL Then
Debug.Print Timer, "WM_VSCROLL",
SendMessage hWnd, EM_GETSCROLLPOS, 0, ScrollPos
Debug.Print ScrollPos.y
End If
NewRTBWndProc = CallWindowProc(RTBsubClass.OrigWndProc, hWnd, uMsg, wParam, lParam)
End Function

Public Sub SetCaptureScroll(hWndFRM As Long, hWndRTB As Long)
'subclass our form to get scrollbar events
Set frmSubClass = New CSubclass
frmSubClass.EnableSubclass hWndFRM, AddressOf NewFrmWndProc
'subclass the RTB to get scrollbar events
Set RTBsubClass = New CSubclass
RTBsubClass.EnableSubclass hWndRTB, AddressOf NewRTBWndProc
'set notify mask for RTB so we receive scroll messages
SendMessage hWndRTB, EM_SETEVENTMASK, 0, ByVal ENM_SCROLL
End Sub

To start it off just do thisPrivate Sub Form_Load()
'pass form hWnd and RichTextBox hWnd
SetCaptureScroll Me.hWnd, RTB.hWnd
End Sub

[神马被哪个妞占用了呢]

抄袭有理