mousedemo.frm

这是一个JSP在线考试系统

      TabIndex        =   2
      Top             =   480
      Width           =   2175
   End
   Begin VB.Label Label2 
      BackColor       =   &H00400040&
      BackStyle       =   0  'Transparent
      Caption         =   "2"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0080FFFF&
      Height          =   255
      Left            =   2280
      TabIndex        =   1
      Top             =   120
      Width           =   375
   End
   Begin VB.Label Label1 
      BackColor       =   &H00400040&
      BackStyle       =   0  'Transparent
      Caption         =   "当前鼠标按键数："
      ForeColor       =   &H0080FFFF&
      Height          =   255
      Left            =   720
      TabIndex        =   0
      Top             =   120
      Width           =   1455
   End
   Begin VB.Image Image2 
      Height          =   3495
      Left            =   -20
      Picture         =   "MouseDemo.frx":11D3
      Stretch         =   -1  'True
      Top             =   0
      Width           =   4095
   End
End
Attribute VB_Name = "MouseDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'说明：各种鼠标操作的制作技巧
'日期：1999.01.08
'编者：徐景周


Private Declare Function GetDoubleClickTime Lib "user32" () As Long
Private Declare Function SetDoubleClickTime Lib "user32" (ByVal wCount As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function SwapMouseButton Lib "user32" (ByVal bSwap As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

Const SM_CMOUSEBUTTONS = 43 '鼠标按键数

Private Type POINTAPI    '鼠标移动范围
           X As Long
           Y As Long
End Type
Private Type RECT
       Left As Long
       Top As Long
       Right As Long
       Bottom As Long
End Type

Dim z As POINTAPI
Dim NewRect As RECT
Dim tmpX As Long
Dim tmpY As Long
Dim X As Long, Y As Long, tmp As Long
Dim pos As Long

Private Sub Check1_Click()
   
   If Check1.Value = 1 Then
    Option6(0).Enabled = True
    Option6(1).Enabled = True
    Option6(2).Enabled = True
   Else
     Option6(0).Enabled = False
     Option6(1).Enabled = False
     Option6(2).Enabled = False
   End If
   
End Sub

Private Sub Command1_Click()
   Dim rv As Long
   
    If Check1.Value = 1 Then
       If Option6(0).Value = True Then
         pos = SetCursorPos(MouseDemo.Left / X&, MouseDemo.Top / Y&)
       ElseIf Option6(1).Value = True Then
         pos = SetCursorPos(MouseDemo.Left / X& + MouseDemo.Width / (2 * X&), MouseDemo.Top / Y& + MouseDemo.Height / (2 * Y&))
       ElseIf Option6(2).Value = True Then
         pos = SetCursorPos(MouseDemo.Left / X& + MouseDemo.Width / X& - 5, MouseDemo.Top / Y& + MouseDemo.Height / Y& - 5)
       End If
    End If
    
    rv = SetWindowLong(hwnd, GWL_WNDPROC, PROROC) '恢复标题栏拖动
    If Option2.Value = True Then
        GetCursorPos z
        tmpX = z.X
        tmpY = z.Y
        ShowCursor False
    ElseIf Option1.Value = True Then
        SwapMouseButton (True)
    ElseIf Option4.Value = True Then
        SetDoubleClickTime (CInt(Text1.Text))
    ElseIf Option3.Value = True Then
        X& = Screen.TwipsPerPixelX
        Y& = Screen.TwipsPerPixelY
        With NewRect
         .Left = MouseDemo.Left / X&
         .Top = MouseDemo.Top / Y&
         .Right = .Left + MouseDemo.Width / X&
         .Bottom = .Top + MouseDemo.Height / Y&
        End With
        tmp& = ClipCursor(NewRect)
    ElseIf Option5.Value = True Then
        PROROC = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
    End If

End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Form_Load()
     
     '建立特殊形状的窗体
   SetWindowRgn MouseDemo.hwnd, CreateRoundRectRgn(0, 0, MouseDemo.Width / Screen.TwipsPerPixelX, MouseDemo.Height / Screen.TwipsPerPixelY, 160, 160), True
    '建立椭圆按钮
   SetWindowRgn Command1.hwnd, CreateEllipticRgn(0, 0, Command1.Width / Screen.TwipsPerPixelX, Command1.Height / Screen.TwipsPerPixelY), True
   SetWindowRgn Command2.hwnd, CreateEllipticRgn(0, 0, Command2.Width / Screen.TwipsPerPixelX, Command2.Height / Screen.TwipsPerPixelY), True
    
    flush = 0
    num = 0
    '显示当前鼠标按键数，双击时间及当前坐标位置
    Label2.Caption = Str(GetSystemMetrics(SM_CMOUSEBUTTONS))
    Label4.Caption = Str(GetDoubleClickTime)
    GetCursorPos z
    Label6.Caption = "X:" & Str(z.X)
    Label7.Caption = "Y:" & Str(z.Y)
    Option2.Value = True
    X& = Screen.TwipsPerPixelX
    Y& = Screen.TwipsPerPixelY
    pos = SetCursorPos(MouseDemo.Left / X& + MouseDemo.Width / (2 * X&), MouseDemo.Top / Y& + MouseDemo.Height / (2 * Y&))
    
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    
'    GetCursorPos z
'    Label6.Caption = "X:" & Str(z.X)
'    Label7.Caption = "Y:" & Str(z.Y)
'    If Abs(z.X - tmpX) > 6 Or Abs(z.Y - tmpY) > 6 Then
'        ShowCursor True
'    End If

End Sub

Private Sub Form_Resize()
   Dim rv As Long
   
     With NewRect
         .Left = 0&
         .Top = 0&
         .Right = Screen.Width / Screen.TwipsPerPixelX
         .Bottom = Screen.Height / Screen.TwipsPerPixelY
    End With
    tmp& = ClipCursor(NewRect)
    'SwapMouseButton (False)
    'rv = SetWindowLong(hWnd, GWL_WNDPROC, PROROC)
    ShowCursor True
End Sub

Private Sub Form_Unload(Cancel As Integer)
   Dim rv As Long
   
    With NewRect
         .Left = 0&
         .Top = 0&
         .Right = Screen.Width / Screen.TwipsPerPixelX
         .Bottom = Screen.Height / Screen.TwipsPerPixelY
    End With
    tmp& = ClipCursor(NewRect) '恢复鼠标正常移动范围
    ShowCursor True  '显示鼠标
    SwapMouseButton (False) '恢复鼠标左右键
    rv = SetWindowLong(hwnd, GWL_WNDPROC, PROROC) '恢复标题栏拖动
    
End Sub

Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
GetCursorPos z
    Label6.Caption = "X:" & Str(z.X)
    Label7.Caption = "Y:" & Str(z.Y)
    If Abs(z.X - tmpX) > 6 Or Abs(z.Y - tmpY) > 6 Then
        ShowCursor True
    End If
End Sub

Private Sub Image2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   GetCursorPos z
    Label6.Caption = "X:" & Str(z.X)
    Label7.Caption = "Y:" & Str(z.Y)
    If Abs(z.X - tmpX) > 6 Or Abs(z.Y - tmpY) > 6 Then
        ShowCursor True
    End If
End Sub

Private Sub Option1_Click()
    Text1.Enabled = False
     
End Sub

Private Sub Option2_Click()
    Text1.Enabled = False
    
End Sub

Private Sub Option3_Click()
    Text1.Enabled = False
    
End Sub

Private Sub Option4_Click()
    Text1.Enabled = True
    
End Sub

Private Sub Option5_Click()
    Text1.Enabled = False
    
End Sub