fro_3.frm

是API教程4

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H00FFFFFF&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Lesson4_3"
   ClientHeight    =   3870
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5490
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3870
   ScaleWidth      =   5490
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command2 
      Caption         =   "Xing对您说"
      Height          =   315
      Left            =   240
      TabIndex        =   2
      Top             =   120
      Width           =   1455
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   50
      Left            =   2460
      Top             =   2280
   End
   Begin VB.CommandButton Command1 
      Caption         =   "点这里"
      Height          =   315
      Left            =   4140
      TabIndex        =   0
      Top             =   3480
      Width           =   1215
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      BackColor       =   &H00FFFFFF&
      Caption         =   "祝君学习愉快！"
      BeginProperty Font 
         Name            =   "黑体"
         Size            =   21.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   855
      Left            =   360
      TabIndex        =   3
      Top             =   1200
      Visible         =   0   'False
      Width           =   4815
   End
   Begin VB.Label Label1 
      Alignment       =   1  'Right Justify
      BackColor       =   &H00FFFFFF&
      Caption         =   "点击此命令按钮后，请将手轻轻离开鼠标，观看演示。"
      Height          =   375
      Left            =   360
      TabIndex        =   1
      Top             =   3240
      Width           =   4995
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

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 SetCursorPos& Lib "user32" (ByVal x As Long, ByVal y As Long)
Private Declare Function GetCursorPos& Lib "user32" (lpPoint As POINTAPI)
Private Declare Function GetWindowRect& Lib "user32" (ByVal hwnd As Long, lpRect As RECT)


Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)



Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4




Private a As Single      '二次线性方程 Y=aX+b 中的 a 和 b
Private b As Single
Private OldPoint As POINTAPI '鼠标的目标位置
Private NewPoint As POINTAPI


Private Sub Command1_Click()
   Dim dl&
   Dim myrect As RECT
      
   dl& = GetWindowRect(Command2.hwnd, myrect)
   dl& = GetCursorPos(OldPoint)                      '获取当前鼠标位置
   NewPoint.x = myrect.Left + (myrect.Right - myrect.Left) \ 2
   NewPoint.y = myrect.Top + (myrect.Bottom - myrect.Top) \ 2
    
   a = (OldPoint.y - NewPoint.y) / (OldPoint.x - NewPoint.x)
   b = (OldPoint.y - a * OldPoint.x)
   
   Label2.Visible = False
   Timer1.Enabled = True
End Sub

Private Sub Command2_Click()
   Label2.Visible = Not Label2.Visible
End Sub

Private Sub Form_Load()
   Move (Screen.Width - Form1.Width) \ 2, (Screen.Height - Form1.Height) \ 2      '把窗体置于屏幕中央
End Sub

Private Sub Label3_Click()

End Sub

Private Sub Timer1_Timer()
   Dim dl&
   Dim i As Integer
   
   OldPoint.x = OldPoint.x - 10
   OldPoint.y = a * OldPoint.x + b
   
   If OldPoint.x < NewPoint.x And OldPoint.y < NewPoint.y Then
       dl& = SetCursorPos(NewPoint.x, NewPoint.y)
       Timer1.Enabled = False
      ' Command2_Click
       mouse_event MOUSEEVENTF_LEFTDOWN, NewPoint.x, NewPoint.y, 0, 0
       For i = 0 To 20      '延时
            Sleep 20
            DoEvents
       Next
       mouse_event MOUSEEVENTF_LEFTUP, NewPoint.x, NewPoint.y, 0, 0
   Else
       dl& = SetCursorPos(OldPoint.x, OldPoint.y)
   End If
End Sub