| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как отловить раскладку клавиатуры [D6, WinXP]

Z_man7777 ©   (2003-02-26 12:42:00) 

Здравствуйте, уважаемые Мастера!!!
Есть вопрос: Как отловить раскладку клавиатуры, выбранную в текущий момент и передать ее в приложение. Например, вывести сообщение о текущей раскладки.

---

Clickmaker   (2003-02-26 12:48:00) [1]

type TYourForm = class(TForm)
private
procedure WMSetKBLayoutName(var Message: TMessage); message
WM_SETKBLAYOUTNAME;
...
end;

function MyShellProc(code: integer; wParam: integer; lParam: Longint): Longint; stdcall;
begin
if (code = HSHELL_LANGUAGE) then
SendMessage(GetForegroundWindow, WM_SETKBLAYOUTNAME, wParam, lParam);
Result := CallNextHookEx(Hook, code, wParam, lParam);
end;

procedure SetKBLayoutHook(Handle: HWND);
begin
if (Hook = 0) then
Hook := SetWindowsHookEx(WH_SHELL, @MyShellProc, 0, GetWindowThreadProcessId(Handle, nil));
end;

procedure UnhookKBLayoutHook;
begin
if (Hook <> 0) then UnhookWindowsHookEx(Hook);
Hook := 0;
end;

function GetKBLayoutName(kl: Longint): string;
const
ANames: array[0..1] of string = ("EN", "RU");
begin
case Lo(kl) of
25: Result := ANames[1];
else Result := ANames[0];
end;
end;

procedure TYourForm.FormCreate(Sender: TObject);
begin
SetKBLayoutHook(Handle);
end;

procedure TYourForm.FormDestroy(Sender: TObject);
begin
UnhookKBLayoutHook;
end;

procedure TYourForm.WMSetKBLayoutName(var Message: TMessage);
begin
LayoutLabel.Caption := GetKBLayoutName(Message.LParam);
end;

---

Наверх