mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-07 03:58:47 +02:00
268 lines
7.5 KiB
ObjectPascal
268 lines
7.5 KiB
ObjectPascal
{
|
|
$Id$
|
|
|
|
Keyboard unit, part of the portable API for Pascal
|
|
|
|
Copyright (c) 1997 Balazs Scheidler (bazsi@balabit.hu)
|
|
|
|
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.
|
|
|
|
****************************************************************************}
|
|
unit Keyboard;
|
|
|
|
interface
|
|
{$i platform.inc}
|
|
|
|
uses
|
|
{$ifdef DEBUG}
|
|
{$ifdef win32}
|
|
windows,
|
|
{$endif win32}
|
|
{$endif DEBUG}
|
|
|
|
ApiComm;
|
|
|
|
const
|
|
{ We have an errorcode base of 1010 }
|
|
errKbdInitError = errKbdBase + 0;
|
|
errKbdNotImplemented = errKbdBase + 1;
|
|
|
|
type
|
|
TKeyEvent = Longint;
|
|
|
|
{ The structure of a TKeyEvent follows in LSB-MSB order:
|
|
2 bytes: depending on flags either the physical representation of a key
|
|
(under DOS scancode, ascii code pair), or the translated
|
|
ASCII/unicode character
|
|
1 byte: shift-state when this key was pressed (or shortly after)
|
|
1 byte: flags, the following flags are defined:
|
|
bit0-1
|
|
0: the lowest two bytes is the translated ASCII value
|
|
1: the lowest two bytes is the translated Unicode value
|
|
(wide-char)
|
|
2: the lowest two bytes is a function key, and the lowest
|
|
two bytes contains its platform independent code
|
|
3: the lowest two bytes is the physical representation
|
|
bit2
|
|
0: the key is pressed
|
|
1: the key is released (This event is not guaranteed to occur on all platforms)
|
|
bit3-7 undefined, should be 0
|
|
|
|
|
|
If there are two keys returning the same char-code, there's no way to find
|
|
out which one was pressed (Gray+ and Simple+). If you need to know which
|
|
was pressed, you'll need to use the untranslated keycodes, which is system
|
|
dependent. System dependent constants may be defined to cover those, with
|
|
possibily having the same name (but different value). }
|
|
|
|
{ System independent function key codes }
|
|
const
|
|
kbdF1 = $FF01;
|
|
kbdF2 = $FF02;
|
|
kbdF3 = $FF03;
|
|
kbdF4 = $FF04;
|
|
kbdF5 = $FF05;
|
|
kbdF6 = $FF06;
|
|
kbdF7 = $FF07;
|
|
kbdF8 = $FF08;
|
|
kbdF9 = $FF09;
|
|
kbdF10 = $FF0A;
|
|
kbdF11 = $FF0B;
|
|
kbdF12 = $FF0C;
|
|
kbdF13 = $FF0D;
|
|
kbdF14 = $FF0E;
|
|
kbdF15 = $FF0F;
|
|
kbdF16 = $FF10;
|
|
kbdF17 = $FF11;
|
|
kbdF18 = $FF12;
|
|
kbdF19 = $FF13;
|
|
kbdF20 = $FF14;
|
|
{ $15 - $1F reserved for future Fxx keys }
|
|
kbdHome = $FF20;
|
|
kbdUp = $FF21;
|
|
kbdPgUp = $FF22;
|
|
kbdLeft = $FF23;
|
|
kbdMiddle = $FF24;
|
|
kbdRight = $FF25;
|
|
kbdEnd = $FF26;
|
|
kbdDown = $FF27;
|
|
kbdPgDn = $FF28;
|
|
|
|
kbdInsert = $FF29;
|
|
kbdDelete = $FF2A;
|
|
{ $2B - $2F reserved for future keypad keys }
|
|
|
|
{ possible flag values }
|
|
kbASCII = $00;
|
|
kbUniCode = $01;
|
|
kbFnKey = $02;
|
|
kbPhys = $03;
|
|
|
|
kbReleased = $04;
|
|
|
|
{ shiftstate flags }
|
|
kbLeftShift = 1;
|
|
kbRightShift = 2;
|
|
kbShift = kbLeftShift or kbRightShift;
|
|
kbCtrl = 4;
|
|
kbAlt = 8;
|
|
|
|
var
|
|
PendingKeyEvent : TKeyEvent;
|
|
|
|
|
|
procedure InitKeyboard;
|
|
{ Initializes the keyboard interface, additional platform specific parameters
|
|
can be passed by global variables (RawMode etc.) for the first implementation
|
|
under DOS it does nothing }
|
|
|
|
procedure DoneKeyboard;
|
|
{ Deinitializes the keyboard interface }
|
|
|
|
function GetKeyEvent: TKeyEvent;
|
|
{ Returns the last keyevent, and waits for one if not available }
|
|
|
|
procedure PutKeyEvent(KeyEvent: TKeyEvent);
|
|
{ Adds the given KeyEvent to the input queue. Please note that depending on
|
|
the implementation this can hold only one value (NO FIFOs etc) }
|
|
|
|
function PollKeyEvent: TKeyEvent;
|
|
{ Checks if a keyevent is available, and returns it if one is found. If no
|
|
event is pending, it returns 0 }
|
|
|
|
function PollShiftStateEvent: TKeyEvent;
|
|
{ Return the current shiftstate in a keyevent }
|
|
|
|
function TranslateKeyEvent(KeyEvent: TKeyEvent): TKeyEvent;
|
|
{ Performs ASCII translation of the KeyEvent }
|
|
|
|
function TranslateKeyEventUniCode(KeyEvent: TKeyEvent): TKeyEvent;
|
|
{ Performs Unicode translation of the KeyEvent }
|
|
|
|
function GetKeyEventFlags(KeyEvent: TKeyEvent): Byte;
|
|
{ Returns the flags part of the given KeyEvent }
|
|
|
|
function GetKeyEventChar(KeyEvent: TKeyEvent): Char;
|
|
{ Returns the charcode part of the given KeyEvent, if it contains a translated
|
|
keycode }
|
|
|
|
function GetKeyEventUniCode(KeyEvent: TKeyEvent): Word;
|
|
{ Returns the unicode part of the given KeyEvent, if it contains a translated
|
|
unicode character }
|
|
|
|
function GetKeyEventCode(KeyEvent: TKeyEvent): Word;
|
|
{ Returns the translated function keycode part of the given KeyEvent, if it
|
|
contains a translated function keycode }
|
|
|
|
function GetKeyEventShiftState(KeyEvent: TKeyEvent): Byte;
|
|
{ Returns the shift-state values of the given KeyEvent }
|
|
|
|
function IsFunctionKey(KeyEvent: TKeyEvent): Boolean;
|
|
{ Returns true if the given key was a function key or not }
|
|
{$ifdef DEBUG}
|
|
{$ifdef win32}
|
|
var last_ir : INPUT_RECORD;
|
|
{$endif win32}
|
|
{$endif DEBUG}
|
|
|
|
implementation
|
|
|
|
{ Include platform dependent routines }
|
|
|
|
{$i keyboard.inc}
|
|
|
|
|
|
{ Platform independent routines }
|
|
|
|
procedure PutKeyEvent(KeyEvent: TKeyEvent);
|
|
begin
|
|
PendingKeyEvent := KeyEvent;
|
|
end;
|
|
|
|
function GetKeyEventFlags(KeyEvent: TKeyEvent): Byte;
|
|
begin
|
|
GetKeyEventFlags := (KeyEvent and $FF000000) shr 24;
|
|
end;
|
|
|
|
function GetKeyEventChar(KeyEvent: TKeyEvent): Char;
|
|
begin
|
|
if KeyEvent and $03000000 = $00000000 then
|
|
GetKeyEventChar := Chr(KeyEvent and $000000FF)
|
|
else
|
|
GetKeyEventChar := #0;
|
|
end;
|
|
|
|
function GetKeyEventUniCode(KeyEvent: TKeyEvent): Word;
|
|
begin
|
|
if KeyEvent and $03000000 = $01000000 then
|
|
GetKeyEventUniCode := KeyEvent and $0000FFFF
|
|
else
|
|
GetKeyEventUniCode := 0;
|
|
end;
|
|
|
|
function GetKeyEventCode(KeyEvent: TKeyEvent): Word;
|
|
begin
|
|
GetKeyEventCode := KeyEvent and $0000FFFF
|
|
end;
|
|
|
|
function GetKeyEventShiftState(KeyEvent: TKeyEvent): Byte;
|
|
begin
|
|
GetKeyEventShiftState := (KeyEvent and $00FF0000) shr 16;
|
|
end;
|
|
|
|
function IsFunctionKey(KeyEvent: TKeyEvent): Boolean;
|
|
begin
|
|
IsFunctionKey := KeyEvent and $03000000 = $02000000;
|
|
end;
|
|
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.2 2000-02-29 11:43:16 pierre
|
|
Common renamed APIComm to avoid problems with free vision
|
|
|
|
Revision 1.1 2000/01/06 01:20:31 peter
|
|
* moved out of packages/ back to topdir
|
|
|
|
Revision 1.1 1999/12/23 19:36:47 peter
|
|
* place unitfiles in target dirs
|
|
|
|
Revision 1.2 1999/12/09 21:29:15 pierre
|
|
+ some debug code for win32
|
|
|
|
Revision 1.3 1999/11/24 23:36:56 peter
|
|
* moved to packages dir
|
|
|
|
Revision 1.2 1998/12/12 19:12:58 peter
|
|
* keyboard updates
|
|
* make test target, make all only makes units
|
|
|
|
Revision 1.1 1998/12/04 12:48:24 peter
|
|
* moved some dirs
|
|
|
|
Revision 1.6 1998/10/29 12:49:47 peter
|
|
* more fixes
|
|
|
|
Revision 1.5 1998/10/28 21:18:22 peter
|
|
* more fixes
|
|
|
|
Revision 1.4 1998/10/26 11:22:51 peter
|
|
* updates
|
|
|
|
|
|
Date Version Who Comments
|
|
07/28/98 0.2 Bazsi Added some constants
|
|
} |