Форум: "WinAPI";
Текущий архив: 2004.12.05;
Скачать: [xml.tar.bz2];

Вниз

Управление чужой программой   Найти похожие ветки 

← →
Dmitriy-R   (2004-10-21 09:57) [0]

Народ подскажите как мне из своей программы отправить нажатие клавиши в другую прогу. Тоесть как будто я на клавиатуре нажал клавишу "A" но при етом другая прога которой предназначено ето нажатие может быть свернута в трей.
И как сделать тоже самое с программным кликом мышки?

---

← →
TUser ©   (2004-10-21 10:05) [1]

wm_char
wm_keydown
wm_lbtndown/up и т.д.

---

← →
Rouse_ ©   (2004-10-21 10:05) [2]

SendMessage(Handle окна которому хочешь отправить...

---

← →
Dmitriy-R   (2004-10-21 10:14) [3]

А если не сложно то можно примерчик?
Для точности действий опищу что конкретно надо.
Есть прога №1 которая запущена и висит в трее, надо мне из своей проги №2 через каждые 3 минуты кидать в прогу №1 кажатие клавиши "А" и через каждые 5 минут нажатие кл. "B".
Самое противное что 1 раз в час надо съемулировать нажатие правой кнопки мыши и прогу №1.
Если кого не затруднит киньте решение вопроса желательно с примером.

---

← →
TUser ©   (2004-10-21 10:43) [4]

> Dmitriy-R   (21.10.04 10:14) [3]

Вот живой модуль. Для управления вот такой программой
http://www.umass.edu/microbio/rasmol/index2.htm

unit uRasCom;

interface
uses Windows, Messages, IniFiles, Dialogs, SysUtils;

type RasWins = record
      RasView, RasCon:hWND;
      AC:string[4];
      Active:boolean;
      end;

function RasOpen(FileName:string = ""):RasWins;
procedure RasStartScript;
procedure RasCommand(Command:string; Window:hWND = 0);
procedure RasExecuteStript(Window:hWND = 0; ScriptName:string = "");
function RasReadAC(Window:hWND):string;
function RasFindNum(AC:string):integer;
function RasFind(AC:string):RasWins;
procedure RasActivate(Window:hWND); overload;
procedure RasInActivate(Window:hWND); overload;
procedure RasActivate(AC:string); overload;
procedure RasInActivate(AC:string); overload;
procedure RasActivateAll;
procedure RasInActivateAll;
function RasReadActive(Window:hWND):boolean; overload;
function RasReadActive(AC:string):boolean; overload;
function RasFindWindowsNum(Window:hWND; ConsolFirst:boolean = true):integer;
function RasFindWindows(Window:hWND; ConsolFirst:boolean = true):RasWins; overload;
procedure RasReReadAll;
function RasGetFirst(var RW:RasWins):boolean;
function RasGetNext(var RW:RasWins):boolean;
function RasGetCurrent(var RW:RasWins):boolean;
function RasIsLast:boolean;
procedure RasShowConsole(Show:byte; Window:hWND = 0); overload;
procedure RasShowConsole(Show:byte; AC:string); overload;
procedure RasShowView(Window:hWND); overload;
procedure RasShowView(AC:string); overload;
function RasCount:integer;
function RasActiveCount:integer;

// procedure RasClose; // ïðèäåòñÿ ïèñàòü ñàìîìó
                      // òîëüêî âîò êàê?
procedure RasExit;

implementation
uses Classes;

var Wins:array of RasWins;
   IsScript:boolean;
   Script:TStringList;
   CurrentWins:integer = -1;

function RasOpen(FileName:string = ""):RasWins;
var SI:_STARTUPINFOA;
   PI:_PROCESS_INFORMATION;
   f:boolean; h:hWND;
   ini:TIniFile;
   rc:string;
   od:TOpenDialog;
begin
  ini:=TIniFile.Create("RasCom.ini");
  try
   rc:=ini.ReadString("RasWin","exe","notfound");
   if not fileexists(rc) then begin
      od:=TOpenDialog.Create(nil);
      try
       od.Title:="Select RasWin executable file";
       od.Filter:="Exe files|*.exe";
       if od.Execute then begin
          rc:=od.FileName;
          ini.WriteString("RasWin","exe",rc);
          end;
      finally
       od.Free;
      end;
      end;
  finally
   ini.Free;
  end;

  if rc <> "notfound" then begin
     FillChar(SI,sizeof(SI),#0);
     SI.cb:=sizeof(SI);
     FillChar(SI,sizeof(PI),#0);
     CreateProcess(PAnsiChar(rc),nil,nil,nil,false,0,nil,nil,SI,PI);
     CloseHandle(PI.hProcess);
     CloseHandle(PI.hThread);

     result.RasView:=0;
     repeat
        result.RasView:=FindWindowEx(0,result.RasView,
                                     "RasWinClass",nil);
        GetWindowThreadProcessId(result.RasView,@h);
     until h = PI.dwProcessId;

     result.RasCon:=0;
     repeat
        result.RasCon:=FindWindowEx(0,result.RasCon,
                                    "RasCliClass",nil);
        GetWindowThreadProcessId(result.RasCon,@h);
     until h = PI.dwProcessId;
     ShowWindow(result.RasCon,SW_HIDE);

     result.Active:=false;

     SetLength(Wins,length(Wins)+1);
     Wins[length(Wins)-1]:=result;

     if FileName <> "" then
        RasCommand("load "+FileName, result.RasCon);

     result.AC:=RasReadAC(result.RasCon);
     Wins[length(Wins)-1].AC:=result.AC;

     end;

end;

procedure RasStartScript;
begin
  IsScript:=true;
  if not assigned (Script) then
     Script:=TStringList.Create;
  Script.Clear;
end;

procedure RasCommand(Command:string; Window:hWND = 0);
var i:integer;
   h:hWND;

procedure Send(W:hWND);
var i:integer;
begin
   Command:=Command+#13;
   for i:=1 to length(Command) do
      SendMessage(W,WM_CHAR,ord(Command[i]),0);
end;

begin
  if not IsScript then
     if Window = 0 then begin
        for i:=0 to length(Wins)-1 do
           if Wins[i].Active then
              Send(Wins[i].RasCon);
        end else begin
        h:=RasFindWindows(Window).RasCon;
        if h <> 0 then
           Send(h);
        end
     else Script.Add(Command);
end;

procedure RasExecuteStript(Window:hWND = 0; ScriptName:string = "");
begin
  if IsScript then begin
     if ScriptName = "" then ScriptName:="c:\unnamedscript.scr";
     Script.SaveToFile(ScriptName);
     IsScript:=false;
     RasCommand("script "+ScriptName,Window);
     end;
end;

function RasReadAC(Window:hWND):string;
var ch:PAnsiChar;
begin
  GetMem(ch,8); // New(ch);
  try
   getwindowtext(RasFindWindows(Window).RasView,ch,7);
   if (ch = "RasMol") or (ch = "RasWin") then
      result:="????"
      else result:=copy(ch,1,4);
   Wins[RasFindWindowsNum(Window)].AC:=result;
  finally
   freeMem(ch); // Dispose(ch);
  end;
end;

function RasFindNum(AC:string):integer;
var i:integer;
   f:boolean;
begin
  AC:=uppercase(AC);
  i:=0; f:=true;
  while f and (i < length(Wins)) do
     if Wins[i].AC = AC then
        f:=false
        else inc (i);
  if not f then
     result:=i
     else result:=-1;
end;

function RasFind(AC:string):RasWins;
var i:integer;
begin
  i:=RasFindNum(AC);
  if i <> -1 then
     result:=Wins[i]
     else begin
     result.RasView:=0;
     result.RasCon:=0;
     result.AC:="????";
     result.Active:=false;
     end;
end;

procedure RasActivate(Window:hWND);
var i:integer;
begin
  i:=RasFindWindowsNum(Window);
  if i <> -1 then
     Wins[i].Active:=true;
end;

procedure RasInActivate(Window:hWND);
var i:integer;
begin
  i:=RasFindWindowsNum(Window);
  if i <> -1 then
     Wins[i].Active:=false;
end;

---

← →
TUser ©   (2004-10-21 10:44) [5]

procedure RasActivate(AC:string);
var i:integer;
begin
  i:=RasFindNum(AC);
  if i <> -1 then
     Wins[i].Active:=true;
end;

procedure RasInActivate(AC:string);
var i:integer;
begin
  i:=RasFindNum(AC);
  if i <> -1 then
     Wins[i].Active:=false;
end;

procedure RasActivateAll;
var i:integer;
begin
  for i:=0 to length(Wins)-1 do
     Wins[i].Active:=true;
end;

procedure RasInActivateAll;
var i:integer;
begin
  for i:=0 to length(Wins)-1 do
     Wins[i].Active:=false;
end;

function RasReadActive(Window:hWND):boolean;
begin
  result:=RasFindWindows(Window).Active;
end;

function RasReadActive(AC:string):boolean;
begin
  result:=RasFind(AC).Active;
end;

function RasFindWindowsNum(Window:hWND; ConsolFirst:boolean = true):integer;
var i:integer;
   f:boolean;
begin
  f:=false; // not found
  if ConsolFirst then begin
     i:=0;
     while (not f) and (i < length(Wins)) do
        if Wins[i].RasCon = Window then
           f:=true
           else inc (i);
     end else begin
     i:=0;
     while (not f) and (i < length(Wins)) do
        if Wins[i].RasView = Window then
           f:=true
           else inc (i);
     end;
  if not f then
     if ConsolFirst then begin
        i:=0;
        while (not f) and (i < length(Wins)) do
           if Wins[i].RasView = Window then
              f:=true
              else inc (i);
        end else begin
        i:=0;
        while (not f) and (i < length(Wins)) do
           if Wins[i].RasCon = Window then
              f:=true
              else inc (i);
        end;
  if f then
     result:=i
     else result:=-1;
end;

function RasFindWindows(Window:hWND; ConsolFirst:boolean = true):RasWins;
var i:integer;
begin
  i:=RasFindWindowsNum(Window, ConsolFirst);
  if i <> -1 then
     result:=Wins[i]
     else begin
     result.RasView:=0;
     result.RasCon:=0;
     result.AC:="????";
     result.Active:=false;
     end;
end;

procedure RasReReadAll;
var hv, hc: hWND;
   pv, pc: hWND;
   ch:PAnsiChar;
   i:integer; f:boolean;
begin
  GetMem(ch,8); // New(ch);
  try
   SetLength(Wins,0);
   hv:=0;
   repeat
      hv:=FindWindowEx(0,hv,"RasWinClass",nil);
      GetWindowThreadProcessId(hv, @pv);

      if hv <> 0 then begin
         SetLength(Wins,length(Wins)+1);
         Wins[length(Wins)-1].RasView:=hv;
         Wins[length(Wins)-1].RasCon:=pv; // &#253;&#242;&#238; &#242;&#238;&#235;&#252;&#234;&#238; &#239;&#238;&#234;&#224;
         GetWindowText(hv,ch,7);
         if (ch = "RasMol") or (ch = "RasWin") then
            Wins[length(Wins)-1].AC:="????"
            else Wins[length(Wins)-1].AC:=copy(ch,1,4);
         Wins[length(Wins)-1].Active:=false;
         end;
   until hv = 0;

   hc:=0;
   repeat
      hc:=FindWindowEx(0,hc,"RasCliClass",nil);
      GetWindowThreadProcessId(hc, @pc);

      if hc <> 0 then begin
         i:=0; f:=true;
         while f and (i < length(Wins)) do
            if Wins[i].RasCon = pc then
               f:=false
               else inc (i);
         if not f then
            Wins[i].RasCon:=hc
         end;
   until hc = 0;

  finally
   // FreeMem(ch); // Dispose(ch);
  end;
end;

function RasGetFirst(var RW:RasWins):boolean;
begin
  CurrentWins:=0;
  result:=RasGetCurrent(RW);
end;

function RasGetNext(var RW:RasWins):boolean;
begin
  inc (CurrentWins);
  result:=RasGetCurrent(RW);
end;

function RasGetCurrent(var RW:RasWins):boolean;
begin
  if not RasIsLast then begin
     RW:=Wins[CurrentWins];
     result:=true;
     end else begin
     RW.RasView:=0;
     RW.RasCon:=0;
     RW.AC:="????";
     RW.Active:=false;
     result:=false;
     end;
end;

function RasIsLast:boolean;
begin
  result:=CurrentWins >= length(Wins);
end;

procedure RasShowConsole(Show:byte; Window:hWND = 0);
var i:integer;
begin
  if Window = 0 then begin
     for i:=0 to length(Wins)-1 do
        if Wins[i].Active then
           ShowWindow(Wins[i].RasCon,Show)
     end else begin
     i:=RasFindWindowsNum(Window);
     if i <> -1 then
        ShowWindow(Wins[i].RasCon,Show);
     end;
end;

procedure RasShowConsole(Show:byte; AC:string);
var i:integer;
begin
  i:=RasFindNum(AC);
  if i <> -1 then
     ShowWindow(Wins[i].RasCon,Show);
end;

procedure RasShowView(Window:hWND); overload;
var i:integer;
begin
  i:=RasFindWindowsNum(Window, false);
  if i <> -1 then
     SetForegroundWindow(Wins[i].RasView);
end;

procedure RasShowView(AC:string); overload;
var i:integer;
begin
  i:=RasFindNum(AC);
  if i <> -1 then
     SetForegroundWindow(Wins[i].RasView);
end;

procedure RasExit;
begin
  RasCommand("exit");
end;

procedure RasClose;
begin
  ShowMessage("""Close"" command is not supported by RasMol");
end;

function RasCount:integer;
begin
  result:=length(Wins);
end;

function RasActiveCount:integer;
var i:integer;
begin
  result:=0;
  for i:=0 to RasCount-1 do
     if Wins[i].Active then
        inc (result);
end;

initialization
finalization
  if assigned (Script) then
     Script.Free;
end.

---

← →
TUser ©   (2004-10-21 10:45) [6]

Правда, это - немного старый вариант, но то, что ты просишь тут уже есть - см. процедуру RasCommand.

---

← →
-=SS=- ©   (2004-10-21 11:10) [7]

Я также предложу borland"s вариант
(*
SendKeys routine for 32-bit Delphi.

Written by Ken Henderson

Copyright (c) 1995 Ken Henderson

This unit includes two routines that simulate popular Visual Basic
routines: Sendkeys and AppActivate.  SendKeys takes a PChar
as its first parameter and a boolean as its second, like so:

SendKeys("KeyString", Wait);

where KeyString is a string of key names and modifiers that you want
to send to the current input focus and Wait is a boolean variable or value
that indicates whether SendKeys should wait for each key message to be
processed before proceeding.  See the table below for more information.

AppActivate also takes a PChar as its only parameter, like so:

AppActivate("WindowName");

where WindowName is the name of the window that you want to make the
current input focus.

SendKeys supports the Visual Basic SendKeys syntax, as documented below.

Supported modifiers:

+ = Shift
^ = Control
% = Alt

Surround sequences of characters or key names with parentheses in order to
modify them as a group.  For example, "+abc" shifts only "a", while "+(abc)" shifts
all three characters.

Supported special characters

~ = Enter
( = Begin modifier group (see above)
) = End modifier group (see above)
{ = Begin key name text (see below)
} = End key name text (see below)

Supported characters:

Any character that can be typed is supported.  Surround the modifier keys
listed above with braces in order to send as normal text.

Supported key names (surround these with braces):

BKSP, BS, BACKSPACE
BREAK
CAPSLOCK
CLEAR
DEL
DELETE
DOWN
END
ENTER
ESC
ESCAPE
F1
F2
F3
F4
F5
F6
F7
F8
F9
F10
F11
F12
F13
F14
F15
F16
HELP
HOME
INS
LEFT
NUMLOCK
PGDN
PGUP
PRTSC
RIGHT
SCROLLLOCK
TAB
UP

Follow the keyname with a space and a number to send the specified key a
given number of times (e.g., {left 6}).
*)

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:"BACKSPACE";       VKey:VK_BACK),
  (Name:"BKSP";            VKey:VK_BACK),
  (Name:"BREAK";           VKey:VK_CANCEL),
  (Name:"BS";              VKey:VK_BACK),
  (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)
 );

 

---

← →
-=SS=- ©   (2004-10-21 11:11) [8]

Продолжение
{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 {Unsigned -1};
 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;

 

---

← →
-=SS=- ©   (2004-10-21 11:12) [9]

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;
   end else begin
      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;

 While (I<L) do begin
   case SendKeysString[I] of
   "(" : begin
           UsingParens:=True;
           Inc(I);
         end;
   ")" : begin
           UsingParens:=False;
           PopUpShiftKeys;
           Inc(I);
         end;
   "%" : begin
            AltDown:=True;
            SendKeyDown(VK_MENU,1,False);
            Inc(I);
         end;
   "+" :  begin
            ShiftDown:=True;
            SendKeyDown(VK_SHIFT,1,False);
            Inc(I);
          end;
   "^" :  begin
            ControlDown:=True;
            SendKeyDown(VK_CONTROL,1,False);
            Inc(I);
          end;
   "{" : begin
           NumTimes:=1;
           If (SendKeysString[Succ(I)]="{") then begin
             MKey:=VK_LEFTBRACKET;
             SetBit(Wbytes(MKey)[1],VKKEYSCANSHIFTON);
             SendKey(MKey,1,True);
             PopUpShiftKeys;
             Inc(I,3);
             Continue;
           end;
           KeyString:="";
           FoundClose:=False;
           While (I<=L) do begin
             Inc(I);
             If (SendKeysString[I]="}") then begin
               FoundClose:=True;
               Inc(I);
               Break;
             end;
             KeyString:=KeyString+Upcase(SendKeysString[I]);
           end;
           If (Not FoundClose) then begin
              DisplayMessage("No Close");
              Exit;
           end;
           If (SendKeysString[I]="}") then begin
             MKey:=VK_RIGHTBRACKET;
             SetBit(Wbytes(MKey)[1],VKKEYSCANSHIFTON);
             SendKey(MKey,1,True);
             PopUpShiftKeys;
             Inc(I);
             Continue;
           end;
           PosSpace:=Pos(" ",KeyString);
           If (PosSpace<>0) then begin
              NumTimes:=StrToInt(Copy(KeyString,Succ(PosSpace),Length(KeyString)-PosSpace));
              KeyString:=Copy(KeyString,1,Pred(PosSpace));
           end;
           If (Length(KeyString)=1) then MKey:=vkKeyScan(KeyString[1])
           else MKey:=StringToVKey(KeyString);
           If (MKey<>INVALIDKEY) then begin
             SendKey(MKey,NumTimes,True);
             PopUpShiftKeys;
             Continue;
           end;
         end;
   "~" : begin
           SendKeyDown(VK_RETURN,1,True);
           PopUpShiftKeys;
           Inc(I);
         end;
   else  begin
            MKey:=vkKeyScan(SendKeysString[I]);
            If (MKey<>INVALIDKEY) then begin
              SendKey(MKey,1,True);
              PopUpShiftKeys;
            end else DisplayMessage("Invalid KeyName");
            Inc(I);
         end;
   end;
 end;
 Result:=true;
 PopUpShiftKeys;
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;
var
 WindowName : array[0..MAX_PATH] of char;
begin
 {Can"t test GetWindowText"s return value since some windows don"t have a title}
 GetWindowText(WHandle,WindowName,MAX_PATH);
 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);
     SetForegroundWindow(WindowHandle);
   end else Result:=false;
 except
   on Exception do Result:=false;
 end;
end;

end.

---

Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2004.12.05;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.55 MB
Время: 0.034 c