Hiks, visual basic 6 untuk mouse scrollnya masih belum bisa digunakan. Tapi Dont Worry bisa diakali kok dengan menambahkan modul baru dan pastekan ini :
------------------------------------------------------------------------------
Public Mydika As Object
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 MK_CONTROL = &H8
Public Const MK_LBUTTON = &H1
Public Const MK_RBUTTON = &H2
Public Const MK_MBUTTON = &H10
Public Const MK_SHIFT = &H4
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
Dim LocalHwnd As Long
Dim LocalPrevWndProc As Long
Dim MyControl As Object
Private Function WindowProc(ByVal Lwnd As Long, ByVal Lmsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim MouseKeys As Long
Dim Rotation As Long
Dim Xpos As Long
Dim Ypos As Long
If Lmsg = WM_MOUSEWHEEL Then
MouseKeys = wParam And 65535
Rotation = wParam / 65536
Xpos = lParam And 65535
Ypos = lParam / 65536
'determine if mouse wheel is being moved up or down
If Rotation = -120 Then
'call scroll method of datagrid and specify the number of columns and rows to scroll through
'DataGrid.Scroll colNum, rowNum
Mydika.Scroll 0, 3
Else
Mydika.Scroll 0, -3
End If
End If
WindowProc = CallWindowProc(LocalPrevWndProc, Lwnd, Lmsg, wParam, lParam)
End Function
Sub WheelHook(PassedControl As Object)
On Error Resume Next
Set MyControl = PassedControl
LocalHwnd = PassedControl.hWnd
LocalPrevWndProc = SetWindowLong(LocalHwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Sub WheelUnHook()
Dim WorkFlag As Long
On Error Resume Next
WorkFlag = SetWindowLong(LocalHwnd, GWL_WNDPROC, LocalPrevWndProc)
Set MyControl = Nothing
End Sub
----------------------------------------------------------------------------------------------
Trus pada datagrid_klik isikan kaya gini
Private Sub DataGrid1_Click()
WheelUnHook
Set Mydika = POSTING.DataGrid1
WheelHook DataGrid1
End Sub
Kok gk bisa jalan gan?
BalasHapusAda error di Set Mydika = POSTING.DataGrid1
BalasHapusPOSTING. nya dihapus jadi gak error. tapi juga masih belum bisa jalan
Hapus