В PT4 добавлны AArray, AFunc, AProc

Добавлен стандартный модуль PT4Databases.pas

Configuration/GlobalAssemblyInfo.cs

@@ -15,7 +15,7 @@ internal static class RevisionClass
 	public const string Major = "3";
 	public const string Minor = "7";
 	public const string Build = "2";
-	public const string Revision = "2805";
+	public const string Revision = "2806";
 
         public const string MainVersion = Major + "." + Minor;
 	public const string FullVersion = Major + "." + Minor + "." + Build + "." + Revision;

Configuration/Version.defs

@@ -1,4 +1,4 @@
-%MINOR%=7
-%REVISION%=2805
 %COREVERSION%=2
+%REVISION%=2806
+%MINOR%=7
 %MAJOR%=3

Release/pabcversion.txt

@@ -1 +1 @@
-3.7.2.2805
+3.7.2.2806

ReleaseGenerators/PascalABCNET_version.nsh

@@ -1 +1 @@
-!define VERSION '3.7.2.2805'
+!define VERSION '3.7.2.2806'

ReleaseGenerators/RebuildStandartModules.pas

@@ -12,7 +12,7 @@
    IniFile, PointerTools, PointRect, PT4, PT4MakerNetX, Robot, RobotField,
    RobotTaskMaker, RobotZadan, Sockets, Utils, VCL, Timers, PT4Exam, PT4TaskMakerNET, RBDMUtils,
    Collections, Arrays, Core, FormsABC, MPI, ClientServer, Speech, Sounds, Countries,
-   ABCDatabases,BlockFileOfT,Controls,
+   ABCDatabases,PT4Databases,BlockFileOfT,Controls,
    OpenCLABC, OpenCL, OpenCLABCBase, 
    OpenGLABC, OpenGL, OpenGLABCBase, 
    BBCMicroBit, School, SF, TwoPanelsWindow, NUnitABC

ReleaseGenerators/sect_Core.nsh

@@ -81,6 +81,7 @@
     File ..\bin\Lib\ABCObjects.pcu
     File ..\bin\Lib\ABCSprites.pcu
     File ..\bin\Lib\ABCDatabases.pcu
+    File ..\bin\Lib\PT4Databases.pcu
     File ..\bin\Lib\Arrays.pcu
     ;File ..\bin\Lib\Colors.pcu
     File ..\bin\Lib\CRT.pcu
@@ -151,6 +152,7 @@
     ${AddFile} "ABCHouse.pcu"
     ${AddFile} "ABCObjects.pcu"
     ${AddFile} "ABCDatabases.pcu"
+    ${AddFile} "PT4Databases.pcu"
     ${AddFile} "ABCSprites.pcu"
     ${AddFile} "Arrays.pcu"
     ${AddFile} "BFSystem.pcu"
@@ -243,6 +245,7 @@
     File ..\bin\Lib\ABCObjects.pas
     File ..\bin\Lib\ABCSprites.pas
     File ..\bin\Lib\ABCDatabases.pas
+    File ..\bin\Lib\PT4Databases.pas
     File ..\bin\Lib\Arrays.pas
     ;File ..\bin\Lib\Colors.pas
     File ..\bin\Lib\CRT.pas
@@ -313,6 +316,7 @@
     ${AddFile} "ABCObjects.pas"
     ${AddFile} "ABCSprites.pas"
     ${AddFile} "ABCDatabases.pas"
+    ${AddFile} "PT4Databases.pas"
     ${AddFile} "Arrays.pas"
     ;${AddFile} "Colors.pas"
     ${AddFile} "CRT.pas"

ReleaseGenerators/sect_PT4.nsh

@@ -160,6 +160,12 @@ Section $(DESC_PT4) PT4
   ${AddFile} "PT4ASeries.dll"
   File "PT4\Lib\PT4AWhile.dll"
   ${AddFile} "PT4AWhile.dll"
