بدست اوردن زبان جاری ویندوز

[gazereng]

سلام،چور می تونم زبان جاری ویندوز بدست بیارم؟ مثلا EN یا FA
یک سورس دارم که این کار انجام میده ولی حتما باید فوکوس روی فرم برناممون باشه!
راه دیگه ای وجود داره؟

[سید حمید حق پرست]

سلام علیکم
بفرمایید :
Option Explicit
Private Declare Function GetThreadLocale Lib "kernel32" () As Long
Dim LangID As Integer

Private Sub Command1_Click()
LangID = GetThreadLocale()
If LangID = "1065" Then
MsgBox "Language : Persian"
End If
If LangID = "2057" Then
MsgBox "Language : English (UK)"
End If
If LangID = "1033" Then
MsgBox "Language : English (US)"
End If
End Sub
موفق باشید.

یا علی (ع)

[gazereng]

این کد در هر صورت پیغام میده Language : Persian
وقتی تغییر زبان میدم و روی انگلیسی میزارم همین پیغام میده!

[سید حمید حق پرست]

اینجوری نیست عزیز، شما زبان کدوم قسمت میگید؟ کیبورد؟ این کد زبان locale نمایش میده
موفق باشید.

یا علی (ع)

[Dr Saeed]

اینجوری نیست عزیز، شما زبان کدوم قسمت میگید؟ کیبورد؟ این کد زبان locale نمایش میده
موفق باشید.

یا علی (ع)

با سلام اقا سید

کدی ندارید که زبان کیبورد رو نمایش بده ؟

[gazereng]

سید چرا عصبانی میشی:لبخند:
منظور منم زبان کیبورد بود

[gazereng]

این کد واسه زبان کیبورد تست کردم جواب داد:قلب:

Private Const LOCALE_SISO639LANGNAME As Long = &H59

Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long

Private Sub Command1_Click()
MsgBox pvGetUserLocaleInfo(GetKeyboardLayout(0&) And &HFFFF&, LOCALE_SISO639LANGNAME)
End Sub

Private Function pvGetUserLocaleInfo(ByVal dwLocaleID As Long, ByVal dwLCType As Long) As String
Dim sReturn As String
Dim nSize As Long

nSize = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
If nSize > 0 Then
sReturn = Space$(nSize)
nSize = GetLocaleInfo(dwLocaleID, dwLCType, sReturn, Len(sReturn))
If nSize > 0 Then
pvGetUserLocaleInfo = Left$(sReturn, nSize - 1)
End If
End If
End Function

[gazereng]

اینم تست کردم وقتی فوکوس فقط روی فرم برناممون باشه جواب میده اما وقتی کد در یک تایمر میزاریم و فوکوس روس برناممون نیست برنامه دیگه جواب نمیده! سید بیا کمک کن:افسرده:

[سید حمید حق پرست]

سلام علیکم
کد شما رو تست کردم اگر رو برنامه فوکوس هم نباشه جواب میده
این هم یک نمونه دیگه :
Private Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long

Private Sub Command1_Click()
Dim KeyName As String, KeyLang As String
KeyName = String(8, 0)
GetKeyboardLayoutName KeyName
If KeyName = "00000409" Then KeyLang = "English"
If KeyName = "00000429" Then KeyLang = "Farsi"
MsgBox KeyLang
End Sub
موفق باشید.

یا علی (ع)

[gazereng]

سید این کد تست کن و فوکوس روی فرم نباشه بعد میبینی جواب نمیده!
فقط کدتون گذاشتم در تایمر تا وقتی برنامه به عنوان برنامه اول یا برنامه فعال نیست نتیجه تغییر زبان بگه ولی جواب نمیده!

Private Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long


Private Sub Timer1_Timer()
Dim KeyName As String, KeyLang As String
KeyName = String(8, 0)
GetKeyboardLayoutName KeyName
If KeyName = "00000409" Then Caption = "English"
If KeyName = "00000429" Then Caption = "Farsi"
End Sub

[سید حمید حق پرست]

خب شما MsgBox KeyLang نزاشتی تو تایمر!
موفق باشید.

یا علی (ع)

[gazereng]

چون از تایمر استفاده کردم به جای MsgBox KeyLang از تغییر Caption استفاده کردم...

[سید حمید حق پرست]

برای من جواب میده اینتروال رو 3000 گذاشتم فوکوس هم رو فرم نیست و جواب میده!
موفق باشید.

یا علی (ع)