Advertisement
MadCortez

Untitled

Oct 27th, 2020
167
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 7.01 KB | None | 0 0
  1. program laba2_4;
  2.  
  3. Uses
  4.    System.SysUtils;
  5.  
  6. Type
  7.    TArray = array of array of real;
  8.    
  9. procedure PrintTask; forward;
  10. function InputValue(Min, Max: Integer): Integer; forward;
  11. procedure UserInputArrayFromConsole(n: Integer); forward;
  12. procedure UserInputFromConsole(); forward;
  13. procedure UserInputFromFile(MyFile: TextFile); forward;
  14. function CheckPath(Path: String): Boolean; forward;
  15. function UserOutputPath(): String; forward;
  16. function Swap(Matrix: TArray):TArray; forward;
  17. procedure PrintWithoutPath(Matrix: TArray); forward;
  18. procedure PrintWithPath(Matrix: TArray); forward;
  19. function CheckFile(MyFile: TextFile): Boolean; forward;
  20. procedure UserInputPath(); forward;
  21. procedure InputMethod; forward;
  22. procedure OutputMethod(Matrix: TArray); forward;
  23.  
  24. function InputValue(Min, Max: Integer): Integer;
  25. var
  26.    CurrentValue: Integer;
  27.    IsValid: Boolean;
  28. begin
  29.    repeat
  30.    IsValid := True;
  31.    try
  32.       Read(CurrentValue);
  33.    except
  34.       begin
  35.          IsValid := False;
  36.          Writeln('Введено нецелое число');
  37.       end;
  38.    end;
  39.    if IsValid then
  40.       if (CurrentValue < Min) or (CurrentValue > Max) then
  41.       begin
  42.          IsValid := False;
  43.          Writeln('Введите число в заданном диапазоне');
  44.       end;
  45.    until IsValid;
  46.    InputValue := CurrentValue;
  47. end;
  48.    
  49. procedure UserInputArrayFromConsole(n: Integer);
  50. var
  51.    i, j: Integer;
  52.    Matrix: TArray;
  53.    const MIN_VALUE = -500;
  54.    const MAX_VALUE = 500;
  55. begin
  56.    Writeln('Введите элементы матрицы в диапазоне ', MIN_VALUE, '..', MAX_VALUE);
  57.    SetLength(Matrix, n);
  58.    for i := 0 to N - 1 do
  59.    begin
  60.       SetLength(Matrix[i], n);
  61.       for j := 0 to N - 1 do
  62.          Matrix[i][j] := InputValue(MIN_VALUE, MAX_VALUE);
  63.    end;
  64.    Readln;
  65.    OutputMethod(Swap(Matrix));
  66. end;
  67.  
  68. procedure UserInputFromConsole();
  69. var
  70.    n: Integer;
  71.    const MIN_SIZE = 1;
  72.    const MAX_SIZE = 20;
  73. begin
  74.    Write('Введите порядок матрицы 2n в диапазоне ', MIN_SIZE, '..', MAX_SIZE, ': ');
  75.    N := InputValue(MIN_SIZE, MAX_SIZE);
  76.    Readln;
  77.    UserInputArrayFromConsole(n);
  78. end;
  79.  
  80. procedure UserInputFromFile(MyFile: TextFile);
  81. var
  82.    i, j, n: Integer;
  83.    Matrix: TArray;
  84. begin
  85.    Readln(MyFile, n);
  86.    SetLength(Matrix, n);
  87.    for i := 0 to n - 1 do
  88.    begin
  89.       SetLength(Matrix[i], n);
  90.       for j := 0 to n - 1 do
  91.          Read(MyFile, Matrix[i, j]);
  92.    end;
  93.    closefile(MyFile);
  94.    OutputMethod(Swap(Matrix));
  95. end;
  96.  
  97. function CheckPath(Path: String): Boolean;
  98. begin
  99.    if FileExists(Path) then
  100.    begin
  101.       Writeln(Path, ' существует');
  102.       CheckPath := True;
  103.    end
  104.    else
  105.    begin
  106.       Writeln(Path, ' не существует');
  107.       Writeln('Введите корректный путь к файлу');
  108.    end;
  109. end;
  110.  
  111. function UserOutputPath(): String;
  112. var
  113.    Path: String;
  114. begin
  115.    Writeln('Введите абсолютный путь к файлу для вывода результата');
  116.    Readln(Path);
  117.    UserOutputPath := Path;
  118. end;
  119.  
  120. function Swap(Matrix: TArray): TArray;
  121. var
  122.    i, j, N1, n: Integer;
  123.    Temp: Real;
  124. begin
  125.    n := High(Matrix);
  126.    N1 := N div 2;
  127.    for i := 0 to N1 do
  128.       for j := 0 to N do
  129.       begin
  130.          Temp := Matrix[i][j];
  131.          Matrix[i][j] := Matrix[N1 + i + 1][j];
  132.          Matrix[N1 + i + 1][j] := Temp;
  133.       end;
  134.    for i := 0 to N1 do
  135.       for j := 0 to N1 do
  136.       begin
  137.          Temp := Matrix[i][j];
  138.          Matrix[i][j] := Matrix[i][N1 + j + 1];
  139.          Matrix[i][N1 + j + 1] := Temp;
  140.       end;
  141.    Swap := Matrix;
  142. end;
  143.  
  144. procedure PrintWithoutPath(Matrix: TArray);
  145. var
  146.    i, j: Integer;
  147. begin
  148.    for i := 0 to High(Matrix) do
  149.    begin
  150.       for j := 0 to High(Matrix) do
  151.          Write(Matrix[i][j], ' ');
  152.       Writeln;
  153.    end;
  154.    Writeln('Нажмите Enter для выхода из программы');
  155.    Readln;
  156. end;
  157.  
  158. procedure PrintWithPath(Matrix: TArray);
  159. var
  160.    i, j: Integer;
  161.    MyFile: TextFile;
  162. begin
  163.    AssignFile(MyFile,UserOutputPath);
  164.    rewrite(MyFile);
  165.    for i := 0 to High(Matrix) do
  166.    begin
  167.       for j := 0 to High(Matrix) do
  168.          Write(MyFile, Matrix[i][j], ' ');
  169.       Writeln(MyFile);
  170.    end;
  171.    close(MyFile);
  172.    Writeln('Результат работы помещён в файл');
  173. end;
  174.  
  175. function CheckFile(MyFile: TextFile): Boolean;
  176. var
  177.    IsValid: Boolean;
  178.    n, i, j: Integer;
  179.    a: real;
  180.    const MIN_SIZE = 1;
  181.    const MAX_SIZE = 20;
  182.    const MIN_VALUE = -500;
  183.    const MAX_VALUE = 500;
  184. begin
  185.    IsValid := True;
  186.    try
  187.       Read(MyFile, n);
  188.    except
  189.       IsValid := False;
  190.    end;
  191.    if IsValid then
  192.       if (n < MIN_SIZE) or (n > MAX_SIZE) then
  193.          IsValid := False;
  194.    while (IsValid) and (i < n) do
  195.    begin
  196.       inc(i);
  197.       j := 0;
  198.       while (IsValid) and (j < n) do
  199.       begin
  200.          inc(j);
  201.          try
  202.             Read(MyFile,a);
  203.          except
  204.             IsValid := False;
  205.          end;
  206.          if IsValid then
  207.             if (a < MIN_VALUE) or (a > MAX_VALUE) then
  208.                IsValid := False;
  209.       end;
  210.    end;
  211.    CheckFile := IsValid;
  212. end;
  213.  
  214. procedure UserInputPath();
  215. var
  216.    Path: String;
  217.    MyFile: TextFile;
  218. begin
  219.    repeat
  220.       repeat
  221.          Writeln('Введите абсолютный путь к файлу с входными данными');
  222.          Readln(Path);
  223.       until CheckPath(Path);
  224.       AssignFile(MyFile, path);
  225.       reset(MyFile);
  226.       if not(CheckFile(MyFile)) then
  227.          Writeln('Неккоректные данные в файле, исправьте файл');
  228.       reset(MyFile);
  229.    until (CheckFile(MyFile));
  230.    reset(MyFile);
  231.    UserInputFromFile(MyFile);
  232. end;
  233.  
  234. procedure InputMethod;
  235. var
  236.    Method: String;
  237. begin
  238.    Writeln('Каким способом хотите ввести данные?');
  239.    Writeln('1 - с помощью консоли');
  240.    Writeln('2 - с помощью файла');
  241.    repeat
  242.    Readln(Method);
  243.    case Method of
  244.    '1': UserInputFromConsole;
  245.    '2': UserInputPath;
  246.    else
  247.       Writeln('Введите корректный способ ввода');
  248.    end;
  249.    until (Method = '1') or (Method = '2');
  250. end;
  251.  
  252. procedure OutputMethod(Matrix: TArray);
  253. var
  254.    Method: String;
  255. begin
  256.    Writeln('Куда хотите вывести результат?');
  257.    Writeln('1 - в консоль');
  258.    Writeln('2 - в файл');
  259.    repeat
  260.    Readln(Method);
  261.    case Method of
  262.    '1': PrintWithoutPath(Matrix);
  263.    '2': PrintWithPath(Matrix);
  264.    else
  265.       Writeln('Введите корректный способ вывода');
  266.    end;
  267.    until (Method = '1') or (Method = '2');
  268. end;
  269.  
  270. procedure PrintTask;
  271. begin
  272.    Writeln('Данная программа в матрице порядка 2n меняет местами подматрицы порядка n');
  273.    Writeln('1 2');
  274.    Writeln('3 4');
  275.    Writeln('---');
  276.    Writeln('4 3');
  277.    Writeln('1 2');
  278. end;
  279.  
  280. begin
  281.    PrintTask;  
  282.    InputMethod;
  283. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement