Phân việc

uses crt;
Var
  a,x,xmax:array[1..7] of integer;
  v: array[1..7,1..7] of integer;
  i,j,n,HSX,HSMAX:integer;

procedure bandau;
var i,j,k: integer;
begin
 clrscr;
 textcolor(white);
 write('   ');
 for k:=1 to n do write('V',k,' ');
 for i:=1 to n do
  begin
   writeln;
   write('N',i);
   for j:=1 to n do write(v[i,j]:3);
  end;
end;

procedure velai;
var i,j,k: integer;
begin
 clrscr;
 textcolor(white);
 write('   ');
 for k:=1 to n do write('V',k,' ');
 for i:=1 to n do
  begin
   writeln;
   write('N',i);
   for j:=1 to n do
    if x[i] <> j then
     begin
      write(v[i,j]:3);
     end
    else
     begin
       textcolor(yellow);
       write(v[i,j]:3);
       textcolor(white);
     end;
  end;
 writeln;
 writeln;
 writeln('HSX= ', HSX);
end;

procedure xong;
var i,j,k: integer;
begin
 clrscr;
 textcolor(white);
 write('   ');
 for k:=1 to n do write('V',k,' ');
 for i:=1 to n do
  begin
   writeln;
   write('N',i);
   for j:=1 to n do
    if xmax[i] <> j then
     begin
      write(v[i,j]:3);
     end
    else
     begin
       textcolor(red);
       write(v[i,j]:3);
       textcolor(white);
     end;
  end;
 writeln;
 writeln;
 writeln('HSMAX= ', HSMAX);
end;

procedure print;
var j,k:integer;
begin
 HSX:=0;
 for j:=1 to n do HSX:=HSX+v[j,x[j]];
 if (HSX<>HSMAX) then velai else xong;
 delay(3000);
end;

procedure print1;
var j,k:integer;
begin
 HSX:=0;
 for j:=1 to n do HSX:=HSX+v[j,x[j]];
 if HSX>HSMAX then
  begin
   HSMAX:=HSX;
   for k:=1 to n do xmax[k]:=x[k];
  end;
end;

procedure try(i:integer; t:integer);
var j:integer;
 begin
  if i>n then
        begin
        case t of
        0: print1;
        1: print;
        end;
        end
        else
  for j:=1 to n do
   if (a[j]=0) then
    begin
     x[i]:=j;
     a[j]:=1;
     try(i+1,t);
     a[j]:=0;
    end;
  end;

begin
 clrscr;
 HSMAX:=0;
 repeat
  write('Nhap so nguoi va so cong viec n= ');
  readln(n);
 until (n>0) and (n<8);
 writeln('Nhap du lieu: ');
 for i:=1 to n do
 begin
 writeln('Cong viec ',i,': ');
 for j:=1 to n do
  begin
   writeln('Hieu suat cong viec ',i,' cua nguoi ',j,' la: ');
   write('v[',i,',',j,']= ');
   readln(v[i,j]);
  end;
 end;
 bandau;
 try(1,0);
 try(1,1);
 xong;
 readln;
end.