Помощь - Поиск - Пользователи - Календарь
Полная версия: ЗАПИСИ
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
GECTOR
я вообще запутался.Сортировка не работает
.помогите пожалустаю
program lab_Zapisi;
uses crt;
const n=9;
type stud=record
fio:string;
srb:integer;
age:integer;
pol:char;
end;
var f1:file of stud;
m,k,a:stud;
gruppa:array[1..n] of stud;
vid: byte;
flag: boolean;
i:integer;
name:string;

procedure file_name;{ima fila}
begin
write(' Введите имя файла ');
readln(name);
end;

procedure zapici; {sozdanie zapici}
begin
writeln(' Записи группы ',filepos(f1)+1);
with gruppa[i] do
begin
write(' Введите ФИО '); readln(fio);
write(' Возраст '); readln(age);
write(' Пол '); readln(pol);
write(' Средний балл '); readln(srb);
write(f1,gruppa[i]);
end;
end;

procedure dobavit_zapic;
var
i,p:integer;
begin
file_name;
assign(f1, name);
rewrite(f1);
writeln(' Создание новой записи ',name);
write(' Введите количество записей ');
readln(p);
for i:=1 to p do
zapici;
writeln(' Добавление нового файла ');
writeln(' Файл имеет ',filesize(f1),' записей ');
close(f1);
end;

procedure vivod;
begin
read(f1,gruppa[i]);
with gruppa[i] do
begin
write(filepos(f1));
writeln(' ФИО ',fio,' Возраст ',age,' Средний балл ', srb,' Пол ',pol);
end;
end;

procedure vivod_zapicei;
begin
file_name;
assign(f1, name);
{$I-}
reset(f1);
{$I+}
if IOresult = 0 then
begin
seek(f1, 0);
writeln(' Вывод записей ',name);
while (not Eof(f1)) do
vivod;
close(f1);
end
else
writeln(' Файла с именем ',name,' нет');
end;

procedure updaterec;
var
numrec: longint;
begin
file_name;
assign(f1, name);
{$I-}
reset(f1);
{$I+}
if IOresult = 0 then
begin
write('N zapici');
readln(numrec);
seek(f1,numrec-1);
writeln(' Старое значение ');
vivod;
seek(f1,numrec-1);
writeln(' Задаем новое значение ',numrec,' записи ');
zapici;
close(f1);
end
else
writeln('Файла с именем ',name,' нет ');
end;

procedure zapic_end;
begin
file_name;
assign(f1, name);
{$I-}
reset(f1);
{$I+}
if IOresult = 0 then
begin
seek(f1, filesize(f1));
zapici;
writeln('Открытый файл имеет ',filesize(f1),' записей ');
close(f1);
end
else
writeln(' Файла с именем ',name,' нет ');
end;

procedure findfio;
var
f: file of stud;
gruppa: stud;
maska: string;
flag: boolean;
countrec: integer;
begin
file_name;
assign(f, name);
{$I-}
reset(f);
{$I+}
if IOresult = 0 then
begin
write('Введите фамилии для поиска: ');
readln(maska);
flag:=false;
countrec:=0;
while (not Eof(f)) do
begin
read(f,gruppa);
with gruppa do
if pos(maska,fio) <> 0 then
begin
flag:=true;
inc(countrec);
writeln(' Фио ',fio,' Возраст ',age,' Средний балл ', srb,' Пол ',pol);
end;
end;
if flag then
begin
writeln(' Число записей с именем ',maska,'=',countrec);
end
else
writeln(' Файл не содержит фамилии ',maska);
close(f);
end
else
writeln(' Файла с именем ',name,' нет ');
end;

procedure sort_age;
var i:integer;
f1:file of stud;
flag:boolean;
begin
file_name;
zapici;
assign(f1,name);
{$I-}
rewrite(f1);
{$I+}
for i:=1 to filesize(f1) do begin
close(f1);
writeln;
writeln('vvedenaa gruppa');

for i:=1 to filesize(f1) do begin
with gruppa[i] do
writeln(' ФИО ',fio,' Возраст ',age,' Средний балл ',srb ,' пол ',pol);
end;
rewrite(f1);
i:=1;
repeat
if gruppa[i].age>gruppa[i+1].age then
begin
k:=gruppa[i];
gruppa[i]:=gruppa[i+1];
gruppa[i+1]:=k;
if i>1 then dec(i);
end
else inc(i);
until i>=3;
writeln;
writeln('Posle sortirovki');
for i:=1 to filesize(f1) do write(f1,gruppa[i]);
close(f1);
reset(f1);
for i:=1 to filesize(f1)do begin
read(f1,gruppa[i]);
with gruppa[i] do writeln(' ФИО ',fio,' Возраст ',age,' Средний балл ',srb ,' пол ',pol);
end;
close(f1);
readln;
end;
end;
Begin
textcolor(6);
flag:=false;
repeat

writeln(' 1. Создать новый файл');
writeln(' 2. Просмотр группы ');
writeln(' 3. Изменение записи');
writeln(' 4. Добавление записи');
writeln(' 5. Поиск записи');
writeln(' 6. Сортировка по возрасту');
writeln(' 0. Выход');
readln(vid);
case vid of
1: dobavit_zapic;
2: begin
clrscr;
vivod_zapicei;
end;
3: updaterec;
4: zapic_end;
5: findfio;
6: begin
sort_age;
end;
0: flag:=true;
end;
writeln('Нажмите [ENTER]');
readln;
clrscr;
until flag;
END.




Артемий
Пжл,выложи отрывок кода, в котором затруднения,ладно? wacko.gif
GECTOR
Цитата(Артемий @ 23.04.2007 22:00) *

Пжл,выложи отрывок кода, в котором затруднения,ладно? wacko.gif

сама программа вроде работает, только не работает процедура сортировки по возрасту(sort_age) ссылаясь на процедуру zapici в ней ошибка
...
procedure sort_age;
var i:integer;
f1:file of stud;
flag:boolean;
begin
file_name;
zapici;
assign(f1,name);
{$I-}
rewrite(f1);
{$I+}
for i:=1 to filesize(f1) do begin
close(f1);
writeln;
writeln('vvedenaa gruppa');

for i:=1 to filesize(f1) do begin
with gruppa[i] do
writeln(' ФИО ',fio,' Возраст ',age,' Средний балл ',srb ,' пол ',pol);
end;
rewrite(f1);
i:=1;
repeat
if gruppa[i].age>gruppa[i+1].age then
begin
k:=gruppa[i];
gruppa[i]:=gruppa[i+1];
gruppa[i+1]:=k;
if i>1 then dec(i);
end
else inc(i);
until i>=3;
writeln;
writeln('Posle sortirovki');
for i:=1 to filesize(f1) do write(f1,gruppa[i]);
close(f1);
reset(f1);
for i:=1 to filesize(f1)do begin
read(f1,gruppa[i]);
with gruppa[i] do writeln(' ФИО ',fio,' Возраст ',age,' Средний балл ',srb ,' пол ',pol);
end;
close(f1);
readln;
end;
end;
...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.