paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-05-19 16:02:47 +02:00
Code Issues Packages Projects Releases Wiki Activity
11fbb1cc6d
fpc/api/win32/keyboard.inc
michael 650fbb86aa + removed logs
2000-07-13 11:32:24 +00:00

796 lines
26 KiB
PHP
Raw Blame History

{
$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 <EFBFBD> }
(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; {<EFBFBD> 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+<EFBFBD> = \ 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
}
Reference in New Issue View Git Blame Copy Permalink