Функция SetCursorPos
Описание : Функция SetCursorPos function moves the cursor to the specified screen coordinates. If the new coordinates are not within the screen rectangle set by the most recent ClipCursor function, Windows automatically adjusts the coordinates so that the cursor stays within the rectangle.
Операционная система : Windows NT 3.1 или выше; Windows 95 или выше
Библиотека : User32.dll
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
X As Long
Y As Long
End Type
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
Sub DrawButton(Pushed As Boolean)
 im Clr1 As Long, Clr2 As Long
If Pushed = True Then
'If Pushed=True then clr1=Dark Gray
Clr1 = &H808080
'If Pushed=True then clr1=White
Clr2 = &HFFFFFF
ElseIf Pushed = False Then
'If Pushed=True then clr1=White
Clr1 = &HFFFFFF
'If Pushed=True then clr1=Dark Gray
Clr2 = &H808080
End If
With Form1.ExplButton
' Draw the button
Form1.ExplButton.Line (0, 0)-(.ScaleWidth, 0), Clr1
Form1.ExplButton.Line (0, 0)-(0, .ScaleHeight), Clr1
Form1.ExplButton.Line ( _
.ScaleWidth - 1, _
.ScaleHeight - 1)-( _
.ScaleWidth - 1, 0), Clr2
Form1.ExplButton.Line ( _
.ScaleWidth - 1, _
.ScaleHeight - 1)-(0, _
.ScaleHeight - 1), Clr2
End With
End Sub
Private Sub Command1_Click()
 im Rec As RECT
'Get Left, Right, Top and Bottom of Form1
GetWindowRect Form1.hwnd, Rec
'Set Cursor position on X
SetCursorPos Rec.Right - 15, Rec.Top + 15
End Sub
Private Sub ExplButton_MouseDown(Button As Integer, _
Shift As Integer, _
X As Single, _
Y As Single)
 rawButton True
End Sub
Private Sub ExplButton_MouseMove(Button As Integer, _
Shift As Integer, _
X As Single, _
Y As Single)
 rawButton False
End Sub
Private Sub ExplButton_MouseUp(Button As Integer, _
Shift As Integer, _
X As Single, _
Y As Single)
 rawButton False
End Sub
Private Sub Form_Load()
 im Stretched As Boolean
'picIcon.Visible = False
'API uses pixels
picIcon.ScaleMode = vbPixels
'No border
ExplButton.BorderStyle = 0
'API uses pixels
ExplButton.ScaleMode = vbPixels
'Set graphic mode te 'persistent graphic'
ExplButton.AutoRedraw = True
'API uses pixels
Me.ScaleMode = vbPixels
'Set the button's caption
Command1.Caption = "Set Mousecursor on X"
' If you set Stretched to true then stretch the
'icon to te Height and Width of the button
' If Stretched=False, the icon will be centered
Stretched = False
If Stretched = True Then
' Stretch the Icon
ExplButton.PaintPicture picIcon.Picture, 1, 1, _
ExplButton.ScaleWidth - 2, _
ExplButton.ScaleHeight - 2
ElseIf Stretched = False Then
' Center the picture of the icon
ExplButton.PaintPicture picIcon.Picture, _
(ExplButton.ScaleWidth - picIcon.ScaleWidth) / 2, _
(ExplButton.ScaleHeight - picIcon.ScaleHeight) / 2
End If
' Set icon as picture
ExplButton.Picture = ExplButton.Image
End Sub
Private Sub Timer1_Timer()
 im Rec As RECT, Point As POINTAPI
' Get Left, Right, Top and Bottom of Form1
GetWindowRect Me.hwnd, Rec
' Get the position of the cursor
GetCursorPos Point
' If the cursor is located above the form then
If Point.X >= Rec.Left And Point.X <= Rec.Right And _
Point.Y >= Rec.Top And Point.Y <= Rec.Bottom Then
Me.Caption = "MouseCursor is on form."
Else
' The cursor is not located above the form
Me.Caption = "MouseCursor is not on form."
End If
End Sub
Private Sub Timer2_Timer()
 im Rec As RECT, Point As POINTAPI
' Get Left, Right, Top and Bottom of ExplButton
GetWindowRect ExplButton.hwnd, Rec
' Get the position of the cursor
GetCursorPos Point
' If the cursor isn't located above ExplButton then
If Point.X < Rec.Left Or Point.X > Rec.Right Or _
Point.Y < Rec.Top Or _
Point.Y > Rec.Bottom Then ExplButton.Cls
End Sub
Ответить
|