用VB5.0收集鍵盤與鼠標(biāo)信息
發(fā)表時(shí)間:2024-02-22 來源:明輝站整理相關(guān)軟件相關(guān)文章人氣:
[摘要]陳耀華 在一些應(yīng)用軟件中,收集鍵盤和鼠標(biāo)的信息比較重要,而VB5.0又沒有提供相應(yīng)的函數(shù)達(dá)到這個(gè)目的。實(shí)際上可以用相應(yīng)的API來實(shí)現(xiàn),如筆者的鍵盤信息為:鍵盤類型:IBM 101/102增強(qiáng)鍵盤,重復(fù)擊鍵速度每秒鐘15個(gè)字符,鍵盤延時(shí)0秒,光標(biāo)閃爍間隔500ms;鼠標(biāo)為MS雙鍵,雙擊間隔為30...
陳耀華
在一些應(yīng)用軟件中,收集鍵盤和鼠標(biāo)的信息比較重要,而VB5.0又沒有提供相應(yīng)的函數(shù)達(dá)到這個(gè)目的。實(shí)際上可以用相應(yīng)的API來實(shí)現(xiàn),如筆者的鍵盤信息為:鍵盤類型:IBM 101/102增強(qiáng)鍵盤,重復(fù)擊鍵速度每秒鐘15個(gè)字符,鍵盤延時(shí)0秒,光標(biāo)閃爍間隔500ms;鼠標(biāo)為MS雙鍵,雙擊間隔為300ms。運(yùn)行以下程序就可以收集到以上信息。
程序代碼:
建立一模塊,命名為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
′搜集鼠標(biāo)信息的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個(gè)label,分別命名為lblkeyboard,lblrepeatspeed,lblrepeatdelay,lblcaretflash.顯示鍵盤的信息建一shape1,表示光標(biāo)閃爍的效果。2個(gè)label,分別命為lblmouse,lbldblclick顯示鼠標(biāo)的信息。
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運(yùn)行,點(diǎn)擊Command1即可收集到鍵盤和鼠標(biāo)信息。
此程序在Pwin95和中文VB5.0中成功運(yùn)行通過,已運(yùn)用到實(shí)際工作中。