pascalabcnet/bin/Lib/CRT.pas

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

/// <summary>
/// Ìîäóëü äëÿ ðàáîòû ñ êîíñîëüþ
/// </summary>
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;

/// <summary>
/// Çàäàåò çàãîëîâîê êîíñîëüíîãî îêíà
/// </summary>
/// <param name="s">Çàãîëîâîê êîíñîëüíîãî îêíà</param>
procedure SetWindowTitle(s: string);
/// <summary>
/// Çàäàåò çàãîëîâîê êîíñîëüíîãî îêíà
/// </summary>
/// <param name="s">Çàãîëîâîê êîíñîëüíîãî îêíà</param>
procedure SetWindowCaption(s: string);
/// <summary>
/// Ïîêàçûâàåò êóðñîð åñëè îí ñêðûò
/// </summary>
procedure ShowCursor;
/// <summary>
/// Ñêðûâàåò êóðñîð
/// </summary>
procedure HideCursor;
/// <summary>
/// Ñ÷èòûâàò íàæàòóþ êëàâèøó
/// </summary>
function ReadKey: char;
/// <summary>
/// Âîçâðàùàåò true åñëè áûëà íàæàòà êëàâèøà. Ñ÷èòàòü ñèìâîë ìîæíî ñïîìîùüþ ôóíêöèè ReadKey
/// </summary>
function KeyPressed: boolean;
/// <summary>
/// Âîçâðàùàåò âûñîòó ýêðàíà
/// </summary>
function WindowWidth: integer;
/// <summary>
/// Âîçâðàùàåò øèðèíó ýêðàíà
/// </summary>
/// <returns></returns>
function WindowHeight: integer;
/// <summary>
/// Âîçâðàùàåò Õ-êîîðäèíàòó êóðñîðà
/// </summary>
function WhereX: integer;
/// <summary>
/// Âîçâðàùàåò Y-êîîðäèíàòó êóðñîðà
/// </summary>
function WhereY: integer;
/// <summary>
/// Ïåðåâîäèò êóðñîð â êîîðäèíàòû (x,y)
/// </summary>
procedure GotoXY(x, y: integer);
procedure Window(x, y, w, h: integer);
/// <summary>
/// Çàäàåò ðàçìåðû êîíñîëüíîãî îêíà
/// </summary>
/// <param name="w">Øèðèíà</param>
/// <param name="h">Âûñîòà</param>
procedure SetWindowSize(w, h: integer);
procedure SetBufferSize(w, h: integer);
/// <summary>
/// Î÷èùàåò ýêðàí, çàïîëíÿÿ åãî òåêóùèì öâåòîì ôîíà
/// </summary>
procedure ClrScr;
/// <summary>
/// Çàäàåò öâåò ôîíà âûâîäèìîãî òåêñòà
/// </summary>
/// <param name="c">Öâåò ôîíà</param>
procedure TextBackground(c: integer);
/// <summary>
/// Çàäàåò öâåò âûâîäèìîãî òåêñòà
/// </summary>
/// <param name="c">Öâåò òåêñòà</param>
procedure TextColor(c: integer);
/// <summary>
/// Î÷èùàåò ëèíèþ íà êîòîðîé óñòàíîâëåí êóðñîð
/// </summary>
procedure ClearLine;
/// <summary>
/// Äåëàåò ïàóçó íà ms ìèëëèñåêóíä
/// </summary>
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.