VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - 用VB5.0收集键盘和鼠标信息
发表评论(0)作者:不详, 平台:VB6.0+Win98, 阅读:9711, 日期:2000-10-10
用VB5.0收集键盘和鼠标信息

  在一些应用软件中,收集键盘和鼠标的信息比较重要,而VB5.0又没有提供相应的函数达到这个目的。实际上可以用相应的API来实现,如笔者的键盘信息为:键盘类型:IBM 101/102增强键盘,重复击键速度每秒钟15个字符,键盘延时0秒,光标闪烁间隔500ms;鼠标为MS双键,双击间隔为300ms。运行以下程序就可以收集到以上信息。

  程序代码:

  建立一模块,命名为info.bas,API声明如下:

  Option Explicit

  ′搜集键盘信息的API

  Declare Function GetCaretBlinkTime Lib ″user32″ () As Long

  Public Const SPI—GETKEYBOARDSPEED = 10

  Public Const SPI—GETKEYBOARDDELAY = 22

  Declare Function SystemParametersInfo Lib ″user32″ Alias ″SystemParametersInfoA″ (ByVal uAction As Long,

  ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long

  Declare Function GetKeyboardType Lib ″user32″ (ByVal nTypeFlag As Long) As Long

  ′搜集鼠标信息的API

  Declare Function GetDoubleClickTime Lib ″user32″ () As Long

  Public Const SM—CMOUSEBUTTONS = 43

  Declare Function GetSystemMetrics Lib ″user32″ (ByVal nIndex As Long) As Long

  Public Const SM—MOUSEPRESENT = 19

  主窗口(Form1)上放Command1,Timer1及4个label,分别命名为lblkeyboard,lblrepeatspeed,lblrepeatdelay,lblcaretflash.显示键盘的信息建一shape1,表示光标闪烁的效果。2个label,分别命为lblmouse,lbldblclick显示鼠标的信息。

  Private Sub Command1—Click()

  Dim r As Long

  Dim t As String

  Dim k As Long

  Dim q As Long

  k = GetKeyboardType(0)

  If k = 1 Then t = ″PC or compatible 83-key keyboard″

  If k = 2 Then t = ″Olivetti 102-key keyboard″

  If k = 3 Then t = ″AT or compatible 84-key keyboard″

  If k = 4 Then t = ″Enhanced(IBM) 101-102-key keyboard″

  If k = 5 Then t = ″Nokia 1050 keyboard″

  If k = 6 Then t = ″Nokia 9140 keyboard″

  If k = 7 Then t = ″Japanese keyboard″

  lblkeyboard = ′Type of keyboard : ″ & t

  q = SystemParametersInfo(SPI—GETKEYBOARDDELAY, 0, r, 0)

  lblrepeatdelay = ″Keyboard Repeat Delay = ″ & r & ″ Seconds″

  q = SystemParametersInfo(SPI—GETKEYBOARDSPEED, 0, r, 0)

  scrRepeatSpeed = r

  lblrepeatspeed = ″Keyboard Repeat Speed = ″ & r & ″ characters per second.″

  Timer1.Interval = GetCaretBlinkTime

  scrCaretFlash = GetCaretBlinkTime

  lblcaretflash = ″Caret Flash Speed = ″ & GetCaretBlinkTime & ″ms″

  If GetSystemMetrics(SM_MOUSEPRESENT) = 1 Then

  lblmouse = ″Standard Mouse Present with ″ & GetSystemMetrics(SM—CMOUSEBUTTONS) & ″ buttons.″

  Else

  lblmouse = ″No Mouse Present.″

  Exit Sub

  End If

  lbldblclick = ″Double Click Speed = ″ & GetDoubleClickTime & ″ms″

  End Sub

  Private Sub Form—Load()

  Call Command1—Click

  End Sub

  Private Sub Timer1—Timer()

  Shape1.Visible = Not Shape1.Visible

  End Sub

  按F5运行,点击Command1即可收集到键盘和鼠标信息。

  此程序在Pwin95和中文VB5.0中成功运行通过,已运用到实际工作中。