VPF::Посылаем нажатия клавиш другому приложению

Radon

Дата 5.8.2006, 20:06 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 36
Регистрация: 11.10.2005

Репутация: нет
Всего: нет

Посылаем нажатия клавиш другому приложению
Как послать Up, Down, Left, Right (стрелки)

Вот использованый код:
http://forum.vingrad.ru/index.php?act=modu...amp;article=772

Alexeis

Дата 5.8.2006, 21:31 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Код


SendKeys1.SendKeys(Chr(VK_LEFT));  
SendKeys1.SendKeys(Chr(VK_UP));  
SendKeys1.SendKeys(Chr(VK_RIGHT));  
SendKeys1.SendKeys(Chr(VK_DOWN));

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Radon

Дата 6.8.2006, 07:53 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 36
Регистрация: 11.10.2005

Репутация: нет
Всего: нет

я это пробывал не рабоает в место штоб делать лефт он пишет 5 (цыфру)

Radon

Дата 6.8.2006, 09:55 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 36
Регистрация: 11.10.2005

Репутация: нет
Всего: нет

все разобрался используя другои код ...

kindDevil

Дата 6.8.2006, 13:59 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 110
Регистрация: 10.10.2005

Репутация: нет
Всего: нет

Radon,
выкладывай smile

у меня с этимим стрелочками вообще война - раньше пользовался только паскалём, а там по ASCII легко было -72, 80 и т.д. а тут Delphi вроде другой формат юзает, а как его использовать по-человечески не понимаю %)

Это сообщение отредактировал(а) kindDevil - 6.8.2006, 14:01

Alexeis

Дата 6.8.2006, 15:09 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Да можно было все проще гораздо

Код


var
  w : HWND;

procedure TForm1.FormCreate(Sender: TObject);
begin
 w := FindWindow(nil, 'Unit1.pas - EmEditor');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 PostMessage(w, WM_KEYDOWN, VK_LEFT, 0);//нужно как нажать так и отпустить клавишу
 PostMessage(w, WM_KEYUP, VK_LEFT, 0);
end;

--------------------

Radon

Дата 6.8.2006, 20:57 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 36
Регистрация: 11.10.2005

Репутация: нет
Всего: нет

Код


unit sndkey32;  

interface  

Uses SysUtils, Windows, Messages;  

function SendKeys(SendKeysString : PChar; Wait : Boolean) : Boolean;  
function AppActivate(WindowName : PChar) : boolean;  


