قفل کردن کيبورد

[warden]

سلام دوستان
ميخواستم بدونم راهي هست که فقط کيبورد را قفل کنم ؟!
ممنون

[pooya1072]

سلام
منم دنبال یه چنین تابعی بودم که فقط کیبورد رو قفل کنه , ولی پیدا نکردم.
با تابع BlockInput کار کردم ولی دو عیب داره .یکی اینکه موس رو هم از کار میندازه و دیگه اینکه اگه Ctrl+Alt+Del رو بگیری از حالت قفل خارج میشه.حالا دارم روی یک نظریه جدید کار می کنم:لبخند:اونم اینه که برنامه ای بنویسم که توی اون در هر پنجره ای که focus روشه هر پیامی که از صفحه کلید برسه رو دریافت کنه و یه کارکتر space یا هر چیز دیگه رو به پنجره ارسال کنه.میدونم که اینکار رو باید با توابع peekmessage و sendmessage انجام داد.ولی هنوز در دست بررسیه :متفکر:

[kooroush]

منم با این تابع مشکل دارم ! آیا تابعی هست که فقط بتونه کیبورد رو قفل کنه ؟

[M.T.P]

البته محض اطلاع بعضی از دوستان این کد BlockInput رو باید تو یه تایمر گذاشت چون با Ctrl + Alt + Del باز میشه :لبخند:

[vbhamed]

سلام

يك راه البته كمي مشكل اينه كه با تابع زير تمام كليدها رو به صورت Shortcut ويندوز تعريف كنيد و در صورت فشرده شدن هيچ كاري انجام ندين
چون اين تابع سطح پايين هست بنابراين زودتر از هر برنامه اي كليد را دريافت مي كند


Public Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal ID As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long

با تابع زير هم مي‌تونيد Shortcut هاي تعريف شده رو حذف كنيد


Public Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal ID As Long) As Long

[warden]

سلام

يك راه البته كمي مشكل اينه كه با تابع زير تمام كليدها رو به صورت Shortcut ويندوز تعريف كنيد و در صورت فشرده شدن هيچ كاري انجام ندين
چون اين تابع سطح پايين هست بنابراين زودتر از هر برنامه اي كليد را دريافت مي كند


Public Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal ID As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long

با تابع زير هم مي‌تونيد Shortcut هاي تعريف شده رو حذف كنيد


Public Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal ID As Long) As Long
سلام
لطفا يک نمونه ساده از اين تابع رو بزارين.
پيشاپيش ممنون

[tehran2009]

کسی راه حلی نداره ؟

[vbhamed]

سلام

اينم نمونه :

فقط يك textbox ساده و يك دكمه به اسم Command1 و با عنوان End روي فرم بزاريد و كدهاي زير رو توش كپي كنيد


Option Explicit

Private Const MOD_ALT = &H1
Private Const MOD_CONTROL = &H2
Private Const MOD_SHIFT = &H4
Private Const PM_REMOVE = &H1
Private Const WM_HOTKEY = &H312

Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal Cx As Long, ByVal Cy As Long, ByVal wFlags As Long) As Long

Private Enum WindowPos

Hwnd_Top = 0
Hwnd_Bottom = 1
Hwnd_TopMost = -1
Hwnd_noTopMost = -2

End Enum

Private Const SWP_SHOWWINDOW = &H40

Private Type POINTAPI

x As Long
y As Long

End Type

Private Type Msg

hWnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI

End Type

Private Declare Function RegisterHotKey _
Lib "user32" (ByVal hWnd As Long, _
ByVal id As Long, _
ByVal fsModifiers As Long, _
ByVal vk As Long) As Long

Private Declare Function UnregisterHotKey _
Lib "user32" (ByVal hWnd As Long, _
ByVal id As Long) As Long

Private Declare Function PeekMessage _
Lib "user32" _
Alias "PeekMessageA" (lpMsg As Msg, _
ByVal hWnd As Long, _
ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, _
ByVal wRemoveMsg As Long) As Long

Private Declare Function WaitMessage Lib "user32" () As Long

Private bCancel As Boolean

Private Sub ProcessMessages()

Dim Message As Msg

'loop until bCancel is set to True
Do While Not bCancel
'wait for a message
WaitMessage

With Me

SetWindowPos .hWnd, Hwnd_TopMost, .Left \ 15, .Top \ 15, .Width \ 15, .Height \ 15, SWP_SHOWWINDOW

End With

'check if it's a HOTKEY-message
If PeekMessage(Message, Me.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
Label1 = "Not Allow"
Dim t!
t = Timer
While Timer < t + 0.2: DoEvents: Wend
End If

'let the operating system process other events
DoEvents
Label1 = ""
Loop

End Sub

Private Sub Command1_Click()
End
End Sub

Private Sub Form_Deactivate()

On Error Resume Next

With Me

SetWindowPos .hWnd, Hwnd_TopMost, _
.Left \ 15, .Top \ 15, .Width \ 15, .Height \ 15, SWP_SHOWWINDOW

End With

Me.SetFocus
Me.ZOrder 0

End Sub

Private Sub Form_Load()

On Error Resume Next

Dim ret As Long, c%


With Me

SetWindowPos .hWnd, Hwnd_TopMost, _
.Left \ 15, .Top \ 15, .Width \ 15, .Height \ 15, SWP_SHOWWINDOW

End With

bCancel = False
Err.Clear
Dim i%
For i = 0 To 255
If Err Then Stop
c = c + 1: ret = RegisterHotKey(Me.hWnd, c, 0, i)
c = c + 1: ret = RegisterHotKey(Me.hWnd, c, MOD_SHIFT, i)
c = c + 1: ret = RegisterHotKey(Me.hWnd, c, MOD_ALT, i)
c = c + 1: ret = RegisterHotKey(Me.hWnd, c, MOD_CONTROL, i)
c = c + 1: ret = RegisterHotKey(Me.hWnd, c, MOD_SHIFT Or MOD_CONTROL, i)
c = c + 1: ret = RegisterHotKey(Me.hWnd, c, MOD_SHIFT Or MOD_ALT, i)
c = c + 1: ret = RegisterHotKey(Me.hWnd, c, MOD_SHIFT Or MOD_ALT Or MOD_CONTROL, i)
c = c + 1: ret = RegisterHotKey(Me.hWnd, c, MOD_ALT Or MOD_CONTROL, i)
c = c + 1: ret = RegisterHotKey(Me.hWnd, c, MOD_CONTROL Or MOD_ALT, i)
Next

Show
ProcessMessages

End Sub

Private Sub Form_LostFocus()

On Error Resume Next

With Me

SetWindowPos .hWnd, Hwnd_TopMost, _
.Left \ 15, .Top \ 15, .Width \ 15, .Height \ 15, SWP_SHOWWINDOW

End With

Me.SetFocus
Me.ZOrder 0

End Sub

Private Sub Form_Unload(Cancel As Integer)
bCancel = True
'unregister hotkey
Call UnregisterHotKey(Me.hWnd, &HBFFF&)
End Sub