Гость
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Скролинг мышью MSFlexGrid vba / 6 сообщений из 6, страница 1 из 1
24.10.2015, 16:39
    #39085587
Скролинг мышью MSFlexGrid vba
Здравствуйте. Как реализовать прокручивание колесиком мыши MSFlexGrid который находится на форме в проекте vba (Excell). В сети есть примеры для VB, для VBA неполучается применить
...
Рейтинг: 0 / 0
24.10.2015, 16:44
    #39085589
Скролинг мышью MSFlexGrid vba
Есть пример для 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
24.10.2015, 17:20
    #39085598
Shocker.Pro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Скролинг мышью MSFlexGrid vba
Владимир197243неполучаетсяВладимир197243не выходитэто все подробности, которые ты готов сообщить?

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


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