2016-12-12 00:18:03 +03:00
/// Модуль электронного задачника Programming Taskbook 4
unit PT4;
2015-05-14 22:35:07 +03:00
//------------------------------------------------------------------------------
2015-12-28 14:25:15 +03:00
// Модуль для подключения задачника Programming Taskbook
2018-08-30 20:02:25 +03:00
// Версия 4.18
// Copyright © 2006-2008 DarkStar, SSM
// Copyright © 2010 М .Э.Абрамян, дополнения к версии 1.3
// Copyright © 2014-2015 М .Э.Абрамян, дополнения к версии 4.13
// Copyright © 2015 М .Э.Абрамян, дополнения к версии 4.14
// Copyright © 2016 М .Э.Абрамян, дополнения к версии 4.15
// Copyright © 2017 М .Э.Абрамян, дополнения к версии 4.17
// Copyright © 2018 М .Э.Абрамян, дополнения к версии 4.18
2018-07-31 20:01:19 +03:00
// Электронный задачник Programming Taskbook Copyright (c)М .Э.Абрамян, 1998-2018
2015-05-14 22:35:07 +03:00
//------------------------------------------------------------------------------
{$apptype windows}
{$platformtarget x86}
interface
uses System,
System. Collections,
System. Runtime. InteropServices;
type
2015-12-28 14:25:15 +03:00
/// Тип указателя на узел списка
2015-05-14 22:35:07 +03:00
PNode = ^ TNode;
2015-12-28 14:25:15 +03:00
/// Тип узла списка
2015-05-14 22:35:07 +03:00
TNode = record
Data: integer ;
Next, Prev, Left, Right, Parent: PNode;
end ;
InternalNode = record
Data: integer ;
Next, Prev, Left, Right, Parent: IntPtr ;
end ;
IOPT4System = class( IOStandardSystem)
public
procedure write( obj: object ) ; override ;
procedure writeln; override ;
end ;
PT4Exception = Exception;
Node = class( IDisposable)
private
isAllocMem: boolean ;
isDisposed: boolean ;
x: InternalNode;
addr: IntPtr ;
constructor Create( x: InternalNode; a: IntPtr ) ;
procedure Init( Data: integer ; Next, Prev, Left, Right, Parent: Node) ;
procedure internalDispose( disposing: boolean ) ;
procedure setNext( value: Node) ;
function getNext: Node;
procedure setPrev( value: Node) ;
function getPrev: Node;
procedure setLeft( value: Node) ;
function getLeft: Node;
procedure setRight( value: Node) ;
function getRight: Node;
procedure setParent( value: Node) ;
function getParent: Node;
procedure setData( value: integer ) ;
function getData: integer ;
public
constructor Create;
constructor Create( aData: integer ) ;
constructor Create( aData: integer ; aNext: Node) ;
constructor Create( aData: integer ; aNext, aPrev: Node) ;
constructor Create( left, right: Node; data: integer ) ;
constructor Create( left, right: Node; data: integer ; parent: Node) ;
procedure Dispose;
property Next: Node read getNext write SetNext;
property Prev: Node read getPrev write SetPrev;
property Left: Node read getLeft write SetLeft;
property Right: Node read getRight write SetRight;
property Parent: Node read getParent write SetParent;
property Data: integer read getData write SetData;
end ;
2015-12-28 14:25:15 +03:00
/// Вывести формулировку задания
2015-05-14 22:35:07 +03:00
procedure Task( name : string ) ;
2015-12-28 14:25:15 +03:00
/// Ввести и вернуть значение целого типа
2015-05-14 22:35:07 +03:00
function GetInt: integer ;
2015-12-28 14:25:15 +03:00
/// Ввести и вернуть значение целого типа
2015-05-14 22:35:07 +03:00
function GetInteger: integer ;
2015-12-28 14:25:15 +03:00
/// Ввести и вернуть значение вещественного типа
2015-05-14 22:35:07 +03:00
function GetReal: real ;
2015-12-28 14:25:15 +03:00
/// Ввести и вернуть значение вещественного типа
2015-05-14 22:35:07 +03:00
function GetDouble: real ;
2015-12-28 14:25:15 +03:00
/// Ввести и вернуть значение символьного типа
2015-05-14 22:35:07 +03:00
function GetChar: char ;
2015-12-28 14:25:15 +03:00
/// Ввести и вернуть значение строкового типа
2015-05-14 22:35:07 +03:00
function GetString: string ;
2015-12-28 14:25:15 +03:00
/// Ввести и вернуть значение логического типа
2015-05-14 22:35:07 +03:00
function GetBool: boolean ;
2015-12-28 14:25:15 +03:00
/// Ввести и вернуть значение логического типа
2015-05-14 22:35:07 +03:00
function GetBoolean: boolean ;
2015-12-28 14:25:15 +03:00
/// Ввести и вернуть значение типа Node
2015-05-14 22:35:07 +03:00
function GetNode: Node;
2015-12-28 14:25:15 +03:00
/// Ввести и вернуть значение типа PNode
2015-05-14 22:35:07 +03:00
function GetPNode: PNode;
2015-12-28 14:25:15 +03:00
/// Возвращает введенное значение типа integer
2015-05-14 22:35:07 +03:00
function ReadInteger: integer ;
2015-12-28 14:25:15 +03:00
/// Возвращает введенное значение типа real
2015-05-14 22:35:07 +03:00
function ReadReal: real ;
2015-12-28 14:25:15 +03:00
/// Возвращает введенное значение типа char
2015-05-14 22:35:07 +03:00
function ReadChar: char ;
2015-12-28 14:25:15 +03:00
/// Возвращает введенное значение типа string
2015-05-14 22:35:07 +03:00
function ReadString: string ;
2015-12-28 14:25:15 +03:00
/// Возвращает введенное значение типа boolean
2015-05-14 22:35:07 +03:00
function ReadBoolean: boolean ;
2015-12-28 14:25:15 +03:00
/// Возвращает введенное значение типа PNode
2015-05-14 22:35:07 +03:00
function ReadPNode: PNode;
2015-12-28 14:25:15 +03:00
/// Возвращает введенное значение типа Node
2015-05-14 22:35:07 +03:00
function ReadNode: Node;
2015-12-28 14:25:15 +03:00
/// Возвращает введенное значение типа integer
2015-12-13 21:52:32 +03:00
function ReadlnInteger: integer ;
2015-12-28 14:25:15 +03:00
/// Возвращает введенное значение типа real
2015-12-13 21:52:32 +03:00
function ReadlnReal: real ;
2015-12-28 14:25:15 +03:00
/// Возвращает введенное значение типа char
2015-12-13 21:52:32 +03:00
function ReadlnChar: char ;
2015-12-28 14:25:15 +03:00
/// Возвращает введенное значение типа string
2015-12-13 21:52:32 +03:00
function ReadlnString: string ;
2015-12-28 14:25:15 +03:00
/// Возвращает введенное значение типа boolean
2015-12-13 21:52:32 +03:00
function ReadlnBoolean: boolean ;
2015-12-28 14:25:15 +03:00
/// Возвращает введенное значение типа PNode
2015-12-13 21:52:32 +03:00
function ReadlnPNode: PNode;
2015-12-28 14:25:15 +03:00
/// Возвращает введенное значение типа Node
2015-12-13 21:52:32 +03:00
function ReadlnNode: Node;
2015-05-14 22:35:07 +03:00
2016-12-12 00:18:03 +03:00
// == Версия 4.15. Дополнения ==
/// Возвращает введенное значение типа integer.
/// Строковое приглашение prompt игнорируется
function ReadInteger( prompt: string ) : integer ;
/// Возвращает введенное значение типа real.
/// Строковое приглашение prompt игнорируется
function ReadReal( prompt: string ) : real ;
/// Возвращает введенное значение типа char.
/// Строковое приглашение prompt игнорируется
function ReadChar( prompt: string ) : char ;
/// Возвращает введенное значение типа string.
/// Строковое приглашение prompt игнорируется
function ReadString( prompt: string ) : string ;
/// Возвращает введенное значение типа boolean.
/// Строковое приглашение prompt игнорируется
function ReadBoolean( prompt: string ) : boolean ;
/// Возвращает введенное значение типа PNode.
/// Строковое приглашение prompt игнорируется
function ReadPNode( prompt: string ) : PNode;
/// Возвращает введенное значение типа Node.
/// Строковое приглашение prompt игнорируется
function ReadNode( prompt: string ) : Node;
/// Возвращает введенное значение типа integer.
/// Строковое приглашение prompt игнорируется
function ReadlnInteger( prompt: string ) : integer ;
/// Возвращает введенное значение типа real.
/// Строковое приглашение prompt игнорируется
function ReadlnReal( prompt: string ) : real ;
/// Возвращает введенное значение типа char.
/// Строковое приглашение prompt игнорируется
function ReadlnChar( prompt: string ) : char ;
/// Возвращает введенное значение типа string.
/// Строковое приглашение prompt игнорируется
function ReadlnString( prompt: string ) : string ;
/// Возвращает введенное значение типа boolean.
/// Строковое приглашение prompt игнорируется
function ReadlnBoolean( prompt: string ) : boolean ;
/// Возвращает введенное значение типа PNode.
/// Строковое приглашение prompt игнорируется
function ReadlnPNode( prompt: string ) : PNode;
/// Возвращает введенное значение типа Node.
/// Строковое приглашение prompt игнорируется
function ReadlnNode( prompt: string ) : Node;
// == Версия 4.15. Конец дополнений ==
2018-07-31 20:01:19 +03:00
// == Версия 4.17. Дополнения ==
/// Возвращает кортеж из двух введенных значений типа integer
function ReadInteger2: ( integer , integer ) ;
/// Возвращает кортеж из двух введенных значений типа real
function ReadReal2: ( real , real ) ;
/// Возвращает кортеж из двух введенных значений типа char
function ReadChar2: ( char , char ) ;
/// Возвращает кортеж из двух введенных значений типа string
function ReadString2: ( string , string ) ;
/// Возвращает кортеж из двух введенных значений типа boolean
function ReadBoolean2: ( boolean , boolean ) ;
/// Возвращает кортеж из двух введенных значений типа Node
function ReadNode2: ( Node, Node) ;
/// Возвращает кортеж из двух введенных значений типа integer
function ReadlnInteger2: ( integer , integer ) ;
/// Возвращает кортеж из двух введенных значений типа real
function ReadlnReal2: ( real , real ) ;
/// Возвращает кортеж из двух введенных значений типа char
function ReadlnChar2: ( char , char ) ;
/// Возвращает кортеж из двух введенных значений типа string
function ReadlnString2: ( string , string ) ;
/// Возвращает кортеж из двух введенных значений типа boolean
function ReadlnBoolean2: ( boolean , boolean ) ;
/// Возвращает кортеж из двух введенных значений типа Node
function ReadlnNode2: ( Node, Node) ;
/// Возвращает кортеж из трех введенных значений типа integer
function ReadInteger3: ( integer , integer , integer ) ;
/// Возвращает кортеж из трех введенных значений типа real
function ReadReal3: ( real , real , real ) ;
/// Возвращает кортеж из трех введенных значений типа char
function ReadChar3: ( char , char , char ) ;
/// Возвращает кортеж из трех введенных значений типа string
function ReadString3: ( string , string , string ) ;
/// Возвращает кортеж из трех введенных значений типа boolean
function ReadBoolean3: ( boolean , boolean , boolean ) ;
/// Возвращает кортеж из трех введенных значений типа Node
function ReadNode3: ( Node, Node, Node) ;
/// Возвращает кортеж из трех введенных значений типа integer
function ReadlnInteger3: ( integer , integer , integer ) ;
/// Возвращает кортеж из трех введенных значений типа real
function ReadlnReal3: ( real , real , real ) ;
/// Возвращает кортеж из трех введенных значений типа char
function ReadlnChar3: ( char , char , char ) ;
/// Возвращает кортеж из трех введенных значений типа string
function ReadlnString3: ( string , string , string ) ;
/// Возвращает кортеж из трех введенных значений типа boolean
function ReadlnBoolean3: ( boolean , boolean , boolean ) ;
/// Возвращает кортеж из трех введенных значений типа Node
function ReadlnNode3: ( Node, Node, Node) ;
/// Возвращает кортеж из двух введенных значений типа integer.
/// Строковое приглашение prompt игнорируется
function ReadInteger2( prompt: string ) : ( integer , integer ) ;
/// Возвращает кортеж из двух введенных значений типа real.
/// Строковое приглашение prompt игнорируется
function ReadReal2( prompt: string ) : ( real , real ) ;
/// Возвращает кортеж из двух введенных значений типа char.
/// Строковое приглашение prompt игнорируется
function ReadChar2( prompt: string ) : ( char , char ) ;
/// Возвращает кортеж из двух введенных значений типа string.
/// Строковое приглашение prompt игнорируется
function ReadString2( prompt: string ) : ( string , string ) ;
/// Возвращает кортеж из двух введенных значений типа boolean.
/// Строковое приглашение prompt игнорируется
function ReadBoolean2( prompt: string ) : ( boolean , boolean ) ;
/// Возвращает кортеж из двух введенных значений типа Node.
/// Строковое приглашение prompt игнорируется
function ReadNode2( prompt: string ) : ( Node, Node) ;
/// Возвращает кортеж из двух введенных значений типа integer.
/// Строковое приглашение prompt игнорируется
function ReadlnInteger2( prompt: string ) : ( integer , integer ) ;
/// Возвращает кортеж из двух введенных значений типа real.
/// Строковое приглашение prompt игнорируется
function ReadlnReal2( prompt: string ) : ( real , real ) ;
/// Возвращает кортеж из двух введенных значений типа char.
/// Строковое приглашение prompt игнорируется
function ReadlnChar2( prompt: string ) : ( char , char ) ;
/// Возвращает кортеж из двух введенных значений типа string.
/// Строковое приглашение prompt игнорируется
function ReadlnString2( prompt: string ) : ( string , string ) ;
/// Возвращает кортеж из двух введенных значений типа boolean.
/// Строковое приглашение prompt игнорируется
function ReadlnBoolean2( prompt: string ) : ( boolean , boolean ) ;
/// Возвращает кортеж из двух введенных значений типа Node.
/// Строковое приглашение prompt игнорируется
function ReadlnNode2( prompt: string ) : ( Node, Node) ;
/// Возвращает кортеж из трех введенных значений типа integer.
/// Строковое приглашение prompt игнорируется
function ReadInteger3( prompt: string ) : ( integer , integer , integer ) ;
/// Возвращает кортеж из трех введенных значений типа real.
/// Строковое приглашение prompt игнорируется
function ReadReal3( prompt: string ) : ( real , real , real ) ;
/// Возвращает кортеж из трех введенных значений типа char.
/// Строковое приглашение prompt игнорируется
function ReadChar3( prompt: string ) : ( char , char , char ) ;
/// Возвращает кортеж из трех введенных значений типа string.
/// Строковое приглашение prompt игнорируется
function ReadString3( prompt: string ) : ( string , string , string ) ;
/// Возвращает кортеж из трех введенных значений типа boolean.
/// Строковое приглашение prompt игнорируется
function ReadBoolean3( prompt: string ) : ( boolean , boolean , boolean ) ;
/// Возвращает кортеж из трех введенных значений типа Node.
/// Строковое приглашение prompt игнорируется
function ReadNode3( prompt: string ) : ( Node, Node, Node) ;
/// Возвращает кортеж из трех введенных значений типа integer.
/// Строковое приглашение prompt игнорируется
function ReadlnInteger3( prompt: string ) : ( integer , integer , integer ) ;
/// Возвращает кортеж из трех введенных значений типа real.
/// Строковое приглашение prompt игнорируется
function ReadlnReal3( prompt: string ) : ( real , real , real ) ;
/// Возвращает кортеж из трех введенных значений типа char.
/// Строковое приглашение prompt игнорируется
function ReadlnChar3( prompt: string ) : ( char , char , char ) ;
/// Возвращает кортеж из трех введенных значений типа string.
/// Строковое приглашение prompt игнорируется
function ReadlnString3( prompt: string ) : ( string , string , string ) ;
/// Возвращает кортеж из трех введенных значений типа boolean.
/// Строковое приглашение prompt игнорируется
function ReadlnBoolean3( prompt: string ) : ( boolean , boolean , boolean ) ;
/// Возвращает кортеж из трех введенных значений типа Node.
/// Строковое приглашение prompt игнорируется
function ReadlnNode3( prompt: string ) : ( Node, Node, Node) ;
// == Версия 4.17. Конец дополнений ==
2015-05-14 22:35:07 +03:00
procedure GetR( var param: real ) ;
procedure GetN( var param: integer ) ;
procedure GetC( var param: char ) ;
procedure GetS( var param: string ) ;
procedure GetB( var param: boolean ) ;
procedure GetP( var param: PNode) ;
procedure GetP( var param: Node) ;
procedure PutR( param: real ) ;
procedure PutN( param: integer ) ;
procedure PutC( param: char ) ;
procedure PutS( param: string ) ;
procedure PutB( param: boolean ) ;
procedure PutP( param: PNode) ;
procedure PutP( param: Node) ;
procedure Put( params args: array of Object ) ;
procedure Put( param: real ) ;
procedure Put( param: integer ) ;
procedure Put( param: char ) ;
procedure Put( param: string ) ;
procedure Put( param: boolean ) ;
procedure Put( param: PNode) ;
procedure Put( param: Node) ;
2015-12-28 14:25:15 +03:00
//Ввод этих данных не поддерживается
2015-05-14 22:35:07 +03:00
///- read(a,b,...)
2015-12-28 14:25:15 +03:00
/// Вводит значения a,b,... из окна электронного задачника
2015-05-14 22:35:07 +03:00
procedure read( var x: byte ) ;
///--
procedure read( var x: shortint ) ;
///--
procedure read( var x: smallint ) ;
///--
procedure read( var x: word ) ;
///--
procedure read( var x: longword ) ;
///--
procedure read( var x: int64 ) ;
///--
procedure read( var x: uint64 ) ;
///--
procedure read( var x: single ) ;
//---------------------------------
///--
procedure Read( var val: integer ) ;
///--
procedure Read( var val: real ) ;
///--
procedure Read( var val: char ) ;
///--
procedure Read( var val: string ) ;
///--
procedure Read( var val: boolean ) ;
///--
procedure Read( var val: Node) ;
///--
procedure Read( var val: PNode) ;
///--
procedure Readln;
2015-12-13 21:52:32 +03:00
procedure Print( params args: array of object ) ;
procedure Println( params args: array of object ) ;
2016-12-12 00:18:03 +03:00
// == Версия 4.15. Дополнения ==
procedure Print( s: string ) ;
procedure Println( s: string ) ;
2018-07-31 20:01:19 +03:00
procedure Print( s: char ) ;
procedure Println( s: char ) ;
2016-12-12 00:18:03 +03:00
// == Версия 4.15. Конец дополнений ==
2018-07-31 20:01:19 +03:00
2015-12-28 14:25:15 +03:00
/// Освобождает память, выделенную динамически, на которую указывает p
2015-05-14 22:35:07 +03:00
procedure Dispose( p: pointer ) ;
2015-12-28 14:25:15 +03:00
// Фиктивная пустая процедура - для Intellisense
// Нет, нельзя пользоваться - закрываются процедуры write системного модуля
2015-05-14 22:35:07 +03:00
///- write(a,b,...)
2015-12-28 14:25:15 +03:00
/// Выводит значения a,b,... в окно электронного задачника
2015-05-14 22:35:07 +03:00
//procedure write;
///--
procedure __InitModule__;
///--
procedure __FinalizeModule__;
2015-12-28 14:25:15 +03:00
// == Версия 1.3. Дополнения ==
2015-05-14 22:35:07 +03:00
2018-08-30 20:02:25 +03:00
// == Версия 4.18. Изменения ==
( *
/// Выводит число A в разделе отладки окна задачника
procedure Show( A: integer ) ;
/// Выводит число A в разделе отладки окна задачника
procedure Show( A: real ) ;
/// Выводит строку S в разделе отладки окна задачника,
/// после чего выполняет переход на новую экранную строку
procedure ShowLine( S: string ) ;
/// Выводит число A в разделе отладки окна задачника,
/// после чего выполняет переход на новую экранную строку
procedure ShowLine( A: integer ) ;
/// Выводит число A в разделе отладки окна задачника,
/// после чего выполняет переход на новую экранную строку
procedure ShowLine( A: real ) ;
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
/// Выводит число A с комментарием S в разделе отладки
/// окна задачника; для вывода числа отводится W экранных позиций
2015-05-14 22:35:07 +03:00
procedure Show( S: string ; A: integer ; W: integer ) ;
2015-12-28 14:25:15 +03:00
/// Выводит число A с комментарием S в разделе отладки
/// окна задачника; для вывода числа отводится W экранных позиций
2015-05-14 22:35:07 +03:00
procedure Show( S: string ; A: real ; W: integer ) ;
2015-12-28 14:25:15 +03:00
/// Выводит число A с комментарием S в разделе отладки окна задачника
2015-05-14 22:35:07 +03:00
procedure Show( S: string ; A: integer ) ;
2015-12-28 14:25:15 +03:00
/// Выводит число A с комментарием S в разделе отладки окна задачника
2015-05-14 22:35:07 +03:00
procedure Show( S: string ; A: real ) ;
2015-12-28 14:25:15 +03:00
/// Выводит число A в разделе отладки окна задачника;
/// для вывода отводится W экранных позиций
2015-05-14 22:35:07 +03:00
procedure Show( A: integer ; W: integer ) ;
2015-12-28 14:25:15 +03:00
/// Выводит число A в разделе отладки окна задачника;
/// для вывода отводится W экранных позиций
2015-05-14 22:35:07 +03:00
procedure Show( A: real ; W: integer ) ;
2015-12-28 14:25:15 +03:00
/// Выводит число A с комментарием S в разделе отладки
/// окна задачника; для вывода числа отводится W экранных позиций.
/// После вывода данных выполняет переход на новую экранную строку
2015-05-14 22:35:07 +03:00
procedure ShowLine( S: string ; A: integer ; W: integer ) ;
2015-12-28 14:25:15 +03:00
/// Выводит число A с комментарием S в разделе отладки
/// окна задачника; для вывода числа отводится W экранных позиций.
/// После вывода данных выполняет переход на новую экранную строку
2015-05-14 22:35:07 +03:00
procedure ShowLine( S: string ; A: real ; W: integer ) ;
2015-12-28 14:25:15 +03:00
/// Выводит число A с комментарием S в разделе отладки окна задачника,
/// после чего выполняет переход на новую экранную строку
2015-05-14 22:35:07 +03:00
procedure ShowLine( S: string ; A: integer ) ;
2015-12-28 14:25:15 +03:00
/// Выводит число A с комментарием S в разделе отладки окна задачника,
/// после чего выполняет переход на новую экранную строку
2015-05-14 22:35:07 +03:00
procedure ShowLine( S: string ; A: real ) ;
2015-12-28 14:25:15 +03:00
/// Выводит число A в разделе отладки окна задачника;
/// для вывода отводится W экранных позиций.
/// После вывода числа выполняет переход на новую экранную строку
2015-05-14 22:35:07 +03:00
procedure ShowLine( A: integer ; W: integer ) ;
2015-12-28 14:25:15 +03:00
/// Выводит число A в разделе отладки окна задачника;
/// для вывода отводится W экранных позиций.
/// После вывода числа выполняет переход на новую экранную строку
2015-05-14 22:35:07 +03:00
procedure ShowLine( A: real ; W: integer ) ;
2018-08-30 20:02:25 +03:00
* )
2015-05-14 22:35:07 +03:00
2018-08-30 20:02:25 +03:00
/// Выводит строку S в разделе отладки окна задачника
procedure Show( S: string ) ;
/// Выводит набор данных в разделе отладки окна задачника.
/// Вещественные числа выводятся в формате, настроенном
/// с помощью функции SetPrecision (по умолчанию 2 дробных знака).
/// Если аргументом является последовательность, то после вывода
/// е е элементов выполняется автоматический переход на новую строку.
procedure Show( params args: array of object ) ;
/// Выполняет переход на новую экранную строку
/// в разделе отладки окна задачника
procedure ShowLine;
/// Выводит набор данных в разделе отладки окна задачника,
/// после чего выполняет переход на новую экранную строку.
/// Вещественные числа выводятся в формате, настроенном
/// с помощью функции SetPrecision (по умолчанию 2 дробных знака).
/// Если аргументом является последовательность, то после вывода
/// е е элементов выполняется автоматический переход на новую строку.
procedure ShowLine( params args: array of object ) ;
/// Задает ширину W области вывода для числовых и строковых данных
/// в разделе отладки. Влияет на последующие вызовы функций
/// Show и ShowLine.
procedure SetWidth( W: Integer ) ;
// == Версия 4.18. Конец изменений ==
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
/// Настраивает формат вывода вещественных чисел в разделе отладки
/// окна задачника. Если N > 0, то число выводится в формате
/// с фиксированной точкой и N дробными знаками. Если N = 0,
/// то число выводится в экспоненциальном формате, число дробных
/// знаков определяется шириной поля вывода
2015-05-14 22:35:07 +03:00
procedure SetPrecision( N: integer ) ;
2015-12-28 14:25:15 +03:00
/// Обеспечивает автоматическое скрытие всех разделов
/// окна задачника, кроме раздела отладки
2015-05-14 22:35:07 +03:00
procedure HideTask;
2015-12-28 14:25:15 +03:00
// == Конец дополнений к версии 1.3 ==
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
// == Версия 4.14. Дополнения ==
2015-12-13 21:52:32 +03:00
2015-12-28 14:25:15 +03:00
/// Вводит n целых чисел
/// и возвращает введенные числа в виде массива
2015-12-13 21:52:32 +03:00
function ReadArrInteger( n: integer ) : array of integer ;
2015-12-28 14:25:15 +03:00
/// Вводит n вещественных чисел
/// и возвращает введенные числа в виде массива
2015-12-13 21:52:32 +03:00
function ReadArrReal( n: integer ) : array of real ;
2015-12-28 14:25:15 +03:00
/// Вводит n строк
/// и возвращает введенные строки в виде массива
2015-12-13 21:52:32 +03:00
function ReadArrString( n: integer ) : array of string ;
2015-12-28 14:25:15 +03:00
/// Вводит n целых чисел
/// и возвращает введенные числа в виде последовательности
2016-12-12 00:18:03 +03:00
function ReadSeqInteger( n: integer ) : sequence of integer ;
2015-12-13 21:52:32 +03:00
2015-12-28 14:25:15 +03:00
/// Вводит n вещественных чисел
/// и возвращает введенные числа в виде последовательности
2016-12-12 00:18:03 +03:00
function ReadSeqReal( n: integer ) : sequence of real ;
2015-12-13 21:52:32 +03:00
2015-12-28 14:25:15 +03:00
/// Вводит n строк
/// и возвращает введенные строки в виде последовательности
2016-12-12 00:18:03 +03:00
function ReadSeqString( n: integer ) : sequence of string ;
2015-12-13 21:52:32 +03:00
2015-12-28 14:25:15 +03:00
/// Вводит размер набора целых чисел и е г о элементы
/// и возвращает введенный набор в виде последовательности
2016-12-12 00:18:03 +03:00
function ReadSeqInteger( ) : sequence of integer ;
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
/// Вводит размер набора вещественных чисел и е г о элементы
/// и возвращает введенный набор в виде последовательности
2016-12-12 00:18:03 +03:00
function ReadSeqReal( ) : sequence of real ;
2015-12-13 21:52:32 +03:00
2015-12-28 14:25:15 +03:00
/// Вводит размер набора строк и е г о элементы
/// и возвращает введенный набор в виде последовательности
2016-12-12 00:18:03 +03:00
function ReadSeqString( ) : sequence of string ;
2015-12-13 21:52:32 +03:00
2015-12-28 14:25:15 +03:00
/// Вводит размер набора целых чисел и е г о элементы
/// и возвращает введенный набор в виде массива
2015-12-13 21:52:32 +03:00
function ReadArrInteger( ) : array of integer ;
2015-12-28 14:25:15 +03:00
/// Вводит размер набора вещественных чисел и е г о элементы
/// и возвращает введенный набор в виде массива
2015-12-13 21:52:32 +03:00
function ReadArrReal( ) : array of real ;
2015-12-28 14:25:15 +03:00
/// Вводит размер набора строк и е г о элементы
/// и возвращает введенный набор в виде массива
2015-12-13 21:52:32 +03:00
function ReadArrString( ) : array of string ;
2018-08-30 20:02:25 +03:00
/// Вводит целочисленную матрицу размера m на n по строкам
2015-12-13 21:52:32 +03:00
function ReadMatrInteger( m, n: integer ) : array [ , ] of integer ;
2018-08-30 20:02:25 +03:00
/// Вводит размеры матрицы и затем целочисленную матрицу указанных размеров по строкам
2015-12-13 21:52:32 +03:00
function ReadMatrInteger( ) : array [ , ] of integer ;
2015-12-28 14:25:15 +03:00
/// Вводит вещественную матрицу размера m на n по строкам
2015-12-13 21:52:32 +03:00
function ReadMatrReal( m, n: integer ) : array [ , ] of real ;
2015-12-28 14:25:15 +03:00
/// Вводит размеры матрицы и затем вещественную матрицу указанных размеров по строкам
2015-12-13 21:52:32 +03:00
function ReadMatrReal( ) : array [ , ] of real ;
2018-08-30 20:02:25 +03:00
/// Вводит строковую матрицу размера m на n по строкам
2015-12-13 21:52:32 +03:00
function ReadMatrString( m, n: integer ) : array [ , ] of string ;
2015-12-28 14:25:15 +03:00
/// Вводит размеры матрицы и затем строковую матрицу указанных размеров по строкам
2015-12-13 21:52:32 +03:00
function ReadMatrString( ) : array [ , ] of string ;
2016-12-12 00:18:03 +03:00
procedure ReadMatr( var m, n: integer ; var a: array [ , ] of integer ) ;
procedure ReadMatr( var m, n: integer ; var a: array [ , ] of real ) ;
procedure ReadMatr( var m, n: integer ; var a: array [ , ] of string ) ;
procedure ReadMatr( var m: integer ; var a: array [ , ] of integer ) ;
procedure ReadMatr( var m: integer ; var a: array [ , ] of real ) ;
procedure ReadMatr( var m: integer ; var a: array [ , ] of string ) ;
procedure ReadMatr( var m, n: integer ; var a: array of array of integer ) ;
procedure ReadMatr( var m, n: integer ; var a: array of array of real ) ;
procedure ReadMatr( var m, n: integer ; var a: array of array of string ) ;
procedure ReadMatr( var m: integer ; var a: array of array of integer ) ;
procedure ReadMatr( var m: integer ; var a: array of array of real ) ;
procedure ReadMatr( var m: integer ; var a: array of array of string ) ;
procedure ReadMatr( var m, n: integer ; var a: List< List< integer > > ) ;
procedure ReadMatr( var m, n: integer ; var a: List< List< real > > ) ;
procedure ReadMatr( var m, n: integer ; var a: List< List< string > > ) ;
procedure ReadMatr( var m: integer ; var a: List< List< integer > > ) ;
procedure ReadMatr( var m: integer ; var a: List< List< real > > ) ;
procedure ReadMatr( var m: integer ; var a: List< List< string > > ) ;
2018-08-30 20:02:25 +03:00
// == Изменения в версии 4.18
/// Вводит квадратную целочисленную матрицу порядка m по строкам
function ReadMatrInteger( m: integer ) : array [ , ] of integer ;
/// Вводит квадратную вещественную матрицу порядка m по строкам
function ReadMatrReal( m: integer ) : array [ , ] of real ;
/// Вводит квадратную строковую матрицу порядка m по строкам
function ReadMatrString( m: integer ) : array [ , ] of string ;
/// Вводит размер набора целых чисел и е г о элементы
/// и возвращает введенный набор в виде списка List
function ReadListInteger( ) : List< integer > ;
/// Вводит размер набора вещественных чисел и е г о элементы
/// и возвращает введенный набор в виде списка List
function ReadListReal( ) : List< real > ;
/// Вводит размер набора строк и е г о элементы
/// и возвращает введенный набор в виде списка List
function ReadListString( ) : List< string > ;
/// Вводит n целых чисел
/// и возвращает введенные числа в виде списка List
function ReadListInteger( n: integer ) : List< integer > ;
/// Вводит n вещественных чисел
/// и возвращает введенные числа в виде списка List
function ReadListReal( n: integer ) : List< real > ;
/// Вводит n строк
/// и возвращает введенные строки в виде списка List
function ReadListString( n: integer ) : List< string > ;
/// Вводит целочисленную матрицу размера m на n по строкам
/// и возвращает е е в виде массива массивов
function ReadArrArrInteger( m, n: integer ) : array of array of integer ;
/// Вводит размеры матрицы и затем целочисленную матрицу указанных размеров по строкам
/// и возвращает е е в виде массива массивов
function ReadArrArrInteger( ) : array of array of integer ;
/// Вводит вещественную матрицу размера m на n по строкам
/// и возвращает е е в виде массива массивов
function ReadArrArrReal( m, n: integer ) : array of array of real ;
/// Вводит квадратную целочисленную матрицу порядка m по строкам
/// и возвращает е е в виде массива массивов
function ReadArrArrInteger( m: integer ) : array of array of integer ;
/// Вводит квадратную вещественную матрицу порядка m по строкам
/// и возвращает е е в виде массива массивов
function ReadArrArrReal( m: integer ) : array of array of real ;
/// Вводит квадратную строковую матрицу порядка m по строкам
/// и возвращает е е в виде массива массивов
function ReadArrArrString( m: integer ) : array of array of string ;
/// Вводит размеры матрицы и затем вещественную матрицу указанных размеров по строкам
/// и возвращает е е в виде массива массивов
function ReadArrArrReal( ) : array of array of real ;
/// Вводит строковую матрицу размера m на n по строкам
/// и возвращает е е в виде массива массивов
function ReadArrArrString( m, n: integer ) : array of array of string ;
/// Вводит размеры матрицы и затем строковую матрицу указанных размеров по строкам
/// и возвращает е е в виде массива массивов
function ReadArrArrString( ) : array of array of string ;
/// Вводит целочисленную матрицу размера m на n по строкам
/// и возвращает е е в виде списка списков
function ReadListListInteger( m, n: integer ) : List< List< integer > > ;
/// Вводит квадратную целочисленную матрицу порядка m по строкам
/// и возвращает е е в виде списка списков
function ReadListListInteger( m: integer ) : List< List< integer > > ;
/// Вводит размеры матрицы и затем целочисленную матрицу указанных размеров по строкам
/// и возвращает е е в виде списка списков
function ReadListListInteger( ) : List< List< integer > > ;
/// Вводит вещественную матрицу размера m на n по строкам
/// и возвращает е е в виде списка списков
function ReadListListReal( m, n: integer ) : List< List< real > > ;
/// Вводит квадратную вещественную матрицу порядка m по строкам
/// и возвращает е е в виде списка списков
function ReadListListReal( m: integer ) : List< List< real > > ;
/// Вводит размеры матрицы и затем вещественную матрицу указанных размеров по строкам
/// и возвращает е е в виде списка списков
function ReadListListReal( ) : List< List< real > > ;
/// Вводит строковую матрицу размера m на n по строкам
/// и возвращает е е в виде списка списков
function ReadListListString( m, n: integer ) : List< List< string > > ;
/// Вводит квадратную строковую матрицу порядка m по строкам
/// и возвращает е е в виде списка списков
function ReadListListString( m: integer ) : List< List< string > > ;
/// Вводит размеры матрицы и затем строковую матрицу указанных размеров по строкам
/// и возвращает е е в виде списка списков
function ReadListListString( ) : List< List< string > > ;
( *
2016-12-12 00:18:03 +03:00
procedure WriteMatr< T> ( a: array [ , ] of T) ;
procedure WriteMatr< T> ( a: array of array of T) ;
procedure WriteMatr< T> ( a: List< List< T> > ) ;
// == Дополнения 2016.07
procedure PrintMatr< T> ( a: array [ , ] of T) ;
procedure PrintMatr< T> ( a: array of array of T) ;
procedure PrintMatr< T> ( a: List< List< T> > ) ;
// == Конец дополнений 2016.07
2018-08-30 20:02:25 +03:00
* )
// == Конец изменений в версии 4.18
2016-12-12 00:18:03 +03:00
2015-12-28 14:25:15 +03:00
// == Конец дополнений к версии 4.14 ==
2015-05-14 22:35:07 +03:00
2018-07-31 20:01:19 +03:00
2018-08-30 20:02:25 +03:00
implementation
2018-07-31 20:01:19 +03:00
// == Версия 4.18. Дополнения ==
2018-08-30 20:02:25 +03:00
uses ABCDatabases;
2018-07-31 20:01:19 +03:00
// == Версия 4.18. Конец дополнений ==
2015-05-14 22:35:07 +03:00
const
2015-12-28 14:25:15 +03:00
NotSupportedReadTypeMessage = 'Ввод данных типа {0} не поддерживается' ;
NotSupportedWriteTypeMessage = 'Вывод данных типа {0} не поддерживается' ;
eMessage = 'Попытка обращения к объекту Node после вызова е г о метода Dispose' ;
2015-05-14 22:35:07 +03:00
var
loadNodes: ArrayList;
InfoT: integer ;
InfoS: string ;
ExceptionThrowed : = false ;
procedure PutInt( val: integer ) ; forward ;
procedure PutReal( val: real ) ; forward ;
procedure PutChar( val: char ) ; forward ;
procedure PutString( val: string ) ; forward ;
procedure PutBoolean( val: boolean ) ; forward ;
procedure PutNode( val: Node) ; forward ;
procedure PutPNode( val: PNode) ; forward ;
procedure StartPT( options: integer ) ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'startpt' ;
procedure FreePT; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'freept' ;
function CheckPT( var res: integer ) : string ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'checkptf' ;
procedure RaisePT( s1, s2: string ) ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'raisept' ;
procedure Task( name : string ) ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'task' ;
procedure GetR( var param: real ) ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'getr' ;
procedure PutR( param: real ) ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'putr' ;
procedure GetN( var param: integer ) ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'getn' ;
procedure PutN( param: integer ) ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'putn' ;
procedure GetC( var param: char ) ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'getc' ;
procedure PutC( param: char ) ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'putc' ;
procedure _GetS( param: System. Text . StringBuilder) ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'gets' ;
procedure PutS( param: string ) ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'puts' ;
procedure _GetB( var param: integer ) ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'getb' ;
procedure _PutB( param: integer ) ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'putb' ;
procedure _GetP( var param: IntPtr ) ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'getp' ;
procedure _PutP( param: IntPtr ) ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'putp' ;
procedure DisposeP( sNode: IntPtr ) ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'disposep' ;
2015-12-13 21:52:32 +03:00
function FinishPT( ) : integer ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'finishpt' ; // == 4.13 ==
2015-05-14 22:35:07 +03:00
procedure Dispose( p: pointer ) ;
begin
DisposeP( IntPtr( p) ) ;
end ;
procedure GetS( var param: string ) ;
begin
param : = GetString( ) ;
end ;
procedure GetB( var param: boolean ) ;
begin
param : = GetBoolean( ) ;
end ;
procedure PutB( param: boolean ) ;
begin
PutBoolean( param) ;
end ;
procedure GetP( var param: PNode) ;
begin
param : = GetPNode( ) ;
end ;
procedure GetP( var param: Node) ;
begin
param : = GetNode( ) ;
end ;
procedure PutP( param: PNode) ;
begin
PutPNode( param) ;
end ;
procedure PutP( param: Node) ;
begin
PutNode( param) ;
end ;
procedure Put( params args: array of Object ) ;
begin
foreach x: Object in args do
begin
if x. GetType = typeof( integer ) then
Put( integer( x) )
else if x. GetType = typeof( real ) then
Put( real( x) )
else if x. GetType = typeof( char ) then
Put( char( x) )
else if x. GetType = typeof( string ) then
Put( string( x) )
else if x. GetType = typeof( boolean ) then
Put( boolean( x) )
else if x. GetType = typeof( Node) then
Put( Node( x) )
// else if x.GetType = typeof(PNode) then
// Put(PNode(x))
end ;
end ;
procedure Put( param: real ) ;
begin
PutR( param) ;
end ;
procedure Put( param: integer ) ;
begin
PutN( param) ;
end ;
procedure Put( param: char ) ;
begin
PutC( param) ;
end ;
procedure Put( param: string ) ;
begin
PutS( param) ;
end ;
procedure Put( param: boolean ) ;
begin
PutB( param) ;
end ;
procedure Put( param: PNode) ;
begin
PutP( param) ;
end ;
procedure Put( param: Node) ;
begin
PutP( param) ;
end ;
// -----------------------------------------------------
// Node
// -----------------------------------------------------
constructor Node. Create( x: InternalNode; a: IntPtr ) ;
begin
Self. x. Data : = x. Data;
Self. x. Next : = x. Next;
Self. x. Prev : = x. Prev;
Self. x. Left : = x. Left;
Self. x. Right : = x. Right;
Self. x. Parent : = x. Parent;
addr : = a;
isAllocMem : = false ;
isDisposed : = false ;
end ;
constructor Node. Create;
begin
Init( 0 , nil , nil , nil , nil , nil ) ;
end ;
constructor Node. Create( aData: integer ) ;
begin
Init( aData, nil , nil , nil , nil , nil ) ;
end ;
constructor Node. Create( aData: integer ; aNext: Node) ;
begin
Init( aData, aNext, nil , nil , nil , nil ) ;
end ;
constructor Node. Create( aData: integer ; aNext, aPrev: Node) ;
begin
Init( aData, aNext, aPrev, nil , nil , nil ) ;
end ;
constructor Node. Create( left, right: Node; data: integer ) ;
begin
Init( data, nil , nil , left, right, nil ) ;
end ;
constructor Node. Create( left, right: Node; data: integer ; parent: Node) ;
begin
Init( data, nil , nil , left, right, parent) ;
end ;
procedure Node. Dispose;
begin
GC. SuppressFinalize( self) ;
internalDispose( true ) ;
end ;
procedure Node. Init( Data: integer ; Next, Prev, Left, Right, Parent: Node) ;
begin
x. Data : = Data;
if Next = nil then
x. Next : = IntPtr . Zero
else x. Next : = Next. addr;
if Prev = nil then
x. Prev : = IntPtr . Zero
else x. Prev : = Prev. addr;
if Left = nil then
x. Left : = IntPtr . Zero
else x. Left : = Left. addr;
if Right = nil then
x. Right : = IntPtr . Zero
else x. Right : = Right. addr;
if Parent = nil then
x. Parent : = IntPtr . Zero
else x. Parent : = Parent. addr;
addr : = Marshal. AllocHGlobal( sizeof( InternalNode) ) ;
2015-12-13 21:52:32 +03:00
Marshal. StructureToPtr( x as object , addr, false ) ;
2015-05-14 22:35:07 +03:00
isAllocMem : = true ;
isDisposed : = false ;
loadNodes. Add( self) ;
end ;
procedure Node. setNext( value: Node) ;
begin
if isDisposed then
raise new ObjectDisposedException( ToString, eMessage) ;
if value = nil then
begin
x. Next : = IntPtr . Zero;
2015-12-13 21:52:32 +03:00
Marshal. StructureToPtr( x as object , addr, isAllocMem) ;
2015-05-14 22:35:07 +03:00
end else
begin
x. Next : = value. addr;
2015-12-13 21:52:32 +03:00
Marshal. StructureToPtr( x as object , addr, isAllocMem) ;
2015-05-14 22:35:07 +03:00
end ;
end ;
function Node. getNext: Node;
var tmp: IntPtr ;
tmpNode: Node;
begin
result : = nil ;
if isDisposed then
raise new ObjectDisposedException( ToString, eMessage) ;
if x. Next < > IntPtr . Zero then
begin
tmp : = x. Next;
2016-12-12 00:18:03 +03:00
for var i: = 0 to loadNodes. Count- 1 do
2015-05-14 22:35:07 +03:00
if tmp. Equals( Node( loadNodes[ i] ) . addr) then
result : = Node( loadNodes[ i] ) ;
if result = nil then
begin
tmpNode : = new Node( InternalNode( Marshal. PtrToStructure( tmp, typeof( InternalNode) ) ) , tmp) ;
loadNodes. Add( tmpNode) ;
result : = tmpNode;
end ;
end ;
end ;
procedure Node. setPrev( value: Node) ;
begin
if isDisposed then
raise new ObjectDisposedException( ToString, eMessage) ;
if value = nil then
begin
x. Prev : = IntPtr . Zero;
2015-12-13 21:52:32 +03:00
Marshal. StructureToPtr( x as object , addr, isAllocMem) ;
2015-05-14 22:35:07 +03:00
end else
begin
x. Prev : = value. addr;
2015-12-13 21:52:32 +03:00
Marshal. StructureToPtr( x as object , addr, isAllocMem) ;
2015-05-14 22:35:07 +03:00
end ;
end ;
function Node. getPrev: Node;
var tmp: IntPtr ;
tmpNode: Node;
begin
result : = nil ;
if isDisposed then
raise new ObjectDisposedException( ToString, eMessage) ;
if x. Prev < > IntPtr . Zero then begin
tmp : = x. Prev;
2016-12-12 00:18:03 +03:00
for var i: = 0 to loadNodes. Count- 1 do
2015-05-14 22:35:07 +03:00
if tmp. Equals( Node( loadNodes[ i] ) . addr) then
result : = Node( loadNodes[ i] ) ;
if result = nil then begin
tmpNode : = new Node( InternalNode( Marshal. PtrToStructure( tmp, typeof( InternalNode) ) ) , tmp) ;
loadNodes. Add( tmpNode) ;
result : = tmpNode;
end ;
end ;
end ;
procedure Node. setLeft( value: Node) ;
begin
if isDisposed then
raise new ObjectDisposedException( ToString, eMessage) ;
if value = nil then
begin
x. Left : = IntPtr . Zero;
2015-12-13 21:52:32 +03:00
Marshal. StructureToPtr( x as object , addr, isAllocMem) ;
2015-05-14 22:35:07 +03:00
end else
begin
x. Left : = value. addr;
2015-12-13 21:52:32 +03:00
Marshal. StructureToPtr( x as object , addr, isAllocMem) ;
2015-05-14 22:35:07 +03:00
end ;
end ;
function Node. getLeft: Node;
var tmp: IntPtr ;
tmpNode: Node;
begin
result : = nil ;
if isDisposed then
raise new ObjectDisposedException( ToString, eMessage) ;
if x. Left < > IntPtr . Zero then begin
tmp : = x. Left;
2016-12-12 00:18:03 +03:00
for var i: = 0 to loadNodes. Count- 1 do
2015-05-14 22:35:07 +03:00
if tmp. Equals( Node( loadNodes[ i] ) . addr) then
result : = Node( loadNodes[ i] ) ;
if result = nil then begin
tmpNode : = new Node( InternalNode( Marshal. PtrToStructure( tmp, typeof( InternalNode) ) ) , tmp) ;
loadNodes. Add( tmpNode) ;
result : = tmpNode;
end ;
end ;
end ;
procedure Node. setRight( value: Node) ;
begin
if isDisposed then
raise new ObjectDisposedException( ToString, eMessage) ;
if value = nil then
begin
x. Right : = IntPtr . Zero;
2015-12-13 21:52:32 +03:00
Marshal. StructureToPtr( x as object , addr, isAllocMem) ;
2015-05-14 22:35:07 +03:00
end else
begin
x. Right : = value. addr;
2015-12-13 21:52:32 +03:00
Marshal. StructureToPtr( x as object , addr, isAllocMem) ;
2015-05-14 22:35:07 +03:00
end ;
end ;
function Node. getRight: Node;
var tmp: IntPtr ;
tmpNode: Node;
begin
result : = nil ;
if isDisposed then
raise new ObjectDisposedException( ToString, eMessage) ;
if x. Right < > IntPtr . Zero then begin
tmp : = x. Right;
2016-12-12 00:18:03 +03:00
for var i: = 0 to loadNodes. Count- 1 do
2015-05-14 22:35:07 +03:00
if tmp. Equals( Node( loadNodes[ i] ) . addr) then
result : = Node( loadNodes[ i] ) ;
if result = nil then begin
tmpNode : = new Node( InternalNode( Marshal. PtrToStructure( tmp, typeof( InternalNode) ) ) , tmp) ;
loadNodes. Add( tmpNode) ;
result : = tmpNode;
end ;
end ;
end ;
procedure Node. setParent( value: Node) ;
begin
if isDisposed then
raise new ObjectDisposedException( ToString, eMessage) ;
if value = nil then
begin
x. Parent : = IntPtr . Zero;
2015-12-13 21:52:32 +03:00
Marshal. StructureToPtr( x as object , addr, isAllocMem) ;
2015-05-14 22:35:07 +03:00
end else
begin
x. Parent : = value. addr;
2015-12-13 21:52:32 +03:00
Marshal. StructureToPtr( x as object , addr, isAllocMem) ;
2015-05-14 22:35:07 +03:00
end ;
end ;
function Node. getParent: Node;
var tmp: IntPtr ;
tmpNode: Node;
begin
result : = nil ;
if isDisposed then
raise new ObjectDisposedException( ToString, eMessage) ;
if x. Parent < > IntPtr . Zero then begin
tmp : = x. Parent;
2016-12-12 00:18:03 +03:00
for var i: = 0 to loadNodes. Count- 1 do
2015-05-14 22:35:07 +03:00
if tmp. Equals( Node( loadNodes[ i] ) . addr) then
result : = Node( loadNodes[ i] ) ;
if result = nil then begin
tmpNode : = new Node( InternalNode( Marshal. PtrToStructure( tmp, typeof( InternalNode) ) ) , tmp) ;
loadNodes. Add( tmpNode) ;
result : = tmpNode;
end ;
end ;
end ;
procedure Node. setData( value: integer ) ;
begin
if isDisposed then
raise new ObjectDisposedException( ToString, eMessage) ;
self. x. Data : = value;
2015-12-13 21:52:32 +03:00
Marshal. StructureToPtr( x as object , addr, isAllocMem) ;
2015-05-14 22:35:07 +03:00
end ;
function Node. getData: integer ;
begin
if isDisposed then
raise new ObjectDisposedException( ToString, eMessage) ;
result : = self. x. Data;
end ;
procedure Node. internalDispose( disposing: boolean ) ;
begin
if not isDisposed then
//lock(self)
begin
if disposing then
DisposeP( addr) ;
if isAllocMem then
Marshal. FreeHGlobal( addr) ;
isDisposed : = true ;
end ;
end ;
procedure internalWrite( args: array of object ) ; forward ;
// -----------------------------------------------------
// IOPT4System
// -----------------------------------------------------
procedure IOPT4System. write( obj: object ) ;
var args: array of object ;
begin
SetLength( args, 1 ) ;
args[ 0 ] : = obj;
internalWrite( args) ;
end ;
procedure IOPT4System. writeln;
begin
end ;
// -----------------------------------------------------
2015-12-28 14:25:15 +03:00
// Функции Get
2015-05-14 22:35:07 +03:00
// -----------------------------------------------------
function GetInt: integer ;
var val: integer ;
begin
Getn( val) ;
result : = val;
end ;
function GetInteger: integer ;
begin
result : = GetInt;
end ;
function GetReal: real ;
var val: real ;
begin
getr( val) ;
result : = val;
end ;
function GetDouble: real ;
begin
result : = GetReal;
end ;
function GetChar: char ;
var val: char ;
begin
getc( val) ;
result : = val;
end ;
function GetString: string ;
var val: System. Text . StringBuilder;
begin
2015-12-28 14:25:15 +03:00
val : = new System. Text . StringBuilder( 2 0 0 ) ; //TODO почему 200?
2015-05-14 22:35:07 +03:00
_gets( val) ;
result : = val. ToString;
end ;
function GetBool: boolean ;
var val: integer ;
begin
_getb( val) ;
result : = val= 1 ;
end ;
function GetBoolean: boolean ;
begin
result : = GetBool;
end ;
function GetNode: Node;
procedure GetPtr( var sNode: InternalNode; var pNode: IntPtr ) ;
var p: IntPtr ;
begin
p : = IntPtr . Zero;
_GetP( p) ;
pNode : = p;
if p < > IntPtr . Zero then
sNode : = InternalNode( Marshal. PtrToStructure( p, typeof( InternalNode) ) ) ;
end ;
var
p: IntPtr ;
sNode: InternalNode;
begin
2015-12-28 14:25:15 +03:00
//raise new NotSupportedException('Работа с динамическими структурами задачника PT4 не поддерживается в этой версии компилятора. Исправление ошибки планируется в следуйщей версии');
//result := new PT4Node(sNode, p);// fixme здесь ошибка генерации кода!
2015-05-14 22:35:07 +03:00
p : = IntPtr . Zero;
sNode. Data : = 0 ;
sNode. Next : = IntPtr . Zero;
sNode. Prev : = IntPtr . Zero;
sNode. Left : = IntPtr . Zero;
sNode. Right : = IntPtr . Zero;
sNode. Parent : = IntPtr . Zero;
GetPtr( sNode, p) ;
if p = IntPtr . Zero then
result : = nil
else begin
2016-12-12 00:18:03 +03:00
for var i: = 0 to loadNodes. Count- 1 do
2015-05-14 22:35:07 +03:00
if sNode= Node( loadNodes[ i] ) . x then
result : = Node( loadNodes[ i] ) ;
if result = nil then begin
result : = new Node( sNode, p) ;
loadNodes. Add( result ) ;
end ;
end ;
end ;
function GetPNode: PNode;
var ip: IntPtr ;
begin
_GetP( ip) ;
Result : = PNode( pointer( ip) ) ;
end ;
function ReadInteger: integer ;
begin
Result : = GetInt;
end ;
function ReadReal: real ;
begin
Result : = GetReal;
end ;
function ReadChar: char ;
begin
Result : = GetChar;
end ;
function ReadString: string ;
begin
Result : = GetString;
end ;
function ReadBoolean: boolean ;
begin
Result : = GetBool;
end ;
function ReadPNode: PNode;
begin
Result : = GetPNode;
end ;
function ReadNode: Node;
begin
Result : = GetNode;
end ;
2015-12-13 21:52:32 +03:00
function ReadlnInteger: integer ;
begin
Result : = GetInt;
end ;
function ReadlnReal: real ;
begin
Result : = GetReal;
end ;
function ReadlnChar: char ;
begin
Result : = GetChar;
end ;
function ReadlnString: string ;
begin
Result : = GetString;
end ;
function ReadlnBoolean: boolean ;
begin
Result : = GetBool;
end ;
function ReadlnPNode: PNode;
begin
Result : = GetPNode;
end ;
function ReadlnNode: Node;
begin
Result : = GetNode;
end ;
2016-12-12 00:18:03 +03:00
// == Версия 4.15. Дополнения ==
function ReadInteger( prompt: string ) : integer ;
begin
Result : = GetInt;
end ;
function ReadReal( prompt: string ) : real ;
begin
Result : = GetReal;
end ;
function ReadChar( prompt: string ) : char ;
begin
Result : = GetChar;
end ;
function ReadString( prompt: string ) : string ;
begin
Result : = GetString;
end ;
function ReadBoolean( prompt: string ) : boolean ;
begin
Result : = GetBool;
end ;
function ReadPNode( prompt: string ) : PNode;
begin
Result : = GetPNode;
end ;
function ReadNode( prompt: string ) : Node;
begin
Result : = GetNode;
end ;
function ReadlnInteger( prompt: string ) : integer ;
begin
Result : = GetInt;
end ;
function ReadlnReal( prompt: string ) : real ;
begin
Result : = GetReal;
end ;
function ReadlnChar( prompt: string ) : char ;
begin
Result : = GetChar;
end ;
function ReadlnString( prompt: string ) : string ;
begin
Result : = GetString;
end ;
function ReadlnBoolean( prompt: string ) : boolean ;
begin
Result : = GetBool;
end ;
function ReadlnPNode( prompt: string ) : PNode;
begin
Result : = GetPNode;
end ;
function ReadlnNode( prompt: string ) : Node;
begin
Result : = GetNode;
end ;
// == Версия 4.15. Конец дополнений ==
2018-07-31 20:01:19 +03:00
// == Версия 4.17. Дополнения ==
function ReadInteger2: ( integer , integer ) ;
begin
Result : = ( GetInt, GetInt) ;
end ;
function ReadReal2: ( real , real ) ;
begin
Result : = ( GetReal, GetReal) ;
end ;
function ReadChar2: ( char , char ) ;
begin
Result : = ( GetChar, GetChar) ;
end ;
function ReadString2: ( string , string ) ;
begin
Result : = ( GetString, GetString) ;
end ;
function ReadBoolean2: ( boolean , boolean ) ;
begin
Result : = ( GetBool, GetBool) ;
end ;
function ReadNode2: ( Node, Node) ;
begin
Result : = ( GetNode, GetNode) ;
end ;
function ReadlnInteger2: ( integer , integer ) ;
begin
Result : = ( GetInt, GetInt) ;
end ;
function ReadlnReal2: ( real , real ) ;
begin
Result : = ( GetReal, GetReal) ;
end ;
function ReadlnChar2: ( char , char ) ;
begin
Result : = ( GetChar, GetChar) ;
end ;
function ReadlnString2: ( string , string ) ;
begin
Result : = ( GetString, GetString) ;
end ;
function ReadlnBoolean2: ( boolean , boolean ) ;
begin
Result : = ( GetBool, GetBool) ;
end ;
function ReadlnNode2: ( Node, Node) ;
begin
Result : = ( GetNode, GetNode) ;
end ;
function ReadInteger2( prompt: string ) : ( integer , integer ) ;
begin
Result : = ( GetInt, GetInt) ;
end ;
function ReadReal2( prompt: string ) : ( real , real ) ;
begin
Result : = ( GetReal, GetReal) ;
end ;
function ReadChar2( prompt: string ) : ( char , char ) ;
begin
Result : = ( GetChar, GetChar) ;
end ;
function ReadString2( prompt: string ) : ( string , string ) ;
begin
Result : = ( GetString, GetString) ;
end ;
function ReadBoolean2( prompt: string ) : ( boolean , boolean ) ;
begin
Result : = ( GetBool, GetBool) ;
end ;
function ReadNode2( prompt: string ) : ( Node, Node) ;
begin
Result : = ( GetNode, GetNode) ;
end ;
function ReadlnInteger2( prompt: string ) : ( integer , integer ) ;
begin
Result : = ( GetInt, GetInt) ;
end ;
function ReadlnReal2( prompt: string ) : ( real , real ) ;
begin
Result : = ( GetReal, GetReal) ;
end ;
function ReadlnChar2( prompt: string ) : ( char , char ) ;
begin
Result : = ( GetChar, GetChar) ;
end ;
function ReadlnString2( prompt: string ) : ( string , string ) ;
begin
Result : = ( GetString, GetString) ;
end ;
function ReadlnBoolean2( prompt: string ) : ( boolean , boolean ) ;
begin
Result : = ( GetBool, GetBool) ;
end ;
function ReadlnNode2( prompt: string ) : ( Node, Node) ;
begin
Result : = ( GetNode, GetNode) ;
end ;
function ReadInteger3: ( integer , integer , integer ) ;
begin
Result : = ( GetInt, GetInt, GetInt) ;
end ;
function ReadReal3: ( real , real , real ) ;
begin
Result : = ( GetReal, GetReal, GetReal) ;
end ;
function ReadChar3: ( char , char , char ) ;
begin
Result : = ( GetChar, GetChar, GetChar) ;
end ;
function ReadString3: ( string , string , string ) ;
begin
Result : = ( GetString, GetString, GetString) ;
end ;
function ReadBoolean3: ( boolean , boolean , boolean ) ;
begin
Result : = ( GetBool, GetBool, GetBool) ;
end ;
function ReadNode3: ( Node, Node, Node) ;
begin
Result : = ( GetNode, GetNode, GetNode) ;
end ;
function ReadlnInteger3: ( integer , integer , integer ) ;
begin
Result : = ( GetInt, GetInt, GetInt) ;
end ;
function ReadlnReal3: ( real , real , real ) ;
begin
Result : = ( GetReal, GetReal, GetReal) ;
end ;
function ReadlnChar3: ( char , char , char ) ;
begin
Result : = ( GetChar, GetChar, GetChar) ;
end ;
function ReadlnString3: ( string , string , string ) ;
begin
Result : = ( GetString, GetString, GetString) ;
end ;
function ReadlnBoolean3: ( boolean , boolean , boolean ) ;
begin
Result : = ( GetBool, GetBool, GetBool) ;
end ;
function ReadlnNode3: ( Node, Node, Node) ;
begin
Result : = ( GetNode, GetNode, GetNode) ;
end ;
function ReadInteger3( prompt: string ) : ( integer , integer , integer ) ;
begin
Result : = ( GetInt, GetInt, GetInt) ;
end ;
function ReadReal3( prompt: string ) : ( real , real , real ) ;
begin
Result : = ( GetReal, GetReal, GetReal) ;
end ;
function ReadChar3( prompt: string ) : ( char , char , char ) ;
begin
Result : = ( GetChar, GetChar, GetChar) ;
end ;
function ReadString3( prompt: string ) : ( string , string , string ) ;
begin
Result : = ( GetString, GetString, GetString) ;
end ;
function ReadBoolean3( prompt: string ) : ( boolean , boolean , boolean ) ;
begin
Result : = ( GetBool, GetBool, GetBool) ;
end ;
function ReadNode3( prompt: string ) : ( Node, Node, Node) ;
begin
Result : = ( GetNode, GetNode, GetNode) ;
end ;
function ReadlnInteger3( prompt: string ) : ( integer , integer , integer ) ;
begin
Result : = ( GetInt, GetInt, GetInt) ;
end ;
function ReadlnReal3( prompt: string ) : ( real , real , real ) ;
begin
Result : = ( GetReal, GetReal, GetReal) ;
end ;
function ReadlnChar3( prompt: string ) : ( char , char , char ) ;
begin
Result : = ( GetChar, GetChar, GetChar) ;
end ;
function ReadlnString3( prompt: string ) : ( string , string , string ) ;
begin
Result : = ( GetString, GetString, GetString) ;
end ;
function ReadlnBoolean3( prompt: string ) : ( boolean , boolean , boolean ) ;
begin
Result : = ( GetBool, GetBool, GetBool) ;
end ;
function ReadlnNode3( prompt: string ) : ( Node, Node, Node) ;
begin
Result : = ( GetNode, GetNode, GetNode) ;
end ;
// == Версия 4.17. Конец дополнений ==
2015-05-14 22:35:07 +03:00
// -----------------------------------------------------
2015-12-28 14:25:15 +03:00
// Процедуры Put
2015-05-14 22:35:07 +03:00
// -----------------------------------------------------
procedure PutInt( val: integer ) ;
begin
putn( val) ;
end ;
procedure PutReal( val: Real ) ;
begin
putr( val) ;
end ;
procedure PutChar( val: char ) ;
begin
putc( val) ;
end ;
procedure PutString( val: string ) ;
begin
puts( val) ;
end ;
procedure PutBoolean( val: boolean ) ;
begin
if val then
_putb( 1 )
else _putb( 0 ) ;
end ;
procedure PutNode( val: Node) ;
var p: IntPtr ;
begin
p : = IntPtr . Zero;
if val < > nil then begin
if val. isDisposed then
raise new ObjectDisposedException( val. ToString, eMessage) ;
p : = val. addr;
end ;
_PutP( p) ;
end ;
procedure PutPNode( val: PNode) ;
var pp: pointer ;
begin
pp : = pointer( val) ;
_PutP( IntPtr( pp) ) ;
end ;
// -----------------------------------------------------
2015-12-28 14:25:15 +03:00
// Генерация исключений
2015-05-14 22:35:07 +03:00
// -----------------------------------------------------
procedure RaisePTAndCheckPT( e: Exception) ;
begin
RaisePT( e. GetType. ToString, e. Message ) ;
InfoS : = CheckPT( InfoT) ;
if InfoT = 0 then
System. Console. WriteLine( InfoS) ;
FreePT;
end ;
procedure GenerateNotSupportedTypeException( MsgTemplate, TypeName: string ) ;
var e: Exception;
begin
e : = new PT4Exception( string . Format( MsgTemplate, TypeName) ) ;
RaisePTAndCheckPT( e) ;
ExceptionThrowed : = true ;
raise e;
end ;
procedure GenerateNotSupportedWriteTypeException( TypeName: string ) ;
begin
GenerateNotSupportedTypeException( NotSupportedWriteTypeMessage, TypeName) ;
end ;
procedure GenerateNotSupportedReadTypeException( TypeName: string ) ;
begin
GenerateNotSupportedTypeException( NotSupportedReadTypeMessage, TypeName) ;
end ;
// -----------------------------------------------------
// read
// -----------------------------------------------------
procedure read( var x: byte ) ;
begin
GenerateNotSupportedReadTypeException( x. GetType. ToString) ;
end ;
procedure read( var x: shortint ) ;
begin
GenerateNotSupportedReadTypeException( x. GetType. ToString) ;
end ;
procedure read( var x: smallint ) ;
begin
GenerateNotSupportedReadTypeException( x. GetType. ToString) ;
end ;
procedure read( var x: word ) ;
begin
GenerateNotSupportedReadTypeException( x. GetType. ToString) ;
end ;
procedure read( var x: longword ) ;
begin
GenerateNotSupportedReadTypeException( x. GetType. ToString) ;
end ;
procedure read( var x: int64 ) ;
begin
GenerateNotSupportedReadTypeException( x. GetType. ToString) ;
end ;
procedure read( var x: uint64 ) ;
begin
GenerateNotSupportedReadTypeException( x. GetType. ToString) ;
end ;
procedure read( var x: single ) ;
begin
GenerateNotSupportedReadTypeException( x. GetType. ToString) ;
end ;
procedure Read( var val: integer ) ;
begin
val : = GetInt;
end ;
procedure Read( var val: real ) ;
begin
val : = GetReal;
end ;
procedure Read( var val: char ) ;
begin
val : = GetChar;
end ;
procedure Read( var val: string ) ;
begin
val : = GetString;
end ;
procedure Read( var val: boolean ) ;
begin
val : = GetBoolean;
end ;
procedure Read( var val: Node) ;
begin
val : = GetNode;
end ;
procedure Read( var val: PNode) ;
begin
val : = GetPNode;
end ;
procedure Readln;
begin
end ;
2015-12-13 21:52:32 +03:00
procedure Print( params args: array of object ) ;
begin
if args. Length = 0 then
exit;
for var i : = 0 to args. length - 1 do
write( args[ i] ) ;
end ;
procedure Println( params args: array of object ) ;
begin
Print( args) ;
end ;
2016-12-12 00:18:03 +03:00
// == Версия 4.15. Дополнения ==
procedure Print( s: string ) ;
begin
write( s) ;
end ;
procedure Println( s: string ) ;
begin
write( s) ;
end ;
2018-07-31 20:01:19 +03:00
procedure Print( s: char ) ;
begin
write( s) ;
end ;
procedure Println( s: char ) ;
begin
write( s) ;
end ;
2016-12-12 00:18:03 +03:00
// == Версия 4.15. Конец дополнений ==
2015-05-14 22:35:07 +03:00
{ procedure write ;
begin
end ; }
// -----------------------------------------------------
// InternalWrite
// -----------------------------------------------------
procedure InternalWrite( args: array of object ) ;
begin
if ( args[ 0 ] is PABCSystem. Text ) then
begin
for var i: = 1 to args. length - 1 do
PABCSystem. Write( PABCSystem. Text( args[ 0 ] ) , args[ i] ) ;
end
else
for var i: = 0 to args. length - 1 do
if args[ i] = nil then PutNode( nil ) else
if args[ i] is integer then PutInt( integer( args[ i] ) ) else
if args[ i] is shortint then PutInt( shortint( args[ i] ) ) else
if args[ i] is smallint then PutInt( smallint( args[ i] ) ) else
if args[ i] is int64 then PutInt( int64( args[ i] ) ) else
if args[ i] is byte then PutInt( byte( args[ i] ) ) else
if args[ i] is word then PutInt( word( args[ i] ) ) else
if args[ i] is longword then PutInt( longword( args[ i] ) ) else
if args[ i] is uint64 then PutInt( uint64( args[ i] ) ) else
if args[ i] is real then PutReal( real( args[ i] ) ) else
if args[ i] is char then PutChar( char( args[ i] ) ) else
if args[ i] is string then PutString( string( args[ i] ) ) else
if args[ i] is boolean then PutBoolean( boolean( args[ i] ) ) else
if args[ i] is Node then PutNode( Node( args[ i] ) ) else
if args[ i] is PointerOutput then
begin
var ip : = IntPtr( PointerOutput( args[ i] ) . p) ;
_PutP( ip) ;
end
2018-07-31 20:01:19 +03:00
// == Версия 4.17. Дополнения ==
else if args[ i] . GetType. FullName. StartsWith( 'System.Tuple' ) then
foreach var e in args[ i] . GetType. GetProperties do
InternalWrite( Arr( e. GetValue( args[ i] , nil ) ) )
else if args[ i] is IEnumerable then
begin
var e : = ( args[ i] as IEnumerable) . GetEnumerator;
while e. MoveNext do
InternalWrite( Arr( e. Current) ) ;
end
// == Версия 4.17. Конец дополнений ==
// == Версия 4.18. Дополнения ==
2018-08-30 20:02:25 +03:00
else
begin
var res : = PrintAttributeString( args[ i] ) ;
if res < > nil then
PutString( res)
else GenerateNotSupportedWriteTypeException( args[ i] . GetType. ToString) ;
end
2018-07-31 20:01:19 +03:00
// == Версия 4.18. Конец дополнений ==
2015-05-14 22:35:07 +03:00
end ;
procedure PT4_ExecuteBeforeProcessTerminateIn__Mode( e: Exception) ;
begin
if not ExceptionThrowed then
RaisePTAndCheckPT( e) ;
end ;
var __initialized : = false ;
procedure __InitModule;
begin
CurrentIOSystem : = new IOPT4System;
2016-12-12 00:18:03 +03:00
PrintDelimDefault : = '' ;
2015-05-14 22:35:07 +03:00
loadNodes : = new ArrayList;
ExecuteBeforeProcessTerminateIn__Mode + = PT4_ExecuteBeforeProcessTerminateIn__Mode;
StartPT( 5 1 2 ) ;
end ;
procedure __InitModule__;
begin
if not __initialized then
begin
__initialized : = true ;
__InitModule;
end ;
end ;
procedure __FinalizeModule__;
begin
InfoS : = CheckPT( InfoT) ;
if InfoT= 0 then
Console. WriteLine( InfoS) ;
FreePT;
2015-12-28 14:25:15 +03:00
// == Начало дополнений к версии 4.13 ==
2015-12-13 21:52:32 +03:00
var fpt : = FinishPT;
if fpt = 1 then exit;
var asm : = System. Reflection. Assembly. GetExecutingAssembly;
var nm : = asm . FullName;
Delete( nm, Pos( ',' , nm) , length( nm) ) ;
var prg : = asm . GetType( nm+ '.Program' ) ;
var solveproc : = prg. GetMethod( '$Main' ) ;
var initproc : = prg. GetMethod( '$_InitVariables_' ) ;
2018-07-31 20:01:19 +03:00
if ( solveproc = nil ) or ( initproc = nil ) then
foreach var prg0 in asm . GetTypes( ) do
begin
prg : = prg0;
solveproc : = prg0. GetMethod( '$Main' ) ;
initproc : = prg0. GetMethod( '$_InitVariables_' ) ;
if ( solveproc < > nil ) and ( initproc < > nil ) then
break;
end ;
2015-12-13 21:52:32 +03:00
var examunit : = asm . GetType( 'PT4Exam.PT4Exam' ) ;
var finexamproc: System. Reflection. MethodInfo : = nil ;
if examunit < > nil then
finexamproc : = examunit. GetMethod( 'FinExam' ) ;
var i : = 0 ;
while ( fpt = 0 ) and ( i < 1 0 ) do
begin
StartPT( 5 1 2 ) ;
try
2018-07-31 20:01:19 +03:00
foreach var f in prg. GetFields( ) do
2015-12-13 21:52:32 +03:00
if not f. Name . StartsWith( '$' ) then
try
f. SetValue( nil , nil ) ;
except
end ;
if initproc < > nil then
2018-07-31 20:01:19 +03:00
begin
2015-12-13 21:52:32 +03:00
initproc. Invoke( nil , nil ) ;
2018-07-31 20:01:19 +03:00
end ;
2015-12-13 21:52:32 +03:00
solveproc. Invoke( nil , nil ) ;
except
on e: Exception do
RaisePT( e. InnerException. GetType. ToString, e. InnerException. Message ) ;
end ;
if finexamproc < > nil then
finexamproc. Invoke( nil , nil ) ;
InfoS : = CheckPT( InfoT) ;
FreePT;
inc( i) ;
fpt : = FinishPT;
end ;
2015-12-28 14:25:15 +03:00
// == Конец дополнений к версии 4.13 ==
2015-05-14 22:35:07 +03:00
end ;
2015-12-28 14:25:15 +03:00
// == Версия 1.3. Дополнения ==
2015-05-14 22:35:07 +03:00
var
D: integer : = 2 ;
2018-08-30 20:02:25 +03:00
var
_Width: integer : = 0 ;
procedure ShowStr( s: string ) ; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'show' ;
procedure Show( s: string ) ;
begin
ShowStr( s. PadRight( _Width) ) ;
end ;
procedure Show( s: char ) ;
begin
ShowStr( s. ToString) ;
end ;
procedure Show( A: Real ) ;
begin
ShowStr( ( D > 0 ? string . Format( '{0,' + _Width+ ':f' + D+ '}' , a)
: ( D = 0 ? string . Format( '{0,' + _Width+ ':e}' , a)
: string . Format( '{0,' + _Width+ ':e' + ( - D) + '}' , a) ) ) . Replace( ',' , '.' ) ) ;
end ;
procedure Show( A: Integer ) ;
begin
ShowStr( A. ToString. PadLeft( _Width) ) ;
end ;
procedure ShowLine;
begin
Show( #13 ) ;
end ;
procedure ShowLine( S: string ) ;
begin
Show( S) ;
ShowLine;
end ;
procedure ShowLine( A: Real ) ;
begin
Show( A) ;
ShowLine;
end ;
procedure ShowLine( A: Integer ) ;
begin
Show( A) ;
ShowLine;
end ;
2015-05-14 22:35:07 +03:00
2018-08-30 20:02:25 +03:00
( *
2015-05-14 22:35:07 +03:00
procedure Show( S: string ; A: Integer ; W: Integer ) ;
var s0: string ;
begin
Str( A: W, s0) ;
Show( S + s0) ;
end ;
procedure Show( S: string ; A: Real ; W: Integer ) ;
var s0: string ;
begin
if D > 0 then
2015-12-13 21:52:32 +03:00
s0 : = string . Format( '{0,' + W+ ':f' + D+ '}' , A) . Replace( ',' , '.' )
2015-05-14 22:35:07 +03:00
else
2015-12-13 21:52:32 +03:00
s0 : = string . Format( '{0,' + W+ ':e}' , A) . Replace( ',' , '.' ) ;
2015-05-14 22:35:07 +03:00
Show( S + s0) ;
end ;
procedure Show( S: string ; A: Integer ) ;
begin
Show( S, A, 0 ) ;
end ;
procedure Show( S: string ; A: Real ) ;
begin
Show( S, A, 0 ) ;
end ;
procedure Show( A: Integer ; W: Integer ) ;
begin
Show( '' , A, W) ;
end ;
procedure Show( A: Real ; W: Integer ) ;
begin
Show( '' , A, W) ;
end ;
procedure Show( A: Integer ) ;
begin
Show( '' , A, 0 ) ;
end ;
procedure Show( A: Real ) ;
begin
Show( '' , A, 0 ) ;
end ;
procedure ShowLine( S: string ) ;
begin
Show( S + #13 ) ;
end ;
procedure ShowLine;
begin
Show( #13 ) ;
end ;
procedure ShowLine( S: string ; A: Integer ; W: Integer ) ;
begin
Show( S, A, W) ;
Show( #13 ) ;
end ;
procedure ShowLine( S: string ; A: Real ; W: Integer ) ;
begin
Show( S, A, W) ;
Show( #13 ) ;
end ;
procedure ShowLine( S: string ; A: Integer ) ;
begin
Show( S, A, 0 ) ;
Show( #13 ) ;
end ;
procedure ShowLine( S: string ; A: Real ) ;
begin
Show( S, A, 0 ) ;
Show( #13 ) ;
end ;
procedure ShowLine( A: Integer ; W: Integer ) ;
begin
Show( '' , A, W) ;
Show( #13 ) ;
end ;
procedure ShowLine( A: Real ; W: Integer ) ;
begin
Show( '' , A, W) ;
Show( #13 ) ;
end ;
procedure ShowLine( A: Integer ) ;
begin
Show( '' , A, 0 ) ;
Show( #13 ) ;
end ;
procedure ShowLine( A: Real ) ;
begin
2018-08-30 20:02:25 +03:00
Show( A) ;
2015-05-14 22:35:07 +03:00
Show( #13 ) ;
end ;
2018-08-30 20:02:25 +03:00
* )
// == Версия 4.18. Дополнения ==
var LineBreak : = false ;
procedure ShowArray( a: System. Array ; indexes: array of integer ; i: integer ) ; forward ;
var spaces : = 0 ;
procedure Show( params args: array of object ) ;
begin
// SHowStr('!!!!');
var b : = false ;
for var i: = 0 to args. length - 1 do
begin
if args[ i] = nil then Show( 'nil' ) else
if args[ i] is integer then Show( integer( args[ i] ) ) else
if args[ i] is shortint then ShowStr( shortint( args[ i] ) . ToString. PadLeft( _Width) ) else
if args[ i] is smallint then ShowStr( smallint( args[ i] ) . ToString. PadLeft( _Width) ) else
if args[ i] is int64 then ShowStr( int64( args[ i] ) . ToString. PadLeft( _Width) ) else
if args[ i] is byte then ShowStr( byte( args[ i] ) . ToString. PadLeft( _Width) ) else
if args[ i] is word then ShowStr( word( args[ i] ) . ToString. PadLeft( _Width) ) else
if args[ i] is longword then ShowStr( longword( args[ i] ) . ToString. PadLeft( _Width) ) else
if args[ i] is uint64 then ShowStr( uint64( args[ i] ) . ToString. PadLeft( _Width) ) else
if args[ i] is real then Show( real( args[ i] ) ) else
if args[ i] is char then Show( char( args[ i] ) ) else
if args[ i] is string then Show( string( args[ i] ) ) else
if args[ i] is boolean then Show( boolean( args[ i] ) . ToString) else
if args[ i] is Node then Show( 'Node' ) else
if args[ i] is PointerOutput then
begin
var ip : = IntPtr( PointerOutput( args[ i] ) . p) ;
ShowStr( ip. ToString. PadLeft( _Width) ) ;
end
else if args[ i] . GetType. FullName. StartsWith( 'System.Tuple' ) then
begin
LineBreak : = false ;
Show( '(' ) ;
foreach var e in args[ i] . GetType. GetProperties do
begin
if b then
Show( ',' )
else
b : = true ;
Show( e. GetValue( args[ i] , nil ) ) ;
end ;
Show( ')' ) ;
b : = false ;
end
else if args[ i] . GetType. Name . StartsWith( 'KeyValuePair' ) then
begin
LineBreak : = false ;
Show( '(' ) ;
foreach var e in args[ i] . GetType. GetProperties do
begin
if b then
Show( ':' )
else
b : = true ;
Show( e. GetValue( args[ i] , nil ) ) ;
end ;
Show( ')' ) ;
b : = false ;
end
else if args[ i] is System. Array then
begin
var a : = args[ i] as System. Array ;
ShowArray( a, new integer [ a. Rank] , 0 ) ;
end
else if args[ i] is IEnumerable then
begin
var isdictorset : = args[ i] . GetType. Name . Equals( 'Dictionary`2' ) or args[ i] . GetType. Name . Equals( 'SortedDictionary`2' )
or ( args[ i] . GetType = typeof( TypedSet) ) or args[ i] . GetType. Name . Equals( 'HashSet`1' )
or args[ i] . GetType. Name . Equals( 'SortedSet`1' ) ;
var ( lbr, rbr) : = isdictorset ? ( '{' , '}' ) : ( '[' , ']' ) ;
if LineBreak then
loop spaces do
Show( ' ' ) ;
Show( lbr) ;
LineBreak : = false ;
var e : = ( args[ i] as IEnumerable) . GetEnumerator;
while e. MoveNext do
begin
if b then
begin
if not LineBreak then
Show( ',' ) ;
end
else
b : = true ;
spaces + = 1 ;
Show( e. Current) ;
spaces - = 1 ;
end ;
if LineBreak then
loop spaces do
Show( ' ' ) ;
Show( rbr) ;
Show( #13 ) ;
LineBreak : = true ;
b : = false ;
end
else
begin
var res : = PrintAttributeString( args[ i] ) ;
if res < > nil then
Show( res)
else
Show( args[ i] . ToString) ;
end ;
end ;
end ;
procedure ShowArray( a: System. Array ; indexes: array of integer ; i: integer ) ;
begin
if i = a. Rank then
Show( a. GetValue( indexes) )
else
begin
if LineBreak then
loop spaces do
Show( ' ' ) ;
Show( '[' ) ;
LineBreak : = false ;
for var k : = 0 to a. GetLength( i) - 1 do
begin
indexes[ i] : = k;
spaces + = 1 ;
ShowArray( a, indexes, i + 1 ) ;
spaces - = 1 ;
if k < a. GetLength( i) - 1 then
if not LineBreak then
Show( {LineBreak ? ' ' : } ',' ) ;
end ;
if LineBreak then
loop spaces do
Show( ' ' ) ;
Show( ']' ) ;
Show( #13 ) ;
LineBreak : = true ;
end ;
end ;
procedure ShowLine( params args: array of object ) ;
begin
LineBreak : = false ;
Show( args) ;
if not LineBreak then
ShowLine;
end ;
procedure SetWidth( W: Integer ) ;
begin
if W > = 0 then
_Width : = W;
end ;
// == Конец дополнений к версии 4.18 ==
2015-05-14 22:35:07 +03:00
procedure HideTask; external '%PABCSYSTEM%\PT4\PT4PABC.dll' name 'hidetask' ;
procedure SetPrecision( N: Integer ) ;
begin
if N < = 0 then
D : = 0
else
D : = N;
end ;
2015-12-28 14:25:15 +03:00
// == Конец дополнений к версии 1.3 ==
2015-05-14 22:35:07 +03:00
2015-12-28 14:25:15 +03:00
// == Версия 4.14. Дополнения ==
2015-12-13 21:52:32 +03:00
2016-12-12 00:18:03 +03:00
function ReadSeqInteger( ) : sequence of integer ;
2015-12-13 21:52:32 +03:00
begin
result : = Range( 1 , GetInteger( ) ) . Select( e - > GetInteger( ) ) . ToArray( ) ;
end ;
2016-12-12 00:18:03 +03:00
function ReadSeqReal( ) : sequence of real ;
2015-12-13 21:52:32 +03:00
begin
result : = Range( 1 , GetInteger( ) ) . Select( e - > GetReal( ) ) . ToArray( ) ;
end ;
2016-12-12 00:18:03 +03:00
function ReadSeqString( ) : sequence of string ;
2015-12-13 21:52:32 +03:00
begin
result : = Range( 1 , GetInteger( ) ) . Select( e - > GetString( ) ) . ToArray( ) ;
end ;
2016-12-12 00:18:03 +03:00
function ReadSeqInteger( n: integer ) : sequence of integer ;
2015-12-13 21:52:32 +03:00
begin
result : = Range( 1 , n) . Select( e - > GetInteger( ) ) . ToArray( ) ;
end ;
2016-12-12 00:18:03 +03:00
function ReadSeqReal( n: integer ) : sequence of real ;
2015-12-13 21:52:32 +03:00
begin
result : = Range( 1 , n) . Select( e - > GetReal( ) ) . ToArray( ) ;
end ;
2016-12-12 00:18:03 +03:00
function ReadSeqString( n: integer ) : sequence of string ;
2015-12-13 21:52:32 +03:00
begin
result : = Range( 1 , n) . Select( e - > GetString( ) ) . ToArray( ) ;
end ;
function ReadArrInteger( ) : array of integer ;
begin
result : = Range( 1 , GetInteger( ) ) . Select( e - > GetInteger( ) ) . ToArray( ) ;
end ;
function ReadArrReal( ) : array of real ;
begin
result : = Range( 1 , GetInteger( ) ) . Select( e - > GetReal( ) ) . ToArray( ) ;
end ;
function ReadArrString( ) : array of string ;
begin
result : = Range( 1 , GetInteger( ) ) . Select( e - > GetString( ) ) . ToArray( ) ;
end ;
function ReadArrInteger( n: integer ) : array of integer ;
begin
result : = Range( 1 , n) . Select( e - > GetInteger( ) ) . ToArray( ) ;
end ;
function ReadArrReal( n: integer ) : array of real ;
begin
result : = Range( 1 , n) . Select( e - > GetReal( ) ) . ToArray( ) ;
end ;
function ReadArrString( n: integer ) : array of string ;
begin
result : = Range( 1 , n) . Select( e - > GetString( ) ) . ToArray( ) ;
end ;
2016-12-12 00:18:03 +03:00
function ReadMatrInteger( m, n: integer ) : array [ , ] of integer ;
2015-12-13 21:52:32 +03:00
begin
result : = new integer [ m, n] ;
for var i : = 0 to m- 1 do
for var j : = 0 to n- 1 do
result [ i, j] : = ReadInteger;
end ;
2016-12-12 00:18:03 +03:00
function ReadMatrInteger( ) : array [ , ] of integer ;
2015-12-13 21:52:32 +03:00
begin
result : = ReadMatrInteger( ReadInteger, ReadInteger) ;
end ;
function ReadMatrReal( m, n: integer ) : array [ , ] of real ;
begin
result : = new real [ m, n] ;
for var i : = 0 to m- 1 do
for var j : = 0 to n- 1 do
result [ i, j] : = ReadReal;
end ;
function ReadMatrReal( ) : array [ , ] of real ;
begin
result : = ReadMatrReal( ReadInteger, ReadInteger) ;
end ;
function ReadMatrString( m, n: integer ) : array [ , ] of string ;
begin
result : = new string [ m, n] ;
for var i : = 0 to m- 1 do
for var j : = 0 to n- 1 do
result [ i, j] : = ReadString;
end ;
function ReadMatrString( ) : array [ , ] of string ;
begin
result : = ReadMatrString( ReadInteger, ReadInteger) ;
end ;
2016-12-12 00:18:03 +03:00
procedure ReadMatr( var m, n: integer ; var a: array [ , ] of integer ) ;
begin
read( m) ; read( n) ;
a : = new integer [ m, n] ;
for var i : = 0 to m - 1 do
for var j : = 0 to n - 1 do
read( a[ i, j] ) ;
end ;
procedure ReadMatr( var m, n: integer ; var a: array [ , ] of real ) ;
begin
read( m) ; read( n) ;
a : = new real [ m, n] ;
for var i : = 0 to m - 1 do
for var j : = 0 to n - 1 do
read( a[ i, j] ) ;
end ;
procedure ReadMatr( var m, n: integer ; var a: array [ , ] of string ) ;
begin
read( m) ; read( n) ;
a : = new string [ m, n] ;
for var i : = 0 to m - 1 do
for var j : = 0 to n - 1 do
read( a[ i, j] ) ;
end ;
procedure ReadMatr( var m: integer ; var a: array [ , ] of integer ) ;
begin
read( m) ;
a : = new integer [ m, m] ;
for var i : = 0 to m - 1 do
for var j : = 0 to m - 1 do
read( a[ i, j] ) ;
end ;
procedure ReadMatr( var m: integer ; var a: array [ , ] of real ) ;
begin
read( m) ;
a : = new real [ m, m] ;
for var i : = 0 to m - 1 do
for var j : = 0 to m - 1 do
read( a[ i, j] ) ;
end ;
procedure ReadMatr( var m: integer ; var a: array [ , ] of string ) ;
begin
read( m) ;
a : = new string [ m, m] ;
for var i : = 0 to m - 1 do
for var j : = 0 to m - 1 do
read( a[ i, j] ) ;
end ;
procedure ReadMatr( var m, n: integer ; var a: array of array of integer ) ;
begin
read( m) ; read( n) ;
SetLength( a, m) ;
for var i : = 0 to m - 1 do
a[ i] : = ReadArrInteger( n) ;
end ;
procedure ReadMatr( var m, n: integer ; var a: array of array of real ) ;
begin
read( m) ; read( n) ;
SetLength( a, m) ;
for var i : = 0 to m - 1 do
a[ i] : = ReadArrReal( n) ;
end ;
procedure ReadMatr( var m, n: integer ; var a: array of array of string ) ;
begin
read( m) ; read( n) ;
SetLength( a, m) ;
for var i : = 0 to m - 1 do
a[ i] : = ReadArrString( n) ;
end ;
procedure ReadMatr( var m: integer ; var a: array of array of integer ) ;
begin
read( m) ;
SetLength( a, m) ;
for var i : = 0 to m - 1 do
a[ i] : = ReadArrInteger( m) ;
end ;
procedure ReadMatr( var m: integer ; var a: array of array of real ) ;
begin
read( m) ;
SetLength( a, m) ;
for var i : = 0 to m - 1 do
a[ i] : = ReadArrReal( m) ;
end ;
procedure ReadMatr( var m: integer ; var a: array of array of string ) ;
begin
read( m) ;
SetLength( a, m) ;
for var i : = 0 to m - 1 do
a[ i] : = ReadArrString( m) ;
end ;
procedure ReadMatr( var m, n: integer ; var a: List< List< integer > > ) ;
begin
read( m) ; read( n) ;
a : = new List< List< integer > > ( m) ;
for var i : = 0 to m - 1 do
a. Add( ReadSeqInteger( n) . ToList) ;
end ;
procedure ReadMatr( var m, n: integer ; var a: List< List< real > > ) ;
begin
read( m) ; read( n) ;
a : = new List< List< real > > ( m) ;
for var i : = 0 to m - 1 do
a. Add( ReadSeqReal( n) . ToList) ;
end ;
procedure ReadMatr( var m, n: integer ; var a: List< List< string > > ) ;
begin
read( m) ; read( n) ;
a : = new List< List< string > > ( m) ;
for var i : = 0 to m - 1 do
a. Add( ReadSeqString( n) . ToList) ;
end ;
procedure ReadMatr( var m: integer ; var a: List< List< integer > > ) ;
begin
read( m) ;
a : = new List< List< integer > > ( m) ;
for var i : = 0 to m - 1 do
a. Add( ReadSeqInteger( m) . ToList) ;
end ;
procedure ReadMatr( var m: integer ; var a: List< List< real > > ) ;
begin
read( m) ;
a : = new List< List< real > > ( m) ;
for var i : = 0 to m - 1 do
a. Add( ReadSeqReal( m) . ToList) ;
end ;
procedure ReadMatr( var m: integer ; var a: List< List< string > > ) ;
begin
read( m) ;
a : = new List< List< string > > ( m) ;
for var i : = 0 to m - 1 do
a. Add( ReadSeqString( m) . ToList) ;
end ;
2018-08-30 20:02:25 +03:00
// == Версия 4.18. Дополнения ==
function ReadMatrInteger( m: integer ) : array [ , ] of integer ;
begin
result : = ReadMatrInteger( m, m) ;
end ;
function ReadMatrReal( m: integer ) : array [ , ] of real ;
begin
result : = ReadMatrReal( m, m) ;
end ;
function ReadMatrString( m: integer ) : array [ , ] of string ;
begin
result : = ReadMatrString( m, m) ;
end ;
function ReadArrArrInteger( m, n: integer ) : array of array of integer ;
begin
SetLength( result , m) ;
for var i : = 0 to m - 1 do
result [ i] : = ReadArrInteger( n) ;
end ;
function ReadArrArrReal( m, n: integer ) : array of array of real ;
begin
SetLength( result , m) ;
for var i : = 0 to m - 1 do
result [ i] : = ReadArrReal( n) ;
end ;
function ReadArrArrString( m, n: integer ) : array of array of string ;
begin
SetLength( result , m) ;
for var i : = 0 to m - 1 do
result [ i] : = ReadArrString( n) ;
end ;
function ReadArrArrInteger( m: integer ) : array of array of integer : = ReadArrArrInteger( m, m) ;
function ReadArrArrReal( m: integer ) : array of array of real : = ReadArrArrReal( m, m) ;
function ReadArrArrString( m: integer ) : array of array of string : = ReadArrArrString( m, m) ;
function ReadArrArrInteger: array of array of integer ;
begin
var ( m, n) : = ReadInteger2;
result : = ReadArrArrInteger( m, n) ;
end ;
function ReadArrArrReal: array of array of real ;
begin
var ( m, n) : = ReadInteger2;
result : = ReadArrArrReal( m, n) ;
end ;
function ReadArrArrString: array of array of string ;
begin
var ( m, n) : = ReadInteger2;
result : = ReadArrArrString( m, n) ;
end ;
function ReadListInteger( n: integer ) : List< integer > : = Range( 1 , n) . Select( e - > GetInteger( ) ) . ToList( ) ;
function ReadListReal( n: integer ) : List< real > : = Range( 1 , n) . Select( e - > GetReal( ) ) . ToList( ) ;
function ReadListString( n: integer ) : List< string > : = Range( 1 , n) . Select( e - > GetString( ) ) . ToList( ) ;
function ReadListInteger: List< integer > : = ReadListInteger( ReadInteger) ;
function ReadListReal: List< real > : = ReadListReal( ReadInteger) ;
function ReadListString: List< string > : = ReadListString( ReadInteger) ;
function ReadListListInteger( m, n: integer ) : List< List< integer > > ;
begin
result : = new List< List< integer > > ( m) ;
loop m do
result . Add( ReadListInteger( n) ) ;
end ;
function ReadListListReal( m, n: integer ) : List< List< real > > ;
begin
result : = new List< List< real > > ( m) ;
loop m do
result . Add( ReadListReal( n) ) ;
end ;
function ReadListListString( m, n: integer ) : List< List< string > > ;
begin
result : = new List< List< string > > ( m) ;
loop m do
result . Add( ReadListString( n) ) ;
end ;
function ReadListListInteger( m: integer ) : List< List< integer > > : = ReadListListInteger( m, m) ;
function ReadListListReal( m: integer ) : List< List< real > > : = ReadListListReal( m, m) ;
function ReadListListString( m: integer ) : List< List< string > > : = ReadListListString( m, m) ;
function ReadListListInteger: List< List< integer > > ;
begin
var ( m, n) : = ReadInteger2;
result : = ReadListListInteger( m, n) ;
end ;
function ReadListListReal: List< List< real > > ;
begin
var ( m, n) : = ReadInteger2;
result : = ReadListListReal( m, n) ;
end ;
function ReadListListString: List< List< string > > ;
begin
var ( m, n) : = ReadInteger2;
result : = ReadListListString( m, n) ;
end ;
// == Конец дополнений к версии 4.18 ==
2016-12-12 00:18:03 +03:00
procedure WriteMatr< T> ( a: array [ , ] of T) ;
begin
for var i : = 0 to a. GetLength( 0 ) - 1 do
for var j : = 0 to a. GetLength( 1 ) - 1 do
write( a[ i, j] ) ;
end ;
procedure WriteMatr< T> ( a: array of array of T) ;
begin
for var i : = 0 to a. Length - 1 do
for var j : = 0 to a[ i] . Length - 1 do
write( a[ i] [ j] ) ;
end ;
procedure WriteMatr< T> ( a: List< List< T> > ) ;
begin
for var i : = 0 to a. Count- 1 do
for var j : = 0 to a[ i] . Count- 1 do
write( a[ i] [ j] ) ;
end ;
2015-12-13 21:52:32 +03:00
2015-12-28 14:25:15 +03:00
/// Выводит размер и элементы последовательности
2016-12-12 00:18:03 +03:00
procedure WriteAll< T> ( self: sequence of T) ; extensionmethod;
2015-12-13 21:52:32 +03:00
begin
var b : = self. ToArray( ) ;
PT4. Put( b. Length ) ;
foreach e : T in b do
2018-08-30 20:02:25 +03:00
PT4. Write( e) ;
2015-12-13 21:52:32 +03:00
end ;
2015-12-28 14:25:15 +03:00
/// Выводит элементы последовательности
2016-12-12 00:18:03 +03:00
procedure Write< T> ( self: sequence of T) ; extensionmethod;
2015-12-13 21:52:32 +03:00
begin
var b : = self. ToArray( ) ;
foreach e : T in b do
2018-08-30 20:02:25 +03:00
PT4. Write( e) ;
2015-12-13 21:52:32 +03:00
end ;
2015-12-28 14:25:15 +03:00
/// Выводит элементы динамического массива
2015-12-13 21:52:32 +03:00
procedure Write< T> ( self: array of T) ; extensionmethod;
begin
for var i: = 0 to self. Length - 1 do
2018-08-30 20:02:25 +03:00
PT4. Write( self[ i] ) ;
2015-12-13 21:52:32 +03:00
end ;
2015-12-28 14:25:15 +03:00
/// Выводит элементы матрицы
2015-12-13 21:52:32 +03:00
procedure Write< T> ( self: array [ , ] of T) ; extensionmethod;
begin
for var i: = 0 to self. GetLength( 0 ) - 1 do
for var j: = 0 to self. GetLength( 1 ) - 1 do
2018-08-30 20:02:25 +03:00
PT4. Write( self[ i, j] ) ;
2015-12-13 21:52:32 +03:00
end ;
2016-12-12 00:18:03 +03:00
// == Дополнения 2016.07
2018-08-30 20:02:25 +03:00
( *
// == Удалено в версии 4.18
2016-12-12 00:18:03 +03:00
procedure PrintMatr< T> ( a: array [ , ] of T) ;
begin
for var i : = 0 to a. GetLength( 0 ) - 1 do
for var j : = 0 to a. GetLength( 1 ) - 1 do
write( a[ i, j] ) ;
end ;
procedure PrintMatr< T> ( a: array of array of T) ;
begin
for var i : = 0 to a. Length - 1 do
for var j : = 0 to a[ i] . Length - 1 do
write( a[ i] [ j] ) ;
end ;
procedure PrintMatr< T> ( a: List< List< T> > ) ;
begin
for var i : = 0 to a. Count- 1 do
for var j : = 0 to a[ i] . Count- 1 do
write( a[ i] [ j] ) ;
end ;
2018-08-30 20:02:25 +03:00
* )
2016-12-12 00:18:03 +03:00
/// Выводит размер и элементы последовательности
procedure PrintAll< T> ( self: sequence of T) ; extensionmethod;
begin
var b : = self. ToArray( ) ;
PT4. Put( b. Length ) ;
foreach e : T in b do
2018-08-30 20:02:25 +03:00
PT4. Write( e) ;
2016-12-12 00:18:03 +03:00
end ;
/// Выводит размер и элементы динамического массива
procedure PrintAll< T> ( self: array of T) ; extensionmethod;
begin
PT4. Put( self. Length ) ;
for var i: = 0 to self. Length - 1 do
2018-08-30 20:02:25 +03:00
PT4. Write( self[ i] ) ;
2016-12-12 00:18:03 +03:00
end ;
/// Выводит размер и элементы динамического массива
procedure WriteAll< T> ( self: array of T) ; extensionmethod;
begin
PT4. Put( self. Length ) ;
for var i: = 0 to self. Length - 1 do
2018-08-30 20:02:25 +03:00
PT4. Write( self[ i] ) ;
2016-12-12 00:18:03 +03:00
end ;
/// Выводит элементы последовательности
procedure Writeln< T> ( self: sequence of T) ; extensionmethod;
begin
var b : = self. ToArray( ) ;
foreach e : T in b do
2018-08-30 20:02:25 +03:00
PT4. Write( e) ;
2016-12-12 00:18:03 +03:00
end ;
/// Выводит элементы динамического массива
procedure Writeln< T> ( self: array of T) ; extensionmethod;
begin
for var i: = 0 to self. Length - 1 do
2018-08-30 20:02:25 +03:00
PT4. Write( self[ i] ) ;
2016-12-12 00:18:03 +03:00
end ;
/// Выводит элементы матрицы
procedure Writeln< T> ( self: array [ , ] of T) ; extensionmethod;
begin
for var i: = 0 to self. GetLength( 0 ) - 1 do
for var j: = 0 to self. GetLength( 1 ) - 1 do
2018-08-30 20:02:25 +03:00
PT4. Write( self[ i, j] ) ;
2016-12-12 00:18:03 +03:00
end ;
// == Конец дополнений 2016.07
2015-12-28 14:25:15 +03:00
/// Выводит в разделе отладки окна задачника
/// комментарий cmt, размер последовательности и значения,
/// полученные из элементов последовательности
2018-08-30 20:02:25 +03:00
/// с помощью указанного лямбда-выражения.
/// После этого переходит на новую экранную строку.
function Show< TSource> ( self: sequence of TSource; cmt: string ; selector: System. Func< TSource, object > ) : sequence of TSource; extensionmethod;
begin
var b : = self. Select( selector) ; //.ToArray();
if cmt < > '' then
PT4. Show( cmt) ;
PT4. Show( ( b. Count + ':' ) . PadLeft( 3 ) ) ;
// foreach var e in b do
PT4. Show( b) ;
if not LineBreak then
PT4. ShowLine( ) ;
2015-12-13 21:52:32 +03:00
result : = self;
end ;
2015-12-28 14:25:15 +03:00
/// Выводит в разделе отладки окна задачника
/// размер последовательности и значения,
/// полученные из элементов последовательности
2018-08-30 20:02:25 +03:00
/// с помощью указанного лямбда-выражения.
/// После этого переходит на новую экранную строку.
function Show< TSource> ( Self: sequence of TSource; selector: System. Func< TSource, object > ) : sequence of TSource; extensionmethod;
2015-12-13 21:52:32 +03:00
begin
result : = self. Show( '' , selector) ;
end ;
2015-12-28 14:25:15 +03:00
/// Выводит в разделе отладки окна задачника
2018-08-30 20:02:25 +03:00
/// комментарий cmt, размер последовательности и е е элементы.
/// После этого переходит на новую экранную строку.
2016-12-12 00:18:03 +03:00
function Show< TSource> ( Self: sequence of TSource; cmt: string ) : sequence of TSource; extensionmethod;
2015-12-13 21:52:32 +03:00
begin
result : = self;
2018-08-30 20:02:25 +03:00
self. Show( cmt, e - > object( e) ) ;
2015-12-13 21:52:32 +03:00
end ;
2016-12-12 00:18:03 +03:00
2015-12-28 14:25:15 +03:00
/// Выводит в разделе отладки окна задачника
/// размер последовательности и е е элементы.
2018-08-30 20:02:25 +03:00
/// После этого переходит на новую экранную строку.
2016-12-12 00:18:03 +03:00
function Show< TSource> ( Self: sequence of TSource) : sequence of TSource; extensionmethod;
2015-12-13 21:52:32 +03:00
begin
2018-08-30 20:02:25 +03:00
result : = self;
self. Show( '' , e - > e as object ) ;
2015-12-13 21:52:32 +03:00
end ;
2015-12-28 14:25:15 +03:00
// == Конец дополнений к версии 4.14 ==
2015-12-13 21:52:32 +03:00
2015-05-14 22:35:07 +03:00
initialization
__InitModule;
finalization
__FinalizeModule__;
end .