Помогите в паскале

[Abay_Usagaliev]

Вот программа

uses CRT;

const NZ=5;
 NM=7;
 NF=5;
 COLOR1=green;
 COLOR2=red;
 Group='M-135';
 NAME='Усагалиев Абай';
 MX=25;
 MY=80;
 X=27;
 Y=10;
 OUTCOD = '*';
type
 TDate = Record
 d,m,y:longint;
 end;
 Trec = Record
 f1:string[30];
 f2:string[30];
 f3:string[30];
 f4:TDate;
 f5:string[30];
 end;
 TDB = file of Trec;
 TZA = array[1..NZ]of string;
 TMA = array[1..NM]of string;
 TNF = array[1..NF]of string;
const
 Z:TZA =('Список жилья, с минимальной стоимостью',
 'Список жилья, сдаваемого в определенном районе',
 'Список жилья c определенным количеством комнат',
 'Средняя стоимость жилья в определенном районе',
 'Выход');
 M:TMA = ('Создание БД',
 'Вывод БД',
 'Добавление записей в БД',
 'Удаление записей из БД',
 'Корректировка сведений в БД',
 'Запрос',
 'Выход');
 FLD:TNF = ('Адрес(полный)',
 'Признак(квартира или подселение)'
 ,'','','Район');
var
 F:TDB;
 R:Trec;
 C:Char;
 D,i:Byte;
{процедура вывода титульного листа}
procedure TitulnyList;
begin
 clrScr;
 textbackground(COLOR1);
 textcolor(COLOR2);
 clrScr;
 GotoXY(14,2);
 write('ВОЛГОГРАДСКИЙ ГОСУДАРСТВЕННЫЙ ТЕХНИЧЕСКИЙ УНИВЕРСИТЕТ');
 GotoXY(18,4);
 write('КАФЕДРА "ТЕХНОЛОГИЯ КОНСТРУКЦИОННЫХ МАТЕРИАЛОВ"');
 GotoXY(32,8);
 write('СЕМЕСТРОВАЯ РАБОТА');
 GotoXY(45,16);
 write('ВЫПОЛНИЛ СТУДЕНТ ГРУППЫ: ',group);
 GotoXY(45,17);
 write(NAME);
 GotoXY(45,19);
 write('ПРОВЕРИЛ:');
 GotoXY(45,20);
 write('Наумов  В.Ю.');
 GotoXY(33,24);
 write('ВОЛГОГРАД, 2013');
 readKey;
end;

{процедура вывода заголовка при вводе записи}
procedure IFF(var R:Trec);
var k:integer;
c:char;
begin
clrScr;
write(FLD[1],' (',OUTCOD,' - конец ввода): ');
readln(r.f1);
end;

{процедура ввода даты}
procedure InputDate(var D:TDate);
begin
writeLn;
write('Число комнат: ');
readln(D.d);
write('Этаж: ');
readln(D.m);
write('Размер платы за месяц: ');
readln(D.y);
end;

{процедура ввода записи}
procedure InputRecord(var R:Trec);
begin
write(FLD[2],': ');
write(R.f2);
write(FLD[3],': ');
readln(R.f3);
write(FLD[4],': ');
InputDate(R.f4);
write(FLD[5],': ');
readln(R.f5);
end;

{процедура, которая вызывает ввод записи и проверяет
признак конца ввода}
procedure CF(var F:TDB);
begin
IFF(R);
while R.f5<>OUTCOD do
begin
InputRecord(R);
write(F,R);
IFF(R);
end;
end;

{процедура, которая создает файл и производит вызов
процедуры его заполнения}
procedure VV(var F:TDB);
begin
clrScr;
rewrite(F);
CF(F);
close(F);
end;

{процедура, вывода экземпляра записи}
procedure PrintRecord(R:Trec);
begin
clrScr;
writeLn(FLD[1],': ',r.f1);
writeLn(FLD[2],': ',r.f2);
writeLn(FLD[3],': ',r.f3);
writeLn(FLD[4],': ',r.f4.d,'.',r.f4.m,'.',r.f4.y);
writeLn(FLD[5],': ',r.f5);
end;

{процедура печати базы}
procedure PrintBase(var F:TDB);
begin
reset(F);
while not eof(F) do
begin
read(F,R);
PrintRecord(R);
readKey;
end;
close(F);
end;

{процедура добавления записи}
procedure AddRecords(var F:TDB);
begin
clrScr;
reset(F);
seek(F,Filesize(F));
CF(F);
close(F);
end;

{процедура удаления записи}
procedure DeleteRecords(var F:TDB);
var
I:Longint;
begin
reset(F);
while not eof(F) do
begin
read(F,R);
PrintRecord(R);
writeLn('Удалить ? (1-Да)');
C:=readKey;
if C='1' then
begin
I:=filepos(F)-1;
While not eof(f) do
begin
read(F,R);
seek(F,filepos(F)-2);
write(F,R);
seek(F,filepos(F)+1);
end;
seek(F,filesize(F)-1);
truncate(F);
seek(F,I);
end;
end;
close(F);
end;

{процедура корректировки записи}
procedure CorrectRecords(var F:TDB);
begin
reset(F);
while not eof(F) do
begin
read(F,R);
PrintRecord(R);
writeLn('Корректировать ? (1-Да)');
C:=readKey;
If C='1' then
begin
IFF(R);
InputRecord(R);
seek(F,Filepos(F)-1);
write(F,R);
end;
end;
close(F);
end;

{процедура выделения цветом пункта меню}
procedure SetLineColor(NP,NS: Byte);
begin
if NP=NS then
begin
textbackground(COLOR2);
textcolor(COLOR1);
end
else
begin
textbackground(COLOR1);
textcolor(COLOR2);
end
end;






