MaksNew

Untitled

Oct 29th, 2020
166
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 5.32 KB | None | 0 0
  1. program Lab2_4;
  2.  
  3. uses
  4.     System.SysUtils;
  5.  
  6. type
  7.     Matrix = array of array of Integer;
  8.  
  9. var
  10.     MainMatrix: Matrix;
  11.     Order: Integer;
  12.     Path: String;
  13.     Zero: array of Integer;
  14.  
  15. function IsFileCorrect(var Path: String; Order: Integer): Boolean;
  16. var
  17.     ISize, JSize, Num: Integer;
  18.     IsCorrect: Boolean;
  19.     MatrixFile: TextFile;
  20. begin
  21.     ISize := 0;
  22.     JSize := 0;
  23.     IsCorrect := true;
  24.     AssignFile(MatrixFile, Path);
  25.     Reset(MatrixFile);
  26.     while not(SeekEof(MatrixFile)) and IsCorrect do
  27.     begin
  28.         inc(ISize);
  29.         while not(SeekEoln(MatrixFile)) and IsCorrect do
  30.         begin
  31.             try
  32.                 Read(MatrixFile, Num);
  33.             except
  34.                 IsCorrect := false;
  35.             end;
  36.             inc(JSize);
  37.         end;
  38.         Readln(MatrixFile);
  39.         if (JSize <> Order) then
  40.             IsCorrect := false;
  41.         JSize := 0;
  42.     end;
  43.     if ISize <> Order then
  44.         IsCorrect := false;
  45.     CloseFile(MatrixFile);
  46.     result := IsCorrect;
  47. end;
  48.  
  49. function FilePath(Order: Integer): String;
  50. var
  51.     Path: String;
  52.     IsCorrect: Boolean;
  53. begin
  54.     repeat
  55.         Writeln('Введите абсолютный путь к файлу ');
  56.         Readln(Path);
  57.         IsCorrect := false;
  58.         if FileExists(Path) then
  59.         begin
  60.             if IsFileCorrect(Path, Order) then
  61.                 IsCorrect := true
  62.             else
  63.                 Writeln('Данные в файле некорректны');
  64.         end
  65.         else
  66.             Writeln('Файл не найден');
  67.  
  68.     until IsCorrect;
  69.     result := Path;
  70. end;
  71.  
  72. function InputOrder(): Integer;
  73. var
  74.     Order: Integer;
  75.     IsCorrect: Boolean;
  76. begin
  77.     repeat
  78.         Writeln('Введите порядок матрицы: ');
  79.         IsCorrect := true;
  80.         try
  81.             Readln(Order)
  82.         except
  83.             IsCorrect := false;
  84.             Writeln('Порядок матрицы должен быть числом')
  85.         end;
  86.         if ((Order < 1) or (Order > 10000))and IsCorrect then
  87.         begin
  88.             Writeln('Размер матрицы должен принадлежать промежутку от 2 до 10000');
  89.             IsCorrect := false
  90.         end;
  91.  
  92.     until IsCorrect;
  93.     result := Order;
  94. end;
  95.  
  96. procedure FileToMatrix(var MainMatrix:Matrix; Order: Integer; var Path: String);
  97. var
  98.     I, J: Integer;
  99.     MatrixFile: TextFile;
  100. begin
  101.     SetLength(MainMatrix, Order, Order);
  102.     AssignFile(MatrixFile, Path);
  103.     Reset(MatrixFile);
  104.     for I := 0 to Order-1 do
  105.     begin
  106.         for J := 0 to Order-1 do
  107.         Read(MatrixFile, MainMatrix[I, J]);
  108.         Readln(MatrixFile);
  109.     end;
  110.     CloseFile(MatrixFile);
  111. end;
  112.  
  113. function Output(): String;
  114. var
  115.     Patho: String;
  116.     IsCorrect: Boolean;
  117. begin
  118.     IsCorrect := false;
  119.     repeat
  120.         Writeln('Введите директорию, в которую хотите сохранить матрицу');
  121.         Readln(Patho);
  122.         if DirectoryExists(Patho) then
  123.             IsCorrect := true
  124.         else
  125.             Writeln('Такой директории не существует.Попробуйте ещё раз');
  126.     until IsCorrect;
  127.     Result := Patho;
  128. end;
  129.  
  130. procedure ConditionToFile(MainMatrix: Matrix; Order: Integer; var Zero: array of Integer);
  131. var
  132.     I, J: Integer;
  133.     OutputFile: TextFile;
  134.     Directory: String;
  135. begin
  136.     Directory := Output();
  137.     AssignFile(OutputFile, Directory + '\output.txt');
  138.     Rewrite(OutputFile);
  139.  
  140.     for I := 0 to High(Zero) do
  141.     begin
  142.         Zero[I]:=1;
  143.         Write(OutputFile, Zero[I]:6);
  144.         Writeln(OutputFile);
  145.     end;
  146.  
  147.     for I := 0 to High(MainMatrix) do
  148.     begin
  149.         for J := 0 to High(MainMatrix) do
  150.             Write(OutputFile, MainMatrix[I, J]:6);
  151.             Writeln(OutputFile);
  152.     end;
  153.  
  154.         for I := 0 to High(Zero) do
  155.     begin
  156.         Zero[I]:=1;
  157.         Write(OutputFile, Zero[I]:6);
  158.         Writeln(OutputFile);
  159.     end;
  160.  
  161.     Writeln('Матрица сохранена по указанному пути');
  162.     CloseFile(OutputFile);
  163.     Writeln;
  164. end;
  165.  
  166. procedure PrintMatrix(MainMatrix: Matrix);
  167. var
  168.     I, J: Integer;
  169. begin
  170. Writeln;
  171.     for I := 0 to High(MainMatrix) do
  172.     begin
  173.         for J := 0 to High(MainMatrix) do
  174.             Write(MainMatrix[I, J]:6);
  175.             Writeln;
  176.     end;
  177. Writeln;
  178. end;
  179.  
  180. procedure Condition(MainMatrix: Matrix; Order: Integer; var Zero: array of Integer);
  181. var
  182. I, J:Integer;
  183.  
  184. begin
  185.     for I := 0 to High(Zero) do
  186.     begin
  187.         Zero[I]:=1;
  188.         Write(Zero[I]:6);
  189.     end;
  190.     Writeln;
  191.  
  192.     for I := 0 to High(MainMatrix) do
  193.     begin
  194.         for J := 0 to High(MainMatrix) do
  195.         Write(MainMatrix[I, J]:6);
  196.         Writeln;
  197.     end;
  198.  
  199.     for I := 0 to High(Zero) do
  200.     begin
  201.         Zero[I]:=1;
  202.         Write(Zero[I]:6);
  203.     end;
  204.     Writeln;
  205.  
  206. end;
  207.  
  208. begin
  209.     Order := InputOrder();
  210.     Path := FilePath(Order);
  211.     FileToMatrix(MainMatrix, Order, Path);
  212.     Writeln('Матрица до выполнения условия: ');
  213.     PrintMatrix(MainMatrix);
  214.     Writeln('Матрица после выполнения условия: ');
  215.     Setlength(Zero, Order);
  216.     Condition(MainMatrix, Order, Zero);
  217.     ConditionToFile(MainMatrix, Order, Zero);
  218.     Readln;
  219. end.
Advertisement
Add Comment
Please, Sign In to add comment