fpc/api/win32/keyboard.inc

{
   $Id$
   System independent keyboard interface for windows

   Copyright (c) 1999 by Florian Klaempfl
   Member of the Free Pascal development team

   This library is free software; you can redistribute it and/or
   modify it under the terms of the GNU Library General Public
   License as published by the Free Software Foundation; either
   version 2 of the License, or (at your option) any later version.


   This library is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   Library General Public License for more details.

   You should have received a copy of the GNU Library General Public
   License along with this library; if not, write to the Free
   Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

 ****************************************************************************}

{ WARNING: Keyboard-Drivers (i.e. german) will only work under WinNT.
           95 and 98 do not support keyboard-drivers other than us for win32
           console-apps. So we always get the keys in us-keyboard layout
           from Win9x.
}

uses
{$ifndef DEBUG}
   Windows,
{$endif DEBUG}
   Dos,
   Event;

const MaxQueueSize = 120;
      FrenchKeyboard = $040C040C;
      KeyboardActive : boolean =false;
var
   keyboardeventqueue : array[0..maxqueuesize] of TKeyEventRecord;
   nextkeyevent,nextfreekeyevent : longint;
   newKeyEvent    : THandle;            {sinaled if key is available}
   lockVar        : TCriticalSection;   {for queue access}
   lastShiftState : byte;               {set by handler for PollShiftStateEvent}
   altNumActive   : boolean;            {for alt+0..9}
   altNumBuffer   : string [3];
   { used for keyboard specific stuff }
   KeyBoardLayout : HKL;

procedure incqueueindex(var l : longint);

  begin
     inc(l);
     { wrap around? }
     if l>maxqueuesize then
       l:=0;
  end;

function keyEventsInQueue : boolean;
begin
  keyEventsInQueue := (nextkeyevent <> nextfreekeyevent);
end;


{ gets or peeks the next key from the queue, does not wait for new keys }
function getKeyEventFromQueue (VAR t : TKeyEventRecord; Peek : boolean) : boolean;
begin
  EnterCriticalSection (lockVar);
  if keyEventsInQueue then
  begin
    t := keyboardeventqueue[nextkeyevent];
    if not peek then incqueueindex (nextkeyevent);
    getKeyEventFromQueue := true;
    if not keyEventsInQueue then ResetEvent (newKeyEvent);
  end else
  begin
    getKeyEventFromQueue := false;
    ResetEvent (newKeyEvent);
  end;
  LeaveCriticalSection (lockVar);
end;


{ gets the next key from the queue, does wait for new keys }
function getKeyEventFromQueueWait (VAR t : TKeyEventRecord) : boolean;
begin
  WaitForSingleObject (newKeyEvent, INFINITE);
  getKeyEventFromQueueWait := getKeyEventFromQueue (t, false);
end;

{ translate win32 shift-state to keyboard shift state }
function transShiftState (ControlKeyState : dword) : byte;
var b : byte;
begin
  b := 0;
  if ControlKeyState and SHIFT_PRESSED <> 0 then  { win32 makes no difference between left and right shift }
    b := b or kbShift;
  if (ControlKeyState and LEFT_CTRL_PRESSED <> 0) or
     (ControlKeyState  and RIGHT_CTRL_PRESSED <> 0) then
    b := b or kbCtrl;
  if (ControlKeyState and LEFT_ALT_PRESSED <> 0) or
     (ControlKeyState and RIGHT_ALT_PRESSED <> 0) then
    b := b or kbAlt;
  transShiftState := b;
end;

{ The event-Handler thread from the unit event will call us if a key-event
  is available }

procedure HandleKeyboard;
var
   ir     : INPUT_RECORD;
   dwRead : DWord;
   i      : longint;
   c      : word;
   addThis: boolean;
