crt.pp 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by the Free Pascal development team.
  5. Borland Pascal 7 Compatible CRT Unit - win32 implentation
  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 crt;
  13. interface
  14. {$i crth.inc}
  15. procedure Window32(X1,Y1,X2,Y2: DWord);
  16. procedure GotoXY32(X,Y: DWord);
  17. function WhereX32: DWord;
  18. function WhereY32: DWord;
  19. implementation
  20. uses
  21. windows;
  22. var
  23. SaveCursorSize: Longint;
  24. {
  25. definition of textrec is in textrec.inc
  26. }
  27. {$i textrec.inc}
  28. {****************************************************************************
  29. Low level Routines
  30. ****************************************************************************}
  31. procedure TurnMouseOff;
  32. var Mode: DWORD;
  33. begin
  34. if GetConsoleMode(GetStdHandle(STD_INPUT_HANDLE), @Mode) then begin { Turn the mouse-cursor off }
  35. Mode := Mode AND cardinal(NOT enable_processed_input)
  36. AND cardinal(NOT enable_mouse_input);
  37. SetConsoleMode(GetStdHandle(STD_INPUT_HANDLE), Mode);
  38. end; { if }
  39. end; { proc. TurnMouseOff }
  40. function GetScreenHeight : DWord;
  41. var
  42. ConsoleInfo: TConsoleScreenBufferinfo;
  43. begin
  44. if (not GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), ConsoleInfo)) then begin
  45. {$ifdef SYSTEMDEBUG}
  46. Writeln(stderr,'GetScreenHeight failed GetLastError returns ',GetLastError);
  47. Halt(1);
  48. {$endif SYSTEMDEBUG}
  49. // ts: this is really silly assumption; imho better: issue a halt
  50. GetScreenHeight:=25;
  51. end else
  52. GetScreenHeight := ConsoleInfo.dwSize.Y;
  53. end; { func. GetScreenHeight }
  54. function GetScreenWidth : DWord;
  55. var
  56. ConsoleInfo: TConsoleScreenBufferInfo;
  57. begin
  58. if (not GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), ConsoleInfo)) then begin
  59. {$ifdef SYSTEMDEBUG}
  60. Writeln(stderr,'GetScreenWidth failed GetLastError returns ',GetLastError);
  61. Halt(1);
  62. {$endif SYSTEMDEBUG}
  63. // ts: this is really silly assumption; imho better: issue a halt
  64. GetScreenWidth:=80;
  65. end else
  66. GetScreenWidth := ConsoleInfo.dwSize.X;
  67. end; { func. GetScreenWidth }
  68. procedure GetScreenCursor(var x : DWord; var y : DWord);
  69. var
  70. ConsoleInfo : TConsoleScreenBufferInfo;
  71. begin
  72. FillChar(ConsoleInfo, SizeOf(ConsoleInfo), 0);
  73. GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), ConsoleInfo);
  74. X := ConsoleInfo.dwCursorPosition.X + 1;
  75. Y := ConsoleInfo.dwCursorPosition.Y + 1;
  76. end;
  77. procedure SetScreenCursor(x,y : DWord);
  78. var
  79. CurInfo: TCoord;
  80. begin
  81. FillChar(Curinfo, SizeOf(Curinfo), 0);
  82. CurInfo.X := X - 1;
  83. CurInfo.Y := Y - 1;
  84. SetConsoleCursorPosition(GetStdHandle(STD_OUTPUT_HANDLE), CurInfo);
  85. end;
  86. {****************************************************************************
  87. Public Crt Functions
  88. ****************************************************************************}
  89. procedure textmode(mode : integer);
  90. begin
  91. {!!! Not done yet !!! }
  92. end;
  93. Procedure TextColor(Color: Byte);
  94. { Switch foregroundcolor }
  95. Begin
  96. TextAttr:=(Color and $8f) or (TextAttr and $70);
  97. End;
  98. Procedure TextBackground(Color: Byte);
  99. { Switch backgroundcolor }
  100. Begin
  101. TextAttr:=((Color shl 4) and ($f0 and not Blink)) or (TextAttr and ($0f OR Blink) );
  102. End;
  103. Procedure HighVideo;
  104. { Set highlighted output. }
  105. Begin
  106. TextColor(TextAttr Or $08);
  107. End;
  108. Procedure LowVideo;
  109. { Set normal output }
  110. Begin
  111. TextColor(TextAttr And $77);
  112. End;
  113. Procedure NormVideo;
  114. { Set normal back and foregroundcolors. }
  115. Begin
  116. TextColor(7);
  117. TextBackGround(0);
  118. End;
  119. Procedure GotoXY(X: Byte; Y: Byte);
  120. begin
  121. GotoXY32(X,Y);
  122. end;
  123. Procedure GotoXY32(X: DWord; Y: DWord);
  124. { Go to coordinates X,Y in the current window. }
  125. Begin
  126. If (X > 0) and (X <= (WindMaxX - WindMinX + 1)) and
  127. (Y > 0) and (Y <= (WindMaxY - WindMinY + 1)) Then Begin
  128. Inc(X, WindMinX - 1);
  129. Inc(Y, WindMinY - 1);
  130. SetScreenCursor(x,y);
  131. End;
  132. End;
  133. Procedure Window(X1, Y1, X2, Y2: Byte);
  134. begin
  135. Window32(X1,Y1,X2,Y2);
  136. end;
  137. Procedure Window32(X1, Y1, X2, Y2: DWord);
  138. {
  139. Set screen window to the specified coordinates.
  140. }
  141. Begin
  142. if (X1 > X2) or (X2 > GetScreenWidth) or
  143. (Y1 > Y2) or (Y2 > GetScreenHeight) then
  144. exit;
  145. WindMinY := Y1;
  146. WindMaxY := Y2;
  147. WindMinX := X1;
  148. WindMaxX := X2;
  149. WindMin:=((Y1-1) Shl 8)+(X1-1);
  150. WindMax:=((Y2-1) Shl 8)+(X2-1);
  151. GotoXY(1, 1);
  152. End;
  153. procedure ClrScr;
  154. var
  155. DestCoor: TCoord;
  156. numChars, x : DWord;
  157. begin
  158. DestCoor.X := WindMinX - 1;
  159. DestCoor.Y := WindMinY - 1;
  160. numChars := (WindMaxX - WindMinX + 1) * (WindMaxY - WindMinY + 1);
  161. FillConsoleOutputAttribute(GetStdHandle(STD_OUTPUT_HANDLE), TextAttr,
  162. numChars, DestCoor, x);
  163. FillConsoleOutputCharacter(GetStdHandle(STD_OUTPUT_HANDLE), #32,
  164. numChars, DestCoor, x);
  165. GotoXY(1, 1);
  166. end; { proc. ClrScr }
  167. procedure ClrEol;
  168. {
  169. Clear from current position to end of line.
  170. }
  171. var
  172. Temp: DWord;
  173. CharInfo: Char;
  174. Coord: TCoord;
  175. X,Y: DWord;
  176. begin
  177. GetScreenCursor(x, y);
  178. CharInfo := #32;
  179. Coord.X := X - 1;
  180. Coord.Y := Y - 1;
  181. FillConsoleOutputCharacter(GetStdHandle(STD_OUTPUT_HANDLE), CharInfo, WindMaxX - X + 1,
  182. Coord, @Temp);
  183. FillConsoleOutputAttribute(GetStdHandle(STD_OUTPUT_HANDLE), TextAttr, WindMaxX - X + 1,
  184. Coord, @Temp);
  185. end;
  186. Function WhereX: Byte;
  187. begin
  188. WhereX:=WhereX32 mod 256;
  189. end;
  190. Function WhereX32: DWord;
  191. {
  192. Return current X-position of cursor.
  193. }
  194. var
  195. x,y : DWord;
  196. Begin
  197. GetScreenCursor(x, y);
  198. WhereX32:= x - WindMinX +1;
  199. End;
  200. Function WhereY: Byte;
  201. begin
  202. WhereY:=WhereY32 mod 256;
  203. end;
  204. Function WhereY32: DWord;
  205. {
  206. Return current Y-position of cursor.
  207. }
  208. var
  209. x, y : DWord;
  210. Begin
  211. GetScreenCursor(x, y);
  212. WhereY32:= y - WindMinY + 1;
  213. End;
  214. {*************************************************************************
  215. KeyBoard
  216. *************************************************************************}
  217. var
  218. ScanCode : char;
  219. SpecialKey : boolean;
  220. DoingNumChars: Boolean;
  221. DoingNumCode: Byte;
  222. Function RemapScanCode (ScanCode: byte; CtrlKeyState: byte; keycode:longint): byte;
  223. { Several remappings of scancodes are necessary to comply with what
  224. we get with MSDOS. Special Windows keys, as Alt-Tab, Ctrl-Esc etc.
  225. are excluded }
  226. var
  227. AltKey, CtrlKey, ShiftKey: boolean;
  228. const
  229. {
  230. Keypad key scancodes:
  231. Ctrl Norm
  232. $77 $47 - Home
  233. $8D $48 - Up arrow
  234. $84 $49 - PgUp
  235. $8E $4A - -
  236. $73 $4B - Left Arrow
  237. $8F $4C - 5
  238. $74 $4D - Right arrow
  239. $4E $4E - +
  240. $75 $4F - End
  241. $91 $50 - Down arrow
  242. $76 $51 - PgDn
  243. $92 $52 - Ins
  244. $93 $53 - Del
  245. }
  246. CtrlKeypadKeys: array[$47..$53] of byte =
  247. ($77, $8D, $84, $8E, $73, $8F, $74, $4E, $75, $91, $76, $92, $93);
  248. begin
  249. AltKey := ((CtrlKeyState AND
  250. (RIGHT_ALT_PRESSED OR LEFT_ALT_PRESSED)) > 0);
  251. CtrlKey := ((CtrlKeyState AND
  252. (RIGHT_CTRL_PRESSED OR LEFT_CTRL_PRESSED)) > 0);
  253. ShiftKey := ((CtrlKeyState AND SHIFT_PRESSED) > 0);
  254. if AltKey then
  255. begin
  256. case ScanCode of
  257. // Digits, -, =
  258. $02..$0D: inc(ScanCode, $76);
  259. // Function keys
  260. $3B..$44: inc(Scancode, $2D);
  261. $57..$58: inc(Scancode, $34);
  262. // Extended cursor block keys
  263. $47..$49, $4B, $4D, $4F..$53:
  264. inc(Scancode, $50);
  265. // Other keys
  266. $1C: Scancode := $A6; // Enter
  267. $35: Scancode := $A4; // / (keypad and normal!)
  268. end
  269. end
  270. else if CtrlKey then
  271. case Scancode of
  272. // Tab key
  273. $0F: Scancode := $94;
  274. // Function keys
  275. $3B..$44: inc(Scancode, $23);
  276. $57..$58: inc(Scancode, $32);
  277. // Keypad keys
  278. $35: Scancode := $95; // \
  279. $37: Scancode := $96; // *
  280. $47..$53: Scancode := CtrlKeypadKeys[Scancode];
  281. end
  282. else if ShiftKey then
  283. case Scancode of
  284. // Function keys
  285. $3B..$44: inc(Scancode, $19);
  286. $57..$58: inc(Scancode, $30);
  287. end
  288. else
  289. case Scancode of
  290. // Function keys
  291. $57..$58: inc(Scancode, $2E); // F11 and F12
  292. end;
  293. RemapScanCode := ScanCode;
  294. end;
  295. function KeyPressed : boolean;
  296. var
  297. nevents,nread : dword;
  298. buf : TINPUTRECORD;
  299. AltKey: Boolean;
  300. c : longint;
  301. begin
  302. KeyPressed := FALSE;
  303. if ScanCode <> #0 then
  304. KeyPressed := TRUE
  305. else
  306. begin
  307. GetNumberOfConsoleInputEvents(TextRec(input).Handle,nevents);
  308. while nevents>0 do
  309. begin
  310. ReadConsoleInputA(TextRec(input).Handle,buf,1,nread);
  311. if buf.EventType = KEY_EVENT then
  312. if buf.Event.KeyEvent.bKeyDown then
  313. begin
  314. { Alt key is VK_MENU }
  315. { Capslock key is VK_CAPITAL }
  316. AltKey := ((Buf.Event.KeyEvent.dwControlKeyState AND
  317. (RIGHT_ALT_PRESSED OR LEFT_ALT_PRESSED)) > 0);
  318. if not(Buf.Event.KeyEvent.wVirtualKeyCode in [VK_SHIFT, VK_MENU, VK_CONTROL,
  319. VK_CAPITAL, VK_NUMLOCK,
  320. VK_SCROLL]) then
  321. begin
  322. keypressed:=true;
  323. if (ord(buf.Event.KeyEvent.AsciiChar) = 0) or
  324. (buf.Event.KeyEvent.dwControlKeyState and (LEFT_ALT_PRESSED or ENHANCED_KEY) > 0) then
  325. begin
  326. SpecialKey := TRUE;
  327. ScanCode := Chr(RemapScanCode(Buf.Event.KeyEvent.wVirtualScanCode, Buf.Event.KeyEvent.dwControlKeyState,
  328. Buf.Event.KeyEvent.wVirtualKeyCode));
  329. end
  330. else
  331. begin
  332. { Map shift-tab }
  333. if (buf.Event.KeyEvent.AsciiChar=#9) and
  334. (buf.Event.KeyEvent.dwControlKeyState and SHIFT_PRESSED > 0) then
  335. begin
  336. SpecialKey := TRUE;
  337. ScanCode := #15;
  338. end
  339. else
  340. begin
  341. SpecialKey := FALSE;
  342. ScanCode := Chr(Ord(buf.Event.KeyEvent.AsciiChar));
  343. end;
  344. end;
  345. if AltKey then
  346. begin
  347. case Buf.Event.KeyEvent.wVirtualScanCode of
  348. 71 : c:=7;
  349. 72 : c:=8;
  350. 73 : c:=9;
  351. 75 : c:=4;
  352. 76 : c:=5;
  353. 77 : c:=6;
  354. 79 : c:=1;
  355. 80 : c:=2;
  356. 81 : c:=3;
  357. 82 : c:=0;
  358. else
  359. break;
  360. end;
  361. DoingNumChars := true;
  362. DoingNumCode := Byte((DoingNumCode * 10) + c);
  363. Keypressed := false;
  364. Specialkey := false;
  365. ScanCode := #0;
  366. end
  367. else
  368. break;
  369. end;
  370. end
  371. else
  372. begin
  373. if (Buf.Event.KeyEvent.wVirtualKeyCode in [VK_MENU]) then
  374. if DoingNumChars then
  375. if DoingNumCode > 0 then
  376. begin
  377. ScanCode := Chr(DoingNumCode);
  378. Keypressed := true;
  379. DoingNumChars := false;
  380. DoingNumCode := 0;
  381. break
  382. end; { if }
  383. end;
  384. { if we got a key then we can exit }
  385. if keypressed then
  386. exit;
  387. GetNumberOfConsoleInputEvents(TextRec(input).Handle,nevents);
  388. end;
  389. end;
  390. end;
  391. function ReadKey: char;
  392. begin
  393. while (not KeyPressed) do
  394. Sleep(1);
  395. if SpecialKey then begin
  396. ReadKey := #0;
  397. SpecialKey := FALSE;
  398. end else begin
  399. ReadKey := ScanCode;
  400. ScanCode := #0;
  401. end;
  402. end;
  403. {*************************************************************************
  404. Delay
  405. *************************************************************************}
  406. procedure Delay(MS: Word);
  407. begin
  408. Sleep(ms);
  409. end; { proc. Delay }
  410. procedure sound(hz : word);
  411. begin
  412. MessageBeep(0); { lame ;-) }
  413. end;
  414. procedure nosound;
  415. begin
  416. end;
  417. {****************************************************************************
  418. HighLevel Crt Functions
  419. ****************************************************************************}
  420. procedure removeline(y : DWord);
  421. var
  422. ClipRect: TSmallRect;
  423. SrcRect: TSmallRect;
  424. DestCoor: TCoord;
  425. CharInfo: TCharInfo;
  426. begin
  427. CharInfo.UnicodeChar := #32;
  428. CharInfo.Attributes := TextAttr;
  429. Y := (WindMinY - 1) + (Y - 1) + 1;
  430. SrcRect.Top := Y;
  431. SrcRect.Left := WindMinX - 1;
  432. SrcRect.Right := WindMaxX - 1;
  433. SrcRect.Bottom := WindMaxY - 1;
  434. DestCoor.X := WindMinX - 1;
  435. DestCoor.Y := Y - 1;
  436. ClipRect := SrcRect;
  437. cliprect.top := destcoor.y;
  438. ScrollConsoleScreenBuffer(GetStdHandle(STD_OUTPUT_HANDLE), SrcRect, ClipRect,
  439. DestCoor, CharInfo);
  440. end; { proc. RemoveLine }
  441. procedure delline;
  442. begin
  443. removeline(wherey);
  444. end; { proc. DelLine }
  445. procedure insline;
  446. var
  447. ClipRect: TSmallRect;
  448. SrcRect: TSmallRect;
  449. DestCoor: TCoord;
  450. CharInfo: TCharInfo;
  451. X,Y: DWord;
  452. begin
  453. GetScreenCursor(X, Y);
  454. CharInfo.UnicodeChar := #32;
  455. CharInfo.Attributes := TextAttr;
  456. SrcRect.Top := Y - 1;
  457. SrcRect.Left := WindMinX - 1;
  458. SrcRect.Right := WindMaxX - 1;
  459. SrcRect.Bottom := WindMaxY - 1 + 1;
  460. DestCoor.X := WindMinX - 1;
  461. DestCoor.Y := Y;
  462. ClipRect := SrcRect;
  463. ClipRect.Bottom := WindMaxY - 1;
  464. ScrollConsoleScreenBuffer(GetStdHandle(STD_OUTPUT_HANDLE), SrcRect, ClipRect,
  465. DestCoor, CharInfo);
  466. end; { proc. InsLine }
  467. {****************************************************************************
  468. Extra Crt Functions
  469. ****************************************************************************}
  470. procedure cursoron;
  471. var CursorInfo: TConsoleCursorInfo;
  472. begin
  473. GetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
  474. CursorInfo.dwSize := SaveCursorSize;
  475. CursorInfo.bVisible := true;
  476. SetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
  477. end;
  478. procedure cursoroff;
  479. var CursorInfo: TConsoleCursorInfo;
  480. begin
  481. GetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
  482. CursorInfo.bVisible := false;
  483. SetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
  484. end;
  485. procedure cursorbig;
  486. var CursorInfo: TConsoleCursorInfo;
  487. begin
  488. GetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
  489. CursorInfo.dwSize := 100;
  490. CursorInfo.bVisible := true;
  491. SetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
  492. end;
  493. {*****************************************************************************
  494. Read and Write routines
  495. *****************************************************************************}
  496. var
  497. CurrX, CurrY : DWord;
  498. procedure WriteChar(c : char);
  499. var
  500. WritePos: Coord; { Upper-left cell to write from }
  501. numWritten : DWord;
  502. WinAttr : word;
  503. begin
  504. Case C of
  505. #10 : begin
  506. Inc(CurrY);
  507. end;
  508. #13 : begin
  509. CurrX := WindMinX;
  510. end; { if }
  511. #08 : begin
  512. if CurrX > WindMinX then Dec(CurrX);
  513. end; { ^H }
  514. #07 : begin
  515. //MessagBeep(0);
  516. end; { ^G }
  517. else begin
  518. WritePos.X := currX - 1;
  519. WritePos.Y := currY - 1;
  520. WriteConsoleOutputCharacter(GetStdhandle(STD_OUTPUT_HANDLE),
  521. @c, 1, writePos, numWritten);
  522. WinAttr:=TextAttr;
  523. WriteConsoleOutputAttribute(GetStdhandle(STD_OUTPUT_HANDLE),
  524. @WinAttr, 1, writePos, numWritten);
  525. Inc(CurrX);
  526. end; { else }
  527. end; { case }
  528. if CurrX > WindMaxX then begin
  529. CurrX := WindMinX;
  530. Inc(CurrY);
  531. end; { if }
  532. While CurrY > WindMaxY do begin
  533. RemoveLine(1);
  534. Dec(CurrY);
  535. end; { while }
  536. end;
  537. Function CrtWrite(var f : textrec) : integer;
  538. var
  539. i : longint;
  540. begin
  541. GetScreenCursor(CurrX, CurrY);
  542. for i:=0 to f.bufpos-1 do
  543. WriteChar(f.buffer[i]);
  544. SetScreenCursor(CurrX, CurrY);
  545. f.bufpos:=0;
  546. CrtWrite:=0;
  547. end;
  548. Function CrtRead(Var F: TextRec): Integer;
  549. procedure BackSpace;
  550. begin
  551. if (f.bufpos>0) and (f.bufpos=f.bufend) then begin
  552. WriteChar(#8);
  553. WriteChar(' ');
  554. WriteChar(#8);
  555. dec(f.bufpos);
  556. dec(f.bufend);
  557. end;
  558. end;
  559. var
  560. ch : Char;
  561. Begin
  562. GetScreenCursor(CurrX,CurrY);
  563. f.bufpos:=0;
  564. f.bufend:=0;
  565. repeat
  566. if f.bufpos>f.bufend then
  567. f.bufend:=f.bufpos;
  568. SetScreenCursor(CurrX,CurrY);
  569. ch:=readkey;
  570. case ch of
  571. #0 : case readkey of
  572. #71 : while f.bufpos>0 do begin
  573. dec(f.bufpos);
  574. WriteChar(#8);
  575. end;
  576. #75 : if f.bufpos>0 then begin
  577. dec(f.bufpos);
  578. WriteChar(#8);
  579. end;
  580. #77 : if f.bufpos<f.bufend then begin
  581. WriteChar(f.bufptr^[f.bufpos]);
  582. inc(f.bufpos);
  583. end;
  584. #79 : while f.bufpos<f.bufend do begin
  585. WriteChar(f.bufptr^[f.bufpos]);
  586. inc(f.bufpos);
  587. end;
  588. #28: begin // numpad enter
  589. WriteChar(#13);
  590. WriteChar(#10);
  591. f.bufptr^[f.bufend]:=#13;
  592. f.bufptr^[f.bufend+1]:=#10;
  593. inc(f.bufend,2);
  594. break;
  595. end;
  596. #53: begin
  597. ch:='/';
  598. if f.bufpos<f.bufsize-2 then begin
  599. f.buffer[f.bufpos]:=ch;
  600. inc(f.bufpos);
  601. WriteChar(ch);
  602. end;
  603. end;
  604. end;
  605. ^S,
  606. #8 : BackSpace;
  607. ^Y,
  608. #27 : begin
  609. while f.bufpos<f.bufend do begin
  610. WriteChar(f.bufptr^[f.bufpos]);
  611. inc(f.bufpos);
  612. end;
  613. while f.bufend>0 do
  614. BackSpace;
  615. end;
  616. #13 : begin
  617. WriteChar(#13);
  618. WriteChar(#10);
  619. f.bufptr^[f.bufend]:=#13;
  620. f.bufptr^[f.bufend+1]:=#10;
  621. inc(f.bufend,2);
  622. break;
  623. end;
  624. #26 : if CheckEOF then begin
  625. f.bufptr^[f.bufend]:=#26;
  626. inc(f.bufend);
  627. break;
  628. end;
  629. else begin
  630. if f.bufpos<f.bufsize-2 then begin
  631. f.buffer[f.bufpos]:=ch;
  632. inc(f.bufpos);
  633. WriteChar(ch);
  634. end;
  635. end;
  636. end;
  637. until false;
  638. f.bufpos:=0;
  639. SetScreenCursor(CurrX, CurrY);
  640. CrtRead:=0;
  641. End;
  642. Function CrtReturn(Var F:TextRec):Integer;
  643. Begin
  644. CrtReturn:=0;
  645. end;
  646. Function CrtClose(Var F: TextRec): Integer;
  647. Begin
  648. F.Mode:=fmClosed;
  649. CrtClose:=0;
  650. End;
  651. Function CrtOpen(Var F: TextRec): Integer;
  652. Begin
  653. If F.Mode=fmOutput Then begin
  654. TextRec(F).InOutFunc:=@CrtWrite;
  655. TextRec(F).FlushFunc:=@CrtWrite;
  656. end Else begin
  657. F.Mode:=fmInput;
  658. TextRec(F).InOutFunc:=@CrtRead;
  659. TextRec(F).FlushFunc:=@CrtReturn;
  660. end;
  661. TextRec(F).CloseFunc:=@CrtClose;
  662. CrtOpen:=0;
  663. End;
  664. procedure AssignCrt(var F: Text);
  665. begin
  666. Assign(F,'');
  667. TextRec(F).OpenFunc:=@CrtOpen;
  668. end;
  669. var
  670. CursorInfo : TConsoleCursorInfo;
  671. ConsoleInfo : TConsoleScreenBufferinfo;
  672. // ts
  673. begin
  674. { Initialize the output handles }
  675. LastMode := 3;
  676. SetActiveWindow(0);
  677. {--------------------- Get the cursor size and such -----------------------}
  678. FillChar(CursorInfo, SizeOf(CursorInfo), 00);
  679. GetConsoleCursorInfo(GetStdHandle(STD_OUTPUT_HANDLE), CursorInfo);
  680. SaveCursorSize := CursorInfo.dwSize;
  681. {------------------ Get the current cursor position and attr --------------}
  682. FillChar(ConsoleInfo, SizeOf(ConsoleInfo), 0);
  683. GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), ConsoleInfo);
  684. TextAttr := ConsoleInfo.wAttributes;
  685. { Not required, the dos crt does also not touch the mouse }
  686. {TurnMouseOff;}
  687. WindMinX := (ConsoleInfo.srWindow.Left) + 1;
  688. WindMinY := (ConsoleInfo.srWindow.Top) + 1;
  689. WindMaxX := (ConsoleInfo.srWindow.Right) + 1;
  690. WindMaxY := (ConsoleInfo.srWindow.Bottom) + 1;
  691. DoingNumChars := false;
  692. DoingNumCode := 0;
  693. { Redirect the standard output }
  694. AssignCrt(Output);
  695. Rewrite(Output);
  696. TextRec(Output).Handle:= GetStdHandle(STD_OUTPUT_HANDLE);
  697. AssignCrt(Input);
  698. Reset(Input);
  699. TextRec(Input).Handle:= GetStdHandle(STD_INPUT_HANDLE);
  700. end. { unit Crt }
  701. {
  702. $Log$
  703. Revision 1.22 2004-05-02 13:05:39 marco
  704. * Fixes for numeric keypad enter and /
  705. Revision 1.21 2004/02/08 16:22:20 michael
  706. + Moved CRT interface to common include file
  707. Revision 1.20 2003/11/03 09:42:28 marco
  708. * Peter's Cardinal<->Longint fixes patch
  709. Revision 1.19 2002/12/15 20:23:30 peter
  710. * fix empty string in readln when not at end of string
  711. * fix alt-xyz in readkey
  712. Revision 1.18 2002/10/06 20:00:22 peter
  713. * Use Widechar in the Windows unit
  714. Revision 1.17 2002/09/07 16:01:28 peter
  715. * old logs removed and tabs fixed
  716. Revision 1.16 2002/01/19 11:56:34 peter
  717. * fixed clrscr for small windows
  718. * no turnoffmouse
  719. }