powered by simpleCommunicator - 2.0.51     © 2025 Programmizd 02
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Скролинг мышью MSFlexGrid vba
6 сообщений из 6, страница 1 из 1
Скролинг мышью MSFlexGrid vba
    #39085587
Здравствуйте. Как реализовать прокручивание колесиком мыши MSFlexGrid который находится на форме в проекте vba (Excell). В сети есть примеры для VB, для VBA неполучается применить
...
Рейтинг: 0 / 0
Скролинг мышью MSFlexGrid vba
    #39085589
Есть пример для VB, пытаюсь тоже сделать VBA не выходит
код в форму:
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
Public Sub MouseWheel(ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)
  If TypeOf Me.ActiveControl Is MSFlexGrid Then FlexGridScroll Me.ActiveControl, MouseKeys, Rotation, Xpos, Ypos
End Sub

Private Sub Form_Load()
  Dim N As Integer
  Dim I As Integer
  With MSFlexGrid1
    .Rows = 100
    .Cols = 10
    For N = .FixedRows To .Rows - 1
      .TextMatrix(N, 0) = "Row " & N
    Next N
  End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Call WheelUnHook(Me)
End Sub



код в стандартный модуль:
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
Option Explicit

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 LocalPrevWndProc As Long

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
      GetForm(Lwnd).MouseWheel MouseKeys, Rotation, Xpos, Ypos
  End If
  WindowProc = CallWindowProc(LocalPrevWndProc, Lwnd, Lmsg, Wparam, Lparam)
End Function

Public Sub WheelHook(PassedForm As Form)
  On Error Resume Next
  LocalPrevWndProc = SetWindowLong(PassedForm.hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub WheelUnHook(PassedForm As Form)
  Dim WorkFlag As Long

  On Error Resume Next
  WorkFlag = SetWindowLong(PassedForm.hWnd, GWL_WNDPROC, LocalPrevWndProc)
End Sub

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

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 Lstep < 10 Then
          Lstep = 10
      End If
      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
...
Рейтинг: 0 / 0
Скролинг мышью MSFlexGrid vba
    #39085598
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Владимир197243неполучаетсяВладимир197243не выходитэто все подробности, которые ты готов сообщить?

и где, собственно, вызов WheelHook?
...
Рейтинг: 0 / 0
Скролинг мышью MSFlexGrid vba
    #39085613
Shocker.Pro,
Вот пример. Прошу подсказать что не так
...
Рейтинг: 0 / 0
Скролинг мышью MSFlexGrid vba
    #39085636
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Вот здесь рассматривается вариант для VBA
http://www.sql.ru/forum/1112907/excel-vba-listbox-prokrutka-kolesikom-myshi
...
Рейтинг: 0 / 0
Скролинг мышью MSFlexGrid vba
    #39085753
Shocker.Pro,
Спасибо. разобрался
...
Рейтинг: 0 / 0
6 сообщений из 6, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Скролинг мышью MSFlexGrid vba
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]