{Buffer for working with PChar's}  


const  
  WorkBufLen = 40;  
var  
  WorkBuf : array[0..WorkBufLen] of Char;  

implementation  
type  
  THKeys = array[0..pred(MaxLongInt)] of byte;  
var  
  AllocationSize : integer;  


(*  
Converts a string of characters and key names to keyboard events and  
passes them to Windows.  

Example syntax:  

SendKeys('abc123{left}{left}{left}def{end}456{left 6}ghi{end}789', True);  

*)  


function SendKeys(SendKeysString : PChar; Wait : Boolean) : Boolean;  
type  
  WBytes = array[0..pred(SizeOf(Word))] of Byte;  

  TSendKey = record  
    Name : ShortString;  
    VKey : Byte;  
  end;  

const  

{Array of keys that SendKeys recognizes.  

  if you add to this list, you must be sure to keep it sorted alphabetically  
  by Name because a binary search routine is used to scan it.}  


  MaxSendKeyRecs = 41;  
  SendKeyRecs : array[1..MaxSendKeyRecs] of TSendKey =  
  (  
   (Name:'BKSP'; VKey:VK_BACK),  
   (Name:'BS'; VKey:VK_BACK),  
   (Name:'BACKSPACE'; VKey:VK_BACK),  
   (Name:'BREAK'; VKey:VK_CANCEL),  
   (Name:'CAPSLOCK'; VKey:VK_CAPITAL),  
   (Name:'CLEAR'; VKey:VK_CLEAR),  
   (Name:'DEL'; VKey:VK_DELETE),  
   (Name:'DELETE'; VKey:VK_DELETE),  
   (Name:'DOWN'; VKey:VK_DOWN),  
   (Name:'END'; VKey:VK_END),  
   (Name:'ENTER'; VKey:VK_RETURN),  
   (Name:'ESC'; VKey:VK_ESCAPE),  
   (Name:'ESCAPE'; VKey:VK_ESCAPE),  
   (Name:'F1'; VKey:VK_F1),  
   (Name:'F10'; VKey:VK_F10),  
   (Name:'F11'; VKey:VK_F11),  
   (Name:'F12'; VKey:VK_F12),  
   (Name:'F13'; VKey:VK_F13),  
   (Name:'F14'; VKey:VK_F14),  
   (Name:'F15'; VKey:VK_F15),  
   (Name:'F16'; VKey:VK_F16),  
   (Name:'F2'; VKey:VK_F2),  
   (Name:'F3'; VKey:VK_F3),  
   (Name:'F4'; VKey:VK_F4),  
   (Name:'F5'; VKey:VK_F5),  
   (Name:'F6'; VKey:VK_F6),  
   (Name:'F7'; VKey:VK_F7),  
   (Name:'F8'; VKey:VK_F8),  
   (Name:'F9'; VKey:VK_F9),  
   (Name:'HELP'; VKey:VK_HELP),  
   (Name:'HOME'; VKey:VK_HOME),  
   (Name:'INS'; VKey:VK_INSERT),  
   (Name:'LEFT'; VKey:VK_LEFT),  
   (Name:'NUMLOCK'; VKey:VK_NUMLOCK),  
   (Name:'PGDN'; VKey:VK_NEXT),  
   (Name:'PGUP'; VKey:VK_PRIOR),  
   (Name:'PRTSC'; VKey:VK_PRINT),  
   (Name:'RIGHT'; VKey:VK_RIGHT),  
   (Name:'SCROLLLOCK'; VKey:VK_SCROLL),  
   (Name:'TAB'; VKey:VK_TAB),  
   (Name:'UP'; VKey:VK_UP)  
  );  
{Extra VK constants missing from Delphi's Windows API interface}  
  VK_NULL=0;  
  VK_SemiColon=186;  
  VK_Equal=187;  
  VK_Comma=188;  
  VK_Minus=189;  
  VK_Period=190;  
  VK_Slash=191;  
  VK_BackQuote=192;  
  VK_LeftBracket=219;  
  VK_BackSlash=220;  
  VK_RightBracket=221;  
  VK_Quote=222;  
  VK_Last=VK_Quote;  

  ExtendedVKeys : set of byte =  
  [VK_Up,  
   VK_Down,  
   VK_Left,  
   VK_Right,  
   VK_Home,  
   VK_End,  
   VK_Prior, {PgUp}  
   VK_Next, {PgDn}  
   VK_Insert,  
   VK_Delete];  

const  
  INVALIDKEY = $FFFF;  
  VKKEYSCANSHIFTON = $01;  
  VKKEYSCANCTRLON = $02;  
  VKKEYSCANALTON = $04;  
  UNITNAME = 'SendKeys';  
var  
  UsingParens, ShiftDown, ControlDown, AltDown, FoundClose : Boolean;  
  PosSpace : Byte;  
  I, L : Integer;  
  NumTimes, MKey : Word;  
  KeyString : String[20];  

procedure DisplayMessage(Message : PChar);  
begin  
  MessageBox(0,Message,UNITNAME,0);  
end;  

function BitSet(BitTable, BitMask : Byte) : Boolean;  
begin  
  Result:=ByteBool(BitTable and BitMask);  
end;  

procedure SetBit(var BitTable : Byte; BitMask : Byte);  
begin  
  BitTable:=BitTable or Bitmask;  
end;  

procedure KeyboardEvent(VKey, ScanCode : Byte; Flags : Longint);  
var  
  KeyboardMsg : TMsg;  
begin  
  keybd_event(VKey, ScanCode, Flags,0);  
  if (Wait) then While (PeekMessage(KeyboardMsg,0,WM_KEYFIRST, WM_KEYLAST, PM_REMOVE)) do begin  
    TranslateMessage(KeyboardMsg);  
    DispatchMessage(KeyboardMsg);  
  end;  
end;  

procedure SendKeyDown(VKey: Byte; NumTimes : Word; GenUpMsg : Boolean);  
var  
  Cnt : Word;  
  ScanCode : Byte;  
  NumState : Boolean;  
  KeyBoardState : TKeyboardState;  
begin  
  if (VKey=VK_NUMLOCK) then begin  
    NumState:=ByteBool(GetKeyState(VK_NUMLOCK) and 1);  
    GetKeyBoardState(KeyBoardState);  
    if NumState then KeyBoardState[VK_NUMLOCK]:=(KeyBoardState[VK_NUMLOCK] and not 1)  
    else KeyBoardState[VK_NUMLOCK]:=(KeyBoardState[VK_NUMLOCK] or 1);  
    SetKeyBoardState(KeyBoardState);  
    exit;  
  end;  

  ScanCode:=Lo(MapVirtualKey(VKey,0));  
  For Cnt:=1 to NumTimes do  
    if (VKey in ExtendedVKeys)then begin  
      KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY);  
      if (GenUpMsg) then  
        KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP)  
    end else begin  
      KeyboardEvent(VKey, ScanCode, 0);  
      if (GenUpMsg) then KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);  
    end;  