+  File "PT4\Lib\PT4AProc.dll"
+  ${AddFile} "PT4AProc.dll"
+  File "PT4\Lib\PT4AFunc.dll"
+  ${AddFile} "PT4AFunc.dll"
+  File "PT4\Lib\PT4AArray.dll"
+  ${AddFile} "PT4AArray.dll"
  
 
   SetOutPath "$INSTDIR\PT4\Lib\Graph"

bin/Lib/PT4Databases.pas

@@ -0,0 +1,509 @@
+unit PT4Databases;
+//uses PrintAttributeUnit;
+
+function PrintAttributeString(a: object): string; forward;
+function PrintAttributeString(a: object; fProvider: System.IFormatProvider): string; forward;
+
+type 
+  Country = auto class
+  private
+    _name, _capital: string;
+    _population: integer;
+    _continent: string;
+  public
+    [PrintAttribute(0, -32)]
+    property Name: string read _name;
+    [PrintAttribute(' ', 1, -19)]
+    property Capital: string read _capital;
+    [PrintAttribute(3, 13, 'd')]
+    property Population: integer read _population;
+    [PrintAttribute(' ', 2, -9)]
+    property Continent: string read _continent;
+  end;
+
+  Страна = auto class
+  private
+    _name, _capital: string;
+    _population: integer;
+    _continent: string;
+  public
+    [PrintAttribute(0, -32)]
+    property Название: string read _name;
+    [PrintAttribute(' ', 1, -19)]
+    property Столица: string read _capital;
+    [PrintAttribute(3, 13, 'd')]
+    property Население: integer read _population;
+    [PrintAttribute(' ', 2, -9)]
+    property Континент: string read _continent;
+  end;
+
+
+  ТипПола = (Муж, Жен);
+
+  Pupil = auto class
+  private
+    _name: string;
+    _gender: ТипПола; 
+    _height: integer;
+    _cls: integer;
+    _inSunSchool: boolean; 
+    function getGender: ТипПола := _gender;
+  public
+    [PrintAttribute(0, -16)]
+    property Name: string read _name;
+    [PrintAttribute(' ', 1, -3)]
+    property Gender: ТипПола read getGender;
+    [PrintAttribute(' ', 2, 3, 'd')]
+    property Height: integer read _height;
+    [PrintAttribute(' ',3, 2, 'd')]
+    property Cls: integer read _cls;
+    [PrintAttribute(' ', 4, -5)]
+    property InSunSchool: boolean read _inSunSchool;
+  end;
+
+  Ученик = auto class
+  private
+    _name: string;
+    _gender: ТипПола; 
+    _height: integer;
+    _cls: integer;
+    _inSunSchool: boolean; 
+    function getGender: ТипПола := _gender;
+  public
+    [PrintAttribute(0, -16)]
+    property Фамилия: string read _name;
+    [PrintAttribute(' ', 1, -3)]
+    property Пол: ТипПола read getGender;
+    [PrintAttribute(' ', 2, 3, 'd')]
+    property Рост: integer read _height;
+    [PrintAttribute(' ',3, 2, 'd')]
+    property Класс: integer read _cls;
+    [PrintAttribute(' ', 4, -5)]
+    property УчитсяВКШ: boolean read _inSunSchool;
+  end;
+
+function GenderToТипПола(a: string): ТипПола := a = 'Муж' ? Муж : Жен;
+function InSunSchoolToBoolean(a: string): boolean := a = 'Да';
+
+type 
+  Fitness = auto class
+  private
+    _code, _year, _month, _time: integer;
+  public
+//    [PrintAttribute('( Code = ', 0, 2)]
+//    property Код: integer read _code;
+    [PrintAttribute('( Code = ', 0, 2)]
+    property Code: integer read _code;
+//    [PrintAttribute(' , Year = ', 1, 4)]
+//    property Год: integer read _year;
+    [PrintAttribute(' , Year = ', 1, 4)]
+    property Year: integer read _year;
+//    [PrintAttribute(' , Month = ', 2, 2)]
+//    property Месяц: integer read _month;
+    [PrintAttribute(' , Month = ', 2, 2)]
+    property Month: integer read _month;
+//    [PrintAttribute(' , Time = ', 3, 2)]
+//    property Время: integer read _time;
+    [PrintAttribute(' , Time = ', 3, 2)]
+    property Time: integer read _time;
+    function ToString: string; override;
+    begin
+      result := PrintAttributeString(self);
+    end;
+  end;
+  
+  Abitur = auto class
+  private
+    _name: string;
+    _year: integer;
+    _school: integer;
+  public
+//    [PrintAttribute('( Name = ', 0, -11)]
+//    property Фамилия: string read _name;
+    [PrintAttribute('( Name = ', 0, -11)]
+    property Name: string read _name;
+//    [PrintAttribute(', Year = ', 1, 4)]
+//    property Год: integer read _year;
+    [PrintAttribute(', Year = ', 1, 4)]
+    property Year: integer read _year;
+//    [PrintAttribute(' , School = ', 2, 2)]
+//    property Школа: integer read _school;
+    [PrintAttribute(' , School = ', 2, 2)]
+    property School: integer read _school;
+    function ToString: string; override;
+    begin
+      result := PrintAttributeString(self);
+    end;
+  end;
+
+  Debtor = auto class
+  private
+    _name: string;
+    _flat: integer;
+    _debt: real;
+  public
+//    [PrintAttribute('( Name = ', 0, -11)]
+//    property Фамилия: string read _name;
+    [PrintAttribute('( Name = ', 0, -11)]
+    property Name: string read _name;
+//    [PrintAttribute(', Flat = ', 1, 3)]
+//    property Квартира: integer read _flat;
+    [PrintAttribute(', Flat = ', 1, 3)]
+    property Flat: integer read _flat;
+//    [PrintAttribute(' , Debt = ', 2, 7, 'f2')]
+//    property Долг: real read _debt;
+    [PrintAttribute(' , Debt = ', 2, 7, 'f2')]
+    property Debt: real read _debt;
+//    [PrintAttribute(' , Entrance = ', 3, 1)]
+//    property Подъезд: integer read (_flat - 1) div 36 + 1;
+    [PrintAttribute(' , Entrance = ', 3, 1)]
+    property Entrance: integer read (_flat - 1) div 36 + 1;
+//    [PrintAttribute(' , Floor = ', 4, 1)]
+//    property Этаж: integer read (_flat - 1) mod 36 div 4 + 1;
+    [PrintAttribute(' , Floor = ', 4, 1)]
+    property Floor: integer read (_flat - 1) mod 36 div 4 + 1;
+    function ToString: string; override;
+    begin
+      result := PrintAttributeString(self);
+    end;
+  end;
+
+FuelStation = auto class
+  private
+    _brand, _price: integer;
+    _company, _street: string;
+  public
+//    [PrintAttribute('( Brand = ', 0, 2)]
+//    property Марка: integer read _brand;
+    [PrintAttribute('( Brand = ', 0, 2)]
+    property Brand: integer read _brand;
+//    [PrintAttribute(', Price = ', 1, 4)]
+//    property Цена: integer read _price;
+    [PrintAttribute(', Price = ', 1, 4)]
+    property Price: integer read _price;
+//    [PrintAttribute(', Company = ', 2, -12)]
+//    property Компания: string read _company;
+    [PrintAttribute(', Company = ', 2, -12)]
+    property Company: string read _company;
+//    [PrintAttribute(', Street = ', 3, -15)]
+//    property Улица: string read _street;
+    [PrintAttribute(', Street = ', 3, -15)]
+    property Street: string read _street;
+    function ToString: string; override;
+    begin
+      result := PrintAttributeString(self);
+    end;
+  end;
+
+PupilExam = auto class
+  private
+    _name: string;
+    _school, _point0, _point1, _point2: integer;
+//    [PrintAttribute(' , Point : ', 2, 3)]
+//    property Балл0: integer read _point0;
+    [PrintAttribute(' , Point : ', 2, 3)]
+    property Point0: integer read _point0;
+//    [PrintAttribute(' , ', 3, 3)]
+//    property Балл1: integer read _point1;
+    [PrintAttribute(' , ', 3, 3)]
+    property Point1: integer read _point1;
+//    [PrintAttribute(' , ', 4, 3)]
+//    property Балл2: integer read _point2;
+    [PrintAttribute(' , ', 4, 3)]
+    property Point2: integer read _point2;
+  public
+//    [PrintAttribute('( Name = ', 0, -16)]
+//    property ФИО: string read _name;
+    [PrintAttribute('( Name = ', 0, -16)]
+    property Name: string read _name;
+//    [PrintAttribute(', School = ', 1, 2)]
+//    property Школа: integer read _school;
+    [PrintAttribute(', School = ', 1, 2)]
+    property School: integer read _school;
+//    property Балл: array of integer read Arr(_point0, _point1, _point2);
+    property Point: array of integer read Arr(_point0, _point1, _point2);
+    function ToString: string; override;
+    begin
+      result := PrintAttributeString(self);
+    end;
+  end;
+
+PupilMark = auto class
+  private
+    _name: string;
+    _cls: integer;
+    _subject: string;
+    _mark: integer;
+  public
+//    [PrintAttribute('( Name = ', 0, -16)]
+//    property ФИО: string read _name;
+    [PrintAttribute('( Name = ', 0, -16)]
+    property Name: string read _name;
+//    [PrintAttribute(', Cls = ', 1, 2)]
+//    property Класс: integer read _cls;
+    [PrintAttribute(', Cls = ', 1, 2)]
+    property Cls: integer read _cls;
+//    [PrintAttribute(' , Subject = ', 2, -11)]
+//    property Предмет: string read _subject;
+    [PrintAttribute(' , Subject = ', 2, -11)]
+    property Subject: string read _subject;
+//    [PrintAttribute(' , Mark = ', 3, 1)]
+//    property Оценка: integer read _mark;
+    [PrintAttribute(' , Mark = ', 3, 1)]
+    property Mark: integer read _mark;
+    function ToString: string; override;
+    begin
+      result := PrintAttributeString(self);
+    end;
+  end;
+
+function ЗаполнитьМассивСтран: array of Страна;
+begin
+  var fname := 'c:\Program files (x86)\PascalABC.NET\Files\Databases\Страны.csv';
+  if fname = '' then
+    raise new System.ApplicationException('Не найден массив стран Databases\Страны.csv');
+  Result := ReadLines(fname)
+    .Select(s->s.ToWords(';'))
+    .Select(w->new Страна(w[0],w[1],w[2].ToInteger,w[3])).ToArray;
+end; 
+
+function GetCountries: array of Country;
+begin
+  var fname := 'c:\Program files (x86)\PascalABC.NET\Files\Databases\Страны.csv';
+  if fname = '' then
+    raise new System.ApplicationException('Не найден массив стран Databases\Страны.csv');
+  Result := ReadLines(fname)
+    .Select(s->s.ToWords(';'))
+    .Select(w->new Country(w[0],w[1],w[2].ToInteger,w[3])).ToArray;
+end; 
+
+function ЗаполнитьМассивУчеников: array of Ученик;
+begin
+  var fname := 'c:\Program files (x86)\PascalABC.NET\Files\Databases\Ученики.csv';
+  if fname = '' then
+    raise new System.ApplicationException('Не найден массив учеников Databases\Ученики.csv');
+  Result := ReadLines(fname)
+    .Select(s->s.ToWords(';'))
+    .Select(w->new Ученик(w[0],GenderToТипПола(w[2]),w[4].ToInteger,w[1].ToInteger,
+      InSunschoolToBoolean(w[3]))).ToArray;
+end; 
+
+function GetPupils: array of Pupil;
+begin
+  var fname := 'c:\Program files (x86)\PascalABC.NET\Files\Databases\Ученики.csv';
+  if fname = '' then
+    raise new System.ApplicationException('Не найден массив учеников Databases\Ученики.csv');
+  Result := ReadLines(fname)
+    .Select(s->s.ToWords(';'))
+    .Select(w->new Pupil(w[0],GenderToТипПола(w[2]),w[4].ToInteger,w[1].ToInteger,
+      InSunschoolToBoolean(w[3]))).ToArray;
+end; 
+
+function GetFitness: array of Fitness;
+begin
+  var fname := 'Fitness.tst';
+  if not FileExists(fname) then
+  begin
+    fname := 'Fitness.txt';
+    if not FileExists(fname) then
+    raise new System.IO.FileNotFoundException('Не найден файл-источник для массива объектов Fitness');
+  end;  
+  try  
+  Result := ReadLines(fname)
+    .Select(s->s.ToWords(','))
+    .Select(w->new Fitness(w[0].ToInteger,w[1].ToInteger,w[2].ToInteger,w[3].ToInteger)).ToArray;
+  except
+    raise new System.FormatException('Файл-источник для массива объектов Fitness содержит неверные данные');
+  end;
+end; 
+
+function GetAbiturs: array of Abitur;
+begin
+  var fname := 'Abitur.tst';
+  if not FileExists(fname) then
+  begin
+    fname := 'Abitur.txt';
+    if not FileExists(fname) then
+    raise new System.IO.FileNotFoundException('Не найден файл-источник для массива объектов Abitur');
+  end;  
+  try  
+  Result := ReadLines(fname)
+    .Select(s->s.ToWords(','))
+    .Select(w->new Abitur(w[0],w[1].ToInteger,w[2].ToInteger)).ToArray;
+  except
+    raise new System.FormatException('Файл-источник для массива объектов Abitur содержит неверные данные');
+  end;
+end; 
+
+function GetDebtors: array of Debtor;
+begin
+  var fname := 'Debtor.tst';
+  if not FileExists(fname) then
+  begin
+    fname := 'Debtor.txt';
+    if not FileExists(fname) then
+    raise new System.IO.FileNotFoundException('Не найден файл-источник для массива объектов Debtor');
+  end;  
+  try  
+  Result := ReadLines(fname)
+    .Select(s->s.ToWords(','))
+    .Select(w->new Debtor(w[0],w[1].ToInteger,w[2].ToReal)).ToArray;
+  except
+    raise new System.FormatException('Файл-источник для массива объектов Debtor содержит неверные данные');
+  end;
+end; 
+
+function GetFuelStations: array of FuelStation;
+begin
+  var fname := 'FuelStation.tst';
+  if not FileExists(fname) then
+  begin
+    fname := 'FuelStation.txt';
+    if not FileExists(fname) then
+      raise new System.IO.FileNotFoundException('Не найден файл-источник для массива объектов FuelStation');
+  end;    
+  try  
+  Result := ReadLines(fname)
+    .Select(s->s.ToWords(','))
+    .Select(w->new FuelStation(w[0].ToInteger,w[1].ToInteger,w[2],w[3])).ToArray;
+  except
+    raise new System.FormatException('Файл-источник для массива объектов FuelStation содержит неверные данные');
+  end;
+end; 
+
+function GetPupilExams: array of PupilExam;
+begin
+  var fname := 'PupilExam.tst';
+  if not FileExists(fname) then
+  begin
+    fname := 'PupilExam.txt';
+    if not FileExists(fname) then
+      raise new System.IO.FileNotFoundException('Не найден файл-источник для массива объектов PupilExam');
+  end;  
+  try  
+  Result := ReadLines(fname)
+    .Select(s->s.ToWords(','))
+    .Select(w->new PupilExam(w[0],w[1].ToInteger,w[2].ToInteger,w[3].ToInteger,w[4].ToInteger)).ToArray;
+  except
+    raise new System.FormatException('Файл-источник для массива объектов PupilExam содержит неверные данные');
+  end;
+end; 
+
+function GetPupilMarks: array of PupilMark;
+begin
+  var fname := 'PupilMark.tst';
+  if not FileExists(fname) then
+  begin
+    fname := 'PupilMark.txt';
+    if not FileExists(fname) then
+    raise new System.IO.FileNotFoundException('Не найден файл-источник для массива объектов PupilMark');
+  end;
+  try  
+  Result := ReadLines(fname)
+    .Select(s->s.ToWords(','))
+    .Select(w->new PupilMark(w[0],w[1].ToInteger,w[2],w[3].ToInteger)).ToArray;
+  except
+    raise new System.FormatException('Файл-источник для массива объектов PupilMark содержит неверные данные');
+  end;
+end; 
+
+function PrintAttributeString(a: object; fProvider: System.IFormatProvider): string;
+begin
+  var t := a.GetType();
+  var res := new Dictionary<integer, string>();
+  foreach var p in t.GetProperties(System.Reflection.BindingFlags.Public 
+    or System.Reflection.BindingFlags.NonPublic or System.Reflection.BindingFlags.Instance) do
+  begin
+    var att := p.GetCustomAttribute(typeof(PrintAttribute), false) as PrintAttribute;
+    if att = nil then
+      continue;
+    var (c, n, w, f) := (att.Comment, att.Num, att.Width, att.Fmt);
+    var val := '';
+    var o := p.GetValue(a, nil);
+    if (f <> '') and (o is System.IFormattable) then
+    begin
+      val := System.IFormattable(o).ToString(f, fProvider);
+    end
+    else
+    begin
+      val := o.ToString;
+    end;  
+    if w > 0 then
+      val := val.PadLeft(w)
+    else if w < 0 then
+      val := val.PadRight(-w);
+    res[n] := c + val;
+  end;
+  result := nil;
+  if res.Keys.Count = 0 then
+    exit;
+  result := '';  
+  foreach var k in res.Keys.OrderBy(e -> e) do
+  begin
+    result += res[k];
+  end;  
+  var delim := Copy(result, 2, 1);  
+  if result.StartsWith('{') then
+    result += (delim = ' ') ? ' }' : '}'
+  else if result.StartsWith('[') then
+    result += (delim = ' ') ? ' ]' : ']'
+  else if result.StartsWith('(') then
+    result += (delim = ' ') ? ' )' : ')'
+  else if result.StartsWith('''') then
+    result += (delim = ' ') ? ' ''' : ''''
+  else if result.StartsWith('"') then
+    result += (delim = ' ') ? ' "' : '"';
+end;
+
+function PrintAttributeString(a: object): string;
+begin
+  result := PrintAttributeString(a, nil);
+end;
+
+function ToStr(params a: array of object): string;
+begin
+  result := '';
+  var b := false;
+  foreach var e in a do
+  begin
+    if b then
+      result += ' '
+    else
+      b := true;
+    if e is real then
+      result += real(e).ToString(2)
+    else if e is string then
+      result += e.ToString()
+    else if e.GetType.FullName.StartsWith('System.Tuple') then
+    begin
+       var b1 := false;
+       foreach var e1 in e.GetType.GetProperties do
+       begin
+          if b1 then
+            result += ' '
+          else
+            b1 := true;
+          result += ToStr(Arr(e1.GetValue(e,nil)));      
+       end;   
+    end      
+    else if e is System.Collections.IEnumerable then
+    begin
+       var b1 := false;
+       var e1 := (e as System.Collections.IEnumerable).GetEnumerator;
+       while e1.MoveNext do
+       begin
+          if b1 then
+            result += ' '
+          else
+            b1 := true;
+          result += ToStr(Arr(e1.Current));
+       end;   
+    end      
+    else 
+          result += e.ToString();
+  end;
+end;
+
+begin  
+  
+end.