تغير اللغه من خلال البرنامج - نسخة قابلة للطباعة

كود :

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