administrator/pascalabcnet
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity
pascalabcnet/TestSuite/CompilationSamples/CRT.pas

303 lines
6.6 KiB
ObjectPascal
Raw Normal View History

...
2015-06-27 19:33:50 +03:00
// 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)
initial commit
2015-05-14 22:35:07 +03:00
/// <summary>
/// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
/// </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>
/// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
/// </summary>
/// <param name="s"><3E><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD></param>
procedure SetWindowTitle(s: string);
/// <summary>
/// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
/// </summary>
/// <param name="s"><3E><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD></param>
procedure SetWindowCaption(s: string);
/// <summary>
/// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD>
/// </summary>
procedure ShowCursor;
/// <summary>
/// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
/// </summary>
procedure HideCursor;
/// <summary>
/// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
/// </summary>
function ReadKey: char;
/// <summary>
/// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> true <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>. <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ReadKey
/// </summary>
function KeyPressed: boolean;
/// <summary>
/// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
/// </summary>
function WindowWidth: integer;
/// <summary>
/// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
/// </summary>
/// <returns></returns>
function WindowHeight: integer;
/// <summary>
/// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>-<2D><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
/// </summary>
function WhereX: integer;
/// <summary>
/// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> Y-<2D><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
/// </summary>
function WhereY: integer;
/// <summary>
/// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> (x,y)
/// </summary>
procedure GotoXY(x, y: integer);
procedure Window(x, y, w, h: integer);
/// <summary>
/// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
/// </summary>
/// <param name="w"><3E><><EFBFBD><EFBFBD><EFBFBD><EFBFBD></param>
/// <param name="h"><3E><><EFBFBD><EFBFBD><EFBFBD><EFBFBD></param>
procedure SetWindowSize(w, h: integer);
procedure SetBufferSize(w, h: integer);
/// <summary>
/// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
/// </summary>
procedure ClrScr;
/// <summary>
/// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
/// </summary>
/// <param name="c"><3E><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD></param>
procedure TextBackground(c: integer);
/// <summary>
/// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
/// </summary>
/// <param name="c"><3E><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD></param>
procedure TextColor(c: integer);
/// <summary>
/// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
/// </summary>
procedure ClearLine;
/// <summary>
/// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> ms <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
/// </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 <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>
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('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> CRT.Window <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
{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('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> CRT <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> F9.');
Console.WriteLine('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 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.
Reference in a new issue Copy permalink