enggak usah pake dll-an, pake aja fungsi api berikut :
copy paste ke modul :
Option Explicit
Public Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA"
(ByVal hWnd As Long, ByVal Msg As Long, wParam As Any, lParam As Any) As Long
Private Declare Function GetProp Lib "user32.dll" Alias "GetPropA" (ByVal hWnd
As Long, ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32.dll" Alias "SetPropA" (ByVal hWnd
As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function RemoveProp Lib "user32.dll" Alias "RemovePropA" (ByVal
hWnd As Long, ByVal lpString 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
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect
As RECT) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
Private Const CB_GETDROPPEDSTATE = &H157
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
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
Dim fFrm As Form
Select Case Lmsg
Case WM_MOUSEWHEEL
MouseKeys = wParam And 65535
Rotation = wParam / 65536
Xpos = lParam And 65535
Ypos = lParam / 65536
Set fFrm = GetForm(Lwnd)
If fFrm Is Nothing Then
If Not IsOver(Lwnd, Xpos, Ypos) And IsOver(GetParent(Lwnd),
Xpos, Ypos) Then
If SendMessage(Lwnd, CB_GETDROPPEDSTATE, 0&, 0&) <> 1 Then
GetForm(GetParent(Lwnd)).MouseWheel MouseKeys,
Rotation, Xpos, Ypos
Exit Function
End If
End If
Else
If IsOver(fFrm.hWnd, Xpos, Ypos) Then fFrm.MouseWheel
MouseKeys, Rotation, Xpos, Ypos
End If
End Select
WindowProc = CallWindowProc(GetProp(Lwnd, "PrevWndProc"), Lwnd, Lmsg,
wParam, lParam)
End Function
Public Sub WheelHook(ByVal hWnd As Long)
On Error Resume Next
SetProp hWnd, "PrevWndProc", SetWindowLong(hWnd, GWL_WNDPROC, AddressOf
WindowProc)
End Sub
Public Sub WheelUnHook(ByVal hWnd As Long)
On Error Resume Next
SetWindowLong hWnd, GWL_WNDPROC, GetProp(hWnd, "PrevWndProc")
RemoveProp hWnd, "PrevWndProc"
End Sub
Public Sub FlexGridScroll(ByRef FG As MSFlexGrid, ByVal MouseKeys As Long,
ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)
Dim NewValue As Long
Dim Lstep As Single
On Error Resume Next
With FG
Lstep = .Height / .RowHeight(0)
Lstep = Int(Lstep)
If .Rows < Lstep Then Exit Sub
Do While Not (.RowIsVisible(.TopRow + Lstep))
Lstep = Lstep - 1
Loop
If Rotation > 0 Then
NewValue = .TopRow - Lstep
If NewValue < 1 Then
NewValue = 1
End If
Else
NewValue = .TopRow + Lstep
If NewValue > .Rows - 1 Then
NewValue = .Rows - 1
End If
End If
.TopRow = NewValue
End With
End Sub
Public Function IsOver(ByVal hWnd As Long, ByVal lX As Long, ByVal lY As Long)
As Boolean
Dim rectCtl As RECT
GetWindowRect hWnd, rectCtl
With rectCtl
If lX >= .Left And lX <= .Right And lY >= .Top And lY <= .Bottom Then
IsOver = True
End With
End Function
Private Function GetForm(ByVal hWnd As Long) As Form
For Each GetForm In Forms
If GetForm.hWnd = hWnd Then Exit Function
Next GetForm
Set GetForm = Nothing
End Function
'ini kode di form
Public Sub MouseWheel(ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal
Xpos As Long, ByVal Ypos As Long)
Dim ctl As Control
For Each ctl In Me.Controls
If TypeOf ctl Is MSFlexGrid Then
If IsOver(ctl.hWnd, Xpos, Ypos) Then FlexGridScroll ctl, MouseKeys,
Rotation, Xpos, Ypos
End If
Next ctl
End Sub
Private Sub Form_Load()
Call WheelHook(Me.hWnd)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call WheelUnHook(Me.hWnd)
End Sub
semoga membantu :)
muchanpage <[EMAIL PROTECTED]> wrote: Hallo,
Mumpang tanya donk...
kalau object MSHFlexgrid, supaya bisa discroll dari mouse scroll..
gimana caranya ?? harus ada dll tambahan yah ??? mohon pencerahannya
terima kasih,
Irsan
---------------------------------
Park yourself in front of a world of choices in alternative vehicles.
Visit the Yahoo! Auto Green Center.
[Non-text portions of this message have been removed]
