IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> ЗАПИСИ, помогите устранить ошибку
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 2
Пол: Мужской

Репутация: -  0  +


я вообще запутался.Сортировка не работает
.помогите пожалустаю
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.




 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Помощник капитана
****

Группа: Пользователи
Сообщений: 601
Пол: Мужской
Реальное имя: Артем

Репутация: -  2  +


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


--------------------
Dum spiro spero!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3





Группа: Пользователи
Сообщений: 2
Пол: Мужской

Репутация: -  0  +


Цитата(Артемий @ 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;
...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 27.09.2020 5:26
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name