[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 270
  • Last Modified:

Use shift with NumPadkeys..

is there a possibility to use the numkeys with the shift key?
when is USE VK_Lshift i can`t access the numkeys..
like VK_NUMPAD1 and VK_NUMPAD3..
and no i don`t want to use ctrl or alt for it,
because they are already in use..
0
Applicationmaker
Asked:
Applicationmaker
1 Solution
 
House_of_DexterCommented:
k...this is not going to be easy...for one these are system keys...and are not passed to your application like normal virtual keys...you are going to need to create a keyboard hook(i.e. dll)...from www.delphifaq.com...with modifications...See KeyBoardProc  where your going to modify and trap and replace the keystrokes...vk_home -> vk_7 vk_up -> vk_8 etc...

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);
   

     {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

      {if the left arrow key is pressed then trap and convert to 4}
//your going to need to do this for each of the Numpad virtual keys...
      VK_LEFT:
        begin
          {if KeyUp}
          if   IsShiftPressed and  (KeyUp <> false) then
            begin
              {Create a UpArrow keyboard event}
              keybd_event (VK_4, 0, 0, 0);
              keybd_event (VK_4, 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.
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now