keyboard.pp 1.8 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by Florian Klaempfl
  5. member of the Free Pascal development team
  6. Keyboard unit for go32v2
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. unit Keyboard;
  14. interface
  15. {$i keybrdh.inc}
  16. implementation
  17. uses
  18. go32;
  19. {$i keyboard.inc}
  20. function SysGetKeyEvent: TKeyEvent;
  21. var
  22. regs : trealregs;
  23. begin
  24. regs.ah:=$10;
  25. realintr($16,regs);
  26. if (regs.al=$e0) and (regs.ah<>0) then
  27. regs.al:=0;
  28. SysGetKeyEvent:=(kbPhys shl 24) or regs.ax or ((mem[$40:$17] and $f) shl 16);
  29. end;
  30. function SysPollKeyEvent: TKeyEvent;
  31. var
  32. regs : trealregs;
  33. begin
  34. regs.ah:=$11;
  35. realintr($16,regs);
  36. if (regs.realflags and zeroflag<>0) then
  37. exit(0);
  38. if (regs.al=$e0) and (regs.ah<>0) then
  39. regs.al:=0;
  40. SysPollKeyEvent:=(kbPhys shl 24) or regs.ax or ((mem[$40:$17] and $f) shl 16);
  41. end;
  42. function SysGetShiftState: Byte;
  43. begin
  44. SysGetShiftState:=(mem[$40:$17] and $f);
  45. end;
  46. Const
  47. SysKeyboardDriver : TKeyboardDriver = (
  48. InitDriver : Nil;
  49. DoneDriver : Nil;
  50. GetKeyevent : @SysGetKeyEvent;
  51. PollKeyEvent : @SysPollKeyEvent;
  52. GetShiftState : @SysGetShiftState;
  53. TranslateKeyEvent : Nil;
  54. TranslateKeyEventUnicode : Nil;
  55. );
  56. begin
  57. SetKeyBoardDriver(SysKeyBoardDriver);
  58. end.
  59. {
  60. $Log$
  61. Revision 1.4 2002-09-07 16:01:18 peter
  62. * old logs removed and tabs fixed
  63. Revision 1.3 2002/08/28 06:35:30 pierre
  64. * merge kbPhys patch from fixes branch
  65. Revision 1.1.2.3 2002/07/13 12:22:03 pierre
  66. * added kbPhys flag
  67. }