Решение транспортной задачи методом Фогеля

end;

min:=100;

for j:=1 to stolb do begin

for i:=1 to strok do

if (mass1[j,i]<min)and (stringgrid1.cells[j,i]='') then begin if mass1[j,i]<>strtoint(stringgrid2.Cells[j-1,k]) then min:=mass1[j,i];end;

stringgrid2.Cells[j-1,k]:=inttostr(abs(strtoint(stringgrid2.Cells[j-1,k])-min));

min:=100;

end;

{ýòàï 2}

max1:=0;

for j:=1 to stolb do if strtoint(stringgrid2.Cells[j-1,k])>max1 then begin max1:=strtoint(stringgrid2.Cells[j-1,k]);y:=j;end;

for i:=1 to strok do if strtoint(stringgrid3.Cells[k,i-1])>max2 then begin max2:=strtoint(stringgrid3.Cells[k,i-1]);x:=i;end;

zapas:=mass1[stolb+1,x];

potreb:=mass1[y,strok+1];

lol:=zapas-potreb;

if lol=0 then begin

mass1[stolb+1,x]:=0;

mass1[y,strok+1]:=0;

for i:=1 to strok do

for j:=1 to stolb do

if (i=x) or (j=y) then

if stringgrid1.Cells[j,i]='' then begin stringgrid1.Cells[j,i]:='-';end;

stringgrid1.Cells[y,x]:=inttostr(zapas);

end;

if lol>0 then begin

mass1[stolb+1,x]:=lol;

mass1[y,strok+1]:=0;

for i:=1 to strok do

for j:=1 to stolb do

if (j=y) then

if stringgrid1.Cells[j,i]='' then begin stringgrid1.Cells[j,i]:='-';end;

stringgrid1.Cells[y,x]:=inttostr(zapas-lol);

end;

if lol<0 then begin

mass1[stolb+1,x]:=0;

mass1[y,strok+1]:=abs(lol);

for i:=1 to strok do

for j:=1 to stolb do

if (i=x) then

if stringgrid1.Cells[j,i]='' then begin stringgrid1.Cells[j,i]:='-';end;

stringgrid1.Cells[y,x]:=inttostr(zapas);

end;

shag4;inc(k);

end;

procedure TForm1.shag0;

var i,j,zap,potr:integer;

begin

zap:=0;potr:=0;

try

for i:=1 to strok+1 do

for j:=1 to stolb+1 do begin

if (i=strok+1) and (j<>stolb+1) then zap:=zap+strtoint(stringgrid1.Cells[j,i]);

if (j=stolb+1) and (i<>strok+1) then potr:=potr+strtoint(stringgrid1.Cells[j,i]);end;

except on Econverterror do begin showmessage(Таблица заполнена не полностью!!!');

prv3:=false;

end;

end;

if potr>zap then begin

stringgrid1.ColCount:=stringgrid1.ColCount+1;

stolb:=stolb+1;

for i:=1 to strok do stringgrid1.Cells[stolb+1,i]:=stringgrid1.Cells[stolb,i];

for i:=1 to strok do stringgrid1.Cells[stolb,i]:='0';

stringgrid1.Cells[stolb,strok+1]:=inttostr(potr-zap);

stringgrid1.Cells[stolb,0]:='B'+inttostr(stolb);

stringgrid1.Cells[stolb+1,0]:='ÇÀÏ.';

prv2:=true;

form1.width:=form1.width+51;

stringgrid1.width:= stringgrid1.width+51;

Label3.Top:=70+StringGrid1.Height;

Label4.Top:=38+StringGrid1.Height;

Label5.Top:=70+StringGrid1.Height;

Label6.Top:=38+StringGrid1.Height;

end;

if potr<zap then begin

stringgrid1.RowCount:=stringgrid1.RowCount+1;

strok:=strok+1;

for i:=1 to stolb do stringgrid1.Cells[i,strok+1]:=stringgrid1.Cells[i,strok];

for i:=1 to stolb do stringgrid1.Cells[i,strok]:='0';

stringgrid1.Cells[stolb+1,strok]:=inttostr(zap-potr);

stringgrid1.Cells[0,strok]:='A'+inttostr(strok);

stringgrid1.Cells[0,strok+1]:='ÏÎÒÐ.';

prv2:=true;

form1.Height:=form1.Height+51;

stringgrid1.Height:=stringgrid1.Height+51;

Label3.Top:=70+StringGrid1.Height;

Label4.Top:=38+StringGrid1.Height;

Label5.Top:=70+StringGrid1.Height;

Label6.Top:=38+StringGrid1.Height;

end;

for j:=1 to strok+1 do

for i:=1 to stolb+1 do begin

if (j=strok+1) and (i=stolb+1) then stringgrid1.cells[i,j]:='0';

mass1[i,j]:=strtoint(stringgrid1.cells[i,j]); end;

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

form4.show;

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

Form3.Show;

Form1.Hide;

end;

procedure TForm1.Button5Click(Sender: TObject);

begin

Form5.show;

Form1.Hide;

end;end.

unit Unit4;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, jpeg, ExtCtrls;

type

  TForm4 = class(TForm)

    Edit1: TEdit;

    Edit2: TEdit;

    Button1: TButton;

    Button2: TButton;

    Image1: TImage;

    Label1: TLabel;

    Label2: TLabel;

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form4: TForm4;

implementation

uses Unit1;

{$R *.dfm}

procedure TForm4.Button1Click(Sender: TObject);

var i,j,c1,c2,c3,c4:integer;

begin

try

Form1.Timer1.Enabled:=false;

for i:=1 to strok+1 do Form1.stringgrid1.rows[i].clear;

for i:=1 to stolb+1 do Form1.stringgrid1.cols[i].clear;

strok:=strtoint(edit2.Text);

stolb:=strtoint(edit1.Text);

Form1.stringgrid1.colcount:=stolb+2;

Form1.stringgrid1.rowcount:=strok+2;

for i:=1 to strok do Form1.stringgrid1.rows[i].Add('A'+inttostr(i));

for i:=1 to stolb do Form1.stringgrid1.cols[i].Add('B'+inttostr(i));

Form1.stringgrid1.rows[strok+1].Add('Потр.');

Form1.stringgrid1.cols[stolb+1].Add('Зап.');

Form1.button1.Enabled:=true;

Form1.button2.Enabled:=true;

Form1.Show;

Form4.Hide;

except   on econverterror do

showmessage('Одно или несколько полей являются не заполненными !!!');end;end;

procedure TForm4.Button2Click(Sender: TObject);

begin

Close;end;end.

unit Unit5;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, StdCtrls, jpeg, ExtCtrls;

type

  TForm5 = class(TForm)

    Image1: TImage;

    procedure FormClick(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure Image1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

var

  Form5: TForm5;

implementation

uses Unit3, Unit1;

{$R *.dfm}

procedure TForm5.FormClick(Sender: TObject);

begin

Close;

end;

procedure TForm5.Button1Click(Sender: TObject);

begin

Form3.Show;

Form5.Hide;end;

procedure TForm5.Image1Click(Sender: TObject);

begin

Form1.Show;

Form5.Hide;

end;

end.