用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中成功運行通過,已運用到實際工作中。   

原文轉自：http://www.anti-gravitydesign.com