Прокурутка формы с помощью колесика мыши

Гм, можно кинуть контролы на большой PictureBox, поставить вертикальный скролер на форму и крутить им пичбокс. Если надо скролить колесиком - ловим WM_MOUSEWHEEL.

Спасибо за ответ!А можно подробнее про WM_MOUSEWHEEL.Никогда с этим не сталкивалась.Прописывать в модуле?

WM_MOUSEWHEEL - ето оконное сообщение. Для того чтобы его словить в VB надо сначала поставить свой обработчик сообщений на требуемое окно, предварительно запомнив старый чтобы потом дать ему управление. Выглядит примерно так:

Код писался с головы и его работоспособность не гарантируеться. Но общая схема думаю понятна. Как говорят апи оно и в африке апи, так что msdn тебе в браузер. Ну если совсем в тягость - есть прога API-Guide - сборник описаний с примерами многих апи-функций специально для VB. А константы в гугле на каждом шагу валяются.

Что надо делать в WM_MOUSEWHEEL я и сам толком незнаю :) Когда мне надо было задействовать колесико в своей проге я просто глянул исходники scintilla и дернул оттуда обработку колесика. Тебе тоже советую посмотреть сырцы етого легендарного контрола для работы с текстом. Правдо они на C++.

Привет!Знаешь,искала что-нибудь подобное в инете и нашла вот такой код



Option Explicit

Private Declare Function SystemParametersInfo Lib "user32.dll" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private 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
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const WM_CLOSE As Long = &H10
Private Const GWL_WNDPROC As Long = -4
Private Const WHEEL_DELTA As Long = 120
Private Const SPI_GETWHEELSCROLLLINES As Long = 104

Private Const PROP_PREVPROC = "prevptr"
Private Const PROP_GRIDPTR = "gridptr"
Private Const PROP_DELTA = "delta"

Private Type POINTAPI
X As Long
Y As Long
End Type

Public Sub AddScroll2Grids(Form As Form)
Dim Grid As Object
Dim p As Long
Dim hwnd As Long
If Form.MDIChild Then
hwnd = GetParent(Form.hwnd)
hwnd = GetParent(hwnd)
Else
hwnd = Form.hwnd
End If
If GetProp(hwnd, PROP_PREVPROC) = 0 Then
p = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf FrmProc)
SetProp hwnd, PROP_PREVPROC, p
End If
For Each Grid In Form.Controls
Select Case TypeName(Grid): Case "DataGrid", "DBGrid", "MSFlexGrid", "MSHFlexGrid"
p = SetWindowLong(Grid.hwnd, GWL_WNDPROC, AddressOf GridProc)
SetProp Grid.hwnd, PROP_PREVPROC, p
SetProp Grid.hwnd, PROP_GRIDPTR, ObjPtr(Grid)
End Select
Next
End Sub

Private Function GridProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lPrevWndProc As Long
Dim lLines2Scroll As Long
Dim GridPtr As Long
Dim Delta As Long
Dim hwnd As Long
Dim oList As Object
Dim pa As POINTAPI
Dim dScroll As Integer
lPrevWndProc = GetProp(hw, PROP_PREVPROC)
If lPrevWndProc = 0 Then Exit Function
Select Case uMsg
Case WM_MOUSEWHEEL
GetCursorPos pa
hwnd = WindowFromPoint(pa.X, pa.Y)
GridPtr = GetProp(hwnd, PROP_GRIDPTR)
If GridPtr <> 0 Then
SystemParametersInfo SPI_GETWHEELSCROLLLINES, 0, lLines2Scroll, 0
Delta = GetProp(hw, PROP_DELTA) + wParam / &H10000
dScroll = -lLines2Scroll * (Delta \ WHEEL_DELTA) * (10 + 9 * (Not (wParam = -7864316 Or wParam = 7864324)))
Set oList = ObjFromPtr(GridPtr)
Select Case TypeName(oList)
Case "DataGrid", "DBGrid"
oList.Scroll 0, dScroll
Case "MSFlexGrid", "MSHFlexGrid"
On Error GoTo errh
If oList.TopRow + dScroll <= oList.FixedRows - 1 Then
oList.TopRow = oList.FixedRows
ElseIf oList.TopRow + dScroll >= oList.Rows Then
oList.TopRow = oList.Rows - 1
Else
oList.TopRow = oList.TopRow + dScroll
End If
End Select
SetProp hw, PROP_DELTA, Delta Mod WHEEL_DELTA
End If
Case WM_CLOSE
RemoveProp hw, PROP_PREVPROC
RemoveProp hw, PROP_GRIDPTR
RemoveProp hw, PROP_DELTA
SetWindowLong hw, GWL_WNDPROC, lPrevWndProc
Case Else
GridProc = CallWindowProc(lPrevWndProc, hw, uMsg, wParam, lParam)
End Select
Exit Function
errh:
Debug.Print Err.Description, oList.Row + dScroll
End Function

Private Function FrmProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lPrevWndProc As Long
Dim hwnd As Long
Dim pa As POINTAPI
lPrevWndProc = GetProp(hw, PROP_PREVPROC)
Select Case uMsg
Case WM_MOUSEWHEEL
GetCursorPos pa
hwnd = WindowFromPoint(pa.X, pa.Y)
If GetProp(hwnd, PROP_PREVPROC) <> 0 Then SendMessage hwnd, uMsg, wParam, lParam
Case WM_CLOSE
RemoveProp hw, PROP_PREVPROC
SetWindowLong hw, GWL_WNDPROC, lPrevWndProc
Case Else
FrmProc = CallWindowProc(lPrevWndProc, hw, uMsg, wParam, lParam)
End Select
End Function

Private Function ObjFromPtr(lObjPtr As Long) As Object
Dim LoTmp As Object
If lObjPtr <> 0 Then
CopyMemory LoTmp, lObjPtr, 4
Set ObjFromPtr = LoTmp
CopyMemory LoTmp, 0&, 4
End If
End Function


Только это не для формы.Но автор написал,что можно модифицировать и должно получиться.Пыталась,не идет...Может посоветуешь,как его изменить???Если не сложно,конечно...

и [Highlight].Так ведь читать неудобно

По теме:особо вчитываться не стал,но,по видимому,этот код для создания полос прокрутки для разных таблиц(типа DataGrid,DBGrid,MSFlexGrid и MSHFlexGrid,как указано в коде).Можно,конечно,этот код преобразовать,только подумать надо и не упустить ничего

гм, из приведенного тобою текста мало чего понятно.
кароче, вот рабочий пример, демонстрирующий как отловить колесико:

http://www.tek-tips.com/viewthread.cfm?qid=902639&page=1

Привет!Спасибо 12345678!Дома попытаюсь запустить программу.Но наверное надо какие-то дополнительные компоненты подключать...

Привет!12345678, Спасибо еще раз.Работает отлично.Форма стала прокручиваться как я хотела!!!!!Спасибо большое!!!