Помощь - Поиск - Пользователи - Календарь
Полная версия: ЗАПИСИ
Форум «Всё о Паскале» > 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;
...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.