Получение и установка текущей раскладки клавиатуры

Ниже представлены 5 функций для получения/установки раскладки клавиатуры в своем или активном в текущий момент времени приложении:

• function NameKeyboardLayout(layout : LongWord) : string; - Получает название раскладки из списка (для удобства сделал :)))
• function GetActiveKbdLayout : LongWord; - Получает раскладку в своей программе
• function GetActiveKbdLayoutWnd : LongWord; - Получает раскладку в активном окне
• procedure SetKbdLayout(kbLayout : LongWord); - Устанавливает раскладку в своей программе
• procedure SetLayoutActiveWnd(kbLayout : LongWord); - Устанавливает раскладку в активном окне

Исходный текст

{ **** UBPFD *********** by delphibase.endimus.ru ****
Зависимости: Windows, Messages
Автор:       savva, savva@nm.ru, ICQ:126578975, Орел
Copyright:   Сапронов Алексей (Savva)
Дата:        27 июня 2002 г.
**************************************************** }

{типы описываем }
const
  CNT_LAYOUT = 2; // количество известных раскладок
  ENGLISH = $409;
  RUSSIAN = $419;

  TKbdValue : array [1..CNT_LAYOUT] of LongWord =
                ( ENGLISH,
                  RUSSIAN
                );
  TKbdDisplayNames : array [1..CNT_LAYOUT] of string =
                ('English',
                 'Русский'
                );


{----- собственно сами процедури и функции -----}
  
{получаем название раскладки}
function NameKeyboardLayout(layout : LongWord) : string;
var
  i: integer;
begin
  Result:='';
  try
    for i:=1 to CNT_LAYOUT do
      if TKbdValue[i]=layout then Result:= TKbdDisplayNames[i];
  except
    Result:='';
  end;
end;
//**************** end of NameKeyboardLayot ***************************
{активная раскладка в своей программе}
function GetActiveKbdLayout : LongWord;
begin
  result:= GetKeyboardLayout(0) shr $10;
end;
//***************** end of GetActiveKbdLayot ****************************
{активная раскладка в активном окне}
function GetActiveKbdLayoutWnd : LongWord;
var
  hWindow,idProcess : THandle;
begin
  // получить handle активного окна чужой программы
  hWindow := GetForegroundWindow;
  // Получить идентификатор чужого процесса
  idProcess := GetWindowThreadProcessId(hWindow,nil);
  // Получить текущую раскладку в чужой программе
  Result:=(GetKeyboardLayout(idProcess) shr $10);
end;
//***************** end of GetActiveKbdLayotWnd **************************
{установить раскладку в своей программе}
procedure SetKbdLayout(kbLayout : LongWord);
var
  Layout: HKL;
begin
  // Получить ссылку на раскладку
  Layout:=LoadKeyboardLayout(PChar(IntToStr(kbLayout)), 0);
  // Переключить раскладку на русскую
  ActivateKeyboardLayout(Layout,KLF_ACTIVATE);
end;
//****************** end of SetKbdLayot **********************************
{установить раскладку в активном окне}
procedure SetLayoutActiveWnd(kbLayout : LongWord);
var 
  Layout: HKL;
  hWindow{, idProcess} : THandle; // ION T: не используется
begin
  // получить handle активного окна чужой программы
  hWindow := GetForegroundWindow;
  // Получить ссылку на раскладку
  Layout:=LoadKeyboardLayout(PChar(IntToStr(kbLayout)), 0);
  // посылаем сообщение о смене раскладки
  sendMessage(hWindow,WM_INPUTLANGCHANGEREQUEST,1,Layout);
end;
//***************** end of SetLayoutActiveWnd *****************************

Пример использования

...
  {активная раскладка в активном окне}
    Label1.Caption:= NameKeyboardLayout(GetActiveKbdLayoutWnd);
  {активная раскладка в своей программе}
    Label2.Caption:= NameKeyboardLayout(GetActiveKbdLayout);
  {установить раскладку в своей программе}
    SetKbdLayout(ENGLISH);
  {установить раскладку в активном окне}
    SetLayoutActiveWnd(ENGLISH);
...

1.

Аноним

22 июля 2005, 11:15:31

Стоит добавить хинт
{$APPTYPE CONSOLE}
как всё это перестаёт работать! Может уважаемый автор подскажет, как определить язык в консоли? Спасибо.