Немогу наладить модуль.. курсовой!!!

[Илья Галушка]

Ето мой модуль...я никак немогу его отладить:
Program silos;
uses crt,graph{,silostpu\};
var gd,gm,i:integer;
v:vol; qar;
begin
gd:=vga;
gm:=2;
INITGRAPH(gd,gm,'');
picture;
v[1]:=15;v[2]:=15;v[3]:=15;
volume(q,v,0);
getpar(q);
mainmenu(q,v);
Closegraph;
end.

[Илья Галушка]

Unit silostpu;
interface
uses crt,graph;
const a:=array[1..7] of string=('yroven surya',
'parametru surya',
'trebovania k prodykty',
'optimizazzua',
'vuxod',
'vozvrat - Esc',
'vvedite zna4enya');
b:array[1..7] of string=('zerno1',
'zerno2',
'zerno3',
'ingridient1',
'ingridient2',
'ingridient3',
'ingridient4');
type vol=array[1..4] of real;
par=array[1..5,1..4] of real;
Function Ordin(k:char):byte;
Procedure Batd(x1,x2,y1,y2:integer);
Function Stroke (m:real):string;
Procedure picture;
Procedure volume(Q:par;v:vol;n:byte);
Procedure getpar(q:par);
Function Inp:real;
Procedure optim(q1:par;var v:vol);
Procedure mainmenu(q:par,v:vol);
Implementatio
function Ordin(k:char):byte;
begin
case k of
'1':ordin:=1;
'2':ordin:=2;
'3':ordin:=3;
'4':ordin:=4;
'5':ordin:=5;
'6':ordin:=6;
'7':ordin:=7;
'8':ordin:=8;
'9':ordin:=9;
end;
end;

[Илья Галушка]