begin
   dwRead:=1;
   ReadConsoleInput(TextRec(Input).Handle,ir,1,dwRead);
   if (dwRead=1) and (ir.EventType=KEY_EVENT) then
     begin
         with ir.KeyEvent do
           begin
              { key up events are ignored (except alt) }
              if bKeyDown then
                begin
                   EnterCriticalSection (lockVar);
                   for i:=1 to wRepeatCount do
                     begin
                        addThis := true;
                        if (dwControlKeyState and LEFT_ALT_PRESSED <> 0) or
                           (dwControlKeyState and RIGHT_ALT_PRESSED <> 0) then            {alt pressed}
                          if (wVirtualKeyCode >= $60) and (wVirtualKeyCode <= $69) then   {0..9 on NumBlock}
                          begin
                            if length (altNumBuffer) = 3 then
                              delete (altNumBuffer,1,1);
                            altNumBuffer := altNumBuffer + char (wVirtualKeyCode-48);
                            altNumActive   := true;
                            addThis := false;
                          end else
                          begin
                            altNumActive   := false;
                            altNumBuffer   := '';
                          end;
                        if addThis then
                        begin
                          keyboardeventqueue[nextfreekeyevent]:=
                            ir.KeyEvent;
                          incqueueindex(nextfreekeyevent);
                        end;
                     end;

                   lastShiftState := transShiftState (dwControlKeyState);  {save it for PollShiftStateEvent}
                   SetEvent (newKeyEvent);             {event that a new key is available}
                   LeaveCriticalSection (lockVar);
                end else
                begin
                  lastShiftState := transShiftState (dwControlKeyState);   {save it for PollShiftStateEvent}
                  {for alt-number we have to look for alt-key release}
                  if altNumActive then
                    if (wVirtualKeyCode = $12) then    {alt-released}
                    begin
                      if altNumBuffer <> '' then       {numbers with alt pressed?}
                      begin
                        Val (altNumBuffer, c, i);
                        if (i = 0) and (c <= 255) then {valid number?}
                        begin                          {add to queue}
                          fillchar (ir, sizeof (ir), 0);
                          bKeyDown := true;
                          AsciiChar := char (c);
                                                       {and add to queue}
                          EnterCriticalSection (lockVar);
                          keyboardeventqueue[nextfreekeyevent]:=
                            ir.KeyEvent;
                          incqueueindex(nextfreekeyevent);
                          SetEvent (newKeyEvent);      {event that a new key is available}
                          LeaveCriticalSection (lockVar);
                        end;
                      end;
                      altNumActive   := false;         {clear alt-buffer}
                      altNumBuffer   := '';
                    end;
                end;
           end;
     end;
end;

procedure InitKeyboard;
begin
   if KeyboardActive then
     exit;
   KeyBoardLayout:=GetKeyboardLayout(0);
   lastShiftState := 0;
   FlushConsoleInputBuffer(TextRec(Input).Handle);
   newKeyEvent := CreateEvent (nil,        // address of security attributes
                               true,       // flag for manual-reset event
                               false,      // flag for initial state
                               nil);       // address of event-object name
   if newKeyEvent = INVALID_HANDLE_VALUE then
   begin
     // what to do here ????
     RunError (217);
   end;
   InitializeCriticalSection (lockVar);
   altNumActive := false;
   altNumBuffer := '';

   nextkeyevent:=0;
   nextfreekeyevent:=0;
   SetKeyboardEventHandler (@HandleKeyboard);
   KeyboardActive:=true;
end;

procedure DoneKeyboard;
begin
   if not KeyboardActive then
     exit;
   SetKeyboardEventHandler(nil);     {hangs???}
   DeleteCriticalSection (lockVar);
   FlushConsoleInputBuffer(TextRec(Input).Handle);
   closeHandle (newKeyEvent);
   KeyboardActive:=false;
end;

{$define USEKEYCODES}

{Translatetable Win32 -> Dos for Special Keys = Function Key, Cursor Keys
 and Keys other than numbers on numblock (to make fv happy) }
{combinations under dos: Shift+Ctrl: same as Ctrl
                         Shift+Alt : same as alt
                         Ctrl+Alt  : nothing (here we get it like alt)}
{$ifdef USEKEYCODES}
   { use positive values for ScanCode we want to set
   0 for key where we should leave the scancode
   -1 for OEM specifc keys
   -2 for unassigned
   -3 for Kanji systems ???
   }
