Visual Basic. Программирование на Visual Basic

..........................................................................................................................

[ Главная ] [ Статьи ] [ Для новичков ] [ Примеры ] [ Программы ] [ Microsoft Agent 2.0 ] [ Пособие ] [ Уроки ] [ Разное ]
..........................................................................................................................



Ограничить передвижение мыши.
Данный пример покажет, как можно ограничить передвижение мыши в пределах запущенной формы.
Расположите на форме 2 элемента CommandButton.

Private Declare Sub ClipCursor Lib "user32" (lpRect As Any)
Private Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT)
Private Declare Sub ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINT)
Private Declare Sub OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long)
Private Type RECT
left As Integer
top As Integer
right As Integer
bottom As Integer
End Type
Private Type POINT
x As Long
y As Long
End Type
Private Sub Form_Load()
Command1.Caption = "Ограничить передв."
Command2.Caption = "Снять ограничение"
End Sub
Private Sub Form_Unload(Cancel As Integer)
ClipCursor ByVal 0&
End Sub
Private Sub Command1_Click()
Dim client As RECT
Dim upperleft As POINT
GetClientRect Me.hWnd, client
upperleft.x = client.left
upperleft.y = client.top
ClientToScreen Me.hWnd, upperleft
OffsetRect client, upperleft.x, upperleft.y
ClipCursor client
End Sub
Private Sub Command2_Click()
ClipCursor ByVal 0&
End Sub

Или такой пример

Private Declare Function ClipCursor& Lib "user32" (lpRect As RECT)
Private Declare Function FreeCursor& Lib "user32" Alias "ClipCursor" (ByVal Zero&)
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private R As RECT
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
With R
.Bottom = (Top + Height) / Screen.TwipsPerPixelY
.Left = Left / Screen.TwipsPerPixelX
.Right = (Left + Width) / Screen.TwipsPerPixelX
.Top = Top / Screen.TwipsPerPixelY
End With
ClipCursor R
End Sub
Private Sub Form_Unload(Cancel As Integer)
FreeCursor 0
End Sub

Или такой пример

Добавьте на форму элемент PictureBox. Добавьте в элемент PictureBox элемент CheckBox

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 Declare Sub ClipCursorRect Lib "user32" Alias "ClipCursor" (lpRect As RECT)
Private Declare Sub ClipCursorClear Lib "user32" Alias "ClipCursor" (ByVal lpRect As Long)
Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long

Private Sub RestrictCursor(ByVal lLeft As Long, ByVal lTop As Long, ByVal lWidth As Long, ByVal lHeight As Long, Optional ByRef oPositionTo As Object = Nothing)
Dim tR As RECT
Dim tP As POINTAPI
tR.Left = lLeft \ Screen.TwipsPerPixelX
tR.Top = lTop \ Screen.TwipsPerPixelY
tR.Right = (lLeft + lWidth) \ Screen.TwipsPerPixelX
tR.Bottom = (lLeft + lHeight) \ Screen.TwipsPerPixelY
If oPositionTo Is Nothing Then Set oPositionTo = Screen
If Not oPositionTo Is Screen Then
tP.X = tR.Left
tP.Y = tR.Top
ClientToScreen oPositionTo.hWnd, tP
tR.Left = tP.X
tR.Top = tP.Y
tP.X = tR.Right
tP.Y = tR.Bottom
ClientToScreen oPositionTo.hWnd, tP
tR.Right = tP.X
tR.Bottom = tP.Y
End If
ClipCursorRect tR
End Sub
Public Sub ClearRestrictCursor()
ClipCursorClear 0
End Sub

Private Sub Check1_Click()
If (Check1.Value = Checked) Then
RestrictCursor 0, 0, Picture1.Width, Picture1.Height, Picture1
Else
ClearRestrictCursor
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
ClearRestrictCursor
End Sub



..........................................................................................................................

[ Главная ] [ Диски ] [ Книги ] [ Архив рассылки ] [ Архив новостей ] [ Готовые кусочки программ ] [ Карта сайта ]
..........................................................................................................................

По страницам сайта Visaul Progs
или Изучение Visual Basic
Рассылка 'По страницам сайта Visaul Progs' >>> Подпишись на рассылку - будешь получать новые статьи , примеры и много полезной информации из первых рук!!! >>>Если у вас есть статья которой нет на сайте
пришлите ее мне-------->
Послать статью
>>>Если вы хотите задать вопрос
пишите-------->
Мне нужна помощь


Рейтинг сайтов YandeG Rambler's Top100
Реклама:
ремонт подвески шкода.

...:::Design by Mystf0rse 2005-2010 year:::...