end;  

procedure SendKeyUp(VKey: Byte);  
var  
  ScanCode : Byte;  
begin  
  ScanCode:=Lo(MapVirtualKey(VKey,0));  
  if (VKey in ExtendedVKeys)then  
    KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY and KEYEVENTF_KEYUP)  
  else KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);  
end;  

procedure SendKey(MKey: Word; NumTimes : Word; GenDownMsg : Boolean);  
begin  
  if (BitSet(Hi(MKey),VKKEYSCANSHIFTON)) then SendKeyDown(VK_SHIFT,1,False);  
  if (BitSet(Hi(MKey),VKKEYSCANCTRLON)) then SendKeyDown(VK_CONTROL,1,False);  
  if (BitSet(Hi(MKey),VKKEYSCANALTON)) then SendKeyDown(VK_MENU,1,False);  
  SendKeyDown(Lo(MKey), NumTimes, GenDownMsg);  
  if (BitSet(Hi(MKey),VKKEYSCANSHIFTON)) then SendKeyUp(VK_SHIFT);  
  if (BitSet(Hi(MKey),VKKEYSCANCTRLON)) then SendKeyUp(VK_CONTROL);  
  if (BitSet(Hi(MKey),VKKEYSCANALTON)) then SendKeyUp(VK_MENU);  
end;  

{Implements a simple binary search to locate special key name strings}  
function StringToVKey(KeyString : ShortString) : Word;  
var  
  Found, Collided : Boolean;  
  Bottom, Top, Middle : Byte;  
begin  
  Result:=INVALIDKEY;  
  Bottom:=1;  
  Top:=MaxSendKeyRecs;  
  Found:=false;  
  Middle:=(Bottom+Top) div 2;  
  Repeat  
    Collided:=((Bottom=Middle) or (Top=Middle));  
    if (KeyString=SendKeyRecs[Middle].Name) then begin  
       Found:=true;  
       Result:=SendKeyRecs[Middle].VKey;  
           if (KeyString>SendKeyRecs[Middle].Name) then Bottom:=Middle  
       else Top:=Middle;  
       Middle:=(Succ(Bottom+Top)) div 2;  
    end;  
  Until (Found or Collided);  
  if (Result=INVALIDKEY) then DisplayMessage('Invalid Key Name');  
end;  

procedure PopUpShiftKeys;  
begin  
  if (not UsingParens) then begin  
    if ShiftDown then SendKeyUp(VK_SHIFT);  
    if ControlDown then SendKeyUp(VK_CONTROL);  
    if AltDown then SendKeyUp(VK_MENU);  
    ShiftDown:=false;  
    ControlDown:=false;  
    AltDown:=false;  
  end;  
end;  

begin  
  AllocationSize:=MaxInt;  
  Result:=false;  
  UsingParens:=false;  
  ShiftDown:=false;  
  ControlDown:=false;  
  AltDown:=false;  
  I:=0;  
  L:=StrLen(SendKeysString);  
  if (L>AllocationSize) then L:=AllocationSize;  
  if (L=0) then Exit;  
  if SendKeysString='LEFT' then SendKey(VK_LEFT,1,True);
  if SendKeysString='RIGHT' then SendKey(VK_RIGTH,1,True); {ну и тогдале :)}
 end;  

