! Input language of active window !

بسم الله الرحمن الرحيم

السلام عليكم و رحمة الله و بركاته

معايا ليكم النهاردة أحد أسئلتى العجيبة (h) , المهم كلنا نعرف أن بأستخدام الـ APIs ممكن نحصل على اللغة النشطة للـ Form اللى أحنا صممناها :rolleyes: , اللى لاحظته أن الدوال دى بتجيب اللغة النشطة بالنافذة بتاعتنا بس يعنى بتشتغل على الـ associated thread :unsure: , و دول مثالين كل واحد محتاج Form و Timer أسمه tmrLang و تكون الـ Interval تساوى 100 مثلا :

Option Explicit

Private Const LANG_EN_US As String = "00000409"
Private Const LANG_AR As String = "00000401"

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

Private Sub tmrLang_Timer()
Dim strName As String

strName = String(KL_NAMELENGTH, 0)
GetKeyboardLayoutName strName

Do Until Right$(strName, 1) <> Chr$(0)
	strName = Left$(strName, Len(strName) - 1)
Loop
Cls
Select Case strName
	Case LANG_EN_US
		Print "English"
	Case LANG_AR
		Print "Arabic"
	Case Else
		Print "Another language"
End Select
End Sub

Option Explicit

Private Const LOCALE_SENGLANGUAGE As Long = &H1001

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 Function LoWord(wParam As Long) As Integer
If wParam And &H8000& Then
	   LoWord = &H8000& Or (wParam And &H7FFF&)
	Else
	   LoWord = wParam And &HFFFF&
End If
End Function

Public Function GetUserLocaleInfo(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
		   GetUserLocaleInfo = Left$(sReturn, nSize - 1)
		End If
	End If
End Function

Private Sub tmrLang_Timer()
Dim hKeyboardID As Long
Dim LCID As Long
hKeyboardID = GetKeyboardLayout(0&)
If hKeyboardID > 0 Then
   LCID = LoWord(hKeyboardID)
   If LCID Then
	  Cls
	  Print GetUserLocaleInfo(LCID, LOCALE_SENGLANGUAGE)
   End If
End If
End Sub

بأستعمال اى من الأمثلة اللى فوق لو فتحنا اى نافذة اخرى و غيرنا اللغة لا تستجيب الأمثلة بتاعتنا للتغيير لأنها زى ما قلت أن على ما يبدوا أنها بتشتغل على الـ associated thread فقط.

و السؤال هو : كيفية الحصول على لغة الأدخال للنافذة النشطة (Input language of active window) :blink: ؟

طبعا الـ Subclassing مش هينفع لأن لا قيمة مباشرة له فى سؤالى بالأضافة الى أن الـ VB6 لا يتحمل Subclassing على كل النوافذ و صعب أنى أعمله على النافذة النشطة بس.

و فكرة معرفة اللغة من الـ Language bar غير عملية لأن مش كل المستخدمين بيستعملوه ( أقصد أن البعض يلغى ظهوره )

و قد يكون الحل برسالة (Window message) معينة نبعتها للنافذة النشطة لمعرفة اللغة لكن ما هى الرسالة :o ؟

و شكرا لكل من يحاول المساعدة.

و السلام عليكم و رحمة الله و بركاته