использование SCROLLа

[Akella]

Hello. И Ещё вопрос, Как написать прогу для использования (SCROLLа на мыши) в графическом интурфейсе (сделанным скажем с помощью Line, BitBlt, и всего подобного). ну понятно. КАК ПЕРЕДВИНУТЬ LINE(...)- (...) с помощью СКРОЛА

[Scuder]

Хук поставить..

На форму Line1, в форму:

Код: Выделить всё

Option Explicit
Dim MScroll As Integer

Private Sub Form_Load()
Call Hook(Me.hwnd)
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call UnHook(Me.hwnd)
End Sub

В модуль:

Код: Выделить всё

Option Explicit
Private Declare Function CallWindowProcA Lib "user32" (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 SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowTextA Lib "user32" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
Private lpPrevWndProc As Long, Wheel As Integer

Sub Hook(hwnd As Long)
lpPrevWndProc = SetWindowLongA(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Sub UnHook(hwnd As Long)
Call SetWindowLongA(hwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub

Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo xErr
If uMsg = WM_MOUSEWHEEL Then
If wParam = -7864320 Or wParam = -23592960 Or wParam = -15728640 Then Wheel = -1
If wParam = 7864320 Or wParam = 23592960 Or wParam = 15728640 Then Wheel = 1
Call SetWindowTextA(Form1.hwnd, "Wheel " & Wheel)

Form1.Line1.Y1 = Form1.Line1.Y1 - Wheel * 10
Form1.Line1.Y2 = Form1.Line1.Y2 - Wheel * 10

Else
WindowProc = CallWindowProcA(lpPrevWndProc, hwnd, uMsg, wParam, lParam)
End If
xErr:
End Function

[Akella]

Привет Scuder. Спасибо за пример. На Форме работает отлично, а как мне его заставить работать в ограниченном пространстве. Смотри я делаю так , а он виснет, все виснет HELLP. у меня wXP

Код: Выделить всё

Private Sub Form_Load()
'Call Hook(Me.hwnd)

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Создаю ограниченное пространство
If X > 10 And X < 200 And Y > 10 And Y < 200 Then
Call Hook(Me.hwnd)
Else
Call UnHook(Me.hwnd)
End If
' Это допустим область действия
Line (10, 10)-(200, 200), , B
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call UnHook(Me.hwnd)
End Sub


[Scuder]

А сам не подумал, почему всё виснет?

Код: Выделить всё

Dim IsHook As Boolean

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Создаю ограниченное пространство
If X > 10 And X < 2000 And Y > 10 And Y < 2000 Then
    Me.Text2 = "Ok"
    If IsHook = False Then
        Call Hook(Me.hwnd)
        IsHook = True
    End If
Else
    Me.Text2 = "Not Ok"
    If IsHook = True Then
        Call UnHook(Me.hwnd)
        IsHook = False
    End If
End If
' Это допустим область действия
Line (10, 10)-(2000, 2000), , B
End Sub

[SHURUP]

У кого виснет, а у меня в XP просто закрывает Бейсик и все

[Akella]

А ты откомпилируй, и повиснет

[SHURUP]

Я тут "гениальный " эсперимент провел, это не выход но заслуживает внимания. (По крайней мере не выкидывает и не виснет)

На первый взгляд это не по теме, но…
На форме размести такие элементы:
Command1, Command2, Timer1, Line1, List1
Имена не меняй, Свойства не имеют значения
А теперь

Код: Выделить всё

Private Sub Command1_Click()
    Timer1.Interval = 10
    List1.SetFocus
End Sub

Private Sub Command2_Click()
    Timer1.Interval = 0
End Sub

Private Sub Form_Load()
    AutoRedraw = True
    Command1.Caption = "Start mini hook"
    Command1.Move 0, 0, 1680, 375
    Command2.Caption = "Stop mini hook"
    Command2.Move 0, 375, 1680, 375
    List1.Height = 0
    List1.Left = -5000
    With Line1
        .Y1 = ScaleHeight / 2
        .Y2 = ScaleHeight / 2
        .X1 = 0
        .X2 = ScaleWidth
    End With
    For i = 0 To 2
        List1.AddItem "item" & i
    Next
    List1.TopIndex = 1
End Sub

Private Sub checkChange()
    Select Case List1.TopIndex
       Case 0: CHange (-1)
       Case 2: CHange (1)
       Case 1: Exit Sub
    End Select
    List1.TopIndex = 1
End Sub

Private Sub Timer1_Timer()
    checkChange
End Sub

Private Sub CHange(direct As Integer)
    Line1.Y1 = Line1.Y1 + direct * 100
    Line1.Y2 = Line1.Y1
End Sub

И вот так без API-хуков. Проблем осталось много, но все-же…