keyboard.inc 2.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133
  1. {
  2. System independent keyboard interface for os2
  3. $Id$
  4. }
  5. uses
  6. {$IFDEF PPC_FPC}
  7. KbdCalls, DosCalls;
  8. {$ELSE}
  9. {$IFDEF PPC_VIRTUAL}
  10. OS2Base;
  11. {$ELSE}
  12. {$IFDEF PPC_BPOS2}
  13. Os2Subs, DosProcs;
  14. {$ELSE}
  15. {$IFDEF PPC_SPEED}
  16. BseSub, BseDos;
  17. {$ENDIF}
  18. {$ENDIF}
  19. {$ENDIF}
  20. {$ENDIF}
  21. type
  22. {$IFDEF PPC_VIRTUAL}
  23. TKbdKeyInfo = KbdKeyInfo;
  24. TKbdInfo = KbdInfo;
  25. {$ELSE}
  26. {$IFDEF PPC_SPEED}
  27. TKbdKeyInfo = KbdKeyInfo;
  28. TKbdInfo = KbdInfo;
  29. {$ENDIF}
  30. {$ENDIF}
  31. const
  32. DefaultKeyboard = 0;
  33. Handle: word = DefaultKeyboard;
  34. procedure InitKeyboard;
  35. var
  36. K: TKbdInfo;
  37. begin
  38. if KbdGetFocus (IO_Wait, DefaultKeyboard) = No_Error then
  39. begin
  40. if KbdOpen (Handle) <> No_Error then Handle := DefaultKeyboard;
  41. KbdFlushBuffer (Handle);
  42. KbdFreeFocus (DefaultKeyboard);
  43. KbdGetFocus (IO_Wait, Handle);
  44. K.cb := 10;
  45. KbdGetStatus (K, Handle);
  46. K.fsMask := $14;
  47. KbdSetStatus (K, Handle);
  48. end;
  49. end;
  50. procedure DoneKeyboard;
  51. begin
  52. KbdFreeFocus (Handle);
  53. if KbdGetFocus (IO_Wait, DefaultKeyboard) = No_Error then
  54. begin
  55. KbdClose (Handle);
  56. Handle := DefaultKeyboard;
  57. KbdFreeFocus (DefaultKeyboard);
  58. end;
  59. end;
  60. function GetKeyEvent: TKeyEvent;
  61. var
  62. K: TKbdKeyInfo;
  63. RC: word;
  64. begin
  65. if PendingKeyEvent <> 0 then
  66. begin
  67. GetKeyEvent := PendingKeyEvent;
  68. PendingKeyEvent := 0;
  69. end else
  70. begin
  71. KbdGetFocus (IO_Wait, Handle);
  72. while (KbdCharIn (K, IO_Wait, Handle) <> No_Error)
  73. or (K.fbStatus and $40 = 0) do DosSleep (5);
  74. with K do GetKeyEvent := cardinal (fsState or $F) shl 16 or
  75. cardinal (byte (chScan)) shl 8 or byte (chChar);
  76. end;
  77. end;
  78. function PollKeyEvent: TKeyEvent;
  79. var
  80. K: TKbdKeyInfo;
  81. begin
  82. if PendingKeyEvent = 0 then
  83. begin
  84. KbdGetFocus (IO_NoWait, Handle);
  85. if (KbdCharIn (K, IO_NoWait, Handle) <> NoError) or
  86. (K.fbStatus and $40 = 0) then FillChar (K, SizeOf (K), 0) else
  87. with K do PendingKeyEvent := cardinal (fsState or $F) shl 16 or
  88. cardinal (byte (chScan)) shl 8 or byte (chChar);
  89. end;
  90. PollKeyEvent := PendingKeyEvent;
  91. if PendingKeyEvent and $FFFF = 0 then PendingKeyEvent := 0;
  92. end;
  93. function PollShiftStateEvent: TKeyEvent;
  94. begin
  95. end;
  96. function TranslateKeyEvent (KeyEvent: TKeyEvent): TKeyEvent;
  97. begin
  98. end;
  99. function TranslateKeyEventUniCode (KeyEvent: TKeyEvent): TKeyEvent;
  100. begin
  101. end;
  102. {
  103. $Log$
  104. Revision 1.3 2000-03-19 11:29:07 hajny
  105. * PollKeyEvent implemented
  106. Revision 1.2 2000/01/09 20:42:05 hajny
  107. + the first part of implementation
  108. Revision 1.1 2000/01/06 01:20:31 peter
  109. * moved out of packages/ back to topdir
  110. Revision 1.1 1999/11/24 23:36:38 peter
  111. * moved to packages dir
  112. Revision 1.1 1998/12/04 12:48:32 peter
  113. * moved some dirs
  114. Revision 1.1 1998/10/26 11:31:49 peter
  115. + inital include files
  116. }