Программеры есть?
Вот исходник, переключает по любому Ctrl, не работает в консольных приложениях... Меня на большее не хватило
Может, кто что поправит?
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure HotKeyPressed( var Msg: TMessage); message WM_HOTKEY;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormActivate(Sender: TObject);
begin
RegisterHotKey(Handle, 1, MOD_CONTROL, 0);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
UnregisterHotKey(Handle, MOD_CONTROL);
end;
Procedure TForm1.HotKeyPressed( var Msg: TMessage);
Var
KeyState:TKeyboardState;
rus,eng,curKey,progKey: HKL;
hwProg,progId : THandle;
Begin
If Msg.LParamHi=VK_CONTROL Then
Begin
hwProg := GetForegroundWindow;
progId := GetWindowThreadProcessId(HwProg,nil);
SetForegroundWindow(hwProg);
SetActiveWindow(hwProg);
rus:=LoadKeyboardLayout('00000419', 0);
eng:=LoadKeyboardLayout('00000409', 0);
progKey := GetKeyboardLayout(progId);
If ProgKey=rus
Then ActivateKeyboardLayout(eng,KLF_ACTIVATE)
Else ActivateKeyboardLayout(rus,KLF_ACTIVATE);
If ProgKey=rus
Then ActivateKeyboardLayout(eng,KLF_ACTIVATE)
Else ActivateKeyboardLayout(rus,KLF_ACTIVATE);
curKey := GetKeyboardLayout(0); // Получить текущую раскладку
if progKey <> curKey then begin
sendMessage(hwProg,WM_INPUTLANGCHANGEREQUEST,1,curKey);
Application.processMessages;
end;
End;
End;
end.