Форум: "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.htmunit 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; // ýòî òîëüêî ïîêà
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.036 c