Procedure Bard(x1,x2,y1,y2);
begin
line(x1,x2,y1,y2);
line(x1,x2,y1,y2);
line(x1,x2,y1,y2);
line(x1,x2,y1,y2);
end;
function Stroke (m:real):string;
var n:real; i,k,k1,k1:integer; flag:boolean;st:string;
begin
sy:=' ';Flag:=false; n:=m; if abs(n)<0.01 then n:=0;
n:=abs(n)+0.001;
for i:=5 downto 0 do begin
k:=trunc(n/()exp(i*ln(10))));
case k of
0:if flag then st:=st+'0';
1:begin st:=st+'1'; flag:=true;end;
2:begin st:=st+'2'; flag:=true;end;
3:begin st:=st+'3'; flag:=true;end;
4:begin st:=st+'4'; flag:=true;end;
5:begin st:=st+'5'; flag:=true;end;
6:begin st:=st+'6'; flag:=true;end;
7:begin st:=st+'7'; flag:=true;end;
8:begin st:=st+'8'; flag:=true;end;
9:begin st:=st+'9'; flag:=true;end;
end;
n:=n-k*exp(i*ln(10));
end;
if st=' ' then st:=st+'0';
k1:=trunc(n*10); n:=n-0.1*k1;
k2:=trunc(n*100);
if ((k1>0) or ((k2>0) and (lengt(st)<3) then Begin
st:='.';
case k1 of
0:st:=st+'0';
1:st:=st+'1';
2:st:=st+'2';
3:st:=st+'3';
4:st:=st+'4';
5:st:=st+'5';
6:st:=st+'6';
7:st:=st+'7';
8:st:=st+'8';
9:st:=st+'9';
end;
if length(st)<4 then
case k2 of
1:st:=st+'1';
2:st:=st+'2';
3:st:=st+'3';
4:st:=st+'4';
5:st:=st+'5';
6:st:=st+'6';
7:st:=st+'7';
8:st:=st+'8';
9:st:=st+'9';
end;
end;
stroke:=st;
end;

[Илья Галушка]

procedure picture;
var i,j:integer;
begin
setcolor(15);
for i:=0 to 2 do begin
line(100+180*i,60,220+180*i,60);
line(100+180*i,60,100+180*i,260);
line(220+180*i,60,220+180*i,260);
line(100+180*i,260,145+180*i,260);
line(175+180*i,260,220+180*i,260);
end;
line(145,260,145,303);{1}
line(175,260,175,280);{2}
line(175,280,325,320);{3}
line(145,303,315,349);{4}
line(325,260,325,320);{5}
line(355,260,355,320);{6}
line(505,260,505,280);{7}
line(535,260,535,303);{8}
line(355,320,505,280);{9}
line(365,349,535,303);{10}
line(315,349,315,370);{11}
line(365,349,365,370);{12}
line(365,370,380,450);{13}
line(380,450,380,470);{14}
line(130,370,315,370);{15}
line(130,470,380,470);{16}
line(130,370,130,470);{17}
setcolor(14);
outtextxy(130,0,b[1]);
for i:=147 to 173 do line(i,260,i,303);
for i:=322 to 349 do line(147,i-48,326,i);
setcolor(18);
outtexy(490,0,b[3]);
for i:=507 to 533 do line(i,260,i,303);
for i:=322 to 349 do line (533,i-48,354,i);
setcolor(10);
outtxy(310,0,b[2]);
for i:=327 to 353 do line(i,260,i,351);
setcolor(6);
for i:=317 to 363 do line(i,469,i,348);
for i:=364 to 378 do line(i-15,370,i,450);
for i:=450 to 469 do line(364,i,379,i);
setcolor(15);
line(340,280,340,300);{1}
line(343,294,340,300);{2}
line(337,294,340,300);{3}
line(340,360,340,300);{4}
line(343,374,340,380);{5}
line(337,294,340,380);{6}
line(228,309,253,,316);{7}
line(247,311,253,316);{8}
line(245,317,253,316);{9}
line(453,309,428,316);{10}
line(436,311,428,316);{11}
line(438,316,428,316);{12}
outtextxy(45,262,'0');
outtextxy(80,472,'0');
setcolor(8);
for i:=0 to 2 do for j:=0 to 2 do
line(45+180*i,60+100*i,90+180*i,60+ 100*j);
for j:=0 to 2 do line(80,370+j*50,125,370+j*50);
setcolor(4);
outtextxy(2,10,b[4]);
outtextxy(0,330,b[4]);
setcolor(10);
outtextxy(2,20,b[5]);
outtextxy(0,350,b[5]);
setcolor(2);
outtextxy(2,30,b[6]);
outtextxy(0,350,b[6]);
setcolor(6);
outtextxy(2,40,b[6]);
outtextxy(0,360,b[7]);
setcolor(5);
outtextxy(2,50,'Cena, grn/kg');
outtextxy(2,400,'stoimost');
outtextxy(20,440,'grn');
setcolor(7);
outtextxy(0,320,'silos: Plan Fakt');
end;
procedure volume(Qar;V:Vol;n:byte);
var max:real; mas,mas4,i,j:integer;
begin
max:=v[1]; v[4]:=v[1]+v[2]+v[3];
for i:=2 to 3 do if v[i]>max then max:=v[i];
if max<=1000 then mas:=1000;
if max<=500 then mas:=500;
if max<=100 then mas:=100;
if max<=50 then mas:=50;
if max<=10 then mas:=10;
if max<=5 then mas:=5;
if max<=1 then mas:=1;
mas4:=3*mas; setcolor(0);
for i:=160 to 220 do line (i,330,i,369);
for i:=420 to 430 do line (0,i,79,i);
for i:=61 to 71 do line (40,i,98,i);
for i:=161 to 171 do line (40,i,98,i);
for i:=371 to 381 do line (80,i,123,i);
for i:=421 to 431 do line (80,i,123,i);
setcolor(5);
outtextxy(20,420,stroke(v[1]*q[5,1]+v[2]*q[5,2]+v[3]*q[5,3]));
for i:=1 to 4 do begin
case i of
1:=setcolor(4);
2:=setcolor(10);
3:=setcolor(2);
4:=setcolor(6);
end;
outtextxy(162,320+10*i,stroke(0.001 *(v[1]*q[i,1]+v[2]*q[i,2]+v[3]*q[i,3]))+'T');
end;
setcolor(15);
outtextxy(40,62,stroke(mas));
outtextxy(40,162,stroke(mas/2));
outtextxy(80,372,stroke(mas4));
outtextxy(80,422,stroke(mas4/2));
setcolor(0);
for i:=1 to 99 do begin
if i=100-round((v[4]/mas4)*99) then setcolor(6);
line(131,370+i,316,370+i);
end; setcolor(11); outtextxy(200,410,stroke(v[4]));
for j:=0 to 2 do begin setcolor(0);
for i:=1 to 199 do begin
if i=200-round(199*(v[j+1]/mas)) then begin
if j=0 then setcolor(14);
if j=1 then setcolor (10);
if j=2 then setcolor(18);
if n=j+1 then setcolor(15);
end;
line(101+180*j,60+i,219+180*j,60+i) ;
end;
setcolor(12);
outtextxy(140+180*j,160,stroke(v[j+1]));
end;
end;

[Илья Галушка]

procedure Getpar(qar);
var i,j:byte;
begin
setcolor(0);
for i:=10 to 59 do line(110,i,640,i);
for i:=100 to 150 do line(i,330,i,369);
for i:=0 to 2 do
for i:=1 to 5 do begin
case j of
1:setcolor(4);
2:setcolor(10);
3:setcolor(2);
4:setcolor(6);
5:setcolor(5);
end;
if j=5 then outtextxy(120+180*i,10+*j,stroke(q[j,i+1]));
else outtextxy(120+180*i,10*j,stroke(q[j,i+1])+' kg/t')
end;
for i:=1 to 4 do begin
case i of
1:setcolor(4);
2:setcolor(10);
3:setcolor(2);
4:setcolor(6);
end;
outtextxy(102,320+10*i,stroke(q[i,4])+'t');
end;
function inp:real;
const symb:set of char=['0','1','2','3','4','5','6','7','8' ,'9','0','.'];
var s:string; n:byte; m:real; k:char; i:integer; flag:boolean;
begin
outtextxy(390,400,a[7]); m:=0; s:='';
for i:=1 to 10 do begin setcolor(0); outtextxy(400,370,a[6]);
flag:=false;
repeat k:=readkey;
if k in symb then flag:=true;
if k:=#13 then flag:=true;
until flag;
if k in symb then begin
setcolor(7);
outtextxy(400+i*10,420,k);
s:=s+k; end;
if k:=#13 then i:=10; end ; setcolor(4);outtextxy(400,370,a[6]);
n:=pos('.',s); if n=0 then n:=length(s)+1;
if n>5 then delete (s,1,n-5);
n:=pos('.',s); if n=0 then n:=length(s)+1;
if n+2<length(s)then delete(s,n+3,length(s)-(n+2));
for i:=1 to n-1 do m:=m+exp((n-1-i)*ln(10))*ordin(s[i]);
if n<length(s) then
for i:=n+1 to length(s) do m:=exp((n-1)*ln(10))*ordin(s[i]);
inp:=m; setcolor(0); outtextxy(390,400,a[7]);
for i:=415 to 435 do line(399,i,600,i);
end;
procedure optim(q1ar;var v:vol);
type last=array[1..6,1..12] of real;
next=array[1..6,1..11] of real;
var P1:last; P2:next; flag:boolean; qar; ch:char;
max,min,find:real;
num,ij,s,k,l:integer;
procedure reverse1 (var p:last,l,k:integer);
var pp:last; i,j:integer;
begin
for i:=1 to 6 do
for j:=1 to 12 do
pp[i,j]:=0;
for i:=2 to 5 do begin pp[i,1]:=p[i,1]; pp[i,2]:=p[i,2]; end;
for j:=1 to 11 do pp[1,j]:=p[1,j];
pp[l,1]:=k-3;
pp[l,2]:=p1[1,k];
for i:=2 to 5 do
for j:=3 to 11 do begin
find:=p[l,k]; if find=0 then find:=0,00001;
if i=1 then pp[i,j]:=p[i,j]/find
else pp[i,j]:=p[i,j]-p[l,j]*p[i,k]/find;
end;
for j:=3 to 11 do begin
Pp[6,j]:=0;
for i:=2 to 5 Pp[6,j]+Pp[6,j]+Pp[i,2]*[i,j];
Pp[6,j]:=Pp[6,j]-Pp[1,j];
end;
p:=pp;
end;

[Илья Галушка]

procedure reverse2(var p:next; l,k:integer);
var pp:next; i,j:integer;
begin for i:=1 to 6 do
for j:=1 to 11 do
pp[i,j]:=0;
for i:=2 to 5 do begin pp[i,1][i,1]; pp[i,2]:=p[i,2]; end;
for j:=1 to 10 do pp[1,j]:=p[1,j];
pp[l,1]:=k-3;
pp[l,2]:=p1[1,k];
for i:=2 to 5 do
for j:=3 to 10 begin
find:=P[l,k]; if find=0 then find:=0.00001;
if i=l then pp[i,j]:=p[i,j]/find
else pp[i,j]:=p[i,j]-p[l,j]*p[i,k]/find;
end;
for j:=3 to 10 do begin
Pp[6,j]:=0;
for i:=2 to 5 do Pp[6,j]:=Pp[6,j]+Pp[i,2]*Pp[i,j];
Pp[6,j]:=Pp[6,j]-Pp[1,j];
end;
p:=pp;
end;
begin
q:=q1;
for i:=1 to 4 do q[i,4]:=q[i,4]*1000;
falg:=true;
if(q[1,4]=0) and (q[2,4]=0) and (q[3,4]=0) and (q[4,4]=0) then
flag:=false;
for i:=1 to 6 do
for j:=1 to 12 do P1[i,j]:=0;
max:=q[1,4]; s:=1;
for i:=2 to 4 do
if q[i,4]>max then begin max:=q[i,4]; s:=i; end;
Num:=4;
for i:=2 to 5 do begin
if nim=s+3 then begin P1[i,1]:=8; p1[i,2]:=1; end
else begin P1[i,1]:=num; p1[i,2]:=0;end;
num:=num+1;
end;
for i:=4 to 8 do
if i=8 then P1[num,2]:=1 else P1[num,2]:=0;
for i:=1 to 4 do
if i=s then P1[i+1,3]:=q[i,4] else P1[i+1,3]:=q[s,4]-q[i,4];
for j:=1 to 11 do
if j=11 then P1[1,j]:=1 else P1[1,j]:=0;
for i:=2 to 5 do
for j:=4 to 11 do begin
if j<6 then if i-1=s then P1[i,j]:=q[i-1,j-3]
else P1[i,j]:=q[s,j-3]-q[i-1,j-3];
if j>6 then begin if j=s+6 then P1[i,j]:=-1
else begin begin if P1[i,1]=j-3 then P1[i,j]:=1
else
P1[i,j]:=0;
end;
end;
end;
for j:=3 to 11 do begin
P1[6,j]:=0;
for i:=2 to 5 do P1[6,j]:=P1[6,j]+P1[i,2]*P1[i,j];
P1[6,j]:=P1[6,j]-P1[1,j];
end;
if flag then
repeat for j:=4 to 11 do if (P1[6,j]>0) and (P1[2,j]<=0) and (P1[3,j]<=0)
and (P1[4,j]<=0)and (P1[5,j]<=0) then flag:=false;
if flag=false then begin sound(3000);
delay(5000); nosound; end;
if flag then begin k:=4; max:=P1[6,4];
for j:=5 to 11 do if P1[6,j]>max then begin k:=j; max:=P1[6,j]; end;
for i:=2 to 5 do begin find:=P1[i,k]; if find=0 then find:=0.00001;
P1[i,12]:=P1[i,3]/find; end;
n:=-1;
for i:=2 to 5 do if P1[i,12]>0 then begin min:=P1[i,12]; l:=i; end;
for i:=2 to 5 if (P1[i,12]>0) and (P1[i,12]<min) then begin
min:=P1[i,12]; l:=i; end;
if not((p1[6,4]<=0) and (p1[6,5]<=0) and (p1[6,6]<=0) and (p1[6,7]<=0) and
(p1[6,8]<=0) and (p1[6,9]<=0) and (p1[6,10]<=0) and (p1[6,11]<=0))
then Reverse1(P1,l,k);
end;
until (p1[6,4]<=0) and (p1[6,5]<=0) and (p1[6,6]<=0) and (p1[6,7]<=0) and
(p1[6,8]<=0) and (p1[6,9]<=0) and (p1[6,10]<=0) and (p1[6,11]<=0);
for i:=2 to 5 do if p1[i,1]=8 then begin sound(3000);
delay(5000); nosound; end;
for i:=1 to 6 do
for j:=1 to 11 do
if (i=6) or (j=11) or (i=1) then P2[i,j]:=0
else P2[i,j]:=P1[i,j];
for j:=4 to 6 do P2[1,j]:=q[5,j-3];
for i:=2 to 5 do if P2[i,1]<=3 then P2[i,2]:=q[5,round(P2[i,1])];
for j:=3 to 10 do begin
P2[6,j]:=0;
for i:=2 to 5 do P2[6,j]:=P2[6,j]+P2[i,2]*P2[i,j];
P2[6,j]:=P2[6,j]-P2[1,j];
end;
if flag then
repeat
for j:=4 to 10 do if (P2[6,j]>0) and (P2[2,j]<=0) and (P2[3,j]<=0)
and (P2[4,j]<=0) and (P2[5,j]<=0) then flag:false;
if flag=false then begin sound(3000);
delay(5000); nosound; end;
if flag then begin k:=4; max:=P2[6,4];
for j:=5 to 10 do if P2[6,j]>max then begin k:=j; max:=P2[6,j]; end;
for i:=2 to 5 do begin find:=P2[i,k]; if find=0 then find:=0.00001;
P2[i,11]:=P2[i,3]/find; end;
min:=-1;
for i:=2 to 5 do if P2[i,11]>0 then begin min:=P2[i,11]; l:=i; end;
for i:=2 to 5 do if (P2[i,11]>0) and (P2[i,11]<min) then begin
min:=P1[i,11]; l:=i; end;
if not ((p2[6,4]<=0) and (p2[6,5]<=0) and (p2[6,6]<=0) and (p2[6,7]<=0) and
(p2[6,8]<=0) and (p2[6,9]<=0) and (p2[6,10]<=0))
then Reverse2(P2,l,k);
end;
until (p2[6,4]<=0) and (p2[6,5]<=0) and (p2[6,6]<=0) and (p2[6,7]<=0) and
(p2[6,8]<=0) and (p2[6,9]<=0) and (p2[6,10]<=0);
for i:=1 to 3 do v[i]:=0;
for i:=2 to 5 do if p2[i,1]<=3 then v[round(p2[i,1])]:=p2[i,3];
for i:=1 to 3 do if v[i]>1000 then begin v[i]:=1000; sound(3000);
delay(5000); nosound; end;
v[4]:=v[1]+v[2]+v[3];
end;

[Илья Галушка]

procedure mainmenu(qar;v:vol);
var p1,p2,n,m:byte; k:char;
q1:=real; i:integer;
begin
m:=1;
repeat
for i:=1 to 5 do begin
setcolor(15); if i=m them setcolor(12);
outtexrxy(400,370+15*i,a[i]);
end;
repeat
k:=readkey; if k=#0 then l:=readkey;
case k of
#72:begin
setcolor(15);outtextxy(400,370+15*m ,a[m]); m:=m-1;
if m=0 then m:=5; setcolor(12); outtextxy(400,370+15*m,a[m]);
end;
#80:begin
setcolor(15); outtextxy(400,370+15*m,a[m]); m:=m+1;
if m=6 then m:=1;setcolor(12); outtextxy(400,370+15*m,a[m]);
end;
end;
until k=#13;
case m of
1:begin
setcolor(0); for i:=1 to 5 do outtextxy(400,370+15*m,a[i]); n:=1;
setcolor(15); outtextxy(400,370+15*m,a[6]);
volume(q,V,n);
repeat
k:=readkey; if k=#0 then k:=readkey;
case k of
#77:begin n:=n+1; if n=4 then n:=1; volume(q,V,n);end;
#75:begin n:=n-1; if n=0 then n:=3; volume(q,V,n);end;
#72:begin v[n]:=v[n]:=v[n]+0.001+0.009*v[n]; if v[n]>1000 then v[n]:=1000;
volume(q,V,n);end;
#80:begin v[n]:=v[n]-0.009*v[n]; volume (q,V,n);end;
end;
until k=#27; k:=#23; volume(q,V,0);
setcolor(0); outtextxy(450,370,a[6]);
end;
2:=begin
setcolor(0); for i:=1 to 5 do outtextxy(400,370+15*i,a[i]);
setcolor(4); outtextxy(450,370,a[6]);
p1:=1; p2:=1;setcolor(15);


bard(110+180*(p1-1),10*p2-2,200+180*(p1-1),8+10*p2);
repeat
k:=readkey; if k=#0 then k:=readkey;
case k of
#72:begin setcolor(0);
bard(110+180*(p1-1),10*p2-2,200+180*(p1-1),8+10*p2);
p2:=p2-1; if p2=0 then p2:=5;
setcolor(15); bard (110+180*(p1-1),10*p2-2,200+180*(p1-1),8+10*p2); end;
#80:begin setcolor(0);
bard (110+180*(p1-1),10*p2-2,200+180*(p1-1),8+10*p2);
p2:=p2+1; if p2=6 then p2:=1; setcolor(15);
bard(110+180*(p1-1),10*p2-2,200+180*(p1-1),8+10*p2);end;
#77:begin setcolor(0);
bard(110+180*(p1-1),10*p2-2,200+180*(p1-1),8+10*p2);
p1 :=p1+1; if p1=4 then p1:=1; setcolor(15);
bard(110+180*(p1-1),10*p2-2,200+180*(p1-1),8+10*p2);end;
#75:begin setcolor(0);
bard(110+180*(p1-1),10*p2-2,200+180*(p1-1),8+10*p2);
p1:=p1-1; if p1=0 then p1:=3; setcolor(15);
bard (110+180*(p1-1),10*p2-2,200+180*(p1-1),8+10*p2);end;
#13:begin q1:=inp; setcolor(0);
bard(110+180*(p1-1),10*p2-2,200+180*(p1-1),8+10*p2);
q[p2,p1]:=q1; q1:=0;
if q[1,p1]+q[2,p1]+q[3,p1]+q[4,p1]>1000then begin
for i:=1 to 4 do i<>p2 then q1:=q1+q[i,p1];
q[p2,p1]:=1000-q1; end;
getpar(q); volume(q,v,0); setcolor(15);
bard(110+180*(p1-1),10*p2-2,200+180*(p1-1),8+10*p2); end;
end;
until k:=#23;
setcolor(0); bard(110+180*(p1-1),10*p2-2,200+180*(p1-1),8+10*p2);
outtextxy(400,370,a[6]);
end;
3:begin
setcolor(0); for i:=1 to 5 do outtextxy(400,370+15*i,a[i]);
setcolor(4); outtextxy(400,370,a[6]);
p2:=1; setcolor(15);
bard(100,318+10*p2,150,328+10*p2);
repeat
k:=readkey; if k=#0 then k:=readkey;
case k of
#72:begin setcolor(0);bard(100,318+10*p2,150, 328+10*p2);
p2:=p2-1; if p2=0 then p2:=4;
setcolor(15); bard(100,318+10*p2,150,328+10*p2);e nd;
#80:begin setcolor(0); bard(100,318+10*p2,150,328+10*p2);
p2:+p2+1; if p2=5 then p2:=1; setcolor(15);
Bard(100,318+10*p2,150,328+10*p2); end;
#13:begin q1:=inp; setcolor (0);
bard(100,318+10*p2,150,328+10*p2);
q[p2,4]:=q1;
getpar(q); volume(q,v,0); setcolor(15);
bard(100,318+10*p2,150,328+10*p2);; end;
end;
until k:=#27; k:=#23;
setcolor(0); bard(100,318+10*p2,150,328+10*p2);
outtextxy(400,370,a[6]);
end;
4:begin
optim(q,V);
volume(q,v,0);
end;
5: k:#27;
end;
until K:=#27;
end; begin end.

[Serge_Bliznykov]

1)Код обязательно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)

2) Тема НЕ ОТРАЖАЕТ суть решаемой задачи/проблемы!
Сообщите, какую задачу Вы решаете - я исправлю тему.
в противном случае данную тему закрою!

3) исходники подобного размера ГОРАЗДО лучше вкладывать в архив и выкладывать на форум в виде архива. Собирать это ручками, чтобы проверить - слишком накладно!

4) "не могу наладить модуль!" - это не вопрос. и не просьба. Это утверждение!
У Вас есть проблемы? Вопросы?! Вот о них и пишите!
То есть - чём конкретно требуется помощь?!!



Модератор.