Как запретить курсору покидать окно программы

[GreenT]

Собственно топик.

[Amed]

Option Explicit
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private cPos As POINTAPI
Private fRect As RECT
Private InPos As POINTAPI

Private Sub Form_Load()
DoEvents
Me.Show
SetCursorPos (fRect.Right - fRect.Left) / 2, (fRect.Bottom - fRect.Top) / 2
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
End
End Sub

Private Sub Form_Resize()
GetWindowRect Me.hwnd, fRect
End Sub

Private Sub Timer1_Timer()
GetCursorPos cPos

If cPos.x < fRect.Left Or cPos.x > fRect.Right Or _
cPos.y < fRect.Top Or cPos.y > fRect.Bottom Then
SetCursorPos InPos.x, InPos.y
Else:
GetCursorPos InPos
End If
End Sub

Код в общем понятен?

[skiperski]

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

Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long

Private ScreenRect As RECT
Private WindowRect As RECT

Private ClipMode As Boolean

Private Sub Command1_Click()
    ClipMode = Not ClipMode
    If (ClipMode) Then
        Call GetWindowRect(Me.hWnd, WindowRect)
        Call ClipCursor(WindowRect)
    Else
        Call ClipCursor(ScreenRect)
    End If
End Sub

Private Sub Form_Load()
    Call GetClipCursor(ScreenRect)
End Sub

Private Sub Form_Terminate()
    Call ClipCursor(ScreenRect)
End Sub

[skiperski]

Плюс небольшая модификация.

Окно можно сменить комбинацией Alt+Tab, следовательно нужно следить за клавой, но мышка мечется только в окне. Единственный глюк: если таскать ею окно, то снова становится активным весь экран. Как побороть не знаю, ни каких событий при этом окно не ловит.

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

Private Sub Form_Paint()
    Call GetWindowRect(Me.hwnd, WindowRect)
    Call ClipCursor(WindowRect)
End Sub

Private Sub Form_Resize()
    If (Me.WindowState = vbNormal) Then
        Call GetWindowRect(Me.hwnd, WindowRect)
        Call ClipCursor(WindowRect)
    Else
        Call ClipCursor(ScreenRect)
    End If
End Sub

[GreenT]

Меня всегда поражало, как можно выкладывать примеры которые не работают. Ладно бы просто не работали, так вообще не запускаются по причине ошибок в коде.
Особенно когда с какого нибуть иностранного сайта скачиваешь его.
Но это я так, просто отступление

Amed, несовсем, но я попытаюсь разобратся.
Кстати, попробуйте вставить этот код и посмотреть что получается. Ооочень интересные эффекты

skiperski, на этом месте
Call GetClipCursor(ScreenRect)
пишет функция нот дефайнд.

Тем не менее, спасибо за ответы.

[SSecurity]

Идея такова ...
раз тебе не нравится варианты выше то действуй логический
если не получается сделать программно, действуем психологически

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

Private Sub Form_Load()
PP = "Внимание! Дорогой  мой  пользователь," + vbCrLf
PP = PP + "если курсор выйдет за пределы формы," + vbCrLf
PP = PP + "то компьютер перезагрузится." + vbCrLf
MsgBox PP, 48, " Предупреждение!"
End Sub


[Amed]

А потом сразу:

Me.Move 0,0,2500,2500

Randomize
SetCursorPos 500+rnd*250, 500+rnd*250

ExitWindowsEx EWX_FORCE, 0

Это чтобы не расслаблялся

GreenT - замени Call GetClipCursor(ScreenRect) на Call ClipCursor(ScreenRect)

[skiperski]

Меня всегда поражало, как можно выкладывать примеры которые не работают. Ладно бы просто не работали, так вообще не запускаются по причине ошибок в коде.

skiperski, на этом месте
Call GetClipCursor(ScreenRect)
пишет функция нот дефайнд.

А вот меня всегда поражало и до сих пор поражает хамство и наглость со стороны спрашивающих. Ещё кто-то древний сформулировал минимально допустимое поведение просящих: "Не кусай руку дающую".

Объявить самому уже никак? Просто скопировать из API Viewer? Да даже по аналогии с другими декларациями можно пораскинуть мозгами и самому написать. Этот пример выдран из объёмной программы. Я пытался его минимизировать чтобы остался прозрачный для понимания код. Случайно удалил одну декларацию. Получил выговор от автора топика за его же нежелание думать. У меня на этом всё.

[GreenT]

Ну что вы, уважаемый skiperski. Я ни в коей мере не хотел вас обидеть. Я вас глубоко признателен за Вашу помощь и за то вы тратите своё личное время отвечая на мои глупые вопросы

Моё замечание относилось не к вам, а было сделано вообще

Я бы из API Viewer скопировал, да только не знаю какую функцию там искать. И обьявил бы, если бы знал что.

[skiperski]

Моё замечание относилось не к вам, а было сделано вообще

Ладно, проехали.

Я бы из API Viewer скопировал, да только не знаю какую функцию там искать. И обьявил бы, если бы знал что.

А вот это уже программисту не простительно.

на этом месте
Call GetClipCursor(ScreenRect)
пишет функция нот дефайнд.

Эта чья цитата? Что компилятор сообщает? Какую функцию надо задекларировать?
Думай, думай, думай!

Или без даже API Viewer'а посмотри на декларацию GetWindowRect. Никаких ассоциаций?
Думай, думай, думай!

ЗЫ:

замени Call GetClipCursor(ScreenRect) на Call ClipCursor(ScreenRect)

Вредный совет, потому как не правильный.

[SSecurity]

А потом сразу:

Me.Move 0,0,2500,2500

Randomize
SetCursorPos 500+rnd*250, 500+rnd*250

ExitWindowsEx EWX_FORCE, 0

Это чтобы не расслаблялся

GreenT - замени Call GetClipCursor(ScreenRect) на Call ClipCursor(ScreenRect)

предлагается вариант проще... если курсор мыши остановится хотябы на секунду - РЕСТАРТ, и используя MouseMove следить .... когда зверь наведет на чего-нить кроме формы .... тогда включается таймер и делает РЕСТАРТ



[/code]