Search code examples
delphiwinapimessaging

How to extract correctly cased CharCode from WM_KeyUp or whereever


I'm trying to process WM_KeyUp messages to identify which alphanumeric key (if any) was pressed, in a case-sensitive manner. In TApplicationEvents we have the OnMessage handler which in my project is assigned to

procedure TForm1.DoOnAppMessage(var Msg: tagMSG; var Handled: Boolean);
var
  CH : Char;
  [...]
begin
  Inc(MsgCount);

  case Msg.Message of
    WM_KeyUp : begin
      CH := Chr(Msg.WParam);
      // do something with CH
    end;

  end; { case ]

That's fine, so far as it goes, except of course that I always get the upper case version of the letter.

So I evidently need to decode the Msg's LParam instead. Googling around, I've come across numerous examples of decoding the LParam, but none I can find deals with what I would have thought would be the "simple" task of getting alphanumeric keys rendered in the correct case. My q is, please could someone show me how to do that.

Please note: I know I could get the correctly capitalised letters by handling the WM_Char message but I can't use that in the real-life situation I'm trying to deal with (which is actually inside a keyboard hook).


Solution

  • I found a solution to this based on an earlier SO q&a, which involves setting up a low-level keyboard hook. Initially when I tried this I got the same results as with the code posted in my q, namely that all the returned characters were lower-cased.

    Interestingly, the thing which made the difference between no capitalisation and correct capitalisation - which the code below does - was one of the 4 lines containing calls to GetKeyState, namely KeyState[VK_SHIFT] := GetKeyState(VK_SHIFT). Without that, the characters returned were all lower-case (unlike the ones from the code in my q, which were all upper case);

    type
      TOutProc = procedure(AString : String) of object;
    var
      OutProc : TOutProc; // requires assignment to a suitable proc in the host application
    
    type
      PKbdLlHookStruct = ^TKbdLlHookStruct;
    
      TKbdLlHookStruct = packed record
        vkCode: DWORD;
        scanCode: DWORD;
        flags: DWORD;
        time: DWORD;
        dwExtraInfo: DWORD;
      end;
    
    const
      WH_KEYBOARD_LL   =   13;
    
    var
      FKeyboardLayoutHandle: HKL;
      hhkLowLevelKybd:   HHOOK;
    
    function LowLevelKeyBoardProc(nCode:   Integer;   awParam:   WPARAM;
      alParam:   LPARAM):   LRESULT;   stdcall;
    const
      LLKHF_UP             =  $0080;
    var
      act:   PKbdllHookStruct;
      CH : Char;
      S : String;
      KeyState : TKeyboardState;
      NewChar: array[0..1] of Char;
    begin
    
      //  adapted from https://stackoverflow.com/q/1590983
      if (nCode = HC_ACTION) then begin
        case awParam  of
          WM_SYSKEYDOWN,
          WM_KEYUP,
          WM_SYSKEYUP: begin
            act := PKbdLlHookStruct(alParam);
            if awParam=WM_KEYUP then begin
              FillChar(NewChar,2,#0);
              GetKeyboardState(KeyState);
              //  Next four lines from https://stackoverflow.com/a/10480563
              KeyState[VK_CAPITAL] := GetKeyState(VK_CAPITAL);
              KeyState[VK_SHIFT] := GetKeyState(VK_SHIFT);
              KeyState[VK_CONTROL] := GetKeyState(VK_CONTROL);
              KeyState[VK_MENU] := GetKeyState(VK_MENU);
    
              if ToAsciiEx(act^.vkCode, act^.scanCode, KeyState, NewChar, 0, FKeyboardLayoutHandle) = 1 then
              CH := NewChar[0];
              if (CH in [#8, #10, #13]) Or (CH >= ' ') then begin
                S := CH;
                OutProc(S);
                GetClassName(GetForegroundWindow, @ClassBuffer, 100);
              end;
            end;
          end; { case }
        end;  { case }
      end;
    
      Result := CallNextHookEx(hhkLowLevelKybd, nCode, awParam, alParam);
    end;