ANTICHAT — форум по информационной безопасности, OSINT и технологиям

procedure TForm1.DynamicCheckBoxChange(Sender: TObject);
begin
 if (sender as TButton).Caption='123' then
  chk[1].Checked:=true;
end;

PROGRAM PMatrix;
uses
    Crt;

const
     N = 5;

Var
   Matrix:      Array [1..N,1..N] of byte;
   Indexes:     set of byte;
   counter:     byte;

function CheckMatrix: boolean;
var
   i, j:           byte;
begin
     CheckMatrix := false;
     Indexes := [];
     for i := 1 to N do
         begin
              counter := 0;
              for j := 1 to N do
                  begin
                       if (Matrix[i,j] = 0) then
                          begin
                               inc(counter);
                               if (j in Indexes) then
                                  exit;
                               Indexes := Indexes + [j];
                          end;
                  end;
              if (counter <> 1) then
                 exit;
         end;
     CheckMatrix := true;
end;


procedure ChangeLines(index1, index2: byte);
var
   tmp:         byte;
   i:           byte;
begin
     for i := 1 to N do
         begin
              tmp := Matrix[index1,i];
              Matrix[index1,i] := Matrix[index2,i];
              Matrix[index2,i] := tmp;
         end;

end;


procedure SortMatrix;
var
   i, j:        byte;
   tmp:         boolean;
begin
     for i := 1 to N do
         begin
              for j := 1 to N do
                  if (Matrix[i,j] = 0) then
                     begin
                          ChangeLines(i,j);
                          break;
                     end;
         end;
end;


procedure ShowMatrix;
var
   i, j:        byte;
begin
     for i := 1 to N do
         begin
              for j := 1 to N do
                  if (Matrix[i,j] < 10) then
                     write(' ', Matrix[i,j], ' ')
                  else
                      write(Matrix[i,j], ' ');
              writeln
         end;
end;


var
   i, j:        byte;
   chose:       char;
begin
     clrscr;
     Indexes := [];
     for i := 1 to N do
         for j := 1 to N do
             begin
                  write('Matrix[',i,',',j,'] = ');
                  readln(Matrix[i,j]);
             end;

     writeln;
     ShowMatrix;
     writeln;

     if CheckMatrix then
         SortMatrix;

     ShowMatrix;
     readln;
end.

const n=5;

type
  matrix=array[1..n, 1..n] of integer;

procedure readmatrix (var mas:matrix);
  var
    i,j:integer;
  begin
    for i:=1 to n do
      for j:=1 to n do
        readln (mas[i,j]);
  end;

function provmatrix (var mas:matrix):boolean;
  var
    i,j:integer;
    k:integer;
  begin
    provmatrix:=false;
    for i:=1 to n do
      begin
        for j:=1 to n do
          begin
            if mas [i,j] = 0 then
              k:=k+1;
            if k>1 then
              exit;
          end;
        k:=0;
      end;
    provmatrix:=true;
  end;

procedure sortmatrix (var mas:matrix);
  var
    i,j:integer;
    index:integer;
    mas2:matrix;
  begin
    for i:=1 to n do
      for j:=1 to n do
        begin
          if mas[j,i]=0 then
            begin
              for index:=1 to n do
                mas2[i,index]:=mas[j,index];
            end;
        end;
    mas:=mas2;
  end;
  
procedure writematrix (mas:matrix);
  var
    i,j:integer;
  begin
    writeln;
    for i:=1 to n do
      begin
        for j:=1 to n do
          write (mas[i,j], ' ');
        writeln;
      end;

  end;

var
  m:matrix;
begin
  readmatrix (m);
  if provmatrix (m) = true then
    begin
      sortmatrix (m);
      writematrix (m);
    end;
  readln;
end.