mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 17:31:42 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			105 lines
		
	
	
		
			2.1 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			105 lines
		
	
	
		
			2.1 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| {
 | |
|     $Id$
 | |
|     This file is part of the Free Pascal run time library.
 | |
|     Copyright (c) 1999-2001 by the Free Pascal development team.
 | |
| 
 | |
|     Keyboard unit for netware
 | |
| 
 | |
|     See the file COPYING.FPC, included in this distribution,
 | |
|     for details about the copyright.
 | |
| 
 | |
|     This program 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.
 | |
| 
 | |
|  **********************************************************************}
 | |
| { 2001/04/16 armin: first version for netware
 | |
|   2002/03/03 armin: changes for fpc 1.1 }
 | |
| unit Keyboard;
 | |
| interface
 | |
| 
 | |
| {$i keybrdh.inc}
 | |
| 
 | |
| 
 | |
| implementation
 | |
| 
 | |
| {$i keyboard.inc}
 | |
| {$i nwsys.inc}
 | |
| 
 | |
| procedure SysInitKeyboard;
 | |
| begin
 | |
|   PendingKeyEvent := 0;
 | |
| end;
 | |
| 
 | |
| 
 | |
| function SysGetKeyEvent: TKeyEvent;
 | |
| var T : TKeyEvent;
 | |
| begin
 | |
|   if PendingKeyEvent<>0 then
 | |
|   begin
 | |
|     SysGetKeyEvent:=PendingKeyEvent;
 | |
|     PendingKeyEvent:=0;
 | |
|     exit;
 | |
|   end;
 | |
|   T := byte(_getch);
 | |
|   if T = 0 then
 | |
|     T := word(_getch) shl 8;
 | |
|   SysGetKeyEvent := $03000000 OR T;
 | |
| end;
 | |
| 
 | |
| 
 | |
| function SysPollKeyEvent: TKeyEvent;
 | |
| begin
 | |
|   if PendingKeyEvent<>0 then
 | |
|    exit(PendingKeyEvent);
 | |
|   if _kbhit <> 0 then
 | |
|   begin
 | |
|     PendingKeyEvent := byte(_getch);
 | |
|     if PendingKeyEvent = 0 then
 | |
|       PendingKeyEvent := word(_getch) shl 8;
 | |
|     PendingKeyEvent := PendingKeyEvent OR $03000000;
 | |
|     SysPollKeyEvent := PendingKeyEvent;
 | |
|   end else
 | |
|     SysPollKeyEvent := 0;
 | |
| end;
 | |
| 
 | |
| 
 | |
| function SysPollShiftStateEvent: TKeyEvent;
 | |
| begin
 | |
|   SysPollShiftStateEvent:=0;
 | |
| end;
 | |
| 
 | |
| function SysGetShiftState: Byte;
 | |
| begin
 | |
|   SysGetShiftState:=0;
 | |
| end;
 | |
| 
 | |
| 
 | |
| Const
 | |
|   SysKeyboardDriver : TKeyboardDriver = (
 | |
|       InitDriver : Nil;
 | |
|       DoneDriver : Nil;
 | |
|       GetKeyevent : @SysGetKeyEvent;
 | |
|       PollKeyEvent : @SysPollKeyEvent;
 | |
|       GetShiftState : @SysGetShiftState;
 | |
|       TranslateKeyEvent : Nil;
 | |
|       TranslateKeyEventUnicode : Nil;
 | |
|     );
 | |
| 
 | |
| begin
 | |
|   KeyboardInitialized := false;
 | |
|   PendingKeyEvent := 0;
 | |
|   SetKeyBoardDriver(SysKeyBoardDriver);
 | |
| end.
 | |
| 
 | |
| {
 | |
|   $Log$
 | |
|   Revision 1.4  2002-09-07 16:01:20  peter
 | |
|     * old logs removed and tabs fixed
 | |
| 
 | |
|   Revision 1.3  2002/03/08 19:02:59  armin
 | |
|   Changes for new style (TKeyboardDriver record)
 | |
| 
 | |
| 
 | |
| }
 | 
