Thầy ơi, nhờ code cải tiến của Thầy mà nó đã trở nên rất tiện ích, em không e ngại gì khi dùng nữa! Cám ơn Thầy rất nhiều!
Nhưng cho em hỏi, với scrollbar của NotePad mình có thể dùng chuột cảm ứng của laptop, nhưng cái này thì chỉ dùng được với scroll wheel thôi. Vậy Thầy có thể cải tiến thêm cho nó được không? (chỉ là "được voi đòi tiên" nhưng nếu có thể thì Thầy cũng thử một lần xem sao Thầy nhé!).
Một lần nữa em cám ơn Thầy rất nhiều.
Chuột này khác chuột kia thì kể cũng lạ.
Tôi không có chuột cảm ứng và laptop nên muốn nghiên cứu cũng đành chịu.
Tôi viết lại theo cách mới. Thực ra ta không cần theo dõi sự kiện chuột trong toàn system mà chỉ trong phạm vi ứng dụng của ta. Khi chuột được lăn trong cửa sổ của ta thì thông điệp WM_MOUSEWHEEL sẽ được gửi tới hàm cửa sổ của UserForm (window procedure). Vậy chỉ cần "đánh tráo" hàm cửa sổ để xử lý thông điệp WM_MOUSEWHEEL.
Tóm lại ta dùng công nghệ "Window Subclassing" thay cho hook. Với cách này thì lăn chuột trong UserForm hay notepad không ảnh hưởng tới nhau. Code này lại còn đơn giản hơn hook.
Trong code sau và trong tập tin đính kèm là code đầy đủ để chạy. Nhưng tôi thêm 1 dòng (mầu đỏ) để test thông điệp được gửi tới hàm cửa sổ. Vậy sau khi test xong thì dòng này xóa đi cho khỏi nhàm code.
Bạn hãy: Kích hoạt UserForm1 (bấm Button 1) --> chọn 1 mục trong ListBox hoặc nhấn tam giác của Combobox --> lăn chuột vài lần --> copy và dán lên GPE những dòng mà Debug.Print ghi trong cửa sổ Immediate để tôi xem.
Module:
[GPECODE=vb]
Option Explicit
Public Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function CallWindowProc Lib "user32.dll" 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 Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = (-4)
Private Const WM_MOUSEMOVE As Long = &H200
Private Const WM_VSCROLL = &H115
Private Const WM_MOUSEWHEEL = &H20A
Public OldWindowProc As Long
Public obj As Object
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Static TopIndex As Integer
Dim mousedata As Integer
On Error GoTo end_
If uMsg = WM_MOUSEWHEEL Or uMsg = WM_VSCROLL Then Debug.Print CStr(uMsg)
If uMsg = WM_MOUSEWHEEL And Not obj Is Nothing Then
mousedata = wParam \ 65536
With obj
If mousedata > 0 Then
.TopIndex = TopIndex - 1
TopIndex = .TopIndex
Else
.TopIndex = TopIndex + 1
TopIndex = .TopIndex
End If
Exit Function
End With
End If
end_:
WindowProc = CallWindowProc(OldWindowProc, hwnd, uMsg, wParam, lParam)
End Function
Sub SetWindowProc(ByVal hWin As Long, ByVal DoSet As Boolean)
If DoSet Then
If OldWindowProc = 0 Then
OldWindowProc = SetWindowLong(hWin, GWL_WNDPROC, AddressOf WindowProc)
End If
ElseIf OldWindowProc <> 0 Then
SetWindowLong hWin, GWL_WNDPROC, OldWindowProc
OldWindowProc = 0
End If
End Sub
[/GPECODE]
UserForm:
[GPECODE=vb]
Private hWin As Long
Private Sub ComboBox1_Enter()
Set obj = ComboBox1
End Sub
Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Set obj = Nothing
End Sub
Private Sub ListBox1_Enter()
Set obj = ListBox1
End Sub
Private Sub ListBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Set obj = Nothing
End Sub
Private Sub UserForm_Initialize()
hWin = FindWindow("ThunderDFrame", Me.Caption)
SetWindowProc hWin, True
End Sub
Private Sub UserForm_Terminate()
SetWindowProc hWin, False
End Sub
[/GPECODE]
10").Value), nó có thuộc tính RowSource để liên kết từ Sheet đến ListBox.
