Нужно при нажатии Ctrl+<Число> в другой программе, вставить определённый текст.
Вынес в отдельную DLL обработчик хука клавиатуры. При нажатии клавиш основному окну передаётся сообщение с номером нажатой клавиши.
Код:
library keyhook;
uses
Messages,
Windows;
var
HookHandle:hHook;
{$R *.res}
const
MSG_HOTKEY = WM_USER + $110;
function KeyboardProc(Code: Integer; wParam: wParam; LParam: LParam): integer;
stdcall;
var
key_no: byte;
begin
if code<0 then
Result:=CallNextHookEx(HookHandle, code, WParam, LParam)
else
begin
if (byte(LParam shr 24)<$80) // Только нажатие
and ((GetKeyState(VK_CONTROL) and (1 shl 15)) <> 0) // Нажат Ctrl (левый или правый)
and (byte (LParam shr 16) in [$2..$B]) // Нажата клавиша "0" .. "9"
then
begin
if byte (LParam shr 16) in [$2..$A] then
key_no := byte (LParam shr 16) - 1
else
key_no := 0;
//SendMessage(FindWindow(nil, 'Вставка фраз'), MSG_HOTKEY, key_no, 0);
PostMessage(FindWindow(nil, 'Вставка фраз'), MSG_HOTKEY, key_no, 0);
Result := 1;
end
else
Result:=CallNextHookEx(HookHandle, code, WParam, LParam);
end;
end;
procedure SetHook; stdcall;
begin
HookHandle := SetWindowsHookEx(WH_KEYBOARD, KeyboardProc, hInstance, 0);
end;
procedure DelHook; stdcall;
begin
UnhookWindowsHookEx(HookHandle);
end;
exports
SetHook, Delhook;
begin
end.
Далее в самой программе через буфер обмена осуществляю вставку текста.
Код:
// ...
type
TForm1 = class(TForm)
// ...
procedure paste_phrase(var Message: TMessage); message MSG_HOTKEY;
// ...
procedure TForm1.paste_phrase(var Message: TMessage);
var
WindowHandle, EditHandle: HWnd;
key_no: byte;
Success: bool;
RetryCount: integer;
begin
LoadKeyboardLayout('00000419', 1); // Принудительно меняем раскладку на RU, иначе ломается кодировка
key_no := Message.WParam;
if key_no in [0..9] then
begin
WindowHandle := GetForegroundWindow; {активное окно}
EditHandle := GetTopWindow(WindowHandle); {активный элемент}
{копируем в буфер нужный текст}
Success := false;
RetryCount := 0;
while not Success do
begin
try
Clipboard.AsText := (FindComponent('phrase_memo_' + IntToStr(key_no)) as TMemo).Text;
Success := True;
except
on Exception do
begin
Inc(RetryCount);
if RetryCount <= CLIPBOARD_MAX_TRIES then
Sleep(RetryCount * 100)
else
begin
raise Exception.Create('Не могу записать в буфер обмена!');
end;
end;
end;
end;
{эмуляция нажатия CTRL+V}
keybd_event(VK_CONTROL,0,0,0);
keybd_event(ord('V'),0,0,0);
keybd_event(ord('V'),0,KEYEVENTF_KEYUP, 0);
keybd_event(VK_CONTROL,0,KEYEVENTF_KEYUP,0);
SendMessage(EditHandle, WM_COMMAND, $00010043, $00000000);
{очистка буфера}
Success := false;
RetryCount := 0;
while not Success do
begin
try
Clipboard.Clear();
Success := True;
except
on Exception do
begin
Inc(RetryCount);
if RetryCount <= CLIPBOARD_MAX_TRIES then
Sleep(RetryCount * 100)
end;
end;
end;
end;
end;
// ...
В блокноте данный код работает без проблем, но на странице в браузере (неважно каком) то вставляет, то нет. Не могу понять, с чем это связано.