Mshflexgrid или есть замена?

[joker979]

Пользуюсь в своем проекте mshflexgrid. Все что мне нужно от этого грида это вывод содержимого таблицы и событие dblclick для вызова окна редактирования БД. Как я понял этот грид не поддерживает прокрутки колесиком и толком никто не можут объяснить как заставить его крутиться. Вот и возник вопросик, а есть ли похожий грид, только с возможностью прокрутки? Мне не нужно редактировать БД непосредственно в гриде, мне нужено только событие dblclick для вызова формы. Так есть такой грид или нет?

 

[Normann]

Есть грид такой, только его качать и устанавливать надо, называется он VSFlexGrid конторы ComponentOne Studio. Этот контрол разработан для работы с ADO. Без покупки можно с ним работать, только окошко рекламное будет выдавать при старте.

 

[Tanya]

можно и в MSFlexGrid заставить колесико работать!

1) создаем класс CMouseWheel:

Private frm As Object
Private intCancel As Integer

Public Event MouseWheel(Cancel As Integer, MWDown As Boolean)
Private Const GWL_WNDPROC = -4
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Public Property Set Form(frmIn As Object)
Set frm = frmIn
End Property

Public Property Get MouseWheelCancel() As Integer
MouseWheelCancel = intCancel
End Property

Public Sub SubClassHookForm()
lpPrevWndProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, AddressOf WindowProc)
Set CMouse = Me
End Sub

Public Sub SubClassUnHookForm()
Call SetWindowLong(frm.hwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub

Public Sub FireMouseWheel(MWDown As Long)
RaiseEvent MouseWheel(intCancel, (MWDown < 0))
End Sub

2) В форме с гридом объявляем объект класса:

Private WithEvents clsMouseWheel As CMouseWheel

3) Там же добавляем 2 процедуры отключения и включения колесика:

Sub WheelOff()
If Not clsMouseWheel Is Nothing Then
clsMouseWheel.SubClassUnHookForm
Set clsMouseWheel.Form = Nothing
Set clsMouseWheel = Nothing
End If
End Sub

Sub WheelOn()
If clsMouseWheel Is Nothing Then
Set clsMouseWheel = New CMouseWheel
Set clsMouseWheel.Form = Me
clsMouseWheel.SubClassHookForm
End If
End Sub

4) и обработчик вращения колесика, у меня, например, был такой:

Private Sub clsMouseWheel_MouseWheel(Cancel As Integer, MWDown As Boolean)
Dim i As Integer
With Me.MSFlexGrid1
'Debug.Print .TopRow
If MWDown Then
For i = .TopRow To .Rows - 1
If Not .RowIsVisible(i) Then
.TopRow = .TopRow + 1
Exit For
End If
Next i
If i = .Rows Then .TopRow = .TopRow + 1
ElseIf .TopRow > .FixedRows Then
.TopRow = .TopRow - 1
End If
End With
End Sub

5) В модуле объявления глобальных переменных объявляем

Public CMouse As CMouseWheel
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Public 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

Public Const WM_MouseWheel = &H20A
Public lpPrevWndProc As Long

6) Конечно же нужно и функцию создать, тоже в глобальном модуле
(по-моему п.п. 5-6 должны быть выполнены только в глобвльном модуле,
но я не уверена наверняка)

Public Function WindowProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Select Case uMsg
Case WM_MouseWheel
CMouse.FireMouseWheel wParam
If CMouse.MouseWheelCancel = False Then
WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
End If
Case Else
WindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
End Select
End Function

7) Ну, кажется, что знала, то рассказала ))
Да!!! WheelOff на всякий случай я включаю вначале каждого обработчика элементов управления формы, соответственно WheelOn в конце,
для того чтобы приложение не глючило (все-таки callback функция)
в случае возникновения каких-нибудь ошибок в обработчиках.

И нужно забыть включить колесико WheelOn в Form_Load
и (скорее всего) отключить WheelOff в form_Unload