// Copyright (c) Ivan Bondarev, Stanislav Mihalkovich (for details please see \doc\copyright.txt) // This code is distributed under the GNU LGPL (for details please see \doc\license.txt) /// /// Модуль для работы с консолью /// unit CRT; {$apptype console} {$gendoc true} interface uses System; const Black = 0; Blue = 1; Green = 2; Cyan = 3; Red = 4; Magenta = 5; Brown = 6; LightGray = 7; DarkGray = 8; LightBlue = 9; LightGreen = 10; LightCyan = 11; LightRed = 12; LightMagenta = 13; Yellow = 14; White = 15; /// /// Задает заголовок консольного окна /// /// Заголовок консольного окна procedure SetWindowTitle(s: string); /// /// Задает заголовок консольного окна /// /// Заголовок консольного окна procedure SetWindowCaption(s: string); /// /// Показывает курсор если он скрыт /// procedure ShowCursor; /// /// Скрывает курсор /// procedure HideCursor; /// /// Считыват нажатую клавишу /// function ReadKey: char; /// /// Возвращает true если была нажата клавиша. Считать символ можно спомощью функции ReadKey /// function KeyPressed: boolean; /// /// Возвращает высоту экрана /// function WindowWidth: integer; /// /// Возвращает ширину экрана /// /// function WindowHeight: integer; /// /// Возвращает Х-координату курсора /// function WhereX: integer; /// /// Возвращает Y-координату курсора /// function WhereY: integer; /// /// Переводит курсор в координаты (x,y) /// procedure GotoXY(x, y: integer); procedure Window(x, y, w, h: integer); /// /// Задает размеры консольного окна /// /// Ширина /// Высота procedure SetWindowSize(w, h: integer); procedure SetBufferSize(w, h: integer); /// /// Очищает экран, заполняя его текущим цветом фона /// procedure ClrScr; /// /// Задает цвет фона выводимого текста /// /// Цвет фона procedure TextBackground(c: integer); /// /// Задает цвет выводимого текста /// /// Цвет текста procedure TextColor(c: integer); /// /// Очищает линию на которой установлен курсор /// procedure ClearLine; /// /// Делает паузу на ms миллисекунд /// procedure Delay(ms: integer); ///-- procedure __InitModule__; implementation var nextkey: char; BlankString: string; procedure ClearLine; begin Console.CursorLeft := 0; Console.Write(BlankString); Console.CursorLeft := 0; end; procedure SetWindowTitle(s: string); begin Console.Title := s; end; procedure SetWindowCaption(s: string); begin Console.Title := s; end; procedure SetWindowSize(w, h: integer); begin Console.SetWindowSize(w, h); end; procedure ShowCursor; begin Console.CursorVisible := True; end; procedure HideCursor; begin Console.CursorVisible := False; end; function ReadKey: char;// TODO продумать это var KeyInfo: ConsoleKeyInfo; begin if NextKey <> Chr(0) then begin ReadKey := nextkey; NextKey := #0; end else begin KeyInfo := Console.ReadKey(true); ReadKey := Convert.ToChar(KeyInfo.KeyChar); if KeyInfo.KeyChar = #0 then NextKey := Convert.ToChar(KeyInfo.Key); end; //ReadKey := Convert.ToChar(Console.ReadKey(true).Key); end; function KeyPressed: boolean; begin KeyPressed := Console.KeyAvailable; end; function WindowWidth: integer; begin WindowWidth := Console.WindowWidth; end; function WindowHeight: integer; begin WindowHeight := Console.WindowHeight; end; function WhereX: integer; begin WhereX := Console.CursorLeft + 1; end; function WhereY: integer; begin WhereY := Console.CursorTop + 1; end; procedure GotoXY(x, y: integer); begin if (x <= Console.WindowWidth) and (y <= Console.WindowHeight) and (x > 0) and (y > 0) then Console.SetCursorPosition(x - 1, y - 1); end; procedure Window(x, y, w, h: integer); begin writeln('Функция CRT.Window не реализована'); {Console.WindowLeft:=x; Console.WindowTop:=y; Console.WindowWidth:=w; Console.WindowHeight:=h;} end; procedure SetBufferSize(w, h: integer); begin Console.SetBufferSize(w, h); end; procedure ClrScr; begin Console.Clear; end; function IntToConsoleColor(c: integer): ConsoleColor; begin case c of Black: IntToConsoleColor := ConsoleColor.Black; Blue: IntToConsoleColor := ConsoleColor.DarkBlue; Green: IntToConsoleColor := ConsoleColor.DarkGreen; Cyan: IntToConsoleColor := ConsoleColor.DarkCyan; Red: IntToConsoleColor := ConsoleColor.DarkRed; Magenta: IntToConsoleColor := ConsoleColor.DarkMagenta; Brown: IntToConsoleColor := ConsoleColor.DarkYellow; LightGray: IntToConsoleColor := ConsoleColor.Gray; DarkGray: IntToConsoleColor := ConsoleColor.DarkGray; LightBlue: IntToConsoleColor := ConsoleColor.Blue; LightGreen: IntToConsoleColor := ConsoleColor.Green; LightCyan: IntToConsoleColor := ConsoleColor.Cyan; LightRed: IntToConsoleColor := ConsoleColor.Red; LightMagenta: IntToConsoleColor := ConsoleColor.Magenta; Yellow: IntToConsoleColor := ConsoleColor.Yellow; White: IntToConsoleColor := ConsoleColor.White; else raise new System.ArgumentOutOfRangeException('c'); end; end; procedure TextBackground(c: integer); begin Console.BackgroundColor := IntToConsoleColor(c); end; procedure TextColor(c: integer); begin Console.ForegroundColor := IntToConsoleColor(c); end; procedure Delay(ms: integer); begin Sleep(ms); end; function RedirectIOUnitUsed: boolean; var t: &Type; begin t := System.Reflection.Assembly.GetExecutingAssembly.GetType('__RedirectIOMode.__RedirectIOMode'); Result := t <> nil; end; var i: integer; var __initialized := false; procedure __InitModule; begin if (not RedirectIOUnitUsed) {and IsConsoleApplication} then begin Console.CursorSize := 15; BlankString := new string(' ', Console.BufferWidth - 1); end else begin Console.WriteLine('Программу с подключенным модулем CRT нельзя запускать по F9.'); Console.WriteLine('Запустите программу, используя Shift-F9'); Halt; end; end; procedure __InitModule__; begin if not __initialized then begin __initialized := true; PABCSystem.__InitModule__; __InitModule; end; end; begin //zdes oshibka ISConsoleApplication u nas nikogda ne inicializiruetsja __InitModule; end.