SHORTCUT در تمام پروژه

ســـــــــــــــــــلــــ ـــــــــــــا م
به دوستان جدید و قدیم


من میخوام وقتی برنامه ام در حال اجرا است در هر قسمتی از پروژه که کلید خاصی مثلا F1 زده میشه من متوجه بشم که این کلید زده شده و همچنین بدونم که در کدوم فرم این کاید زده شده. خالا آیا راهی وجود داره که بدون کد نویسی در همه فرمها این مهم فراهم بشه ؟

با تشکر پیشاپیش.

میتونی از hook up استفاده کنی به این ترتیب که یه dll بسازی و کد زیر رو توش بنویسی بعد اون رو compile کنی و توابع و پروسیجرهای درون اون رو تو برنامت فراخوانی کنی:


Library TheHook;

uses
Windows, Messages, SysUtils;

{Define a record for recording and passing information process wide}
type
PHookRec = ^ THookRec;
THookRec = Packed Record
TheHookHandle: HHOOK;
TheAppWinHandle: HWnd;
TheCtrlWinHandle: HWnd;
TheKeyCount: DWord;
end;

var
hObjHandle : THandle; {Variable for the file mapping object}
lpHookRec : PHookRec;
{Pointer to our hook record}
procedure MapFileMemory (dwAllocSize: DWord);
begin { MapFileMemory }
{Create a process wide memory mapped variable}
hObjHandle := CreateFileMapping ($FFFFFFFF, Nil, PAGE_READWRITE, 0,
dwAllocSize, 'HookRecMemBlock');
if (hObjHandle = 0) then
begin
MessageBox (0, 'Hook DLL', 'Could not create file map object', mb_Ok);
exit
end { (hObjHandle = 0) };
{Get a pointer to our process wide memory mapped variable}
lpHookRec := MapViewOfFile (hObjHandle, FILE_MAP_WRITE, 0, 0, dwAllocSize);
if (lpHookRec = Nil) then
begin
CloseHandle (hObjHandle);
MessageBox (0, 'Hook DLL', 'Could not map file', mb_Ok);
exit
end { (lpHookRec = Nil) }
end; { MapFileMemory }


procedure UnMapFileMemory;
begin { UnMapFileMemory }
{Delete our process wide memory mapped variable}
if (lpHookRec <> Nil) then
begin
UnMapViewOfFile (lpHookRec);
lpHookRec := Nil
end { (lpHookRec <> Nil) };
if (hObjHandle > 0) then
begin
CloseHandle (hObjHandle);
hObjHandle := 0
end { (hObjHandle > 0) }
end; { UnMapFileMemory }


function GetHookRecPointer : pointer
stdcall;
begin { GetHookRecPointer }
{Return a pointer to our process wide memory mapped variable}
Result := lpHookRec
end; { GetHookRecPointer }


{The function that actually processes the keystrokes for our hook}
function KeyBoardProc (code: Integer; wParam: Integer; lParam: Integer) :
Integer;
stdcall;
var
KeyUp : bool;
{Remove comments for additional functionability
IsAltPressed : bool;
IsCtrlPressed : bool;
IsShiftPressed : bool;
}
begin { KeyBoardProc }
Result := 0;

Case code Of
HC_ACTION:
begin
{We trap the keystrokes here}
{Is this a key up message?}
KeyUp := ((lParam and (1 shl 31)) <> 0);

(*Remove comments for additional functionability
{Is the Alt key pressed}
if ((lParam and (1 shl 29)) <> 0) then begin
IsAltPressed := TRUE;
end else begin
IsAltPressed := FALSE;
end;

{Is the Control key pressed}
if ((GetKeyState(VK_CONTROL) and (1 shl 15)) <> 0) then begin
IsCtrlPressed := TRUE;
end else begin
IsCtrlPressed := FALSE;
end;

{if the Shift key pressed}
if ((GetKeyState(VK_SHIFT) and (1 shl 15)) <> 0) then begin
IsShiftPressed := TRUE;
end else begin
IsShiftPressed := FALSE;
end;
*)
{if KeyUp then increment the key count}
if (KeyUp <> false) then
begin
inc (lpHookRec^.TheKeyCount)
end { (KeyUp <> false) };

