keyboard.pp 29 KB

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