Решение транспортной задачи 3 — страница 8

  • Просмотров 351
  • Скачиваний 5
  • Размер файла 108
    Кб

if(way<>'non') then for i:=1 to zikl-1 do begin tmp:=strtofloat(x[uzli[i][1],uzli[i][2]]); if((i mod 2)=0) then begin tmp:=tmp+min; cycle[uzli[i][1],uzli[i][2]]:='+'; end else begin tmp:=tmp-min; cycle[uzli[i][1],uzli[i][2]]:='-'; end; x[uzli[i][1],uzli[i][2]]:=floattostr(tmp); if(((i mod 2)=1)and(tmp=0)and(not bln)) then begin x[uzli[i][1],uzli[i][2]]:='------------'; bln:=true; end end; until false; form3.Visible:=true; print_tabl(); for i:=1 to rw1 do begin s:=inttostr(i)+'-ая фабрика поставила товар в '; tmp:=0; for j:=1 to cl do if not (x[i,j]='------------') then begin s:=s+inttostr(j)+'-й '; tmp:=tmp+1; r:=r+strtofloat(x[i,j])*c[i,j]; end; if tmp>1 then s:=s+'склады ' else s:=s+'склад '; s:=s+' ('+inttostr(i)+'-й

маршрут).'; form1.Memo1.Lines.Append(s); end; tmp:=0; if rw1<rw then begin for j:=1 to cl do if not (x[rw,j]='------------') then tmp:=tmp+strtofloat(x[rw,j]); form1.Memo1.Lines.Append('Не доставлено '+floattostr(tmp)+' партий товара.'); end; s:='Расходы составят '+floattostr(r)+' у.е.'; form1.Memo1.Lines.Append(s); form1.Memo1.Lines.Append('--------------------------------------------------------------------------'); end; procedure TForm1.Button3Click(Sender: TObject); var i,j:integer; s:string; begin if (form1.prdl.text='')or(form1.spr.text='') then begin beep; MessageDLG('Проверьте правильность введенных данных!', mtError, [mbOK], 0); exit;end; val(form1.prdl.text,cl,t);

val(form1.spr.text,rw,t); if (cl>7)or(rw>7) then begin beep; MessageDLG('Нельзя вводить такую большую размерность!', mtError, [mbOK], 0); exit;end; form1.spros.colcount:=cl; form1.predl.rowcount:=rw; form1.bitbtn1.Enabled:=true; label3.Enabled:=true; label4.Enabled:=true; label5.Enabled:=true; label6.Enabled:=true; label8.Enabled:=true; Button2.Enabled:=true; form1.predl.Enabled:=true; form1.spros.Enabled:=true; form1.tab1.Enabled:=true; form1.Memo1.Enabled:=true; // Очистка таблиц 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];