keyboard.inc 8.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by the Free Pascal development team
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. var
  12. PendingKeyEvent : TKeyEvent;
  13. procedure PutKeyEvent(KeyEvent: TKeyEvent);
  14. begin
  15. PendingKeyEvent := KeyEvent;
  16. end;
  17. function GetKeyEventFlags(KeyEvent: TKeyEvent): Byte;
  18. begin
  19. GetKeyEventFlags := (KeyEvent and $FF000000) shr 24;
  20. end;
  21. function GetKeyEventChar(KeyEvent: TKeyEvent): Char;
  22. begin
  23. if KeyEvent and $03000000 = $00000000 then
  24. GetKeyEventChar := Chr(KeyEvent and $000000FF)
  25. else
  26. GetKeyEventChar := #0;
  27. end;
  28. function GetKeyEventUniCode(KeyEvent: TKeyEvent): Word;
  29. begin
  30. if KeyEvent and $03000000 = $01000000 then
  31. GetKeyEventUniCode := KeyEvent and $0000FFFF
  32. else
  33. GetKeyEventUniCode := 0;
  34. end;
  35. function GetKeyEventCode(KeyEvent: TKeyEvent): Word;
  36. begin
  37. GetKeyEventCode := KeyEvent and $0000FFFF
  38. end;
  39. function GetKeyEventShiftState(KeyEvent: TKeyEvent): Byte;
  40. begin
  41. GetKeyEventShiftState := (KeyEvent and $00FF0000) shr 16;
  42. end;
  43. function IsFunctionKey(KeyEvent: TKeyEvent): Boolean;
  44. begin
  45. IsFunctionKey := KeyEvent and $03000000 = $02000000;
  46. end;
  47. Var
  48. KeyBoardInitialized : Boolean;
  49. CurrentKeyboardDriver : TKeyboardDriver;
  50. procedure InitKeyboard;
  51. begin
  52. If Not KeyboardInitialized then
  53. begin
  54. If Assigned(CurrentKeyBoardDriver.InitDriver) Then
  55. CurrentKeyBoardDriver.InitDriver();
  56. KeyboardInitialized:=True;
  57. end;
  58. end;
  59. procedure DoneKeyboard;
  60. begin
  61. If KeyboardInitialized then
  62. begin
  63. If Assigned(CurrentKeyBoardDriver.DoneDriver) Then
  64. CurrentKeyBoardDriver.DoneDriver();
  65. KeyboardInitialized:=False;
  66. end;
  67. end;
  68. function GetKeyEvent: TKeyEvent;
  69. begin
  70. if PendingKeyEvent<>0 then
  71. begin
  72. GetKeyEvent:=PendingKeyEvent;
  73. PendingKeyEvent:=0;
  74. exit;
  75. end;
  76. If Assigned(CurrentKeyBoardDriver.GetKeyEvent) Then
  77. GetKeyEvent:=CurrentKeyBoardDriver.GetKeyEvent()
  78. else
  79. GetKeyEvent:=0;
  80. end;
  81. function PollKeyEvent: TKeyEvent;
  82. begin
  83. if PendingKeyEvent<>0 then
  84. exit(PendingKeyEvent);
  85. If Assigned(CurrentKeyBoardDriver.PollKeyEvent) Then
  86. begin
  87. PollKeyEvent:=CurrentKeyBoardDriver.PollKeyEvent();
  88. // PollKeyEvent:=PendingKeyEvent;
  89. // this was wrong ... PM
  90. end
  91. else
  92. PollKeyEvent:=0;
  93. end;
  94. Procedure SetKeyboardDriver (Const Driver : TKeyboardDriver);
  95. begin
  96. If Not KeyBoardInitialized then
  97. CurrentKeyBoardDriver:=Driver;
  98. end;
  99. Procedure GetKeyboardDriver (Var Driver : TKeyboardDriver);
  100. begin
  101. Driver:=CurrentKeyBoardDriver;
  102. end;
  103. function PollShiftStateEvent: TKeyEvent;
  104. begin
  105. If Assigned(CurrentKeyBoardDriver.GetShiftState) then
  106. PollShiftStateEvent:=CurrentKeyBoardDriver.GetShiftState() shl 16
  107. else
  108. PollShiftStateEvent:=0;
  109. end;
  110. function DefaultTranslateKeyEventUniCode(KeyEvent: TKeyEvent): TKeyEvent;
  111. begin
  112. DefaultTranslateKeyEventUniCode:=KeyEvent;
  113. ErrorCode:=errKbdNotImplemented;
  114. end;
  115. function TranslateKeyEventUniCode(KeyEvent: TKeyEvent): TKeyEvent;
  116. begin
  117. if Assigned(CurrentKeyBoardDriver.TranslateKeyEventUnicode) then
  118. TranslateKeyEventUnicode:=CurrentKeyBoardDriver.TranslateKeyEventUnicode(KeyEvent)
  119. else
  120. TranslateKeyEventUnicode:=DefaultTranslateKeyEventUnicode(KeyEvent);
  121. end;
  122. type
  123. TTranslationEntry = packed record
  124. Min, Max: Byte;
  125. Offset: Word;
  126. end;
  127. const
  128. TranslationTableEntries = 12;
  129. TranslationTable: array [1..TranslationTableEntries] of TTranslationEntry =
  130. ((Min: $3B; Max: $44; Offset: kbdF1), { function keys F1-F10 }
  131. (Min: $54; Max: $5D; Offset: kbdF1), { Shift fn keys F1-F10 }
  132. (Min: $5E; Max: $67; Offset: kbdF1), { Ctrl fn keys F1-F10 }
  133. (Min: $68; Max: $71; Offset: kbdF1), { Alt fn keys F1-F10 }
  134. (Min: $85; Max: $86; Offset: kbdF11), { function keys F11-F12 }
  135. (Min: $87; Max: $88; Offset: kbdF11), { Shift+function keys F11-F12 }
  136. (Min: $89; Max: $8A; Offset: kbdF11), { Ctrl+function keys F11-F12 }
  137. (Min: $8B; Max: $8C; Offset: kbdF11), { Alt+function keys F11-F12 }
  138. (Min: $47; Max: $49; Offset: kbdHome), { Keypad keys kbdHome-kbdPgUp }
  139. (Min: $4B; Max: $4D; Offset: kbdLeft), { Keypad keys kbdLeft-kbdRight }
  140. (Min: $4F; Max: $51; Offset: kbdEnd), { Keypad keys kbdEnd-kbdPgDn }
  141. (Min: $52; Max: $53; Offset: kbdInsert));
  142. function DefaultTranslateKeyEvent(KeyEvent: TKeyEvent): TKeyEvent;
  143. var
  144. I: Integer;
  145. ScanCode: Byte;
  146. begin
  147. if KeyEvent and $03000000 = $03000000 then
  148. begin
  149. if KeyEvent and $000000FF <> 0 then
  150. begin
  151. DefaultTranslateKeyEvent := KeyEvent and $00FFFFFF;
  152. exit;
  153. end
  154. else
  155. begin
  156. { This is a function key }
  157. ScanCode := (KeyEvent and $0000FF00) shr 8;
  158. for I := 1 to TranslationTableEntries do
  159. begin
  160. if (TranslationTable[I].Min <= ScanCode) and (ScanCode <= TranslationTable[I].Max) then
  161. begin
  162. DefaultTranslateKeyEvent := $02000000 + (KeyEvent and $00FF0000) +
  163. (ScanCode - TranslationTable[I].Min) + TranslationTable[I].Offset;
  164. exit;
  165. end;
  166. end;
  167. end;
  168. end;
  169. DefaultTranslateKeyEvent := KeyEvent;
  170. end;
  171. function TranslateKeyEvent(KeyEvent: TKeyEvent): TKeyEvent;
  172. begin
  173. if Assigned(CurrentKeyBoardDriver.TranslateKeyEvent) then
  174. TranslateKeyEvent:=CurrentKeyBoardDriver.TranslateKeyEvent(KeyEvent)
  175. else
  176. TranslateKeyEvent:=DefaultTranslateKeyEvent(KeyEvent);
  177. end;
  178. { ---------------------------------------------------------------------
  179. KeyEvent to String representation section.
  180. ---------------------------------------------------------------------}
  181. Procedure AddToString (Var S : String; Const A : String);
  182. begin
  183. If Length(S)=0 then
  184. S:=A
  185. else
  186. S:=S+' '+A;
  187. end;
  188. Function IntToStr(Int : Longint) : String;
  189. begin
  190. Str(Int,IntToStr);
  191. end;
  192. Function ShiftStateToString(KeyEvent : TKeyEvent; UseLeftRight : Boolean) : String;
  193. Var
  194. S : Integer;
  195. T : String;
  196. begin
  197. S:=GetKeyEventShiftState(KeyEvent);
  198. T:='';
  199. If (S and kbShift)<>0 then
  200. begin
  201. if UseLeftRight then
  202. case (S and kbShift) of
  203. kbShift : AddToString(T,SLeftRight[1]+' '+SAnd+' '+SLeftRight[2]);
  204. kbLeftShift : AddToString(T,SLeftRight[1]);
  205. kbRightShift : AddToString(T,SLeftRight[2]);
  206. end;
  207. AddToString(T,SShift[1]);
  208. end;
  209. If (S and kbCtrl)<>0 Then
  210. AddToString(T,SShift[2]);
  211. If (S and kbAlt)<>0 Then
  212. AddToString(T,SShift[3]);
  213. ShiftStateToString:=T;
  214. end;
  215. Function FunctionKeyName (KeyCode : Word) : String;
  216. begin
  217. If ((KeyCode-KbdF1)<$1F) Then
  218. FunctionKeyName:='F'+IntToStr((KeyCode-KbdF1+1))
  219. else
  220. begin
  221. If (KeyCode-kbdHome)<($2F-$1F) then
  222. FunctionKeyName:=SKeyPad[(KeyCode-kbdHome)]
  223. else
  224. FunctionKeyName:=SUnknownFunctionKey + IntToStr(KeyCode);
  225. end;
  226. end;
  227. Function KeyEventToString(KeyEvent : TKeyEvent) : String;
  228. Var
  229. T : String;
  230. begin
  231. T:=ShiftStateToString(KeyEvent,False);
  232. Case GetKeyEventFlags(KeyEvent) of
  233. kbASCII : AddToString(T,GetKeyEventChar(KeyEvent));
  234. kbUniCode : AddToString(T,SUniCodeChar+IntToStr(GetKeyEventUniCode(Keyevent)));
  235. kbFnKey : AddToString(T,FunctionKeyName(GetKeyEventCode(KeyEvent)));
  236. // Not good, we need a GetKeyEventScanCode function !!
  237. kbPhys : AddToString(T,SScanCode+IntToStr(KeyEvent and $ffff));
  238. end;
  239. KeyEventToString:=T;
  240. end;
  241. {
  242. $Log$
  243. Revision 1.3 2001-09-30 21:08:58 peter
  244. * merged fixes
  245. Revision 1.2 2001/09/21 21:33:36 michael
  246. + Merged driver support from fixbranch
  247. Revision 1.1.2.2 2001/09/21 21:20:43 michael
  248. + Added support for keyboard driver.
  249. + Added DefaultTranslateKeyEvent,DefaultTranslateKeyEventUnicode
  250. + PendingKeyEvent variable no longer public. Handling of this variable is
  251. now done entirely by global functions. System dependent code should not
  252. need it, it is set automatically.
  253. + InitVideo DoneVideo will check whether the keyboard is initialized or not.
  254. Revision 1.1.2.1 2001/01/30 22:21:22 peter
  255. * move api to rtl
  256. Revision 1.1 2001/01/13 11:13:12 peter
  257. * API 2 RTL
  258. }