Автор статьи: Беседин Игорь
Как узнать текущую раскладку клавиатуры?
Для этого нужно следующее.
Вариант 1
В раздел "Generals" вставить код:
Private Declare Function GetKeyboardLayout Lib "user32" _
(ByVal dwLayout As Long) As Long
А затем функцию:
Function DeRasclad()
Dim Rasclad As Long
Rasclad = GetKeyboardLayout(0&)
Select Case Rasclad
Case 68748313: DeRasclad = "Русская раскладка"
Case 67699721: DeRasclad = "Английская (США) раскладка"
Case 68944924: DeRasclad = "Албанская раскладка"
Case 67701769: DeRasclad = "Английская (Австралия) раскладка"
Case 134809609: DeRasclad = "Английская (Великобритания) раскладка "
Case 403249161: DeRasclad = "Английская (Ирландия) раскладка"
Case 269029385: DeRasclad = "Английская (Канада) раскладка"
Case 604578825: DeRasclad = "Английская (Карибский) раскладка"
Case 67703817: DeRasclad = "Английская (Новая Зеландия) раскладка"
Case 67705865: DeRasclad = "Английская (Южная Африка) раскладка"
Case 537468937: DeRasclad = "Английская (Ямайка) раскладка"
Case 67699766: DeRasclad = "Африкаанса раскладка"
Case 70059053: DeRasclad = "Бакская раскладка"
Case 69403683: DeRasclad = "Белорусская раскладка"
Case 67240962: DeRasclad = "Болгарская раскладка"
Case 68027406: DeRasclad = "Венгерская раскладка"
Case 135464979: DeRasclad = "Голландская (Бельгия) раскладка"
Case 68355091: DeRasclad = "Голландская (стандартная) раскладка"
Case 67634184: DeRasclad = "Греческая раскладка"
Case 67503110: DeRasclad = "Датская раскладка"
Case 67699745: DeRasclad = "Индонезийская раскладка"
Case 68092943: DeRasclad = "Исландская раскладка"
Case 738864138: DeRasclad = "Испанская (Аргентина) раскладка"
Case 1074413578: DeRasclad = "Испанская (Боливия) раскладка"
Case 537534474: DeRasclad = "Испанская (Венесуэла) раскладка"
Case 269094922: DeRasclad = "Испанская (Гватемала) раскладка"
Case 1208633354: DeRasclad = "Испанская (Гондурас) раскладка"
Case 470424586: DeRasclad = "Испанская (Доминиканская республика) раскладка"
Case 604644362: DeRasclad = "Испанская (Колумбия) раскладка"
Case 336204810: DeRasclad = "Испанская (Коста-Рика) раскладка"
Case 134875146: DeRasclad = "Испанская (Мексиканская) раскладка"
Case 1275743242: DeRasclad = "Испанская (Никарагуа) раскладка"
Case 403314698: DeRasclad = "Испанская (Панама) раскладка"
Case 1007303690: DeRasclad = "Испанская (Парагвай) раскладка"
Case 671754250: DeRasclad = "Испанская (Перу) раскладка"
Case 1342853130: DeRasclad = "Испанская (Пуэрто-Рико) раскладка"
Case 1141523466: DeRasclad = "Испанская (Сальвадор) раскладка"
Case 201985034: DeRasclad = "Испанская (современная сортировка) раскладка"
Case 67765258: DeRasclad = "Испанская (традиционная) раскладка"
Case 940193802: DeRasclad = "Испанская (Уругвай) раскладка"
Case 873083914: DeRasclad = "Испанская (Чили) раскладка"
Case 805974026: DeRasclad = "Испанская (Эквадор) раскладка"
Case 68158480: DeRasclad = "Итальянская (стандартная) раскладка"
Case 68159504: DeRasclad = "Итальянская (Швейцария) раскладка"
Case 67306499: DeRasclad = "Каталанский раскладка"
Case 69600294: DeRasclad = "Латышский раскладка"
Case 69665831: DeRasclad = "Литовский раскладка"
Case 70190127: DeRasclad = "Македонский (FYROM) раскладка"
Case 67570695: DeRasclad = "Немецкая (Австрия) раскладка"
Case 67572743: DeRasclad = "Немецкая (Линхтейштейн) раскладка"
Case 67571719: DeRasclad = "Немецкая (Люксембург) раскладка"
Case 67568647: DeRasclad = "Немецкая (стандартная) раскладка"
Case 134678535: DeRasclad = "Немецкая (Швейцария) раскладка"
Case 68420628: DeRasclad = "Норвежская (букмол) раскладка"
Case 135530516: DeRasclad = "Норвежская (нюнорск) раскладка"
Case 68486165: DeRasclad = "Польская раскладка"
Case 68551702: DeRasclad = "Португальская (Бразилия) раскладка"
Case 135661590: DeRasclad = "Португальская (стандартная) раскладка"
Case 68682776: DeRasclad = "Румынская раскладка"
Case 203033626: DeRasclad = "Сербская раскладка"
Case 68879387: DeRasclad = "Словацкая раскладка"
Case 69469220: DeRasclad = "Словенская раскладка"
Case 69141535: DeRasclad = "Турецкая раскладка"
Case 69338146: DeRasclad = "Украинская раскладка"
Case 70779960: DeRasclad = "Фарерских островов раскладка"
Case 67830795: DeRasclad = "Финская раскладка"
Case 135006220: DeRasclad = "Французская (Бельгия) раскладка"
Case 202116108: DeRasclad = "Французская (Канада) раскладка"
Case 67900428: DeRasclad = "Французская (Люксембург) раскладка"
Case 67896332: DeRasclad = "Французская (стандартная) раскладка"
Case 269225996: DeRasclad = "Французская (Швейцария) раскладка"
Case 68813850: DeRasclad = "Хорватская раскладка"
Case 67437573: DeRasclad = "Чешская раскладка"
Case 69010461: DeRasclad = "Шведская раскладка"
Case 69534757: DeRasclad = "Эстонская раскладка"
End Select
End
Function
Видно, что функция GetKeyboardLayout возвращает код текущей раскладки клавиатуры, а с помощь Select Case он расшифровывается, и в конечном итоге функция DeRasclad возвращает текстовое значение раскладки As String.
Вариант 2
Следующий код взят с сайта .org, правда не помню с какого именно (случайно обнаружил этот файл на диске) и усовершенствован мною.
В коде формы объявляем две функции:
Private Const LOCALE_SCOUNTRY As Long = &H6 'переменная для определения названия страны раскладки клавиатуры
Private Const LOCALE_SISO639LANGNAME As Long = &H59 'также можно использовать и эту переменную, но в этом случае функция будет возвращать значение аббревиатуры языка - например, "Ru" или "En"
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))
GetUserLocaleInfo = Left$(sReturn, nSize - 1)
End If
End Function
Далее в том месте программы, где Вам нужно определить текущую раскладку клавиатуры вызываете функции с помощью следующего кода:
Dim hKeyboardID As Long
Dim LCID As Long
hKeyboardID = GetKeyboardLayout(0&)
If hKeyboardID > 0 Then
LCID = LoWord(hKeyboardID)
If LCID Then
MsgBox GetUserLocaleInfo(LCID, LOCALE_SCOUNTRY)'Здесь
также можно сделать присваивание значения
переменной
End If
End If
Единственное различие в выполнении этих вариантов - первый будет возвращать значения на русском языке, а второй на английском.
При любом воспроизведении этой статьи (и других статей с этого сайта) ставьте ссылку на сайт www.igoryksoft.narod.ru