{AppActivate  

This is used to set the current input focus to a given window using its  
name. This is especially useful for ensuring a window is active before  
sending it input messages using the SendKeys function. You can specify  
a window's name in its entirety, or only portion of it, beginning from  
the left.  

}  

var  
  WindowHandle : HWND;  

function EnumWindowsProc(WHandle: HWND; lParam: LPARAM): BOOL; export; stdcall;  
const  
  MAX_WINDOW_NAME_LEN = 80;  
var  
  WindowName : array[0..MAX_WINDOW_NAME_LEN] of char;  
begin  
  {Can't test GetWindowText's return value since some windows don't have a title}  
  GetWindowText(WHandle,WindowName,MAX_WINDOW_NAME_LEN);  
  Result := (StrLIComp(WindowName,PChar(lParam), StrLen(PChar(lParam))) <> 0);  
  if (not Result) then WindowHandle:=WHandle;  
end;  

function AppActivate(WindowName : PChar) : boolean;  
begin  
  try  
    Result:=true;  
    WindowHandle:=FindWindow(nil,WindowName);  
    if (WindowHandle=0) then EnumWindows(@EnumWindowsProc,Integer (PChar(WindowName)));  
    if (WindowHandle<>0) then begin  
      SendMessage(WindowHandle, WM_SYSCOMMAND, SC_HOTKEY, WindowHandle);  
      SendMessage(WindowHandle, WM_SYSCOMMAND, SC_RESTORE, WindowHandle);  
    end else Result:=false;  
  except  
    on Exception do Result:=false;  
  end;  
end;  

end.

Сам код взят из Фака и урезан мною smile

тут осталось некоторые не использованые процедуры... лень было убрать smile

Romikgy

Дата 8.8.2006, 09:51 (ссылка)

(нет голосов)

Загрузка ...

Любитель-программер

Профиль
Группа: Участник Клуба
Сообщений: 7326
Регистрация: 11.5.2005
Где: Porto Franco Odes sa

Репутация: 26
Всего: 146

Имхо коректнее то что
alexeis1, предложил

--------------------

Владение русской орфографией это как владение кунг-фу — истинные мастера не применяют его без надобности.

demon13

Дата 12.8.2006, 18:54 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 69
Регистрация: 12.8.2006

Репутация: нет
Всего: нет

Здраствуте я пишу виртуальную клавиатуру, все сделал только незнаю как сделать что бы окно клавиатуры
не становилось активным при нажатии на него. smile

Alexeis

Дата 12.8.2006, 21:07 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Цитата(demon13 @ 12.8.2006, 18:54

)

что бы окно клавиатуры
не становилось активным при нажатии на него

Это невозможно, окно должно при нажатии в любом случае получать фокус, но оно может его возвращать после нажатия тому у кого оно его брало.

--------------------

demon13

Дата 13.8.2006, 21:40 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 69
Регистрация: 12.8.2006

Репутация: нет
Всего: нет

А что делать если мне надо посылать сообщение не окну, а полю ввода допустим в броузере smile

Alexeis

Дата 13.8.2006, 23:32 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Цитата(demon13 @ 13.8.2006, 21:40

)

сообщение не окну, а полю ввода допустим в броузере

Поле ввода в браузере тоже окно.

--------------------

_hunter

Дата 14.8.2006, 10:49 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 8564
Регистрация: 24.6.2003
Где: Europe::Ukraine:: Kiev

Репутация: 15
Всего: 98

Цитата(alexeis1 @ 13.8.2006, 23:32

)

Поле ввода в браузере тоже окно.

только фиг его найдеш...

Цитата(demon13 @ 13.8.2006, 21:40

)

А что делать если мне надо посылать сообщение не
окну, а полю ввода допустим в броузере smile

в таком случае кончай играться с сообщениями и переходи на SendInput

--------------------

Tempora mutantur, et nos mutamur in illis...

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »