[Last Call] Learn about multicloud storage options and how to improve your company's cloud strategy. Register Now

x
?
Solved

Use shift with NumPadkeys..

Posted on 2006-06-29
1
Medium Priority
?
269 Views
Last Modified: 2010-04-05
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
Comment
Question by:Applicationmaker
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
1 Comment
 
LVL 6

Accepted Solution

by:
House_of_Dexter earned 750 total points
ID: 17013959
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: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
This course is ideal for IT System Administrators working with VMware vSphere and its associated products in their company infrastructure. This course teaches you how to install and maintain this virtualization technology to store data, prevent vuln…
In response to a need for security and privacy, and to continue fostering an environment members can turn to for support, solutions, and education, Experts Exchange has created anonymous question capabilities. This new feature is available to our Pr…
Suggested Courses

650 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question