解决方案 »
- TeeChart中怎样才能做出平滑曲线?
- delphi和ASP的疑问
- 50分请教一个字符替换的问题
- 本人用AdOStoreProcedure控件,传入参数取回记录集,然后增加存盘,但发现存不到SERVER上!!
- 小问题, 肯请高手指点, 谢谢!
- 如何在窗体中做一个label单击时打开浏览器访问一个特定的网址?
- 在使用数据库过滤时filtered:=memo3.text,memo3.text:='telphoneid='+s,如果过滤不到数据时系统就出错?如何解决?在线等!!!
- 在2000下用delphi5编辑的窗体和控件,在98下执行时大小完全不同,反过来也是。这是为什么?
- 怎样从工作站取到服务器注册表的数据?
- 用TDeCompressionStream解压缩报错out of memory,求解。。
- 有难度的捕捉异常问题
- 请教高手2个DHTML开发的小问题(就剩这些分了)
SendKeys routine for 32-bit Delphi.Written by Ken HendersonCopyright (c) 1995 Ken HendersonThis 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
% = AltSurround 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
UPFollow the keyname with a space and a number to send the specified key a
given number of times (e.g., {left 6}).
*)
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)
); {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;
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;
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;{AppActivateThis 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.