crt.pp 22 KB

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