const
  Unassigned = -2;
  Kanji = -3;
  OEM_specific = -1;
  KeyToQwertyScan : array [0..255] of integer =
  (
  { 00 } 0,
  { 01 VK_LBUTTON } 0,
  { 02 VK_RBUTTON } 0,
  { 03 VK_CANCEL } 0,
  { 04 VK_MBUTTON } 0,
  { 05 unassigned } -2,
  { 06 unassigned } -2,
  { 07 unassigned } -2,
  { 08 VK_BACK } $E,
  { 09 VK_TAB } $F,
  { 0A unassigned } -2,
  { 0B unassigned } -2,
  { 0C VK_CLEAR ?? } 0,
  { 0D VK_RETURN } 0,
  { 0E unassigned } -2,
  { 0F unassigned } -2,
  { 10 VK_SHIFT } 0,
  { 11 VK_CONTROL } 0,
  { 12 VK_MENU (Alt key) } 0,
  { 13 VK_PAUSE } 0,
  { 14 VK_CAPITAL (Caps Lock) } 0,
  { 15 Reserved for Kanji systems} -3,
  { 16 Reserved for Kanji systems} -3,
  { 17 Reserved for Kanji systems} -3,
  { 18 Reserved for Kanji systems} -3,
  { 19 Reserved for Kanji systems} -3,
  { 1A unassigned } -2,
  { 1B VK_ESCAPE } $1,
  { 1C Reserved for Kanji systems} -3,
  { 1D Reserved for Kanji systems} -3,
  { 1E Reserved for Kanji systems} -3,
  { 1F Reserved for Kanji systems} -3,
  { 20 VK_SPACE} 0,
  { 21 VK_PRIOR (PgUp) } 0,
  { 22 VK_NEXT (PgDown) } 0,
  { 23 VK_END } 0,
  { 24 VK_HOME } 0,
  { 25 VK_LEFT } 0,
  { 26 VK_UP } 0,
  { 27 VK_RIGHT } 0,
  { 28 VK_DOWN } 0,
  { 29 VK_SELECT ??? } 0,
  { 2A OEM specific !! } -1,
  { 2B VK_EXECUTE } 0,
  { 2C VK_SNAPSHOT } 0,
  { 2D VK_INSERT } 0,
  { 2E VK_DELETE } 0,
  { 2F VK_HELP } 0,
  { 30 VK_0 '0' } 11,
  { 31 VK_1 '1' } 2,
  { 32 VK_2 '2' } 3,
  { 33 VK_3 '3' } 4,
  { 34 VK_4 '4' } 5,
  { 35 VK_5 '5' } 6,
  { 36 VK_6 '6' } 7,
  { 37 VK_7 '7' } 8,
  { 38 VK_8 '8' } 9,
  { 39 VK_9 '9' } 10,
  { 3A unassigned } -2,
  { 3B unassigned } -2,
  { 3C unassigned } -2,
  { 3D unassigned } -2,
  { 3E unassigned } -2,
  { 3F unassigned } -2,
  { 40 unassigned } -2,
  { 41 VK_A 'A' } $1E,
  { 42 VK_B 'B' } $30,
  { 43 VK_C 'C' } $2E,
  { 44 VK_D 'D' } $20,
  { 45 VK_E 'E' } $12,
  { 46 VK_F 'F' } $21,
  { 47 VK_G 'G' } $22,
  { 48 VK_H 'H' } $23,
  { 49 VK_I 'I' } $17,
  { 4A VK_J 'J' } $24,
  { 4B VK_K 'K' } $25,
  { 4C VK_L 'L' } $26,
  { 4D VK_M 'M' } $32,
  { 4E VK_N 'N' } $31,
  { 4F VK_O 'O' } $18,
  { 50 VK_P 'P' } $19,
  { 51 VK_Q 'Q' } $10,
  { 52 VK_R 'R' } $13,
  { 53 VK_S 'S' } $1F,
  { 54 VK_T 'T' } $14,
  { 55 VK_U 'U' } $16,
  { 56 VK_V 'V' } $2F,
  { 57 VK_W 'W' } $11,
  { 58 VK_X 'X' } $2D,
  { 59 VK_Y 'Y' } $15,
  { 5A VK_Z 'Z' } $2C,
  { 5B unassigned } -2,
  { 5C unassigned } -2,
  { 5D unassigned } -2,
  { 5E unassigned } -2,
  { 5F unassigned } -2,
  { 60 VK_NUMPAD0 NumKeyPad '0' } 11,
  { 61 VK_NUMPAD1 NumKeyPad '1' } 2,
  { 62 VK_NUMPAD2 NumKeyPad '2' } 3,
  { 63 VK_NUMPAD3 NumKeyPad '3' } 4,
  { 64 VK_NUMPAD4 NumKeyPad '4' } 5,
  { 65 VK_NUMPAD5 NumKeyPad '5' } 6,
  { 66 VK_NUMPAD6 NumKeyPad '6' } 7,
  { 67 VK_NUMPAD7 NumKeyPad '7' } 8,
  { 68 VK_NUMPAD8 NumKeyPad '8' } 9,
  { 69 VK_NUMPAD9 NumKeyPad '9' } 10,
  { 6A VK_MULTIPLY } 0,
  { 6B VK_ADD } 0,
  { 6C VK_SEPARATOR } 0,
  { 6D VK_SUBSTRACT } 0,
  { 6E VK_DECIMAL } 0,
  { 6F VK_DIVIDE } 0,
  { 70 VK_F1 'F1' } $3B,
  { 71 VK_F2 'F2' } $3C,
  { 72 VK_F3 'F3' } $3D,
  { 73 VK_F4 'F4' } $3E,
  { 74 VK_F5 'F5' } $3F,
  { 75 VK_F6 'F6' } $40,
  { 76 VK_F7 'F7' } $41,
  { 77 VK_F8 'F8' } $42,
  { 78 VK_F9 'F9' } $43,
  { 79 VK_F10 'F10' } $44,
  { 7A VK_F11 'F11' } $57,
  { 7B VK_F12 'F12' } $58,
  { 7C VK_F13 } 0,
  { 7D VK_F14 } 0,
  { 7E VK_F15 } 0,
  { 7F VK_F16 } 0,
  { 80 VK_F17 } 0,
  { 81 VK_F18 } 0,
  { 82 VK_F19 } 0,
  { 83 VK_F20 } 0,
  { 84 VK_F21 } 0,
  { 85 VK_F22 } 0,
  { 86 VK_F23 } 0,
  { 87 VK_F24 } 0,
  { 88 unassigned } -2,
  { 89 VK_NUMLOCK } 0,
  { 8A VK_SCROLL } 0,
  { 8B unassigned } -2,
  { 8C unassigned } -2,
  { 8D unassigned } -2,
  { 8E unassigned } -2,
  { 8F unassigned } -2,
  { 90 unassigned } -2,
  { 91 unassigned } -2,
  { 92 unassigned } -2,
  { 93 unassigned } -2,
  { 94 unassigned } -2,
  { 95 unassigned } -2,
  { 96 unassigned } -2,
  { 97 unassigned } -2,
  { 98 unassigned } -2,
  { 99 unassigned } -2,
  { 9A unassigned } -2,
  { 9B unassigned } -2,
  { 9C unassigned } -2,
  { 9D unassigned } -2,
  { 9E unassigned } -2,
  { 9F unassigned } -2,
  { A0 unassigned } -2,
  { A1 unassigned } -2,
  { A2 unassigned } -2,
  { A3 unassigned } -2,
  { A4 unassigned } -2,
  { A5 unassigned } -2,
  { A6 unassigned } -2,
  { A7 unassigned } -2,
  { A8 unassigned } -2,
  { A9 unassigned } -2,
  { AA unassigned } -2,
  { AB unassigned } -2,
  { AC unassigned } -2,
  { AD unassigned } -2,
  { AE unassigned } -2,
  { AF unassigned } -2,
  { B0 unassigned } -2,
  { B1 unassigned } -2,
  { B2 unassigned } -2,
  { B3 unassigned } -2,
  { B4 unassigned } -2,
  { B5 unassigned } -2,
  { B6 unassigned } -2,
  { B7 unassigned } -2,
  { B8 unassigned } -2,
  { B9 unassigned } -2,
  { BA OEM specific } 0,
  { BB OEM specific } 0,
  { BC OEM specific } 0,
  { BD OEM specific } 0,
  { BE OEM specific } 0,
  { BF OEM specific } 0,
  { C0 OEM specific } 0,
  { C1 unassigned } -2,
  { C2 unassigned } -2,
  { C3 unassigned } -2,
  { C4 unassigned } -2,
  { C5 unassigned } -2,
  { C6 unassigned } -2,
  { C7 unassigned } -2,
  { C8 unassigned } -2,
  { C9 unassigned } -2,
  { CA unassigned } -2,
  { CB unassigned } -2,
  { CC unassigned } -2,
  { CD unassigned } -2,
  { CE unassigned } -2,
  { CF unassigned } -2,
  { D0 unassigned } -2,
  { D1 unassigned } -2,
  { D2 unassigned } -2,
  { D3 unassigned } -2,
  { D4 unassigned } -2,
  { D5 unassigned } -2,
  { D6 unassigned } -2,
  { D7 unassigned } -2,
  { D8 unassigned } -2,
  { D9 unassigned } -2,
  { DA unassigned } -2,
  { DB OEM specific } 0,
  { DC OEM specific } 0,
  { DD OEM specific } 0,
  { DE OEM specific } 0,
  { DF OEM specific } 0,
  { E0 OEM specific } 0,
  { E1 OEM specific } 0,
  { E2 OEM specific } 0,
  { E3 OEM specific } 0,
  { E4 OEM specific } 0,
  { E5 unassigned } -2,
  { E6 OEM specific } 0,
  { E7 unassigned } -2,
  { E8 unassigned } -2,
  { E9 OEM specific } 0,
  { EA OEM specific } 0,
  { EB OEM specific } 0,
  { EC OEM specific } 0,
  { ED OEM specific } 0,
  { EE OEM specific } 0,
  { EF OEM specific } 0,
  { F0 OEM specific } 0,
  { F1 OEM specific } 0,
  { F2 OEM specific } 0,
  { F3 OEM specific } 0,
  { F4 OEM specific } 0,
  { F5 OEM specific } 0,
  { F6 unassigned } -2,
  { F7 unassigned } -2,
  { F8 unassigned } -2,
  { F9 unassigned } -2,
  { FA unassigned } -2,
  { FB unassigned } -2,
  { FC unassigned } -2,
  { FD unassigned } -2,
  { FE unassigned } -2,
  { FF unassigned } -2
  );
{$endif  USEKEYCODES}
type TTEntryT = packed record
                  n,s,c,a : byte;   {normal,shift, ctrl, alt, normal only for f11,f12}
                end;

