当前位置: 源码素材网 » VB教程 » 详情页

VB6.0在程序中控制鼠标定位和移动

  •   时间:2019-07-11
  • 概述:鼠标定位 键位

VB6.0在程序中控制鼠标,定位鼠标、移动鼠标、获取鼠标键位数等,测试时候为了避免鼠标丢失,请按提示操作!按Tab键使‘显示鼠标’得到焦点,敲回车!

VERSION 5.00
Begin VB.Form frmMain
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "在程序中控制鼠标"
   ClientHeight    =   4245
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5370
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4245
   ScaleWidth      =   5370
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox Picture1
      Height          =   3975
      Left            =   3960
      ScaleHeight     =   3915
      ScaleWidth      =   1155
      TabIndex        =   0
      Top             =   120
      Width           =   1215
      Begin VB.CommandButton Command8
         Caption         =   "关闭"
         Height          =   375
         Left            =   120
         TabIndex        =   9
         Top             =   3480
         Width           =   975
      End
      Begin VB.CommandButton Command7
         Caption         =   "鼠标键数"
         Height          =   375
         Left            =   120
         TabIndex        =   8
         Top             =   3000
         Width           =   975
      End
      Begin VB.CommandButton Command6
         Caption         =   "设置鼠标"
         Height          =   375
         Left            =   120
         TabIndex        =   7
         Top             =   2520
         Width           =   975
      End
      Begin VB.CommandButton Command5
         Caption         =   "鼠标坐标"
         Height          =   375
         Left            =   120
         TabIndex        =   6
         Top             =   2040
         Width           =   975
      End
      Begin VB.CommandButton Command4
         Caption         =   "移动鼠标"
         Height          =   375
         Left            =   120
         TabIndex        =   5
         Top             =   1560
         Width           =   975
      End
      Begin VB.CommandButton Command3
         Caption         =   "定位鼠标"
         Height          =   375
         Left            =   120
         TabIndex        =   4
         Top             =   1080
         Width           =   975
      End
      Begin VB.CommandButton Command2
         Caption         =   "显示鼠标"
         Enabled         =   0   'False
         Height          =   375
         Left            =   120
         TabIndex        =   3
         Top             =   600
         Width           =   975
      End
      Begin VB.CommandButton Command1
         Caption         =   "隐藏鼠标"
         Height          =   375
         Left            =   120
         TabIndex        =   1
         Top             =   120
         Width           =   975
      End
   End
   Begin VB.Label Label2
      Caption         =   "为了避免鼠标丢失,请按提示操作!"
      BeginProperty Font
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   840
      Left            =   1200
      TabIndex        =   10
      Top             =   1600
      Width           =   1840
   End
   Begin VB.Label Label1
      AutoSize        =   -1  'True
      ForeColor       =   &H000000FF&
      Height          =   180
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   90
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'----------------------
'    作者:段东良
'        99.5.17
'----------------------
'Download by http://www.srcfans.com
Private Sub Command1_Click()
'隐藏鼠标
        Label1.Caption = "按Tab键使‘显示鼠标’得到焦点,敲回车!"
        Command2.Enabled = True
        ShowCursor False
End Sub
Private Sub Command2_Click()
'显示鼠标
       Label1.Caption = ""
       Command2.Enabled = False
       ShowCursor True
End Sub
Private Sub Command3_Click()
'定位鼠标
       Dim x As Long, y As Long
       Dim newrect As rect
       x& = Screen.TwipsPerPixelX
       y& = Screen.TwipsPerPixelY
       Label1.Caption = "鼠标在这里!"
       '将鼠标定位在Label1中
       With newrect
            .sbleft = frmMain.Left / x + Label1.Left / x
            .sbtop = frmMain.Top / x + Label1.Top / x + (frmMain.Height - frmMain.ScaleHeight) / x
            .sbright = .sbleft + Label1.Width / x
            .sbbottom = .sbtop + Label1.Height / x
       End With
       ClipCursor newrect
       Label2.Caption = "请单击一下!"
End Sub
Private Sub Command4_Click()
'移动鼠标
        Label1.Caption = "鼠标在屏幕的左上角!"
        SetCursorPos 0, 0
End Sub
Private Sub Command5_Click()
'鼠标坐标
        Dim z As POINTAPI
        GetCursorPos z
        Label1.Caption = "x: " & z.x & " y: " & z.y
End Sub
Private Sub Command6_Click()
'设置鼠标
        frmMain.MousePointer = 11
        Label2.Caption = "在窗体空白处单击一下!"
End Sub
Private Sub Command7_Click()
'鼠标键数
        Dim mousebtn As Long
        mousebtn = GetSystemMetrics(43)
        Label1.Caption = "你的鼠标是 " & mousebtn & " 键鼠标!"
End Sub
Private Sub Command8_Click()
        End
End Sub
Private Sub Form_Click()
        Me.MousePointer = 0
        Label2.Caption = ""
End Sub
Private Sub Label1_Click()
'使鼠标恢复
        Dim newrect As rect
        With newrect
             .sbleft = 0
             .sbtop = 0
             .sbright = Screen.Width / Screen.TwipsPerPixelX
             .sbbottom = Screen.Height / Screen.TwipsPerPixelY
        End With
        ClipCursor newrect
        Label2.Caption = ""
End Sub

这里使用到了一个bas类文件,代码如下:

Attribute VB_Name = "Module1"
'1、隐藏/显示鼠标。
Public Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
'2、定位鼠标。
Type rect
    sbleft As Long
    sbtop As Long
    sbright As Long
    sbbottom As Long
End Type
Public Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
'3、移动鼠标。
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
'4、鼠标坐标。
Type POINTAPI
    x As Long
    y As Long
End Type
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'鼠标键数。
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

    相关声明:

      若“VB6.0在程序中控制鼠标定位和移动”有损您的权益,请告之我们删除内容。
      部分文章来源于网络,版权归原作者所有。