keyboard.pp 29 KB

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