frmtestmouse.frm

一款飞机射击游戏的源代码

VERSION 5.00
Begin VB.Form FrmTestMouse 
   Caption         =   "Form1"
   ClientHeight    =   3675
   ClientLeft      =   1650
   ClientTop       =   1800
   ClientWidth     =   6420
   LinkTopic       =   "Form1"
   ScaleHeight     =   3675
   ScaleWidth      =   6420
   Begin VB.TextBox Text4 
      Height          =   375
      Left            =   4080
      TabIndex        =   6
      Text            =   "Text4"
      Top             =   600
      Width           =   1095
   End
   Begin VB.TextBox Text3 
      Height          =   375
      Left            =   120
      TabIndex        =   5
      Text            =   "Text3"
      Top             =   600
      Width           =   975
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   4080
      TabIndex        =   4
      Text            =   "Text2"
      Top             =   120
      Width           =   1095
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   120
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   120
      Width           =   975
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H8000000D&
      BorderStyle     =   0  'None
      Height          =   855
      Left            =   2280
      ScaleHeight     =   855
      ScaleWidth      =   1095
      TabIndex        =   2
      Top             =   1440
      Width           =   1095
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Command2"
      Height          =   495
      Left            =   4200
      TabIndex        =   1
      Top             =   1680
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   480
      TabIndex        =   0
      Top             =   2520
      Width           =   1215
   End
End
Attribute VB_Name = "FrmTestMouse"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'ClipCursor
Private Type RECT
    left As Long
    top As Long
    right As Long
    bottom As Long
End Type
Private Type POINT
    X As Long
    Y As Long
End Type
Private Declare Sub ClipCursor Lib "user32" (lpRect As Any)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINT) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

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)
Dim IsTesting As Boolean
    Dim client As RECT
    Dim upperleft As POINT
    Dim SetRECT As RECT
Private Sub Form_Activate()
    Call TestMouse

End Sub

Private Sub Form_Load()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: [e-mail]
    Command1.Caption = "Limit Cursor Movement"
    Command2.Caption = "Release Limit"
End Sub
Private Sub Command1_Click()
    'Limits the Cursor movement to within the form.
    'Get information about our wndow
    GetClientRect Picture1.hWnd, client
    upperleft.X = client.left
    upperleft.Y = client.top
    'MsgBox client.left & " " & client.top
    
    'Convert window co?rdinates to screen co?rdinates
    ClientToScreen Picture1.hWnd, upperleft
    'move our rectangle
    OffsetRect client, upperleft.X, upperleft.Y
    'MsgBox upperleft.X & " " & upperleft.Y
    'limit the cursor movement
    'Debug.Print client.left, client.top, client.right, client.bottom
    With SetRECT
        .left = 319
        .top = 239
        .bottom = 242
        .right = 322
    End With
    ClipCursor SetRECT
End Sub
Private Sub Command2_Click()
    'Releases the cursor limits
    ClipCursor ByVal 0&
    IsTesting = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'Releases the cursor limits
    IsTesting = False
    ClipCursor ByVal 0&
End Sub

Sub TestMouse()
Dim GetSeat As POINT

If IsTesting = True Then Exit Sub

IsTesting = True
Do While IsTesting
DoEvents
    GetCursorPos GetSeat
    Text1.Text = GetSeat.X
    Text2.Text = GetSeat.Y
    
    If GetSeat.X = 319 Then
        Text3.Text = Val(Text3.Text) + 1
    ElseIf GetSeat.X = 321 Then
        Text4.Text = Val(Text4.Text) + 1
    End If
    SetCursorPos 320, 240
    
    
    
    
Loop
End Sub