Решение транспортной задачи

for t:=0 to 100 do

for i:=0 to 100 do begin

  form1.tab1.Cells[i,t]:='';

  form3.sg1.Cells[i,t]:='';

                    end; 

for t:=1 to cl do begin

str(t,s);

form1.tab1.Cells[t,0]:=s;

form3.sg1.Cells[t,0]:=s;

                   end; 

ch[1]:='A'; ch[2]:='Б'; ch[3]:='В';

ch[4]:='Г'; ch[5]:='Д'; ch[6]:='Е';

for t:=0 to rw do  begin

form1.tab1.Cells[0,t]:=ch[t];

form3.sg1.Cells[0,t]:=ch[t];

                    end;

form1.tab1.Cells[0,0]:='';

form3.sg1.Cells[0,0]:='';

end; 

procedure TForm1.Button2Click(Sender: TObject);

var i,j:integer;

begin

c[1,1]:=20; c[1,2]:=40; c[1,3]:=15;   c[1,4]:=30;

c[2,1]:=10;   c[2,2]:=25;   c[2,3]:=25;   c[2,4]:=35;

c[3,1]:=15;   c[3,2]:=45; c[3,3]:=30; c[3,4]:=20;

for t:=1 to cl do

  for i:=1 to rw do form1.tab1.Cells[t,i]:=floattostr(c[i,t]); 

spl[1]:=60; spl[2]:=100; spl[3]:=80;

dmd[1]:=70; dmd[2]:=50; dmd[3]:=90; dmd[4]:=30;

for t:=1 to rw do form1.predl.Cells[0,t-1]:=floattostr(spl[t]);

for t:=1 to cl do form1.spros.Cells[t-1,0]:=floattostr(dmd[t]);

end; 

function TForm1.read_data():bool;

var i,j: integer;

begin

try 

for i:=1 to rw do

  for j:=1 to cl do

   c[i,j]:=strtofloat(form1.tab1.Cells[j,i]); 

sspl:=0;

 for i:=1 to rw do begin

  spl[i]:=strtofloat(form1.predl.Cells[0,i-1]);

  sspl:=sspl+spl[i];

                   end;

sdmd:=0;

 for i:=1 to cl do begin

  dmd[i]:=strtofloat(form1.spros.Cells[i-1,0]);

  sdmd:=sdmd+dmd[i];

                   end;

read_data:=true;

except on EConvertError do

  begin

  MessageDLG('Проверьте  правильность введенных данных!', mtError, [mbOK], 0);

  read_data:=false;

  exit;

  end;

 end;

end; 

procedure TForm1.balans();

var i,j: integer;

begin

rw1:=rw;

if sspl>sdmd then begin

  showmessage('Задача не сбалансирована! Добавляем столбец.');

  cl:=cl+1;

  for i:=1 to rw do begin form1.tab1.Cells[cl,i]:='0'; x[i,cl]:='0'; end;

  form1.tab1.Cells[cl,0]:=inttostr(cl);

  form3.sg1.Cells[cl,0]:=inttostr(cl);

  dmd[cl]:=sspl-sdmd;

  form1.spros.colcount:=cl;

  form1.spros.cells[cl-1,0]:=floattostr(dmd[cl]);

                   end;

if sspl<sdmd then begin

  showmessage('Задача не сбалансирована! Добавляем строку.');

  rw1:=rw;

  rw:=rw+1;

  for i:=1 to cl do begin form1.tab1.Cells[i,rw]:='0'; x[rw,i]:='0'; end;

  form1.tab1.Cells[0,rw]:=ch[rw];

  form3.sg1.Cells[0,rw]:=ch[rw];

  spl[rw]:=sdmd-sspl;

  form1.predl.rowcount:=rw;

  form1.predl.cells[0,rw-1]:=floattostr(spl[rw]);

                   end;

end; 

procedure TForm1.First_resh();

var

ci,ri: byte;

i,j: integer;

tmp:real;

begin

for i:=1 to rw+1 do

  for j:=1 to cl+1 do x[i,j]:='------------';

ri:=1; ci:=1;

while  ((ri<=rw) and (ci<=cl)) do begin

  if spl[ri]<dmd[ci] then tmp:=spl[ri] else tmp:=dmd[ci];

  x[ri,ci]:=floattostr(tmp);

  spl[ri]:=spl[ri]-tmp;

  dmd[ci]:=dmd[ci]-tmp;

  if spl[ri]=0 then ri:=ri+1;

  if dmd[ci]=0 then ci:=ci+1;

                                   end;

end; 

procedure TForm1.find_uv();

 var

vc,uc: array [1..100] of integer;

ind,i,j: integer;

begin

for i:=1 to cl do begin v[i]:=0; vc[i]:=0; end;

for i:=2 to rw do begin u[i]:=0; uc[i]:=0; end;

u[1]:=0; uc[1]:=1;

for t:=1 to rw do

  for ind:=1 to rw do begin

   //цикл для V

   for i:=1 to cl do

    if(not(x[ind,i]='------------'))and(uc[ind]=1) then begin

                              v[i]:=c[ind,i]-u[ind];

                              vc[i]:=1;

                                                        end;

  if not (ind=rw) then

   for j:=1 to cl do

    if(not(x[ind+1,j]='------------'))and(vc[j]=1) then begin

                              u[ind+1]:=c[ind+1,j]-v[j];

                              uc[ind+1]:=1;

                                                        end;

                      end; 

for i:=1 to rw do

  for j:=1 to cl do begin

   if (x[i,j]='------------') then xnb[i,j]:=u[i]+v[j]-c[i,j]

                              else xnb[i,j]:=0;

                    end;

end; 

procedure TForm1.xnbmax(var max:real;var xi,yi:integer);

var

i,j:integer;

begin

max:=0; xi:=1; yi:=1;

for i:=1 to rw do

for j:=1 to cl do begin

  if (max<xnb[i,j]) and (x[i,j]='------------') then begin

                                                     max:=xnb[i,j];

                                                     xi:=i; yi:=j;

                                                     end

                   end;

end; 

procedure TForm1.print_tabl();

var

i,j: integer;

begin

for i:=1 to rw do

   for j:=1 to cl do

      form3.sg1.Cells[j,i]:=x[i,j];

end; 

procedure TForm1.Button1Click(Sender: TObject);

begin

form2.Visible:=true;

end;

end.