keyboard.pp 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2000 by Florian Klaempfl
  4. member of the Free Pascal development team
  5. Keyboard unit for Win32
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. unit Keyboard;
  13. interface
  14. {$ifdef DEBUG}
  15. uses
  16. windows;
  17. var
  18. last_ir : Input_Record;
  19. {$endif DEBUG}
  20. {$i keybrdh.inc}
  21. function KeyPressed:Boolean;
  22. implementation
  23. { WARNING: Keyboard-Drivers (i.e. german) will only work under WinNT.
  24. 95 and 98 do not support keyboard-drivers other than us for win32
  25. console-apps. So we always get the keys in us-keyboard layout
  26. from Win9x.
  27. }
  28. uses
  29. {$ifndef DEBUG}
  30. Windows,
  31. {$endif DEBUG}
  32. Dos,
  33. WinEvent;
  34. {$i keyboard.inc}
  35. const MaxQueueSize = 120;
  36. FrenchKeyboard = $040C040C;
  37. var
  38. keyboardeventqueue : array[0..maxqueuesize] of TKeyEventRecord;
  39. nextkeyevent,nextfreekeyevent : longint;
  40. newKeyEvent : THandle; {sinaled if key is available}
  41. lockVar : TCriticalSection; {for queue access}
  42. lastShiftState : byte; {set by handler for PollShiftStateEvent}
  43. altNumActive : boolean; {for alt+0..9}
  44. altNumBuffer : string [3];
  45. { used for keyboard specific stuff }
  46. KeyBoardLayout : HKL;
  47. Inited : Boolean;
  48. HasAltGr : Boolean = false;
  49. function KeyPressed:Boolean;
  50. begin
  51. KeyPressed:=PollKeyEvent<>0;
  52. end;
  53. procedure incqueueindex(var l : longint);
  54. begin
  55. inc(l);
  56. { wrap around? }
  57. if l>maxqueuesize then
  58. l:=0;
  59. end;
  60. function keyEventsInQueue : boolean;
  61. begin
  62. keyEventsInQueue := (nextkeyevent <> nextfreekeyevent);
  63. end;
  64. function rightistruealt(dw:cardinal):boolean; // inline ?
  65. // used to wrap checks for right alt/altgr.
  66. begin
  67. rightistruealt:=true;
  68. if hasaltgr then
  69. rightistruealt:=(dw and RIGHT_ALT_PRESSED)=0;
  70. end;
  71. { gets or peeks the next key from the queue, does not wait for new keys }
  72. function getKeyEventFromQueue (VAR t : TKeyEventRecord; Peek : boolean) : boolean;
  73. begin
  74. if not Inited then
  75. begin
  76. getKeyEventFromQueue := false;
  77. exit;
  78. end;
  79. EnterCriticalSection (lockVar);
  80. if keyEventsInQueue then
  81. begin
  82. t := keyboardeventqueue[nextkeyevent];
  83. if not peek then incqueueindex (nextkeyevent);
  84. getKeyEventFromQueue := true;
  85. if not keyEventsInQueue then ResetEvent (newKeyEvent);
  86. end else
  87. begin
  88. getKeyEventFromQueue := false;
  89. ResetEvent (newKeyEvent);
  90. end;
  91. LeaveCriticalSection (lockVar);
  92. end;
  93. { gets the next key from the queue, does wait for new keys }
  94. function getKeyEventFromQueueWait (VAR t : TKeyEventRecord) : boolean;
  95. begin
  96. if not Inited then
  97. begin
  98. getKeyEventFromQueueWait := false;
  99. exit;
  100. end;
  101. WaitForSingleObject (newKeyEvent, dword(INFINITE));
  102. { force that we read a keyevent }
  103. while not(getKeyEventFromQueue (t, false)) do
  104. Sleep(0);
  105. getKeyEventFromQueueWait:=true;
  106. end;
  107. { translate win32 shift-state to keyboard shift state }
  108. function transShiftState (ControlKeyState : dword) : byte;
  109. var b : byte;
  110. begin
  111. b := 0;
  112. if ControlKeyState and SHIFT_PRESSED <> 0 then { win32 makes no difference between left and right shift }
  113. b := b or kbShift;
  114. if (ControlKeyState and LEFT_CTRL_PRESSED <> 0) or
  115. (ControlKeyState and RIGHT_CTRL_PRESSED <> 0) then
  116. b := b or kbCtrl;
  117. if (ControlKeyState and LEFT_ALT_PRESSED <> 0) or
  118. (ControlKeyState and RIGHT_ALT_PRESSED <> 0) then
  119. b := b or kbAlt;
  120. transShiftState := b;
  121. end;
  122. { The event-Handler thread from the unit event will call us if a key-event
  123. is available }
  124. procedure HandleKeyboard(var ir:INPUT_RECORD);
  125. var
  126. i : longint;
  127. c : word;
  128. altc : char;
  129. addThis: boolean;
  130. begin
  131. with ir.Event.KeyEvent do
  132. begin
  133. { key up events are ignored (except alt) }
  134. if bKeyDown then
  135. begin
  136. EnterCriticalSection (lockVar);
  137. for i:=1 to wRepeatCount do
  138. begin
  139. addThis := true;
  140. if (dwControlKeyState and LEFT_ALT_PRESSED <> 0) or
  141. (dwControlKeyState and RIGHT_ALT_PRESSED <> 0) then {alt pressed}
  142. if ((wVirtualKeyCode >= $60) and (wVirtualKeyCode <= $69)) or
  143. ((dwControlKeyState and ENHANCED_KEY = 0) and
  144. (wVirtualKeyCode in [$C{VK_CLEAR generated by keypad 5},
  145. $21 {VK_PRIOR (PgUp) 9},
  146. $22 {VK_NEXT (PgDown) 3},
  147. $23 {VK_END 1},
  148. $24 {VK_HOME 7},
  149. $25 {VK_LEFT 4},
  150. $26 {VK_UP 8},
  151. $27 {VK_RIGHT 6},
  152. $28 {VK_DOWN 2},
  153. $2D {VK_INSERT 0}])) then {0..9 on NumBlock}
  154. begin
  155. if length (altNumBuffer) = 3 then
  156. delete (altNumBuffer,1,1);
  157. case wVirtualKeyCode of
  158. $60..$69 : altc:=char (wVirtualKeyCode-48);
  159. $c : altc:='5';
  160. $21 : altc:='9';
  161. $22 : altc:='3';
  162. $23 : altc:='1';
  163. $24 : altc:='7';
  164. $25 : altc:='4';
  165. $26 : altc:='8';
  166. $27 : altc:='6';
  167. $28 : altc:='2';
  168. $2D : altc:='0';
  169. end;
  170. altNumBuffer := altNumBuffer + altc;
  171. altNumActive := true;
  172. addThis := false;
  173. end else
  174. begin
  175. altNumActive := false;
  176. altNumBuffer := '';
  177. end;
  178. if addThis then
  179. begin
  180. keyboardeventqueue[nextfreekeyevent]:=
  181. ir.Event.KeyEvent;
  182. incqueueindex(nextfreekeyevent);
  183. end;
  184. end;
  185. lastShiftState := transShiftState (dwControlKeyState); {save it for PollShiftStateEvent}
  186. SetEvent (newKeyEvent); {event that a new key is available}
  187. LeaveCriticalSection (lockVar);
  188. end
  189. else
  190. begin
  191. lastShiftState := transShiftState (dwControlKeyState); {save it for PollShiftStateEvent}
  192. {for alt-number we have to look for alt-key release}
  193. if altNumActive then
  194. begin
  195. if (wVirtualKeyCode = $12) then {alt-released}
  196. begin
  197. if altNumBuffer <> '' then {numbers with alt pressed?}
  198. begin
  199. Val (altNumBuffer, c, i);
  200. if (i = 0) and (c <= 255) then {valid number?}
  201. begin {add to queue}
  202. fillchar (ir, sizeof (ir), 0);
  203. bKeyDown := true;
  204. AsciiChar := char (c);
  205. {and add to queue}
  206. EnterCriticalSection (lockVar);
  207. keyboardeventqueue[nextfreekeyevent]:=ir.Event.KeyEvent;
  208. incqueueindex(nextfreekeyevent);
  209. SetEvent (newKeyEvent); {event that a new key is available}
  210. LeaveCriticalSection (lockVar);
  211. end;
  212. end;
  213. altNumActive := false; {clear alt-buffer}
  214. altNumBuffer := '';
  215. end;
  216. end;
  217. end;
  218. end;
  219. end;
  220. procedure CheckAltGr;
  221. var ahkl : HKL;
  222. i : integer;
  223. begin
  224. HasAltGr:=false;
  225. ahkl:=GetKeyboardLayout(0);
  226. i:=$20;
  227. while i<$100 do
  228. begin
  229. // <MSDN>
  230. // For keyboard layouts that use the right-hand ALT key as ashift key
  231. // (for example, the French keyboard layout), the shift state is
  232. // represented by the value 6, because the right-hand ALT key is
  233. // converted internally into CTRL+ALT.
  234. // </MSDN>
  235. if (HIBYTE(VkKeyScanEx(chr(i),ahkl))=6) then
  236. begin
  237. HasAltGr:=true;
  238. break;
  239. end;
  240. inc(i);
  241. end;
  242. end;
  243. procedure SysInitKeyboard;
  244. begin
  245. KeyBoardLayout:=GetKeyboardLayout(0);
  246. lastShiftState := 0;
  247. FlushConsoleInputBuffer(StdInputHandle);
  248. newKeyEvent := CreateEvent (nil, // address of security attributes
  249. true, // flag for manual-reset event
  250. false, // flag for initial state
  251. nil); // address of event-object name
  252. if newKeyEvent = INVALID_HANDLE_VALUE then
  253. begin
  254. // what to do here ????
  255. RunError (217);
  256. end;
  257. InitializeCriticalSection (lockVar);
  258. altNumActive := false;
  259. altNumBuffer := '';
  260. nextkeyevent:=0;
  261. nextfreekeyevent:=0;
  262. checkaltgr;
  263. SetKeyboardEventHandler (@HandleKeyboard);
  264. Inited:=true;
  265. end;
  266. procedure SysDoneKeyboard;
  267. begin
  268. SetKeyboardEventHandler(nil); {hangs???}
  269. DeleteCriticalSection (lockVar);
  270. FlushConsoleInputBuffer(StdInputHandle);
  271. closeHandle (newKeyEvent);
  272. Inited:=false;
  273. end;
  274. {$define USEKEYCODES}
  275. {Translatetable Win32 -> Dos for Special Keys = Function Key, Cursor Keys
  276. and Keys other than numbers on numblock (to make fv happy) }
  277. {combinations under dos: Shift+Ctrl: same as Ctrl
  278. Shift+Alt : same as alt
  279. Ctrl+Alt : nothing (here we get it like alt)}
  280. {$ifdef USEKEYCODES}
  281. { use positive values for ScanCode we want to set
  282. 0 for key where we should leave the scancode
  283. -1 for OEM specifc keys
  284. -2 for unassigned
  285. -3 for Kanji systems ???
  286. }
  287. const
  288. Unassigned = -2;
  289. Kanji = -3;
  290. OEM_specific = -1;
  291. KeyToQwertyScan : array [0..255] of integer =
  292. (
  293. { 00 } 0,
  294. { 01 VK_LBUTTON } 0,
  295. { 02 VK_RBUTTON } 0,
  296. { 03 VK_CANCEL } 0,
  297. { 04 VK_MBUTTON } 0,
  298. { 05 unassigned } -2,
  299. { 06 unassigned } -2,
  300. { 07 unassigned } -2,
  301. { 08 VK_BACK } $E,
  302. { 09 VK_TAB } $F,
  303. { 0A unassigned } -2,
  304. { 0B unassigned } -2,
  305. { 0C VK_CLEAR ?? } 0,
  306. { 0D VK_RETURN } 0,
  307. { 0E unassigned } -2,
  308. { 0F unassigned } -2,
  309. { 10 VK_SHIFT } 0,
  310. { 11 VK_CONTROL } 0,
  311. { 12 VK_MENU (Alt key) } 0,
  312. { 13 VK_PAUSE } 0,
  313. { 14 VK_CAPITAL (Caps Lock) } 0,
  314. { 15 Reserved for Kanji systems} -3,
  315. { 16 Reserved for Kanji systems} -3,
  316. { 17 Reserved for Kanji systems} -3,
  317. { 18 Reserved for Kanji systems} -3,
  318. { 19 Reserved for Kanji systems} -3,
  319. { 1A unassigned } -2,
  320. { 1B VK_ESCAPE } $1,
  321. { 1C Reserved for Kanji systems} -3,
  322. { 1D Reserved for Kanji systems} -3,
  323. { 1E Reserved for Kanji systems} -3,
  324. { 1F Reserved for Kanji systems} -3,
  325. { 20 VK_SPACE} 0,
  326. { 21 VK_PRIOR (PgUp) } 0,
  327. { 22 VK_NEXT (PgDown) } 0,
  328. { 23 VK_END } 0,
  329. { 24 VK_HOME } 0,
  330. { 25 VK_LEFT } 0,
  331. { 26 VK_UP } 0,
  332. { 27 VK_RIGHT } 0,
  333. { 28 VK_DOWN } 0,
  334. { 29 VK_SELECT ??? } 0,
  335. { 2A OEM specific !! } -1,
  336. { 2B VK_EXECUTE } 0,
  337. { 2C VK_SNAPSHOT } 0,
  338. { 2D VK_INSERT } 0,
  339. { 2E VK_DELETE } 0,
  340. { 2F VK_HELP } 0,
  341. { 30 VK_0 '0' } 11,
  342. { 31 VK_1 '1' } 2,
  343. { 32 VK_2 '2' } 3,
  344. { 33 VK_3 '3' } 4,
  345. { 34 VK_4 '4' } 5,
  346. { 35 VK_5 '5' } 6,
  347. { 36 VK_6 '6' } 7,
  348. { 37 VK_7 '7' } 8,
  349. { 38 VK_8 '8' } 9,
  350. { 39 VK_9 '9' } 10,
  351. { 3A unassigned } -2,
  352. { 3B unassigned } -2,
  353. { 3C unassigned } -2,
  354. { 3D unassigned } -2,
  355. { 3E unassigned } -2,
  356. { 3F unassigned } -2,
  357. { 40 unassigned } -2,
  358. { 41 VK_A 'A' } $1E,
  359. { 42 VK_B 'B' } $30,
  360. { 43 VK_C 'C' } $2E,
  361. { 44 VK_D 'D' } $20,
  362. { 45 VK_E 'E' } $12,
  363. { 46 VK_F 'F' } $21,
  364. { 47 VK_G 'G' } $22,
  365. { 48 VK_H 'H' } $23,
  366. { 49 VK_I 'I' } $17,
  367. { 4A VK_J 'J' } $24,
  368. { 4B VK_K 'K' } $25,
  369. { 4C VK_L 'L' } $26,
  370. { 4D VK_M 'M' } $32,
  371. { 4E VK_N 'N' } $31,
  372. { 4F VK_O 'O' } $18,
  373. { 50 VK_P 'P' } $19,
  374. { 51 VK_Q 'Q' } $10,
  375. { 52 VK_R 'R' } $13,
  376. { 53 VK_S 'S' } $1F,
  377. { 54 VK_T 'T' } $14,
  378. { 55 VK_U 'U' } $16,
  379. { 56 VK_V 'V' } $2F,
  380. { 57 VK_W 'W' } $11,
  381. { 58 VK_X 'X' } $2D,
  382. { 59 VK_Y 'Y' } $15,
  383. { 5A VK_Z 'Z' } $2C,
  384. { 5B unassigned } -2,
  385. { 5C unassigned } -2,
  386. { 5D unassigned } -2,
  387. { 5E unassigned } -2,
  388. { 5F unassigned } -2,
  389. { 60 VK_NUMPAD0 NumKeyPad '0' } 11,
  390. { 61 VK_NUMPAD1 NumKeyPad '1' } 2,
  391. { 62 VK_NUMPAD2 NumKeyPad '2' } 3,
  392. { 63 VK_NUMPAD3 NumKeyPad '3' } 4,
  393. { 64 VK_NUMPAD4 NumKeyPad '4' } 5,
  394. { 65 VK_NUMPAD5 NumKeyPad '5' } 6,
  395. { 66 VK_NUMPAD6 NumKeyPad '6' } 7,
  396. { 67 VK_NUMPAD7 NumKeyPad '7' } 8,
  397. { 68 VK_NUMPAD8 NumKeyPad '8' } 9,
  398. { 69 VK_NUMPAD9 NumKeyPad '9' } 10,
  399. { 6A VK_MULTIPLY } 0,
  400. { 6B VK_ADD } 0,
  401. { 6C VK_SEPARATOR } 0,
  402. { 6D VK_SUBSTRACT } 0,
  403. { 6E VK_DECIMAL } 0,
  404. { 6F VK_DIVIDE } 0,
  405. { 70 VK_F1 'F1' } $3B,
  406. { 71 VK_F2 'F2' } $3C,
  407. { 72 VK_F3 'F3' } $3D,
  408. { 73 VK_F4 'F4' } $3E,
  409. { 74 VK_F5 'F5' } $3F,
  410. { 75 VK_F6 'F6' } $40,
  411. { 76 VK_F7 'F7' } $41,
  412. { 77 VK_F8 'F8' } $42,
  413. { 78 VK_F9 'F9' } $43,
  414. { 79 VK_F10 'F10' } $44,
  415. { 7A VK_F11 'F11' } $57,
  416. { 7B VK_F12 'F12' } $58,
  417. { 7C VK_F13 } 0,
  418. { 7D VK_F14 } 0,
  419. { 7E VK_F15 } 0,
  420. { 7F VK_F16 } 0,
  421. { 80 VK_F17 } 0,
  422. { 81 VK_F18 } 0,
  423. { 82 VK_F19 } 0,
  424. { 83 VK_F20 } 0,
  425. { 84 VK_F21 } 0,
  426. { 85 VK_F22 } 0,
  427. { 86 VK_F23 } 0,
  428. { 87 VK_F24 } 0,
  429. { 88 unassigned } -2,
  430. { 89 VK_NUMLOCK } 0,
  431. { 8A VK_SCROLL } 0,
  432. { 8B unassigned } -2,
  433. { 8C unassigned } -2,
  434. { 8D unassigned } -2,
  435. { 8E unassigned } -2,
  436. { 8F unassigned } -2,
  437. { 90 unassigned } -2,
  438. { 91 unassigned } -2,
  439. { 92 unassigned } -2,
  440. { 93 unassigned } -2,
  441. { 94 unassigned } -2,
  442. { 95 unassigned } -2,
  443. { 96 unassigned } -2,
  444. { 97 unassigned } -2,
  445. { 98 unassigned } -2,
  446. { 99 unassigned } -2,
  447. { 9A unassigned } -2,
  448. { 9B unassigned } -2,
  449. { 9C unassigned } -2,
  450. { 9D unassigned } -2,
  451. { 9E unassigned } -2,
  452. { 9F unassigned } -2,
  453. { A0 unassigned } -2,
  454. { A1 unassigned } -2,
  455. { A2 unassigned } -2,
  456. { A3 unassigned } -2,
  457. { A4 unassigned } -2,
  458. { A5 unassigned } -2,
  459. { A6 unassigned } -2,
  460. { A7 unassigned } -2,
  461. { A8 unassigned } -2,
  462. { A9 unassigned } -2,
  463. { AA unassigned } -2,
  464. { AB unassigned } -2,
  465. { AC unassigned } -2,
  466. { AD unassigned } -2,
  467. { AE unassigned } -2,
  468. { AF unassigned } -2,
  469. { B0 unassigned } -2,
  470. { B1 unassigned } -2,
  471. { B2 unassigned } -2,
  472. { B3 unassigned } -2,
  473. { B4 unassigned } -2,
  474. { B5 unassigned } -2,
  475. { B6 unassigned } -2,
  476. { B7 unassigned } -2,
  477. { B8 unassigned } -2,
  478. { B9 unassigned } -2,
  479. { BA OEM specific } 0,
  480. { BB OEM specific } 0,
  481. { BC OEM specific } 0,
  482. { BD OEM specific } 0,
  483. { BE OEM specific } 0,
  484. { BF OEM specific } 0,
  485. { C0 OEM specific } 0,
  486. { C1 unassigned } -2,
  487. { C2 unassigned } -2,
  488. { C3 unassigned } -2,
  489. { C4 unassigned } -2,
  490. { C5 unassigned } -2,
  491. { C6 unassigned } -2,
  492. { C7 unassigned } -2,
  493. { C8 unassigned } -2,
  494. { C9 unassigned } -2,
  495. { CA unassigned } -2,
  496. { CB unassigned } -2,
  497. { CC unassigned } -2,
  498. { CD unassigned } -2,
  499. { CE unassigned } -2,
  500. { CF unassigned } -2,
  501. { D0 unassigned } -2,
  502. { D1 unassigned } -2,
  503. { D2 unassigned } -2,
  504. { D3 unassigned } -2,
  505. { D4 unassigned } -2,
  506. { D5 unassigned } -2,
  507. { D6 unassigned } -2,
  508. { D7 unassigned } -2,
  509. { D8 unassigned } -2,
  510. { D9 unassigned } -2,
  511. { DA unassigned } -2,
  512. { DB OEM specific } 0,
  513. { DC OEM specific } 0,
  514. { DD OEM specific } 0,
  515. { DE OEM specific } 0,
  516. { DF OEM specific } 0,
  517. { E0 OEM specific } 0,
  518. { E1 OEM specific } 0,
  519. { E2 OEM specific } 0,
  520. { E3 OEM specific } 0,
  521. { E4 OEM specific } 0,
  522. { E5 unassigned } -2,
  523. { E6 OEM specific } 0,
  524. { E7 unassigned } -2,
  525. { E8 unassigned } -2,
  526. { E9 OEM specific } 0,
  527. { EA OEM specific } 0,
  528. { EB OEM specific } 0,
  529. { EC OEM specific } 0,
  530. { ED OEM specific } 0,
  531. { EE OEM specific } 0,
  532. { EF OEM specific } 0,
  533. { F0 OEM specific } 0,
  534. { F1 OEM specific } 0,
  535. { F2 OEM specific } 0,
  536. { F3 OEM specific } 0,
  537. { F4 OEM specific } 0,
  538. { F5 OEM specific } 0,
  539. { F6 unassigned } -2,
  540. { F7 unassigned } -2,
  541. { F8 unassigned } -2,
  542. { F9 unassigned } -2,
  543. { FA unassigned } -2,
  544. { FB unassigned } -2,
  545. { FC unassigned } -2,
  546. { FD unassigned } -2,
  547. { FE unassigned } -2,
  548. { FF unassigned } -2
  549. );
  550. {$endif USEKEYCODES}
  551. type TTEntryT = packed record
  552. n,s,c,a : byte; {normal,shift, ctrl, alt, normal only for f11,f12}
  553. end;
  554. CONST
  555. DosTT : ARRAY [$3B..$58] OF TTEntryT =
  556. ((n : $3B; s : $54; c : $5E; a: $68), {3B F1}
  557. (n : $3C; s : $55; c : $5F; a: $69), {3C F2}
  558. (n : $3D; s : $56; c : $60; a: $6A), {3D F3}
  559. (n : $3E; s : $57; c : $61; a: $6B), {3E F4}
  560. (n : $3F; s : $58; c : $62; a: $6C), {3F F5}
  561. (n : $40; s : $59; c : $63; a: $6D), {40 F6}
  562. (n : $41; s : $5A; c : $64; a: $6E), {41 F7}
  563. (n : $42; s : $5B; c : $65; a: $6F), {42 F8}
  564. (n : $43; s : $5C; c : $66; a: $70), {43 F9}
  565. (n : $44; s : $5D; c : $67; a: $71), {44 F10}
  566. (n : $45; s : $00; c : $00; a: $00), {45 ???}
  567. (n : $46; s : $00; c : $00; a: $00), {46 ???}
  568. (n : $47; s : $47; c : $77; a: $97), {47 Home}
  569. (n : $48; s : $00; c : $8D; a: $98), {48 Up}
  570. (n : $49; s : $49; c : $84; a: $99), {49 PgUp}
  571. (n : $4A; s : $00; c : $8E; a: $4A), {4A -}
  572. (n : $4B; s : $4B; c : $73; a: $9B), {4B Left}
  573. (n : $4C; s : $00; c : $00; a: $00), {4C ???}
  574. (n : $4D; s : $4D; c : $74; a: $9D), {4D Right}
  575. (n : $4E; s : $00; c : $90; a: $4E), {4E +}
  576. (n : $4F; s : $4F; c : $75; a: $9F), {4F End}
  577. (n : $50; s : $50; c : $91; a: $A0), {50 Down}
  578. (n : $51; s : $51; c : $76; a: $A1), {51 PgDown}
  579. (n : $52; s : $52; c : $92; a: $A2), {52 Insert}
  580. (n : $53; s : $53; c : $93; a: $A3), {53 Del}
  581. (n : $54; s : $00; c : $00; a: $00), {54 ???}
  582. (n : $55; s : $00; c : $00; a: $00), {55 ???}
  583. (n : $56; s : $00; c : $00; a: $00), {56 ???}
  584. (n : $85; s : $87; c : $89; a: $8B), {57 F11}
  585. (n : $86; s : $88; c : $8A; a: $8C)); {58 F12}
  586. DosTT09 : ARRAY [$02..$0F] OF TTEntryT =
  587. ((n : $00; s : $00; c : $00; a: $78), {02 1 }
  588. (n : $00; s : $00; c : $00; a: $79), {03 2 }
  589. (n : $00; s : $00; c : $00; a: $7A), {04 3 }
  590. (n : $00; s : $00; c : $00; a: $7B), {05 4 }
  591. (n : $00; s : $00; c : $00; a: $7C), {06 5 }
  592. (n : $00; s : $00; c : $00; a: $7D), {07 6 }
  593. (n : $00; s : $00; c : $00; a: $7E), {08 7 }
  594. (n : $00; s : $00; c : $00; a: $7F), {09 8 }
  595. (n : $00; s : $00; c : $00; a: $80), {0A 9 }
  596. (n : $00; s : $00; c : $00; a: $81), {0B 0 }
  597. (n : $00; s : $00; c : $00; a: $82), {0C ß }
  598. (n : $00; s : $00; c : $00; a: $00), {0D}
  599. (n : $00; s : $09; c : $00; a: $00), {0E Backspace}
  600. (n : $00; s : $0F; c : $94; a: $00)); {0F Tab }
  601. function TranslateKey (t : TKeyEventRecord) : TKeyEvent;
  602. var key : TKeyEvent;
  603. ss : byte;
  604. {$ifdef USEKEYCODES}
  605. ScanCode : byte;
  606. {$endif USEKEYCODES}
  607. b : byte;
  608. begin
  609. Key := 0;
  610. if t.bKeyDown then
  611. begin
  612. { ascii-char is <> 0 if not a specal key }
  613. { we return it here otherwise we have to translate more later }
  614. if t.AsciiChar <> #0 then
  615. begin
  616. if (t.dwControlKeyState and ENHANCED_KEY <> 0) and
  617. (t.wVirtualKeyCode = $DF) then
  618. begin
  619. t.dwControlKeyState:=t.dwControlKeyState and not ENHANCED_KEY;
  620. t.wVirtualKeyCode:=VK_DIVIDE;
  621. t.AsciiChar:='/';
  622. end;
  623. {drivers needs scancode, we return it here as under dos and linux
  624. with $03000000 = the lowest two bytes is the physical representation}
  625. {$ifdef USEKEYCODES}
  626. Scancode:=KeyToQwertyScan[t.wVirtualKeyCode AND $00FF];
  627. If ScanCode>0 then
  628. t.wVirtualScanCode:=ScanCode;
  629. Key := byte (t.AsciiChar) + (t.wVirtualScanCode shl 8) + $03000000;
  630. ss := transShiftState (t.dwControlKeyState);
  631. key := key or (ss shl 16);
  632. if (ss and kbAlt <> 0) and rightistruealt(t.dwControlKeyState) then
  633. key := key and $FFFFFF00;
  634. {$else not USEKEYCODES}
  635. Key := byte (t.AsciiChar) + ((t.wVirtualScanCode AND $00FF) shl 8) + $03000000;
  636. {$endif not USEKEYCODES}
  637. end else
  638. begin
  639. {$ifdef USEKEYCODES}
  640. Scancode:=KeyToQwertyScan[t.wVirtualKeyCode AND $00FF];
  641. If ScanCode>0 then
  642. t.wVirtualScanCode:=ScanCode;
  643. {$endif not USEKEYCODES}
  644. translateKey := 0;
  645. { ignore shift,ctrl,alt,numlock,capslock alone }
  646. case t.wVirtualKeyCode of
  647. $0010, {shift}
  648. $0011, {ctrl}
  649. $0012, {alt}
  650. $0014, {capslock}
  651. $0090, {numlock}
  652. $0091, {scrollock}
  653. { This should be handled !! }
  654. { these last two are OEM specific
  655. this is not good !!! }
  656. $00DC, {^ : next key i.e. a is modified }
  657. { Strange on my keyboard this corresponds to double point over i or u PM }
  658. $00DD: exit; {´ and ` : next key i.e. e is modified }
  659. end;
  660. key := $03000000 + (t.wVirtualScanCode shl 8); { make lower 8 bit=0 like under dos }
  661. end;
  662. { Handling of ~ key as AltGr 2 }
  663. { This is also French keyboard specific !! }
  664. { but without this I can not get a ~ !! PM }
  665. { MvdV: not rightruealtised, since it already has frenchkbd guard}
  666. if (t.wVirtualKeyCode=$32) and
  667. (KeyBoardLayout = FrenchKeyboard) and
  668. (t.dwControlKeyState and RIGHT_ALT_PRESSED <> 0) then
  669. key:=(key and $ffffff00) or ord('~');
  670. { ok, now add Shift-State }
  671. ss := transShiftState (t.dwControlKeyState);
  672. key := key or (ss shl 16);
  673. { Reset Ascii-Char if Alt+Key, fv needs that, may be we
  674. need it for other special keys too
  675. 18 Sept 1999 AD: not for right Alt i.e. for AltGr+ß = \ on german keyboard }
  676. if ((ss and kbAlt <> 0) and rightistruealt(t.dwControlKeyState)) or
  677. (*
  678. { yes, we need it for cursor keys, 25=left, 26=up, 27=right,28=down}
  679. {aggg, this will not work because esc is also virtualKeyCode 27!!}
  680. {if (t.wVirtualKeyCode >= 25) and (t.wVirtualKeyCode <= 28) then}
  681. no VK_ESCAPE is $1B !!
  682. there was a mistake :
  683. VK_LEFT is $25 not 25 !! *)
  684. { not $2E VK_DELETE because its only the Keypad point !! PM }
  685. (t.wVirtualKeyCode in [$21..$28,$2C,$2D,$2F]) then
  686. { if t.wVirtualScanCode in [$47..$49,$4b,$4d,$4f,$50..$53] then}
  687. key := key and $FFFFFF00;
  688. {and translate to dos-scancodes to make fv happy, we will convert this
  689. back in translateKeyEvent}
  690. if rightistruealt(t.dwControlKeyState) then {not for alt-gr}
  691. if (t.wVirtualScanCode >= low (DosTT)) and
  692. (t.wVirtualScanCode <= high (dosTT)) then
  693. begin
  694. b := 0;
  695. if (ss and kbAlt) <> 0 then
  696. b := DosTT[t.wVirtualScanCode].a
  697. else
  698. if (ss and kbCtrl) <> 0 then
  699. b := DosTT[t.wVirtualScanCode].c
  700. else
  701. if (ss and kbShift) <> 0 then
  702. b := DosTT[t.wVirtualScanCode].s
  703. else
  704. b := DosTT[t.wVirtualScanCode].n;
  705. if b <> 0 then
  706. key := (key and $FFFF00FF) or (cardinal (b) shl 8);
  707. end;
  708. {Alt-0 to Alt-9}
  709. if rightistruealt(t.dwControlKeyState) then {not for alt-gr}
  710. if (t.wVirtualScanCode >= low (DosTT09)) and
  711. (t.wVirtualScanCode <= high (dosTT09)) then
  712. begin
  713. b := 0;
  714. if (ss and kbAlt) <> 0 then
  715. b := DosTT09[t.wVirtualScanCode].a
  716. else
  717. if (ss and kbCtrl) <> 0 then
  718. b := DosTT09[t.wVirtualScanCode].c
  719. else
  720. if (ss and kbShift) <> 0 then
  721. b := DosTT09[t.wVirtualScanCode].s
  722. else
  723. b := DosTT09[t.wVirtualScanCode].n;
  724. if b <> 0 then
  725. key := (key and $FFFF0000) or (cardinal (b) shl 8);
  726. end;
  727. TranslateKey := key;
  728. end;
  729. translateKey := Key;
  730. end;
  731. function SysGetKeyEvent: TKeyEvent;
  732. var t : TKeyEventRecord;
  733. key : TKeyEvent;
  734. begin
  735. key := 0;
  736. repeat
  737. if getKeyEventFromQueueWait (t) then
  738. key := translateKey (t);
  739. until key <> 0;
  740. {$ifdef DEBUG}
  741. last_ir.Event.KeyEvent:=t;
  742. {$endif DEBUG}
  743. SysGetKeyEvent := key;
  744. end;
  745. function SysPollKeyEvent: TKeyEvent;
  746. var t : TKeyEventRecord;
  747. k : TKeyEvent;
  748. begin
  749. SysPollKeyEvent := 0;
  750. if getKeyEventFromQueue (t, true) then
  751. begin
  752. { we get an enty for shift, ctrl, alt... }
  753. k := translateKey (t);
  754. while (k = 0) do
  755. begin
  756. getKeyEventFromQueue (t, false); {remove it}
  757. if not getKeyEventFromQueue (t, true) then exit;
  758. k := translateKey (t)
  759. end;
  760. SysPollKeyEvent := k;
  761. end;
  762. end;
  763. function SysTranslateKeyEvent(KeyEvent: TKeyEvent): TKeyEvent;
  764. begin
  765. if KeyEvent and $03000000 = $03000000 then
  766. begin
  767. if KeyEvent and $000000FF <> 0 then
  768. begin
  769. SysTranslateKeyEvent := KeyEvent and $00FFFFFF;
  770. exit;
  771. end;
  772. {translate function-keys and other specials, ascii-codes are already ok}
  773. case (KeyEvent AND $0000FF00) shr 8 of
  774. {F1..F10}
  775. $3B..$44 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $3B + $02000000;
  776. {F11,F12}
  777. $85..$86 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $85 + $02000000;
  778. {Shift F1..F10}
  779. $54..$5D : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $54 + $02000000;
  780. {Shift F11,F12}
  781. $87..$88 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $87 + $02000000;
  782. {Alt F1..F10}
  783. $68..$71 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $68 + $02000000;
  784. {Alt F11,F12}
  785. $8B..$8C : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $8B + $02000000;
  786. {Ctrl F1..F10}
  787. $5E..$67 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF1 + ((KeyEvent AND $0000FF00) SHR 8) - $5E + $02000000;
  788. {Ctrl F11,F12}
  789. $89..$8A : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdF11 + ((KeyEvent AND $0000FF00) SHR 8) - $89 + $02000000;
  790. {normal,ctrl,alt}
  791. $47,$77,$97 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdHome + $02000000;
  792. $48,$8D,$98 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdUp + $02000000;
  793. $49,$84,$99 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdPgUp + $02000000;
  794. $4b,$73,$9B : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdLeft + $02000000;
  795. $4d,$74,$9D : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdRight + $02000000;
  796. $4f,$75,$9F : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdEnd + $02000000;
  797. $50,$91,$A0 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdDown + $02000000;
  798. $51,$76,$A1 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdPgDn + $02000000;
  799. $52,$92,$A2 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdInsert + $02000000;
  800. $53,$93,$A3 : SysTranslateKeyEvent := (KeyEvent AND $FCFF0000) + kbdDelete + $02000000;
  801. else
  802. SysTranslateKeyEvent := KeyEvent;
  803. end;
  804. end else
  805. SysTranslateKeyEvent := KeyEvent;
  806. end;
  807. function SysGetShiftState: Byte;
  808. begin
  809. {may be better to save the last state and return that if no key is in buffer???}
  810. SysGetShiftState:= lastShiftState;
  811. end;
  812. Const
  813. SysKeyboardDriver : TKeyboardDriver = (
  814. InitDriver : @SysInitKeyBoard;
  815. DoneDriver : @SysDoneKeyBoard;
  816. GetKeyevent : @SysGetKeyEvent;
  817. PollKeyEvent : @SysPollKeyEvent;
  818. GetShiftState : @SysGetShiftState;
  819. TranslateKeyEvent : @SysTranslateKeyEvent;
  820. TranslateKeyEventUnicode : Nil;
  821. );
  822. begin
  823. SetKeyBoardDriver(SysKeyBoardDriver);
  824. end.