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

Тема в разделе "Delphi - Система", создана пользователем ilya00, 27 фев 2013.

  1. ilya00

    ilya00 Member

    Регистрация:
    13 янв 2013
    Сообщения:
    23
    Симпатии:
    0
    Код (Delphi):
    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.
    почему не работает? :)
     
  2. -master-

    -master- Well-Known Member

    Регистрация:
    14 янв 2012
    Сообщения:
    629
    Симпатии:
    19
    Код (Text):
    FindWindow('Form1',0)
    Это что за огород?
     
  3. ilya00

    ilya00 Member

    Регистрация:
    13 янв 2013
    Сообщения:
    23
    Симпатии:
    0
    в смысле? ну да там надо nil поставить вместо нуля, потом понял... впрочем на работоспособности это не сказалось...
    а что еще то? FindWindow возвращает hwnd окна с заголовком Form1, в данном случае моего приложения...
     
  4. -master-

    -master- Well-Known Member

    Регистрация:
    14 янв 2012
    Сообщения:
    629
    Симпатии:
    19
    У вас уже есть окно, зачем его искать?
     
  5. ilya00

    ilya00 Member

    Регистрация:
    13 янв 2013
    Сообщения:
    23
    Симпатии:
    0
    это я просто для теста написал работает\не работает... предполагается таким образом в чужом окне эмулировать клавиши
     
  6. -master-

    -master- Well-Known Member

    Регистрация:
    14 янв 2012
    Сообщения:
    629
    Симпатии:
    19
    ну хорошо, а теперь еще, зачем посылать окну не имеющего для ввода никаких предпоссылок?
     
  7. ilya00

    ilya00 Member

    Регистрация:
    13 янв 2013
    Сообщения:
    23
    Симпатии:
    0
    что вы имеете ввиду? я специально же сделал FormKeyPress чтобы при нажатии Enter выдавалось сообщение... что не понятного то
     
  8. -master-

    -master- Well-Known Member

    Регистрация:
    14 янв 2012
    Сообщения:
    629
    Симпатии:
    19
    ну нажмите на клаву - обработчик вызывается?
     
  9. sinkopa

    sinkopa Well-Known Member

    Регистрация:
    17 июн 2009
    Сообщения:
    344
    Симпатии:
    9
    :) Мда... повеселили... даже не знаю с чего и начать...
    Вопервых. Ваш FindWindow('Form1',0) никогда не найдет никакого окошка, потому как
    первый параметр функции - это КЛАСС окна (в Вашем случае 'TForm1');
    второй параметр функции - это ЗАГОЛОВОК окна (у Вас я так понимаю 'Form1').
    т.е. правильный вызов должен быть
    Код (Delphi):
    FindWindow('TForm1','Form1')
    // или
    FindWindow(nil,'Form1') // если чисто по заголовку искать
    Во-вторых. Вы отправляете (т.е. пытаетесь отправить) сообщения WM_KEYDOWN, WM_KEYUP
    а "ловите" (FormKeyPress) сообщение WM_CHAR... не кажется ли это несколько... странным? :)
    В-третьих. Отправка сообщения через SendMessage подразумевает получение результата. т.е. код останавливается и ждет пока SendMessage что нибудь вернет, так как это функция. Это значит, что Ваша программа (когда Вы наконец достучитесь до нужного окошка) "зависнет" внутри Button1Click, до тех пор, пока Вы не переключитесь в целевое окно и не "погасите" модальное окно рожденное кодом ShowMessage('Key pressed');
    Нужно использовать процедуру PostMessage.
    И еще... маловато у Вас в сообщениях данных для клавиатурной эмуляции...
    Короче... поскольку у вас "предполагается таким образом в чужом окне эмулировать клавиши", предлагаю использовать следующую процедуру
    Код (Delphi):
    { Параметры
    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;
    использование
    Код (Delphi):
    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-рожденным окнам это не относится, но... В общем имейте в виду.
     
  10. ilya00

    ilya00 Member

    Регистрация:
    13 янв 2013
    Сообщения:
    23
    Симпатии:
    0
    большое спасибо за процедуру, с моей проверкой на ShowMessage справились :)
    Теперь помогите доработать: во первых надо обязательно чтобы эмуляция производилась в свернутом окне, во вторых может быть несколько окон с одинаковым именем (может идентифицировать по процессу, а не окну?)
     
  11. -master-

    -master- Well-Known Member

    Регистрация:
    14 янв 2012
    Сообщения:
    629
    Симпатии:
    19
    Ничего не получится.
     
  12. ilya00

    ilya00 Member

    Регистрация:
    13 янв 2013
    Сообщения:
    23
    Симпатии:
    0
    не ну почему так безапеляционно... существуют же автокликеры...
     
  13. sinkopa

    sinkopa Well-Known Member

    Регистрация:
    17 июн 2009
    Сообщения:
    344
    Симпатии:
    9
    ;) Есть шеф! Выполняю... Вот: http://lmgtfy.com/
    Ну а если серьезно... Вот ссылка http://delphiworld.narod.ru/_all_articles_.html
    Читайте... там много чего интересного... ;)
     
  14. lux4home

    lux4home New Member

    Регистрация:
    12 окт 2014
    Сообщения:
    1
    Симпатии:
    0
    не выйдет ничего :D
     
Загрузка...

Поделиться этой страницей