Private Type POINTAPI X As Long Y As Long End Type Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ReleaseCapture Lib "user32" () As Long Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Dim Pt As POINTAPI Private Sub Form_Load() 'KPD-Team 1999 'URL: http://www.allapi.net/ 'E-Mail: [email protected] 'redirect all mouse input to this form SetCapture Me.hwnd End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ReleaseCapture SetCapture Me.hwnd End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Get the current cursor position GetCursorPos Pt Me.CurrentX = 0 Me.CurrentY = 0 'Clear the screen Me.Cls Me.Print "Cursor position:" 'Print the mouse co?rdinates to the form Me.Print "X:" + Str$(Pt.X) + " Y:" + Str$(Pt.Y) Me.Print " (Press ALT-F4 to unload this form)" SetCapture Me.hwnd End Sub Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) ReleaseCapture SetCapture Me.hwnd End Sub
'This project needs 'a Form, called 'Form1' 'a Picture Box, called 'ExplButton' (50x50 pixels) 'a Picture Box with an icon in it, called 'picIcon' 'two timers (Timer1 and Timer2), both with interval 100 'Button, called 'Command1' 'In general section 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'Declare the API-Functions 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) Dim 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() Dim 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) DrawButton True End Sub Private Sub ExplButton_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) DrawButton False End Sub Private Sub ExplButton_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) DrawButton False End Sub Private Sub Form_Load() 'KPD-Team 1998 'URL: http://www.allapi.net/ 'E-Mail: [email protected] Dim 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() Dim 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() Dim 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
【VB声明】 Private Declare Function GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) As Long【说明】 获取鼠标指针的当前位置 【返回值】 Long,非零表示成功,零表示失败。会设置GetLastError 【参数表】 lpPoint -------- POINTAPI,随同指针在屏幕像素坐标中的位置载入的一个结构
X As Long
Y As Long
End Type
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Dim Pt As POINTAPI
Private Sub Form_Load()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: [email protected]
'redirect all mouse input to this form
SetCapture Me.hwnd
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SetCapture Me.hwnd
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Get the current cursor position
GetCursorPos Pt
Me.CurrentX = 0
Me.CurrentY = 0
'Clear the screen
Me.Cls
Me.Print "Cursor position:"
'Print the mouse co?rdinates to the form
Me.Print "X:" + Str$(Pt.X) + " Y:" + Str$(Pt.Y)
Me.Print " (Press ALT-F4 to unload this form)"
SetCapture Me.hwnd
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SetCapture Me.hwnd
End Sub
'a Form, called 'Form1'
'a Picture Box, called 'ExplButton' (50x50 pixels)
'a Picture Box with an icon in it, called 'picIcon'
'two timers (Timer1 and Timer2), both with interval 100
'Button, called 'Command1'
'In general section
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'Declare the API-Functions
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)
Dim 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()
Dim 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)
DrawButton True
End Sub
Private Sub ExplButton_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
DrawButton False
End Sub
Private Sub ExplButton_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
DrawButton False
End Sub
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: [email protected] Dim 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()
Dim 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()
Dim 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
Private Declare Function GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) As Long【说明】
获取鼠标指针的当前位置 【返回值】
Long,非零表示成功,零表示失败。会设置GetLastError 【参数表】
lpPoint -------- POINTAPI,随同指针在屏幕像素坐标中的位置载入的一个结构