[RaggiTech]

كاتب الموضوع : AhmedEssawy

كود :

Option Explicit

'This Project requires 4 Buttons
'Textbox to test changes to input language

'API's to adjust the keyboardlayout
Private Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long
Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Const KLF_ACTIVATE = &H1
'Languages
Const Lang_AR_SAU As String = "00000401" 'Arabic
Const Lang_EN_USA As String = "00000409" 'English
Const Lang_FR_FRA As String = "0000040C" 'French
'Switch input language to French
Private Sub Command3_Click()
Form1.Caption = SetKbLayout(Lang_FR_FRA)
End Sub
'Switch input language to English
Private Sub Command2_Click()
Form1.Caption = SetKbLayout(Lang_EN_USA)
End Sub
'Switch input language to Arabic
Private Sub Command1_Click()
Form1.Caption = SetKbLayout(Lang_AR_SAU)
End Sub
'Test invalid langauge !
Private Sub Command4_Click()
'Invalid language
Form1.Caption = SetKbLayout("00000D0D")
End Sub

'Will return True if succeeds !
Public Function SetKbLayout(strLocaleId As String) As Boolean

'Changes the KeyboardLayout
'Returns TRUE when the KeyboardLayout was adjusted properly, FALSE otherwise
'If the KeyboardLayout isn't installed, this function will install it for you
On Error Resume Next
Dim strLocId As String 'used to retrieve current KeyboardLayout
'create a buffer
strLocId = String(9, 0)
'retrieve the current KeyboardLayout
GetKeyboardLayoutName strLocId
'Check whether the current KeyboardLayout and the
'new one are the same
If strLocId = (strLocaleId & Chr(0)) Then
'If they're the same, we return immediately
SetKbLayout = True
Exit Function
Else
'create buffer
strLocId = String(9, 0)

'load and activate the layout for the current thread
strLocId = LoadKeyboardLayout((strLocaleId & Chr(0)), KLF_ACTIVATE)
End If

'Test success
GetKeyboardLayoutName strLocId

If strLocId = (strLocaleId) Then SetKbLayout = True
End Function

Private Sub Form_Load()
'Set buttons caption for you !
Command1.Caption = "Arabic"
Command2.Caption = "English"
Command3.Caption = "French"
Command4.Caption = "Invalid lang"

End Sub