// 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.