CONST
 DosTT : ARRAY [$3B..$58] OF TTEntryT =
  ((n : $3B; s : $54; c : $5E; a: $68),      {3B F1}
   (n : $3C; s : $55; c : $5F; a: $69),      {3C F2}
   (n : $3D; s : $56; c : $60; a: $6A),      {3D F3}
   (n : $3E; s : $57; c : $61; a: $6B),      {3E F4}
   (n : $3F; s : $58; c : $62; a: $6C),      {3F F5}
   (n : $40; s : $59; c : $63; a: $6D),      {40 F6}
   (n : $41; s : $5A; c : $64; a: $6E),      {41 F7}
   (n : $42; s : $5B; c : $65; a: $6F),      {42 F8}
   (n : $43; s : $5C; c : $66; a: $70),      {43 F9}
   (n : $44; s : $5D; c : $67; a: $71),      {44 F10}
   (n : $45; s : $00; c : $00; a: $00),      {45 ???}
   (n : $46; s : $00; c : $00; a: $00),      {46 ???}
   (n : $47; s : $47; c : $77; a: $97),      {47 Home}
   (n : $48; s : $00; c : $8D; a: $98),      {48 Up}
   (n : $49; s : $49; c : $84; a: $99),      {49 PgUp}
   (n : $4A; s : $00; c : $8E; a: $4A),      {4A -}
   (n : $4B; s : $4B; c : $73; a: $9B),      {4B Left}
   (n : $4C; s : $00; c : $00; a: $00),      {4C ???}
   (n : $4D; s : $4D; c : $74; a: $9D),      {4D Right}
   (n : $4E; s : $00; c : $90; a: $4E),      {4E +}
   (n : $4F; s : $4F; c : $75; a: $9F),      {4F End}
   (n : $50; s : $50; c : $91; a: $A0),      {50 Down}
   (n : $51; s : $51; c : $76; a: $A1),      {51 PgDown}
   (n : $52; s : $52; c : $92; a: $A2),      {52 Insert}
   (n : $53; s : $53; c : $93; a: $A3),      {53 Del}
   (n : $54; s : $00; c : $00; a: $00),      {54 ???}
   (n : $55; s : $00; c : $00; a: $00),      {55 ???}
   (n : $56; s : $00; c : $00; a: $00),      {56 ???}
   (n : $85; s : $87; c : $89; a: $8B),      {57 F11}
   (n : $86; s : $88; c : $8A; a: $8C));     {58 F12}

 DosTT09 : ARRAY [$02..$0F] OF TTEntryT =
  ((n : $00; s : $00; c : $00; a: $78),      {02 1 }
   (n : $00; s : $00; c : $00; a: $79),      {03 2 }
   (n : $00; s : $00; c : $00; a: $7A),      {04 3 }
   (n : $00; s : $00; c : $00; a: $7B),      {05 4 }
   (n : $00; s : $00; c : $00; a: $7C),      {06 5 }
   (n : $00; s : $00; c : $00; a: $7D),      {07 6 }
   (n : $00; s : $00; c : $00; a: $7E),      {08 7 }
   (n : $00; s : $00; c : $00; a: $7F),      {09 8 }
   (n : $00; s : $00; c : $00; a: $80),      {0A 9 }
   (n : $00; s : $00; c : $00; a: $81),      {0B 0 }
   (n : $00; s : $00; c : $00; a: $82),      {0C ß }
   (n : $00; s : $00; c : $00; a: $00),      {0D}
   (n : $00; s : $09; c : $00; a: $00),      {0E Backspace}
   (n : $00; s : $0F; c : $94; a: $00));     {0F Tab }


