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