Скачать: CL | DM;

Как отловить раскладку клавиатуры   Найти похожие ветки 

← →
Z_man7777 ©   (2003-02-26 12:42) [0]

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

---

← →
Clickmaker ©   (2003-02-26 12:48) [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;

---

Страницы: 1 вся ветка

Скачать: CL | DM;



Память: 0.45 MB
Время: 0.011 c