{функция меню запроса}
function MenuZ(X,Y:Byte):byte;
var k:Byte;
begin
k:=1;
repeat
textbackground(COLOR1);
textcolor(COLOR2);
clrScr;
for i:=1 to NZ do
begin
GotoXY(X,Y+i-1);
SetLineColor(k,i);
write(Z[i]);
end;
C:=readKey;
case Ord(C) of
72:begin
if k=1 then k:=NZ
else k:=k-1
end;
80:begin
if k=NZ then k:=1
else k:=k+1
end;
end;
until Ord(C)=13;
MenuZ:=k;
end;
       {логическая функция сравнения полей записи}
function Logic(r,r1:TRec):boolean;
begin
 Logic:=(r.f4.y>r1.f4.y) OR
 (
 (r.f4.y=r1.f4.y) AND (r.f4.m>r1.f4.m)
 ) OR
 (
 (r.f4.y=r1.f4.y) AND
 (r.f4.m=r1.f4.m) AND(r.f4.d>r1.f4.d)
 );
end;



{процедура сортировки файла с записями}
procedure SortFile(var f:TDB);
var r1:Trec;
l:boolean;
begin
repeat
reset(f);
L:=true;
read(f,r);
while NOT EOF(f) do
begin
read(f,r1);
if Logic(r,r1) then
begin
seek(f,filepos(f)-2);
write(f,r1);
write(f,r);
l:=false;
end
else
r:=r1;
end;
until L;
end;

{процедура формирования нового файла}
procedure Z1(var F:TDB);
var g:tdb;
begin
clrScr;
reset(f);
assign(g,'g.db');
rewrite(g);
while not EOF(f) do
begin
read(f,r);
write(g,r);
end;
SortFile(g);
PrintBase(g);
end;








{процедура запроса по cтоимости}
procedure Z3(var F:TDB);
var s:longint;
begin
clrScr;
write('Введите данные о минимальной стоимости: ');
readln(s);
writeLn;
reset(f);
While not eof(f) do
begin
read(f,r);
if r.f4.y<s then
begin
PrintRecord(R);
readKey;
end;
end;
close(F)
end;

{процедура запроса по cтоимости}
procedure Z5(var F:TDB);
var s:string;
begin
clrScr;
write('Введите данные о минимальной стоимости: ');
readln(s);
writeLn;
reset(f);
While not eof(f) do
begin
read(f,r);
if r.f5=s then
begin
PrintRecord(R);
readKey;
end;
end;
close(F)
end;
{процедура запроса по числу комнат}
procedure Z4(var F:TDB);
var s:longint;
begin
clrScr;
write('Количество комнат: ');
readln(s);
writeLn;
reset(f);
While not eof(f) do
begin
read(f,r);
if r.f4.d=s then
begin
PrintRecord(R);
readKey;
end;
end;
close(F)
end;

{процедура запроса по дате регистрации}
procedure Z2(var F:TDB);
var s:TDate;
begin
clrScr;
write(': ');
InputDate(s);
writeLn;
reset(f);
while not eof(f) do
begin
read(f,r);
if (r.f4.d=s.d) and
(r.f4.m=s.m) and
(r.f4.y=s.y) then
begin
PrintRecord(R);
readKey;
end;
end;
close(F);
end;



{процедура для работы с вложенным меню}
procedure Z0(var F:TDB);
var x,y,ml:integer;
begin
ml:=length(z[1]);
for i:=1 to NZ do
if length(z[i])>ml then
ml:=length(z[i]);
y:=((MX-NZ) div 2) + 1;
x:=((MY-ml) div 2) + 1;
repeat
D:=MenuZ(x,y);
case D of
1:z3(F);
2:z2(F);
3:z4(f);
4:z5(f);
5:z1(f);
end;
until D=NZ;
end;

{функция вывода главного меню}
function Menu(X,Y:Byte):byte;
var k:Byte;
begin
k:=1;
repeat
textbackground(COLOR1);
textcolor(COLOR2);
clrScr;
for I:=1 to NM do
begin
GotoXY(X,Y+I-1);
SetLineColor(k,I);
write(M[I]);
end;
C:=readKey;
case Ord(C) of
72:begin
if k=1 then k:=NM
else k:=k-1;
end;
80:begin
if k=NM then k:=1
else k:=k+1;
end
end;
until Ord(C)=13;
Menu:=k;
end;

{основная программа}
begin
assign(F,'Data.db');
TitulnyList;
repeat
D:=Menu(x,y);
case D of
1:VV(F);
2:PrintBase(F);
3:AddRecords(F);
4:DeleteRecords(F);
5:CorrectRecords(F);
6:Z0(F);
end;
until D=NM;
end.

Выдает ошибку
Program1.pas(250) : Переменная цикла for должна описываться в том же блоке, что и цикл for

[NT2000]

Несколько замечаний:
1. ваша тема помещена не в соответствующем разделе
2. интерпункции надо бы соблюсти - при оформлении сообщения выбрать правильно тип языка и табуляцию проводить в коде

Ошибка:
3. в функции function Menu(X,Y:Byte):byte; 
в петле  for I:=1 to NM do 
- где определена переменная I ?

Warning:
4. в процедуре procedure Z0(var F:TDB);
проверьте - где начинается и заканчивается тело петли for ?

PS. Это что бросилось в глаза - возможны и другие ошибки.

[cepesh]

Тема перемещена из форума «Работа форума» в форум «Карантин»
Причина переноса: 1) некорректный выбор раздела, 2) отсутствуют собственные попытки нахождения решения.