Программа решения транспортной задачи с неправильным балансом

private

{ Private declarations } public

{ Public declarations } end;

var

Form2: TForm2;

а, b, и, v, zz : asa;

opt, c, x, met, prim, min, delta : array [ 0..50, 0..50 ] of integer;

ttt,weit,ci,bi,ai:integer; implementation

uses unitl;

label a1;

{$R *.dfm}

function res (al, b1 : asa) : integer;

var

i:integer;

ddl,dd2:longint;

begin

ddl:=0;dd2:=0;

for is=1 to ai do

ddl:=ddl+al[i];

for is=1 to bi do

dd2:=dd2+b[i];ttt:=0;

if dd1>dd2 then ttt:=1;

if ddl<dd2 then ttt:=2;

res:=abs(dd1-dd2);

end;

procedure pods(postl,potrl:tstringgrid;var dannl:tstringgrid);

var

ss:string;

km:longint;

i:integer;

begin

dannl.Cells[0,0] :='a[i]\b[j]';

dannl.ColCount :=potrl.ColCount+l;

dannl.RowCount:=postl.ColCount+l;

dannl.Visible :=true;

dannl.Width:=potrl.Width+53;

if post1.ColCount>13 then

begin dannl.Height:=340; dann1.Width:=dann1.W.idth+15;end

else

dannl.Height:=26*(postl.ColCount+l);

for is=1 to potrl.ColCount+l do

begin

dann1.Cells[i,O]:=potr1.Cells[i-1,1]; ss:=dannl.Cells[i,O];

if ss<>" then b [i] :=strtoint (ss) ;

end;

for is=1 to postl.ColCount+l do

begin

dann1.Cells[0,i]:=post1.Cells[i-1,1]; ss:=dannl.Cells[O,i];

if ss<>" then a [i] :=strtoint (ss) ;

end;

end;

function prov(gods:tstringgrid):boolean;

label a1;

var

kk:boolean;

j , k, i : integer;

begin

k:=gods.ColCount;

kk:=true;

for i:=1 to k-1 do

for j:=1 to l-1 do

