powered by simpleCommunicator - 2.0.41     © 2025 Programmizd 02
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / А как с помощью Win API узнать раскладку ?
3 сообщений из 3, страница 1 из 1
А как с помощью Win API узнать раскладку ?
    #32189793
mazzi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
На hiprog нашел как переключать, а как считать не нашел. Подскажите пожалуйста.
...
Рейтинг: 0 / 0
А как с помощью Win API узнать раскладку ?
    #32189812
Фотография Skleroz
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
В Delphi прописана такая функция

Код: plaintext
function GetKeyboardLayoutName; external user32 name 'GetKeyboardLayoutNameA';


Я ее юзал так (изучил методом тыка, не сильно отвлекаясь на Help)

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
procedure TfmLogin.ApplicationEvents1Idle(Sender: TObject;
  var Done: Boolean);
var
  ln: array [ 0 .. 255 ] of char;
  i: integer;
begin
  GetKeyboardLayoutName(ln);
  try
    i:=StrToInt(StrPas(ln));
  except
    i:= 0 ;
  end;
  //lbKeyLay - енто TLabel
  if i= 409  then lbKeyLay.Caption:='En'
  else if i= 419  then lbKeyLay.Caption:='Ru'
  else lbKeyLay.Caption:='';
  lbKeyLay.Visible:=Length(lbKeyLay.Caption)> 0 ;
end;


Вот. Осталось только переложить на VBA :D
...
Рейтинг: 0 / 0
А как с помощью Win API узнать раскладку ?
    #32189821
-=Alexey=-
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Для работы с раскладкой клавиатуры в VB используются три основные API-функции:

1. GetKeyboardLayout — функция GetKeyboardLayout определяет текущую раскладку клавиатуры. Если idThread равен нулю, тогда возвращается текущяя раскладка клавиатуры для данного процесса. idThread — определяет процесс (приложение). В случае верного выполнения функции возвращаемое значение — идентификатор языка(раскладка клавиатуры).

Declare Function GetKeyboardLayout Lib «user32» (ByVal IdThread As Long) As Long.

Пример:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
Private Declare Function GetKeyboardLayout Lib  "user32"  (ByVal dwLayout As Long) As Long 
Private Declare Function GetWindowThreadProcessId& Lib  "user32"  (ByVal hwnd As Long, lpdwProcessId As Long) As Long
' Определяет текущую раскладку клавиатуры (для данного процесса)'
Dim L_HKL As Long 
L_CHKL = GetKeyboardLayout( 0 ) ' Определяет раскладку клавиатуры для окна другого процесса'
Dim hAppWnd As Long Dim ThreadID As Long 
Dim ThreadLayout As Long 
hAppWnd = FindWindow(vbNullString,  "Безымянный — Блокнот" ) 
If hAppWnd =  0  Then
  MsgBox  "Окно не найдено!"  
Else
  ThreadID = GetWindowThreadProcessId(hAppWnd, ByVal  0 &) 
  ThreadLayout = GetKeyboardLayout(ThreadID) 
  MsgBox  "Раскладка "  & Hex(ThreadLayout) 
End If 


2. ActivateKeyboardLayout — функция устанавливает идентификатор языка для текущего процесса/программы. Идентификатор языка определяет язык а также физическое размещение клавиатуры. hKL — идентификатор языка, который будет активизирован (для Windows 9х этот аргумент может быть получен при помощи LoadKeyboardLayout либо при помощи констант, приведенных ниже, для Windows NT/2k — идентификатор языка должен быть сначала загружен запросом к функции LoadKeyboardLayout). Этот аргумент должен быть либо ссылкой на клавиатурную раскладку, либо одним из следующих значений: HKL_NEXT — выбирает следующую раскладку языка (из списка языков, установленных в системе);

HKL_PREV — выбирает предыдущую раскладку языка (из списка языков, установленных в системе). Flags — Определяют различные аргументы активизации языка. Этими аргументами могут быть одни из следующих значений : KLF_REORDER, KLF_RESET, KLF_SETFORPROCESS, KLF_SHIFTLOCK, KLF_UNLOADPREVIOUS.

Declare Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As Long, ByVal Flags As Long) As Long

Пример:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
Private Const KL_NAMELENGTH As Long =  9  
Private Const HKL_NEXT As Long =  1  
Private Const HKL_PREV As Long =  0  
Private Declare Function ActivateKeyboardLayout Lib  "user32"  (ByVal HKL As Long, ByVal Flags As Long) As Long 
Private Declare Function GetKeyboardLayout Lib  "user32"  (ByVal dwLayout As Long) As Long 
Private Declare Function GetKeyboardLayoutName Lib  "user32"  Alias  "GetKeyboardLayoutNameA"  _
(ByVal pwszKLID As String) As Long 
Dim lC_HKL As Long 
Dim sC_Buffer As String 
Dim lS_HKL As Long 
Dim sS_Buffer As String ' Определяет текущую раскладку клавиатуры'
lC_HKL = GetKeyboardLayout( 0 ) ' Создает буфера'
sC_Buffer = String(KL_NAMELENGTH —  1 ,  0 ) 
sS_Buffer = String(KL_NAMELENGTH —  1 ,  0 ) ' Отыскивает текущее название раскладки клавиатуры'
GetKeyboardLayoutName s_Buffer ' Переключается на следующую клавиатурную раскладку'
ActivateKeyboardLayout HKL_NEXT,  0  ' Отыскивает переключенную клавиатурную раскладку'
lS_HKL = GetKeyboardLayout( 0 ) ' Возвращает название переключенной клавиатурной раскладки'
GetKeyboardLayoutName sS_Buffer 
MsgBox  "Клавиатурная раскладка была переключена"  & vbCrLf &  "с "  & sC_Buffer &  "на "  & sS_Buffer 
' Возвращение иcходной раскладки клавиатуры' 
ActivateKeyboardLayout lC_HKL,  0 


3. API функция GetKeyboardLayoutName, позволяющая узнать не просто идентификатор раскладки, а конкретное имя текущей раскладки.

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

Пример:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
Dim l_HKL As Long
Dim s_Buffer As String
Private Const KL_NAMELENGTH As Long =  9 
' Определяет текущую раскладку клавиатуры'
l_HKL = GetKeyboardLayout( 0 )
s_Buffer = String(KL_NAMELENGTH —  1 ,  0 )
' Получает название раскладки клавиатуры
GetKeyboardLayoutName sCurrent_Buffer
MsgBox «Клавиатурная раскладка -" & s_Buffer

---------------
Из конференции Expert_FAQ
источник
...
Рейтинг: 0 / 0
3 сообщений из 3, страница 1 из 1
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / А как с помощью Win API узнать раскладку ?
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]