VB中使MsFlexGrid和MSHFlexGrid控件支持鼠标滚动操作--2

来源:百度文库 编辑:神马文学网 时间:2024/04/25 08:02:36
‘DataGrid的鼠标滚动操作在另一篇博客里面

‘在VB中,MsFlexGrid和DataGrid等控件本来不支持鼠标的滚动操作,但是人性化的设计要求希望这些控件能支持鼠标的各项操作。但是这些控件本身并不自带鼠标的支持参数,必须要自己添加相应的代码。


‘本代码需要引用Microsoft FlexGrid Control 6.0
Private Const PM_REMOVE = &H1

Private Type POINTAPI
       x As Long
       y As Long
End Type

Private Type Msg
       hWnd As Long
       Message As Long
       wParam As Long
       lParam As Long
       time As Long
       pt As POINTAPI
End Type

Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" _
           (lpMsg As Msg, _
           ByVal hWnd As Long, _
           ByVal wMsgFilterMin As Long, _
           ByVal wMsgFilterMax As Long, _
           ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private bCancel As Boolean
Private Const WM_MOUSEWHEEL = 522

Private Sub ProcessMessages()
Dim Message As Msg
       Do While Not bCancel
          WaitMessage ‘等待消息
          If PeekMessage(Message, MSFlexGrid1.hWnd, WM_MOUSEWHEEL, WM_MOUSEWHEEL, PM_REMOVE) Then ‘...when the mousewheel is used...
             If Message.wParam < 0 Then ‘向上滚动
                ‘Me.Top = Me.Top + 240
                If MSFlexGrid1.TopRow < MSFlexGrid1.Rows Then
                   MSFlexGrid1.TopRow = MSFlexGrid1.TopRow + 1
                End If
             Else ‘向下滚动
                If MSFlexGrid1.TopRow > 1 Then
                    MSFlexGrid1.TopRow = MSFlexGrid1.TopRow - 1
                End If
             End If
          End If
          DoEvents
       Loop
End Sub

Private Sub Form_Unload(Cancel As Integer)
       bCancel = True
End Sub


Private Sub Form_Load()
       For i = 1 To 25
           MSFlexGrid1.AddItem i
       Next i
       Me.AutoRedraw = True
       Me.Print "请使用鼠标滚轮改变本窗体的位置。"
       Me.Show
       ProcessMessages

End Sub