function translateKey (t : TKeyEventRecord) : TKeyEvent;
var key : TKeyEvent;
    ss  : byte;
{$ifdef  USEKEYCODES}
    ScanCode  : byte;
{$endif  USEKEYCODES}
    b   : byte;
begin
  Key := 0;
  if t.bKeyDown then
  begin
    { ascii-char is <> 0 if not a specal key }
    { we return it here otherwise we have to translate more later }
    if t.AsciiChar <> #0 then
    begin
      {drivers needs scancode, we return it here as under dos and linux
       with $03000000 = the lowest two bytes is the physical representation}
{$ifdef  USEKEYCODES}
      Scancode:=KeyToQwertyScan[t.wVirtualKeyCode AND $00FF];
      If ScanCode>0 then
        t.wVirtualScanCode:=ScanCode;
      Key := byte (t.AsciiChar) + (t.wVirtualScanCode shl 8) + $03000000;
      ss := transShiftState (t.dwControlKeyState);
      key := key or (ss shl 16);
      if (ss and kbAlt <> 0) and (t.dwControlKeyState and RIGHT_ALT_PRESSED = 0) then
        key := key and $FFFFFF00;
{$else not USEKEYCODES}
      Key := byte (t.AsciiChar) + ((t.wVirtualScanCode AND $00FF) shl 8) + $03000000;
{$endif not USEKEYCODES}
    end else
    begin
{$ifdef  USEKEYCODES}
      Scancode:=KeyToQwertyScan[t.wVirtualKeyCode AND $00FF];
      If ScanCode>0 then
        t.wVirtualScanCode:=ScanCode;
{$endif not USEKEYCODES}
      translateKey := 0;
      { ignore shift,ctrl,alt,numlock,capslock alone }
      case t.wVirtualKeyCode of
        $0010,         {shift}
        $0011,         {ctrl}
        $0012,         {alt}
        $0014,         {capslock}
        $0090,         {numlock}
        $0091,         {scrollock}
        { This should be handled !! }
        { these last two are OEM specific
          this is not good !!! }
        $00DC,         {^ : next key i.e. a is modified }
        { Strange on my keyboard this corresponds to double point over i or u PM }
        $00DD: exit;   {´ and ` : next key i.e. e is modified }
      end;

      key := $03000000 + (t.wVirtualScanCode shl 8);  { make lower 8 bit=0 like under dos }
    end;
    { Handling of ~ key as AltGr 2 }
    { This is also French keyboard specific !! }
    { but without this I can not get a ~ !! PM }
    if (t.wVirtualKeyCode=$32) and
       (KeyBoardLayout = FrenchKeyboard) and
       (t.dwControlKeyState and RIGHT_ALT_PRESSED <> 0) then
      key:=(key and $ffffff00) or ord('~');
    { ok, now add Shift-State }
    ss := transShiftState (t.dwControlKeyState);
    key := key or (ss shl 16);

    { Reset Ascii-Char if Alt+Key, fv needs that, may be we
      need it for other special keys too
      18 Sept 1999 AD: not for right Alt i.e. for AltGr+ß = \ on german keyboard }
    if ((ss and kbAlt <> 0) and (t.dwControlKeyState and RIGHT_ALT_PRESSED = 0)) or
    (*
      { yes, we need it for cursor keys, 25=left, 26=up, 27=right,28=down}
      {aggg, this will not work because esc is also virtualKeyCode 27!!}
      {if (t.wVirtualKeyCode >= 25) and (t.wVirtualKeyCode <= 28) then}
        no VK_ESCAPE is $1B !!
        there was a mistake :
         VK_LEFT is $25 not 25 !! *)
       { not $2E VK_DELETE because its only the Keypad point !! PM }
      (t.wVirtualKeyCode in [$21..$28,$2C,$2D,$2F]) then
      { if t.wVirtualScanCode in [$47..$49,$4b,$4d,$4f,$50..$53] then}
        key := key and $FFFFFF00;

    {and translate to dos-scancodes to make fv happy, we will convert this
     back in translateKeyEvent}

     if (t.dwControlKeyState and RIGHT_ALT_PRESSED) = 0 then {not for alt-gr}
     if (t.wVirtualScanCode >= low (DosTT)) and
        (t.wVirtualScanCode <= high (dosTT)) then
     begin
       b := 0;
       if (ss and kbAlt) <> 0 then
         b := DosTT[t.wVirtualScanCode].a
       else
       if (ss and kbCtrl) <> 0 then
         b := DosTT[t.wVirtualScanCode].c
       else
       if (ss and kbShift) <> 0 then
         b := DosTT[t.wVirtualScanCode].s
       else
         b := DosTT[t.wVirtualScanCode].n;
       if b <> 0 then
         key := (key and $FFFF00FF) or (longint (b) shl 8);
     end;

     {Alt-0 to Alt-9}
     if (t.dwControlKeyState and RIGHT_ALT_PRESSED) = 0 then {not for alt-gr}
       if (t.wVirtualScanCode >= low (DosTT09)) and
          (t.wVirtualScanCode <= high (dosTT09)) then
       begin
         b := 0;
         if (ss and kbAlt) <> 0 then
           b := DosTT09[t.wVirtualScanCode].a
         else
         if (ss and kbCtrl) <> 0 then
           b := DosTT09[t.wVirtualScanCode].c
         else
         if (ss and kbShift) <> 0 then
           b := DosTT09[t.wVirtualScanCode].s
         else
           b := DosTT09[t.wVirtualScanCode].n;
         if b <> 0 then
           key := (key and $FFFF0000) or (longint (b) shl 8);
       end;

     TranslateKey := key;
  end;
  translateKey := Key;
end;

function GetKeyEvent: TKeyEvent;
var t   : TKeyEventRecord;
    key : TKeyEvent;
begin
  if PendingKeyEvent<>0 then
  begin
    GetKeyEvent:=PendingKeyEvent;
    PendingKeyEvent:=0;
    exit;
  end;
  key := 0;
  repeat
     if getKeyEventFromQueueWait (t) then
       key := translateKey (t);
  until key <> 0;
{$ifdef DEBUG}
  last_ir.KeyEvent:=t;
{$endif DEBUG}
  GetKeyEvent := key;
end;

function PollKeyEvent: TKeyEvent;
var t   : TKeyEventRecord;
    k   : TKeyEvent;
begin
  if PendingKeyEvent<>0 then
    exit(PendingKeyEvent);
  PollKeyEvent := 0;
  if getKeyEventFromQueue (t, true) then
  begin
    { we get an enty for shift, ctrl, alt... }
    k := translateKey (t);
    while (k = 0) do
    begin
      getKeyEventFromQueue (t, false);  {remove it}
      if not getKeyEventFromQueue (t, true) then exit;
      k := translateKey (t)
    end;
    PollKeyEvent := k;
  end;
end;


function TranslateKeyEvent(KeyEvent: TKeyEvent): TKeyEvent;
begin
  if KeyEvent and $03000000 = $03000000 then
   begin
     if KeyEvent and $000000FF <> 0 then
     begin
       TranslateKeyEvent := KeyEvent and $00FFFFFF;
       exit;
     end;
     {translate function-keys and other specials, ascii-codes are already ok}
     case (KeyEvent AND $0000FF00) shr 8 of
       {F1..F10}
       $3B..$44     : TranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $3B + $02000000;
       {F11,F12}
       $85..$86     : TranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $85 + $02000000;
       {Shift F1..F10}
       $54..$5D     : TranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $54 + $02000000;
       {Shift F11,F12}
       $87..$88     : TranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $87 + $02000000;
       {Alt F1..F10}
       $68..$71     : TranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $68 + $02000000;
       {Alt F11,F12}
       $8B..$8C     : TranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $8B + $02000000;
       {Ctrl F1..F10}
       $5E..$67     : TranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $5E + $02000000;
       {Ctrl F11,F12}
       $89..$8A     : TranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $89 + $02000000;

       {normal,ctrl,alt}
       $47,$77,$97  : TranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdHome + $02000000;
       $48,$8D,$98  : TranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdUp + $02000000;
       $49,$84,$99  : TranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdPgUp + $02000000;
       $4b,$73,$9B  : TranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdLeft + $02000000;
       $4d,$74,$9D  : TranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdRight + $02000000;
       $4f,$75,$9F  : TranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdEnd + $02000000;
       $50,$91,$A0  : TranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdDown + $02000000;
       $51,$76,$A1  : TranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdPgDn + $02000000;
       $52,$92,$A2  : TranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdInsert + $02000000;
       $53,$93,$A3  : TranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdDelete + $02000000;
     else
       TranslateKeyEvent := KeyEvent;
     end;
   end else
     TranslateKeyEvent := KeyEvent;
end;

function TranslateKeyEventUniCode(KeyEvent: TKeyEvent): TKeyEvent;
begin
  exit (KeyEvent);  {???}
end;

function PollShiftStateEvent: TKeyEvent;
var t : TKeyEvent;
begin
  {may be better to save the last state and return that if no key is in buffer???}
  t := lastShiftState;
  PollShiftStateEvent := t shl 16;
end;

{
  $Log$
  Revision 1.2  2000-07-13 11:32:27  michael
  + removed logs
 
}