if (gods.Cells [i, j]=" ) then begin

showmessage('Имеется пустая ячейка'+#13+'Введите чиcлo!');kk:=false;

goto a2;

end;

a2:prov:=kk;

end;

procedure TForm2.EditlKeyPress(Sender: TObject; var Key:

Char) ;

begin

case key of

'0'..19',#8:;

else key:=#01;

end;

t1.Enabled :=true;

end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);

begin

forml.Close;

end;

procedure TForm2.Edit2KeyPress(Sender: TObject; var Key: Char) ;

begin

case key of

'0'..'9',#8:;

else key:=#01;

end;

t2.Enabled :=true;

end;

procedure TForm2.Т1Тimer(Sender:TObject);

var

i,k:integer;

begin

if editl.Text <>" then begin

if strtoint(editl.Text)<>0 then begin k:=strtoint(editl.Text);

post.Width:=50*k+k+3;

post.Height:=53;

if post.Width>400 then begin

port.Width:=400;port.Height:=72; end;

potr.Co1Count:=k;

for i:=1 to k do

begin

port. Ce11s [ i-1, 0 ] :='b (' +inttostr (i) +') ' ;

end;

potr.Visible:=true;

bi:=k;

end;

end;

t2.Enabled:=false;

end

procedure TForm2.Button22Click(Sender: TObject);

var

i,j:integer;

begin

for i:=1 to dann.ColCount do

for j:=1 to dann.RowCount do

if dann.Cells[i,j]<> " then c[i,j]:=strtoint(dann.Cells[i,j]);

if provl(dann) then form3.Show;

end;

procedure TForm2.FormCreate(Sender: TObject);

var i,j:integer;

begin

ai.=1;

bi.=1;

for i:=0 to 50 do

for j:=0 to 50 do

begin

c[i,j]:=0;

prim[i, j ] :=0;

met[i,j]:=0; min[i,j]:=0;

zz[i]:=0;

end;

end;

procedure TForm2.Button3Click(Sender: TObject);

begin

form4 . Show;

end;

procedure TForm2.Button2Click(Sender: TObject);

var

i,j:integer;

begin

for i:=1 to dann.ColCount do

for j:=1 to dann.RowCount do

if dann.Cells[i,j]<> " then c[i,j]:=strtoint(dann.Cells[i,j]);

if provl(dann) then form3.Show;

end;

procedure TForm2.Button4Click(Sender: TObject);

var

i,j:integer;

begin

for i:=1 to dann.ColCount до

for j:=1 to dann.RowCount до

if dann.Cells[i,j]<> " then c[i,j]:=strtoint(dann.Ce11s[i,j]);

if provl(dann) then form5.Show;

end;

procedure TForm2.Button11C1ick(Sender: TObject);

begin

if prov (post) and prov (potr) then

begin

panell.Visible :=false; post.Visible :=false;

potr.Visible :=false; buttonll.Visible :=false; button2.Visible :=true; button3.Visible :=true; button4.Visible :=true; button6.Visible :=true;

pods (post, potr, dann) ; form2.AutoSize:=false;

form2.Width:=form2.Width+50;

form2.Height:=form2.Height+50;

end;

end;

procedure TForm2.Button6Click(Sender: TObject);

var

i,j:integer;

begin

for i:=1 to dann.ColCount до

for j:=1 to dann.RowCount до

if dann.Cells[i,j]<> " then c[i,j]:=strtoint(dann.Cells[i,j]);

ci:=res (a,b) ;

form6.Show;

form2.Hide;

end;

unit Unit3;

interface

uses

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

Dialogs, Grids, StdCtrls, ExtCtrls, ComCtrls;

type

TForm3 = class(TForm)

Zona: TLabe1;

Timerl: TTimer;

Button3: TButton;

Labe11: TLabe1;

procedure Timer1Timer(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Button3Click(Sender: TObject);

private

{ Private declarations } public

{ Public declarations } end;

var

Form3: TForm3;

tim:integer; implementation uses unit2;

{$R *.dfm}

procedure tart(n,m:integer;al,bl:asa;var zon:tlabel); var

i,j:integer;

begin

zon.Width:=20+m*60; zon.Height:=20+n*30; for i:=1 to m do for j:=1 to n do begin

zon.Canvas.Font.Size:=14; zon.Canvas.Textout(20+40*i,20*j,'x'); zon.Canvas.Font.Size:=8;

zon.Canvas.Textout(30+40*i,13+20*j,inttostr(j)+inttostr( i));

end;

zon.Canvas.Font.Size:=14;

zon.Canvas.TextOut(20,20*jdiv 2,'X='); end;

procedure TForm3.TimerlTimer(Sender: TObject);

begin

tart (ai, bi, a, b, zona) ;

zona.Visible :=true;

labell.Caption :='Переменные задачи'

end;

procedure TForm3.FormCreate(Sender: TObject);

begin

tim:=0;

end;

procedure TForm3.Button3Click(Sender: TObject);

begin

form3.Close;

end;

end.

unit Unit4;

interface

uses

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

Dialogs, StdCtrls;

type

TForm4 = class(TForm)

Labell: TLabel;

Labe12: TLabel;

Label3: TLabel;

Labe14: TLabel;

Buttonl: TButton;

Labe15: TLabel;

procedure FormShow(Sender: TObject);

procedure ButtonlClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form4: TForm4;

implementation

uses unit2;

{$R *.dfm}

function tt(i:integer;aa:asa):integer

var

dd,j:integer;

begin

dd:=0;

for j:=1 to I do

dd:=dd+aa[j]; tt .

tt:=dd;

end;

procedure TForm4.FormShow(Sender: TObject);

begin

labe13.Caption :=inttostr(tt(ai,a)); 1abe14.Caption :=inttostr(tt(bi,b));

if tt (ai, a) <>tt (bi, b) then

label5.Caption :='Суммарные запасы поставщиков не

сoвпoдaют'+

'с суммарными запасами потребителей'

e1se

1abe15.Caption :='Суммарные запасы поставщиков cовподают'+

'с суммарными запасами потребителей'

end;

procedure TForm4 Button1Click(Sender: TObject);

begin

form4.Close;

end;

end.

unit Unit5;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls;

type

TForm5 =class(TForm)

func: TLabel;

Timerl: TTimer;

Labe12: TLabel;

Button3: TButton;

procedure TimerlTimer(Sender: TObject);

procedure Button3Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form5: TForm5;

implementation

uses unit2;

{$R *.dfm}

procedure tartl(n,m:integer;al,bl:asa;var zon:tlabel);

var

i,j:integer;

begin

zon.Width:=20+m*60;

zon.Height:=20+n*30;

for is=1 to m do

for j:=1 to n do

beginrem~

zon.Canvas.Font.Size:=14;

zon.Canvas.TextOut(20+40*i,20*j,inttostr(c[i,j]));

end;

zon.Canvas.Font.Size:=14;

zon.Canvas.TextOut(20,20*j div 2,'c=');

end;

procedure TForm5.Timer1Тimer(Sender: TObject);

begin tartl(ai,bi,a,b,func);

1abe12.Caption :='Maтpицa cтoимocтeй'

end;

procedure TForm5.Button3Click(Sender: TObject);

begin

formS.Close;

end;

end.

unit Unit6;

interface

usesunit7,

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

Dialogs, Grids, StdCtrls, ExtCtrls;

type1` TForm6 = class(TForm)

StringGridl: ТStringGrid;

GroupBoxl: ТGroupBox;

rad1: ТRadioButton;

Rad2: ТRadioButton;

Button2: ТButton;

Panell: ТPanel;

Labell: ТLabel;

Buttonl: тButton;

Label3: тLabel;

procedure FormShow(Sender: ТObject);

procedure FormClose(Sender: ТObject; var Action:

ТCloseAction);

procedure Button2Click(Sender: ТObject); procedure ButtonlClick(Sender: ТObject); procedure FormCreate(Sender: ТObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form6: тForm6;

implementation

uses unit2,unitl;

{$R *.dfm}

procedure vichis;

d, i, j : integer;

begin

u[1]:=0;

for is=1 to bi do

begin

if met [ i, 1 ] >0 then begin v [ i ] : =c [ i, 1 ] -u [ 1 ] ; end;

end;

end;

procedure chiy(u1,v1:asa;ff:tform6);

var i, d, j : integer;

begin

d:=ff.Canvas.Font.Size; ff.Canvas.Brush.Color:=clgray;

ff.Canvas.Font.Color:=cllime; for is=1 to ai do

begin

ff.Canvas.Font.Size:=12; ff.Canvas.TextOut(120,60+i*30,'u ='+inttostr(u1[i])); ff.Canvas.Font.Size:=6;

ff.Canvas.TextOut(128,69+i*30,inttostr(i));

end;

ff.Canvas.Font.Size:=10;

for i:=1 to bi do

begin

ff.Canvas.Font.Size:=12; ff.Canvas.TextOut(180+i*60,29,'v ='+inttostr(v1[i])); ff.Canvas.Font.Size:=6;

ff.Canvas.TextOut(188+i*60,38,inttostr(i));

end;

ff.Canvas.Font.Size:=10;

end;

function balanc(al,bl:asa):boolean;

var

i:integer; ddl,dd2:longint;

begin

ddl:=0;dd2:=0;

for is=1 to ai do

ddl:=ddl+al[i];
for is=1 to bi do

dd2:=dd2+b[i];

if dd1<>dd2 then balanc:=false else balanc:=true; end;

procedure methodminstoim;

var

qq, dd, aa, i, j , k, 1, j 1 : integer; begin

for is=1 to bi do prim[i,O]:=b[i];

for i:=1 to ai do

begin aa:=a[i];

for j:=1 to bi do

begin qq:=c[1,i];dd:=1;

for 1:=1 to bi do

if qq<c[1,i] then begin qq:=c[1,i];dd:=l;end;

for 1:=1 to bi do

if (c[1,i]<=qq) and (min[1,i]<>1) then

begin qq:=c[1,i];dd:=1;end;

min [dd, i] : =1;

if prim [dd, i-1 ] >=aa then begin

met[dd,i] :=aa;prim[dd,i] :=prim[dd,i-1]-

aa;aa:=0;

end

else

begin

met[dd,i]:=prim[dd,i-1];aa:=aa-prim[dd,i_

1] ;prim[dd, i] .=0;

end; end;

end;

form6.Labell.Caption:='Iiri66iaii iiiciia aaoaiлa iaoiaii ieieiaёiiiiл ri6iёiinoл' ; end;

procedure methodsevzap; var

aa,i,j:integer;

begin

for i:=1 to bi do prim[i, 0] :=b[i] ;

for 1s=1 to ai do

begin aa:=a[i];

for j:=1 to bi do

if prim [ j , i-1 ] >=aa then begin

met [j, i] :=aa;prim[j, i] :=prim[j, i-1] -aa; aa:=0;

end else

begin

met[j,i]:=prim[j,i-1];aa:=aa-prim[j,i-1];prim[j,i]:=0;

end;

end;

form6.Labell.Caption:='Iitiбaiaii iiiбiia баоаiёa iaoiaii naaacii- caiaaiiai баё&';

end;

procedure pods(var dannl:tstringgrid);

var

ss:string;

km:longint;

i:integer;

begin

dannl.Cells[0,0] :='a[i]\b[j]';

dannl.ColCount :=bi+1; dannl.RowCount:=ai+1; dannl.Visible :=true; dannl.Width:=53*(bi+1)+5; if bi>13 then

begin dannl.Height:=340; dannl.Width:=dannl.Width+15;end

else

dannl.Height:=27*(ai+1)+5;

for i:=1 to bi+1 do

begin

dannl .Cells [i, O] :=inttostr (b [i]) ;

end;

for i:=1 to ai+1 do begin

dannl.Cells[O,i]:=inttostr(a[i]);

end; end;

procedure pot(var dannl:tstringgrid);

var

i1,j1:integer;

begin

for i1:=1 to bi do for j1:=1 to ai do

dannl.Cells [i1, j1] :=inttostr (c [i1, j1]) ;

end;

procedure TForm6.FormShow(Sender: TObject);

var

il:integer;

begin

if balanc(a,b) then labe13.Caption :='Caaa+a n ia&aёёiiui aaёainii'

else labe13.Caption :='Qaaa+aaaёainii'; if ci<>0 then begin

case ttt of

begin bi:=bi+1;

b [bi] :=ci;

end;

begin ai:=ai+1;

a [ai] .=ci;

end;

end;

end;

form6.Width:=(bi+l)*50+260; form6.Height:=(ai+1)*24+1З0;

pods(stringgridl); pot(stringgridl); form6.GroupBoxl.Visible:=true; form6.Pane11.Visib1e:=fa1se;

end;

procedure syz(ff:tform6);

var

tt,d,j,i:integer; begin

tt:=50;

ff.Width:=(bi+1)*70+140+tt;

ff.Height:=(ai+1)*35+100; ff.Canvas.Brush.Co1or:=clskyblue;

for i:=0 to bi do for j:=0 to ai do begin

ff.canvas.Rectangle(120+i*60+tt,50+j*30,i*60+180+tt,80+j

*30) ;

end;

ff.Canvas.Font.Co1or:=c1ye11ow;

d:=ff.Canvas.Font.Size; ff.Canvas.Font.Size:=5; for i:=1 to ai do

for j:=1 to bi do ff.Canvas.Textout(160+j*60+tt,52+i*30,inttostr(с[j,i]));

ff.Canvas.Font.Color:=clmaroon;

ff.Canvas.Font.Size:=d;

for is=1 to bi do ff.Canvas.Textout(140+i*60+tt,60,inttostr(b[i]));

for i:=1 to ai do

f f . Canvas . TextOut ;140+t t, 60+i*30, inttostr (a [ i ])) ; ff.Canvas.TextOut(153+tt,51,'b[i]');

f f . Canvas . TextOut (123+tt, 61, ' a [ i ] ') ; d:=ff.Canvas.Font.Size-2;

ff.Canvas.Font.Size:=17; ff.Canvas.TextOut(140+tt,51,'\'); end;

procedure pots(ff:tform6;pp:integer); var

tt,d,j,i:integer;

begin

case pp of

2:methodminstoim;

1:methodsevzap;

end;

tt:=50;

d:=ff.Canvas.Font.Size;

ff.Canvas.Brush.Color:=clskyblue; ff.Canvas.Font.Size:=10;

for is=1 to ai do

for j:=1 to bi do ff.Canvas.TextOut(130+j*60+tt,60+i*30,inttostr(met[j,i]) );

end;

procedure TForm6.FormClose(Sender: TObject; var Action: TC1oseAction);

begin

forml.Close;

end;

procedure TForm6.Button2Click(Sender: TObject);

var g:integer;

begin

panell.Visible:=true;

form6.GroupBox1.Visible:=false; button2.Visible:=true; form6.StringGrid1.Visible:=false;

syz ( form6) ;

if rad1.Checked then g:=1;

if rad2.Checked then g:=2;

pots (form6, g) ;

end;

procedure TForm6.Button1Click(Sender: TObject);

begin

forml.Close;

{vichis;

chiy (u, v, form6) ;

}

end;

procedure TForm6.FormCreate(Sender: TObject);

begin

form6.Font.Size:=10;

end;

end.

Размещено на Allbest.ru

...