Эмуляция Клавиш

13.01.2013
23
0
#1
Код:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then ShowMessage('Key pressed');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(FindWindow('Form1',0), WM_KEYDOWN, 13, 0);
SendMessage(FindWindow('Form1',0), WM_KEYUP, 13, 0);
end;

end.
почему не работает? :)
 
13.01.2013
23
0
#3
Код:
FindWindow('Form1',0)
Это что за огород?
в смысле? ну да там надо nil поставить вместо нуля, потом понял... впрочем на работоспособности это не сказалось...
а что еще то? FindWindow возвращает hwnd окна с заголовком Form1, в данном случае моего приложения...
 

-master-

Well-known member
14.01.2012
616
12
#6
ну хорошо, а теперь еще, зачем посылать окну не имеющего для ввода никаких предпоссылок?
 
13.01.2013
23
0
#7
ну хорошо, а теперь еще, зачем посылать окну не имеющего для ввода никаких предпоссылок?
что вы имеете ввиду? я специально же сделал FormKeyPress чтобы при нажатии Enter выдавалось сообщение... что не понятного то
 

sinkopa

Well-known member
17.06.2009
344
4
#9
Код:
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then ShowMessage('Key pressed');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(FindWindow('Form1',0), WM_KEYDOWN, 13, 0);
SendMessage(FindWindow('Form1',0), WM_KEYUP, 13, 0);
end;
почему не работает? :(
:) Мда... повеселили... даже не знаю с чего и начать...
Вопервых. Ваш FindWindow('Form1',0) никогда не найдет никакого окошка, потому как
первый параметр функции - это КЛАСС окна (в Вашем случае 'TForm1');
второй параметр функции - это ЗАГОЛОВОК окна (у Вас я так понимаю 'Form1').
т.е. правильный вызов должен быть
Код:
FindWindow('TForm1','Form1')
// или
FindWindow(nil,'Form1') // если чисто по заголовку искать
Во-вторых. Вы отправляете (т.е. пытаетесь отправить) сообщения WM_KEYDOWN, WM_KEYUP
а "ловите" (FormKeyPress) сообщение WM_CHAR... не кажется ли это несколько... странным? :)
В-третьих. Отправка сообщения через SendMessage подразумевает получение результата. т.е. код останавливается и ждет пока SendMessage что нибудь вернет, так как это функция. Это значит, что Ваша программа (когда Вы наконец достучитесь до нужного окошка) "зависнет" внутри Button1Click, до тех пор, пока Вы не переключитесь в целевое окно и не "погасите" модальное окно рожденное кодом ShowMessage('Key pressed');
Нужно использовать процедуру PostMessage.
И еще... маловато у Вас в сообщениях данных для клавиатурной эмуляции...
Короче... поскольку у вас "предполагается таким образом в чужом окне эмулировать клавиши", предлагаю использовать следующую процедуру
Код:
{ Параметры
Window : Целевое окно, куда будет послано нажатие клавиши
Key	 : Виртуальный код клавиши. При печатании - ANSI код (Ord(символ)).
Shift  : состояние доп клавиш (Shift, Alt, Ctrl, кнопки мыши)
SpecKey : Обычно False. True для определения цифровой клавиатуры, например.
}

procedure PostKeybrdKey(Window: HWnd; Key: Word; const Shift: TShiftState; SpecKey: Boolean);
var
OldState, SendState: TKeyboardState;
lParam: Integer;
begin
GetKeyboardState(OldState);					// правило хорошего тона - запомнили состояние клавы, чтобы потом восстановить
lParam := MakeLong(0, MapVirtualKey(Key, 0)); // получили scan-код виpтуальной клавиши
if SpecKey then lParam := lParam or $1000000; // выставили бит спец кнопки (если просили)

{ заполняем атрибуты KeyboardState эмулятора }
FillChar(SendState, SizeOf(TKeyboardState), 0); // очистка

{ мышиная "кнопкоэмуляция" :-) }
if (ssLeft in Shift ) then SendState[VK_LBUTTON] := $80;
if (ssRight in Shift ) then SendState[VK_RBUTTON] := $80;
if (ssMiddle in Shift) then SendState[VK_MBUTTON] := $80;

{ эмуляция доп клавиш клавиатуры }
if (ssShift in Shift) then SendState[VK_SHIFT] := $80;
if (ssCtrl in Shift) then SendState[VK_CONTROL] := $80;
if (ssAlt in Shift) then
begin
SendState[VK_MENU] := $80;
lParam := lParam or $20000000;
end;

SetKeyboardState(SendState); // выставляем карту состояний клавиатуры

{ эмулируем нажатие }
if (ssAlt in Shift) then
begin
PostMessage(Window, WM_SYSKEYDOWN, Key, lParam);
PostMessage(Window, WM_SYSKEYUP, Key, lParam or $C0000000);
end
else
begin
PostMessage(Window, WM_KEYDOWN, Key, lParam);
PostMessage(Window, WM_KEYUP, Key, lParam or $C0000000);
end;
Application.ProcessMessages; // пропускаем "вперед себя" сообщения
SetKeyboardState(OldState); // восстанавливаем карту состояний клавиатуры
end;
использование
Код:
procedure TForm1.Button1Click(Sender: TObject);
var
hW: HWND;
begin
Refresh;
hW := FindWindow(nil,'Заголовок окна'); // ищем окно
if hW <> 0 then
begin
{ отправляем слово 'Hi' }
PostKeybrdKey(hW,Ord('h'),[ssShift],False); // "h" c клавишей Shift (верхний регистр)
PostKeybrdKey(hW,Ord('i'),[],False);		  // "i"
PostKeybrdKey(hW,VK_RETURN,[],False); // перевод каретки
end;
end;
Вот... где-то так :)
Кстати, могут и другие приколы встретиться... Например...
Ведь Вы же "эксперементируете" с окошком 'Form1' в дебаг режиме? Т.е. в системе у Вас два окна класса 'TForm1' и заголовком 'Form1'. Одно рождено запущенным EXE-шником, а второе (скорее всего) онкрыто в дизайнере Delphi... Вопрос: Какое окошко найдется первым функцией FindWindow? :)
И еще, к сведению. Бывают окна, которые игнорируют "входящие" сообщения клавиатуры если не в фокусе... Возможно Вам придется с этим что-то делать...
Как правило, к Delphi-рожденным окнам это не относится, но... В общем имейте в виду.
 
13.01.2013
23
0
#10
большое спасибо за процедуру, с моей проверкой на ShowMessage справились :)
Теперь помогите доработать: во первых надо обязательно чтобы эмуляция производилась в свернутом окне, во вторых может быть несколько окон с одинаковым именем (может идентифицировать по процессу, а не окну?)
 

sinkopa

Well-known member
17.06.2009
344
4
#13
Теперь помогите доработать: во первых надо обязательно чтобы эмуляция производилась в свернутом окне, во вторых может быть несколько окон с одинаковым именем (может идентифицировать по процессу, а не окну?)
;) Есть шеф! Выполняю... Вот: http://lmgtfy.com/
Ну а если серьезно... Вот ссылка http://delphiworld.narod.ru/_all_articles_.html
Читайте... там много чего интересного... ;)