具有 AppActivate 和 SendKeys 功能。
使用时：AppActivate('*WordPad'); SendKeys('Test"); 这工作正常 - 应用程序激活和文本粘贴
但是然后从同一程序的 WM_HOTKEY 处理程序中使用它，这是行不通的。
有任何想法吗？
procedure wm_hotkeyhandler(var Msg: TWMHotkey); message WM_HOTKEY;
...
procedure TFormMain.wm_hotkeyhandler(var Msg: TWMHotkey);
var
Pt: TPoint;
begin
inherited;
if (Msg.HotKey = HotKeyId_L) then SendKeys('Test'); // not pasted to active app
if (Msg.HotKey = HotKeyId_M) then begin
// invoke context menu and paste text after click to menu item, works fine
GetCursorPos(Pt);
popPaste.Popup(Pt.x, Pt.y);
end;
end;
更新1：
// this code works fine
procedure TFormTest.btnAppActivateClick(Sender: TObject);
var
sTitle, sKeys: string;
begin
sTitle := '*WordPad';
sKeys := 'Hello{ENTER}World!';
AppActivate(sTitle);
SendKeys(PChar(sKeys), False);
end;
菜单项处理程序（由热键 HotKeyId_M 调用）：
procedure TFormMain.mnPasteLoginClick(Sender: TObject);
begin
SendKeys('Hello{ENTER}World!', False);
end;
热键：
HotKeyId_L: Integer;
HotKeyId_M: Integer;
热键初始化：
HotKeyId_L := GlobalAddAtom('HotKeyL');
RegisterHotKey(Handle, HotKeyId_L, MOD_CONTROL + MOD_ALT, Byte('L'));
HotKeyId_M := GlobalAddAtom('HotKeyM');
RegisterHotKey(Handle, HotKeyId_L, MOD_CONTROL + MOD_ALT, Byte('M'));
更新2：（完整的测试代码）
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Menus;
type
TForm2 = class(TForm)
btnActivate: TButton;
popPopup: TPopupMenu;
Paste1: TMenuItem;
procedure btnActivateClick(Sender: TObject);
procedure Paste1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
HotKeyId_L: Integer;
HotKeyId_M: Integer;
procedure wm_hotkeyhandler(var Msg: TWMHotkey); message WM_HOTKEY;
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.DFM}
type
TCompareDirection = (cdHead, cdTail, cdNone);
TWindowObj = class(TObject)
private
targetTitle : PChar;
compareLength: Integer;
FCompareDirection: TCompareDirection;
FWindowHandle: THandle;
public
constructor Create;
destructor Destroy; override;
function Equal(ATitle: PChar): Boolean;
function SetTitle(const Title: string ): Boolean;
property WindowHandle: THandle read FWindowHandle write FWindowHandle;
end;
function EnumWindowsProc(hWnd: HWND; lParam: LPARAM):Bool; export; stdcall;
var
WinObj: TWindowObj;
aWndName: array[0..MAX_PATH] of Char;
begin
Result := True;
WinObj := TWindowObj(lParam);
GetWindowText(hWnd, aWndName, MAX_PATH);
if WinObj.Equal(aWndName) then begin
WinObj.WindowHandle := hWnd;
Result := False; // Stop Enumerate
end;
end;
function GetWindowHandleByTitle(const Title: string): THandle;
var
WinObj: TWindowObj;
begin
Result := 0;
WinObj := TWindowObj.Create;
try
if WinObj.SetTitle(Title) then begin
EnumWindows(@EnumWindowsProc, Integer(WinObj));
Result := WinObj.WindowHandle;
end;
finally
WinObj.Free;
end;
end;
function AppActivate(const Title: string ): Boolean;
var
hWnd: THandle;
begin
hWnd := GetWindowHandleByTitle(Title);
Result := (hWnd > 0);
if Result then begin
SendMessage(hWnd, WM_SYSCOMMAND, SC_HOTKEY, hWnd);
SendMessage(hWnd, WM_SYSCOMMAND, SC_RESTORE, hWnd);
SetForegroundWindow(hWnd);
end;
end;
constructor TWindowObj.Create;
begin
TargetTitle := nil;
FWindowHandle := 0;
end;
destructor TWindowObj.Destroy;
begin
inherited Destroy;
if Assigned(TargetTitle) then
StrDispose(TargetTitle) ;
end;
function TWindowObj.Equal(ATitle: PChar): Boolean;
var
p : Pchar;
stringLength : integer;
begin
Result := False;
if (TargetTitle = nil) then
Exit;
case FCompareDirection of
cdHead: begin
if StrLIComp(ATitle, TargetTitle, compareLength) = 0 then
Result := True;
end;
cdTail: begin
stringLength := StrLen(ATitle);
p := @ATitle[stringLength - compareLength];
if (StrLIComp(p, Targettitle, compareLength) = 0) then
Result := True;
end;
cdNone: begin
Result := True;
end;
end;
end;
function TWindowObj.SetTitle(const Title: string ): Boolean;
var
pTitle, p: PChar;
begin
Result := False;
pTitle := StrAlloc(Length(Title) + 1);
StrPCopy(pTitle, Title);
p := StrScan(pTitle, '*');
if Assigned(p) then begin
if StrLen(pTitle) = 1 then begin {full matching }
FCompareDirection := cdNone;
compareLength := 0;
TargetTitle := nil;
StrDispose(pTitle);
end
else
if (p = pTitle) then begin {tail matching }
Inc(p);
if StrScan(p, '*') <> nil then begin
{MessageDlg( 'Please 1 wild char ', mtError, [mbOK],0 ); }
StrDispose( pTitle);
TargetTitle := nil;
FCompareDirection := cdNone;
Comparelength := 0;
exit;
end;
FCompareDirection := cdTail;
CompareLength := StrLen(PTitle) - 1;
TargetTitle := StrAlloc(StrLen(p) + 1 );
StrCopy(targetTitle, p);
StrDispose(PTitle);
end
else begin
p^ := #0;
FCompareDirection := cdHead;
CompareLength := Strlen( pTitle );
Targettitle := pTitle;
end;
end
else begin
FCompareDirection := cdHead;
compareLength := Strlen( pTitle );
TargetTitle := pTitle;
end;
Result := True;
end;
//========================================
// SendKeys
//
// 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(SendStr: 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(Msg: PChar);
begin
MessageBox(0, Msg, 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: DWORD);
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;
var
AllocationSize : integer;
begin
AllocationSize := MaxInt;
Result := False;
UsingParens := False;
ShiftDown := False;
ControlDown := False;
AltDown := False;
I := 0;
L := StrLen(SendStr);
if (L > AllocationSize) then
L := AllocationSize;
if (L = 0) then
Exit;
while (I < L) do begin
case SendStr[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 (SendStr[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 (SendStr[I] = '}') then begin
FoundClose := True;
Inc(I);
Break;
end;
KeyString := KeyString + Upcase(SendStr[I]);
end;
if Not FoundClose then begin
DisplayMessage('No Close');
Exit;
end;
if (SendStr[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
MKey := vkKeyScan(SendStr[I]);
if (MKey <> INVALIDKEY) then begin
SendKey(MKey, 1, True);
PopUpShiftKeys;
end
else
DisplayMessage('Invalid KeyName');
Inc(I);
end;
end;
Result := True;
PopUpShiftKeys;
end;
procedure TForm2.btnActivateClick(Sender: TObject);
var
sTitle, sKeys: string;
begin
sTitle := '*WordPad';
sKeys := 'Hello{ENTER}World!';
AppActivate(sTitle);
SendKeys(PChar(sKeys), False);
end;
procedure TForm2.Paste1Click(Sender: TObject);
begin
SendKeys('Hello{ENTER}World!', False);
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
HotKeyId_L := GlobalAddAtom('HotKeyP');
RegisterHotKey(Handle, HotKeyId_L, MOD_CONTROL or MOD_ALT, Byte('L'));
HotKeyId_M := GlobalAddAtom('HotKeyM');
RegisterHotKey(Handle, HotKeyId_M, MOD_CONTROL or MOD_ALT, Byte('M'));
end;
procedure TForm2.FormDestroy(Sender: TObject);
begin
UnregisterHotKey(Handle, HotKeyId_L);
GlobalDeleteAtom(HotKeyId_L);
end;
procedure TForm2.wm_hotkeyhandler(var Msg: TWMHotkey);
var
Pt: TPoint;
begin
inherited;
if (Msg.HotKey = HotKeyId_L) then SendKeys('Hello{ENTER}World!', False);
if (Msg.HotKey = HotKeyId_M) then begin
GetCursorPos(Pt);
popPopup.Popup(Pt.x, Pt.y);
end;
end;
end.