Posted: Mon Oct 31, 2005 10:29 pm Post subject: کد تغییر زبان کیبورد
کد تغییر زبان کیبورد.
این کد را با پسوند frm ذخیره و با vb باز کنید
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 3 'Fixed Dialog
Caption = "Form1"
ClientHeight = 1905
ClientLeft = 45
ClientTop = 330
ClientWidth = 6390
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 178
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
RightToLeft = -1 'True
ScaleHeight = 1905
ScaleWidth = 6390
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command4
Caption = "Invlid lang"
Height = 375
Left = 90
RightToLeft = -1 'True
TabIndex = 4
Top = 1440
Width = 1185
End
Begin VB.CommandButton Command3
Caption = "French"
Height = 375
Left = 90
RightToLeft = -1 'True
TabIndex = 3
Top = 990
Width = 1185
End
Begin VB.CommandButton Command2
Caption = "English"
Height = 375
Left = 90
RightToLeft = -1 'True
TabIndex = 2
Top = 540
Width = 1185
End
Begin VB.CommandButton Command1
Caption = "Arabic"
Height = 375
Left = 90
RightToLeft = -1 'True
TabIndex = 1
Top = 90
Width = 1185
End
Begin VB.TextBox Text1
Alignment = 1 'Right Justify
Height = 285
Left = 1350
RightToLeft = -1 'True
TabIndex = 0
Text = "Text1"
Top = 90
Width = 4965
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'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"
Const Lang_EN_USA As String = "00000409"
Const Lang_FR_FRA As String = "0000040C"
Private Sub Command3_Click()
Form1.Caption = SetKbLayout(Lang_FR_FRA)
End Sub
Private Sub Command2_Click()
Form1.Caption = SetKbLayout(Lang_EN_USA)
End Sub
Private Sub Command1_Click()
Form1.Caption = SetKbLayout(Lang_AR_SAU)
End Sub
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 Command4_Click()
'Invalid language
Form1.Caption = SetKbLayout("00000D0D")
اين هم دو تا متد يكي اول برنامه اجرا ميشه يكي آخرش
Sub Farsi()
Dim Buffer As String
LoadKeyboardLayout "00000429", &H1
Buffer = String(9, 0)
GetKeyboardLayoutName Buffer
If (Buffer = 409) Then
LoadKeyboardLayout "00000401", &H1
End If
End Sub
Sub UnFarsi()
LoadKeyboardLayout "00000409", &H1
End Sub
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum
Profile 
Log in to check your private messages | 
FAQ 
Search 
Memberlist 
Usergroups 
Log in
Register