Case wParam Of
{Was the enter key pressed?}
VK_RETURN:
begin
{if KeyUp}
if (KeyUp <> false) then
begin
{Post a bogus message to the window control in our app}
PostMessage (lpHookRec^.TheCtrlWinHandle, WM_KEYDOWN, 0, 0);
PostMessage (lpHookRec^.TheCtrlWinHandle, WM_KEYUP, 0, 0)
end { (KeyUp <> false) };
{if you wanted to swallow the keystroke then return -1}
{else if you want to allow the keystroke then return 0}
Result := 0;
exit
end; {VK_RETURN}
{if the left arrow key is pressed then lets play a joke!}
VK_LEFT:
begin
{if KeyUp}
if (KeyUp <> false) then
begin
{Create a UpArrow keyboard event}
keybd_event (VK_RIGHT, 0, 0, 0);
keybd_event (VK_RIGHT, 0, KEYEVENTF_KEYUP, 0)
end { (KeyUp <> false) };
{Swallow the keystroke}
Result := -1;
exit
end; {VK_LEFT}
end { case wParam }; {case wParam}
{Allow the keystroke}
Result := 0
end; {HC_ACTION}
HC_NOREMOVE:
begin
{This is a keystroke message, but the keystroke message}
{has not been removed from the message queue, since an}
{application has called PeekMessage() specifying PM_NOREMOVE}
Result := 0;
exit
end;
end { case code }; {case code}
if (code < 0) then
{Call the next hook in the hook chain}
Result := CallNextHookEx (lpHookRec^.TheHookHandle, code, wParam, lParam)
end; { KeyBoardProc }


procedure StartKeyBoardHook;
stdcall;
begin { StartKeyBoardHook }
{if we have a process wide memory variable}
{and the hook has not already been set...}
if ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle = 0)) then
begin
{Set the hook and remember our hook handle}
lpHookRec^.TheHookHandle := SetWindowsHookEx (WH_KEYBOARD, @KeyBoardProc,
HInstance, 0)
end { ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle = 0)) }
end; { StartKeyBoardHook }


procedure StopKeyBoardHook;
stdcall;
begin { StopKeyBoardHook }
{if we have a process wide memory variable}
{and the hook has already been set...}
if ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle <> 0)) then
begin
{Remove our hook and clear our hook handle}
if (UnHookWindowsHookEx (lpHookRec^.TheHookHandle) <> false) then
begin
lpHookRec^.TheHookHandle := 0
end { (UnHookWindowsHookEx (lpHookRec^.TheHookHandle) <> false) }
end { ((lpHookRec <> Nil) and (lpHookRec^.TheHookHandle <> 0)) }
end; { StopKeyBoardHook }


procedure DllEntryPoint (dwReason: DWord);
begin { DllEntryPoint }
Case dwReason Of
Dll_Process_Attach:
begin
{if we are getting mapped into a process, then get}
{a pointer to our process wide memory mapped variable}
hObjHandle := 0;
lpHookRec := Nil;
MapFileMemory (sizeof (lpHookRec^))
end;
Dll_Process_Detach:
begin
{if we are getting unmapped from a process then, remove}
{the pointer to our process wide memory mapped variable}
UnMapFileMemory
end;
end { case dwReason }
end; { DllEntryPoint }


Exports
KeyBoardProc name 'KEYBOARDPROC',
GetHookRecPointer name 'GETHOOKRECPOINTER',
StartKeyBoardHook name 'STARTKEYBOARDHOOK',
StopKeyBoardHook name 'STOPKEYBOARDHOOK';

begin
{Set our Dll's main entry point}
DLLProc := @DllEntryPoint;
{Call our Dll's main entry point}
DllEntryPoint (Dll_Process_Attach)
end.

تشکر
امتحانش می کنم.

با سلام
در صفحه زیر کامپوننت gpsyshook به همراه یک مثال وجود دارد، این را هم امتحان کن ضرری نداره :
http://www.geocities.com/h_r_110/

موفق باشید

سلام،

نقل قول:

---

من میخوام وقتی برنامه ام در حال اجرا است در هر قسمتی از پروژه که کلید خاصی مثلا F1 زده میشه من متوجه بشم که این کلید زده شده و همچنین بدونم که در کدوم فرم این کاید زده شده. خالا آیا راهی وجود داره که بدون کد نویسی در همه فرمها این مهم فراهم بشه ؟

---

یک کامپوننت ApplicationEvents روی یکی از فرم ها قرار دهید و برای رویداد OnShortCut کد موردنظر را بنویسید.
از طریق Screen.ActiveForm هم به فرم فعال دسترسی دارید.

procedure TMainForm.ApplicationEventsShortCut(var Msg: TWMKey;

  var Handled: Boolean);

begin

  if Msg.CharCode = VK_F1 then

  begin

    ShowMessage('F1 on ' + Screen.ActiveForm.Name);

    Handled := True;

  end;

end;