dr.pantagon
دوشنبه 30 اردیبهشت 1387, 18:58 عصر
سلام این یک پروژه است که من روش کار کردم به زبان پاسکال است و یک دفترچه تلفن است که با آرایه های 3 بعدی نوشته شده و فقط سه تا ورودی دراه اسم فامیل و تلفن
حالا من هر کاری کنم هی خطا می گیره و نمی تونم کامپایل کنم لطفا یکی این رو کامپایل کنه و بگه مشکل از کجاست
خطایی که میده : Error In statement
و روی خط زیر میره
{****} procedure list;{**************}
PROGRAM TELEPHONE;
uses crt;
var a:array[1..100,1..3] of longint;
i,j,k,m,n,o,p:integer;
s:string;
c:char;
{****}procedure f(s1:string); {***********************}
begin
n:=1;
repeat
if s1[n]<>' ' then
begin
end;
write(s1[n]);
n:=n+1;
until s1[n]='.';
s1:=' ';
end;
{****} procedure g(x,y:integer;s1:string); {*******************}
begin
if s1[1]=' ' then f(s1)
else write(s1);
end;
{****} function menu:byte; {*********************}
begin
m:=1;
j:=5;
repeat;
if (j=72) or (j=1) then m:=m*-1;
g(j,4,'1.ADD');
g(j,5,'2.DELETE');
g(j,6,'3.EDIT');
g(j,10,'4.EXIT');
if m=-1 then j:=j-1
else j:=j+1;
g(10,15,'PLEASE ENTER SELECT(1-4):');
if not((s='1')or(s='2')or(s='3')or(s='4'))then
begin
g(35,15,'INCORECT NUMBER');
end
else
begin
val(s,k,m);
menu:=k;
end;
{****} procedure list;{**************}
egin
clrscr;
for j:=1 to i-1 do
for k:=1 to length (a[j,2]) do
a[j,2,k]:=upcase(a[j,2,k]);
for j:=1 to i-2 do
for k:=j+1 to i-1 do
if(a[j,2]>a[k,2]) then
for m:=1 to 4 do
begin
s:=a[j,m];
a[j,m]:=a[k,m];
a[k,m]:=s;
end;
for k:=1 to 80 do write('?');
g(10,3,'NAME');
g(30,3,'FAMILY');
g(50,3,'TELEPHONE');
for k:=1 to i-1 do
begin
write(k,'_');
if a[k,4]='1' then textcolor(white);
g(10,3+k,a[k,1]);
g(30,3+k,a[k,2]);
g(50,3+k,a[k,3]);
if a[k,4]='1' then
begin
a[k,4]:='';
end;
end;
end;
{****} procedure add; {**********************}
begin
clrscr;
g(14,8,' ENTER PROPERTIES.');
g(18,10,'NAME:');
readln(a[i,1]);
g(18,12,'FAMILY:');
readln(a[i,2]);
g(18,14,'TELEPHONE:');
readln(a[i,3]);
i:=i+1;
end;
{****} procedure delete; {********************}
begin
clrscr;
list;
g(1,1,' INTER PERSONS NUMBER (RED COLOR) IN LIST TO DELETE(1_.');
write(i-1,'):');
readln(k);
g(1,1,' ARE YOU SURE YOU WANT TO DELETE ".');
write(a[k,1],' ',a[k,2],'"?','(Y/N): ');
if readkey='y' then
begin
for j:=k to i do
for m:=1 to 3 do
a[j,m]:=a[j+1,m];
i:=i-1;
end;
{****} procedure edit; {******************}
begin
clrscr;
list;
g(1,1,' ENTER PERSONS NUMBER (RED COLOR) IN THE LIST TO EDIT(1_.');
write(i-1,'):' );
readln(k);
clrscr;
g(15,10,'1.EDIT NAME');
g(15,12,'2.EDIT FAMILY');
g(15,14,'3.EDIT PHONE NUMBER');
g(14,16,' PLEASE ENTER SELECT(1_3):.');
readln(j);
g(14,20,' EDIT .');
write('"',a[k,j],'":');
readln(s);
a[k,j]:=s;
a[k,4]:='1';
report;
end;
{********* MAIN BODY **********}
begin
for k:=1 to 100 do writeln(' ');
repeat
k:=menu;
case k of
1:add;
2:delete;
3:edit;
4:exit;
end;
until k=4;
end.
حالا من هر کاری کنم هی خطا می گیره و نمی تونم کامپایل کنم لطفا یکی این رو کامپایل کنه و بگه مشکل از کجاست
خطایی که میده : Error In statement
و روی خط زیر میره
{****} procedure list;{**************}
PROGRAM TELEPHONE;
uses crt;
var a:array[1..100,1..3] of longint;
i,j,k,m,n,o,p:integer;
s:string;
c:char;
{****}procedure f(s1:string); {***********************}
begin
n:=1;
repeat
if s1[n]<>' ' then
begin
end;
write(s1[n]);
n:=n+1;
until s1[n]='.';
s1:=' ';
end;
{****} procedure g(x,y:integer;s1:string); {*******************}
begin
if s1[1]=' ' then f(s1)
else write(s1);
end;
{****} function menu:byte; {*********************}
begin
m:=1;
j:=5;
repeat;
if (j=72) or (j=1) then m:=m*-1;
g(j,4,'1.ADD');
g(j,5,'2.DELETE');
g(j,6,'3.EDIT');
g(j,10,'4.EXIT');
if m=-1 then j:=j-1
else j:=j+1;
g(10,15,'PLEASE ENTER SELECT(1-4):');
if not((s='1')or(s='2')or(s='3')or(s='4'))then
begin
g(35,15,'INCORECT NUMBER');
end
else
begin
val(s,k,m);
menu:=k;
end;
{****} procedure list;{**************}
egin
clrscr;
for j:=1 to i-1 do
for k:=1 to length (a[j,2]) do
a[j,2,k]:=upcase(a[j,2,k]);
for j:=1 to i-2 do
for k:=j+1 to i-1 do
if(a[j,2]>a[k,2]) then
for m:=1 to 4 do
begin
s:=a[j,m];
a[j,m]:=a[k,m];
a[k,m]:=s;
end;
for k:=1 to 80 do write('?');
g(10,3,'NAME');
g(30,3,'FAMILY');
g(50,3,'TELEPHONE');
for k:=1 to i-1 do
begin
write(k,'_');
if a[k,4]='1' then textcolor(white);
g(10,3+k,a[k,1]);
g(30,3+k,a[k,2]);
g(50,3+k,a[k,3]);
if a[k,4]='1' then
begin
a[k,4]:='';
end;
end;
end;
{****} procedure add; {**********************}
begin
clrscr;
g(14,8,' ENTER PROPERTIES.');
g(18,10,'NAME:');
readln(a[i,1]);
g(18,12,'FAMILY:');
readln(a[i,2]);
g(18,14,'TELEPHONE:');
readln(a[i,3]);
i:=i+1;
end;
{****} procedure delete; {********************}
begin
clrscr;
list;
g(1,1,' INTER PERSONS NUMBER (RED COLOR) IN LIST TO DELETE(1_.');
write(i-1,'):');
readln(k);
g(1,1,' ARE YOU SURE YOU WANT TO DELETE ".');
write(a[k,1],' ',a[k,2],'"?','(Y/N): ');
if readkey='y' then
begin
for j:=k to i do
for m:=1 to 3 do
a[j,m]:=a[j+1,m];
i:=i-1;
end;
{****} procedure edit; {******************}
begin
clrscr;
list;
g(1,1,' ENTER PERSONS NUMBER (RED COLOR) IN THE LIST TO EDIT(1_.');
write(i-1,'):' );
readln(k);
clrscr;
g(15,10,'1.EDIT NAME');
g(15,12,'2.EDIT FAMILY');
g(15,14,'3.EDIT PHONE NUMBER');
g(14,16,' PLEASE ENTER SELECT(1_3):.');
readln(j);
g(14,20,' EDIT .');
write('"',a[k,j],'":');
readln(s);
a[k,j]:=s;
a[k,4]:='1';
report;
end;
{********* MAIN BODY **********}
begin
for k:=1 to 100 do writeln(' ');
repeat
k:=menu;
case k of
1:add;
2:delete;
3:edit;
4:exit;
end;
until k=4;
end.