|
Главная | Правила | Регистрация | Дневники | Справка | Пользователи | Календарь | Поиск | Сообщения за день | Все разделы прочитаны |
|
Опции темы | Опции просмотра |
29.05.2014, 22:28 | #1 (permalink) |
Новичок
Регистрация: 29.05.2014
Сообщений: 1
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Паскаль, программа, помощь в корректировке
Задание: Сводная ведомость результатов экзаменационной сессии студенческой группы находится в файле на диске и для каждого студента содержит фамилию, инициалы и оценки по пяти предметам. Количество студентов в группе не превышает 20 человек. Составить программу, с помощью которой можно корректировать и дополнять список и получать: • список студентов; • список студентов, сдавших экзамены только на «5»; • список студентов, имеющих тройки; • список студентов, имеющих двойки. При этом студент, имеющий более чем одну двойку, исключается из списка. есть наработки: Вариант 1: Program curs; uses crt; Type student = record n : byte ; f,ini: string[10] ; bal : array [1..5] of byte; end; Var spisok : student ; sp : file; a: integer; procedure vvod; var i,j:byte; f:text; begin assign (sp,'Vedom.txt'); rewrite ( sp); with spisok do For i:=1 to 2 do begin n:=i; write(sp); writeln (' Введите фамилию - ' ); readln (f); writeln (' Введите инициалы - ' ); readln (ini); writeln (' Введите 5 оценкок ' ); For j:= 1 to 5 do readln ( bal [j] ); write (sp , spisok); end; close (sp); end; procedure print; var j : byte; begin reset ( sp); writeln (' Список студентов: '); while not eof (sp) do with spisok do begin Read (sp, spisok); writeln (f,' ',ini); For j:= 1 to 5 do write (' ', bal [j],' ' ); writeln ; end; readln; close (sp) ; end; procedure otl; var j : byte;k:=0; begin reset ( sp); writeln (' Cписок студентов, сдавших экзамены только на «5» '); while not eof (sp) do with spisok do begin Read (sp, spisok); For j:= 1 to 5 do if bal[j]=5 then k:=k+1; if k=5 then write ( f, ' ' ,ini ); k:=0; writeln ; end; readln; close (sp) ; end; procedure ydov; var j : byte;begin reset ( sp); writeln (' Cписок студентов,имеющих тройки '); while not eof (sp) do with spisok do begin Read (sp, spisok); For j:= 1 to 5 do begin if bal[j]=3 then begin write (f,' ' ,ini ); break; end; end; writeln ; end; readln; close (sp) ; end; procedure dva; var j : byte; begin reset ( sp); writeln (' Cписок студентов,имеющих двойки'); while not eof (sp) do with spisok do begin Read (sp, spisok); For j:= 1 to 5 do begin if bal[j]=2 then begin write (f,' ' ,ini ); break; end; writeln ; end; readln; close (sp) ; end;end; begin assign (sp,'Vedom.txt'); repeat writeln('_________________________________________ ____________________________________'); writeln('========================================= ===================================='); writeln('_____Внести фамилии, инициалы и оценки студентов в базу________________/1 ___'); writeln('_____Посмотреть список всех студентов__________________________________/2____'); writeln('_____Посмотреть список студентов, сдавших экзамены только на «5»_______/3____'); writeln('_____Посмотреть список студентов,имеющих тройки________________________/4____'); writeln('_____Посмотреть список студентов,имеющих двойки________________________/5____'); writeln('_____Посмотреть список студентов, сдавших экзамены без 2_______________/6____'); writeln('========================================= ===================================='); writeln('_________________________________________ ____________________________________'); read (a); case a of 1: Vvod; 2: print; 3: otl; 4: ydov; 5: dva; end; until a=0; end. проблема в записи в файл, получаю не верные символы. Нужно исправить, чтобы в сохраненном файле показывалось список группы и оценки. Вариант 2: uses crt; const n=3; Type Tstudent=record (*Тип студент*) LastName:string[10]; FIO:string[10]; Mark:array[1..5] of byte; end; VAr Student:array[1..n] of Tstudent;(*Массив з 20 студентами*) I,j:integer; F:text; Ch:char; Procedure Refresh; (*Процедура ввода информации о студентах*) var I,j:integer; begin for i:=1 to n do Begin Writeln; Write('Фамилия: '); Readln(student[i].LastName); Write('Ф.И.О: '); Readln(student[i].FIO); for j:=1 to 5 do Begin Write('Оценка: '); Readln(student[i].mark[j]); end; end; end; Procedure Write_File;(*Запись информации в файл о студентах*) var I,j:integer; begin Assign(f,'q.txt'); Rewrite(f); for i:=1 to n do Begin Writeln(f,student[i].LastName); Writeln(f,Student[i].FIO); for j:=1 to 5 do Writeln(f,student[i].mark[j]); end; Close(f); end; Procedure Read_File;(*Чтение информации из файла о студентах*) var I,j:integer; Begin Assign(f,'q.txt'); Reset(f); i:=0; Repeat inc(i); Readln(f,student[i].LastName); Readln(f,Student[i].FIO); for j:=1 to 5 do Readln(f,student[i].mark[j]); until (eof(f))or(i>=n); Close(f); end; записывает в файл, но не могу додумать как составить процедуру вывода всех студентов, студентов отличников итд. Буду благодарна любой помощи, даже маленькой подсказки. |
29.05.2014, 22:28 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
По содержанию ваш топик аналогичен данным темам Программа с несколькими процедурами, Паскаль Помощь с программой. Фортран и Паскаль Паскаль, последняя помощь Программа на алгоритмическом языке Турбо Паскаль |
29.05.2014, 23:46 | #2 (permalink) |
Member
Регистрация: 05.03.2014
Сообщений: 200
Сказал(а) спасибо: 2
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 834
|
я весь код не читал конечно (не люблю разбираться в чужом коде), нго могу предложить след. вариант. раз число студиков не велико, можно забить все это дело в массив. mas: array[1..20] of student. а в студент дописать поле средний балл (по которому и найдутся отличники), а количество записей массива - количество студиков.
надеюсь доходчиво высказал теорию. |
30.05.2014, 11:58 | #3 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Всё, чем могу помочь - предложить свой, полностью отлаженный вариант решения задачи:
Код:
uses CRT; Type student = record f,ini:string[10] ; bal:array [1..5] of byte; end; file_type=file of student; Var sp0,sp1,sp5,sp3,sp2:file_type; a:Byte; procedure Vvod; var i,j,N,Q,k,m:byte; C:Char; stud:student; spisok:Array[1..20] of student; begin {$I-} N:=0; Q:=1; reset(sp0); If IOResult=0 then begin while not EoF(sp0) do begin Inc(N); read(sp0,stud); spisok[N]:=stud; end; close(sp0); rewrite(sp0); Writeln('New list - 1'); Writeln('Add students - 2'); Writeln('Delete students - 3'); Readln(Q); if Q=2 then for i:=1 to N do write(sp0,spisok[i]) else if Q=3 then begin k:=0; for i:=1 to N do begin with spisok[i] do begin write(f,' ',ini); for m:=Length(f)+Length(ini)+2 to 20 do write(' '); for j:=1 to 5 do write(bal[j]:4); end; write(' - delete (Y/N)? '); readln(C); if (C='N') or (C='n') then write(sp0,spisok[i]) else Inc(k); end; Dec(N,k); end; end else rewrite(sp0); if Q<3 then repeat Inc(N); Writeln('Next student:'); if N<21 then begin with stud do begin write('family - ' ); readln(f); write('initials - ' ); readln(ini); writeln('5 marks - ' ); for i:=1 to 4 do read(bal[i]); readln(bal[5]); end; write (sp0,stud); write('Continue? (Y/N) '); Readln(C); writeln; end; until (C='N') or (C='n') or (N=20); close(sp0); {$I+} end; procedure Print(var fff:file_type); var i,j:byte; stud:student; begin Reset(fff); while not eof(fff) do begin read(fff,stud); with stud do begin write(f,' ',ini); for i:=Length(f)+Length(ini)+2 to 20 do write(' '); for j:=1 to 5 do write(bal[j]:4); writeln; end; end; Close(fff); Readkey; end; procedure Otsev; var stud:student; i,k:byte; begin reset(sp0); rewrite(sp1); repeat read(sp0,stud); with stud do begin k:=0; for i:=1 to 5 do if bal[i]=2 then Inc(k); if k<2 then write(sp1,stud); end; until EoF(sp0); Close(sp0); Close(sp1); end; procedure Udov; var stud:student; i,k:byte; begin reset(sp1); rewrite(sp3); repeat read(sp1,stud); with stud do begin k:=0; for i:=1 to 5 do if bal[i]=3 then Inc(k); if k>0 then write(sp3,stud); end; until EoF(sp1); Close(sp1); Close(sp3); end; procedure Otl; var stud:student; i,k:byte; begin reset(sp1); rewrite(sp5); repeat read(sp1,stud); with stud do begin k:=0; for i:=1 to 5 do if bal[i]=5 then Inc(k); if k=5 then write(sp5,stud); end; until EoF(sp1); Close(sp1); Close(sp5); end; procedure Dva; var stud:student; i,k:byte; begin reset(sp1); rewrite(sp2); repeat read(sp1,stud); with stud do begin k:=0; for i:=1 to 5 do if bal[i]=2 then Inc(k); if k>0 then write(sp2,stud); end; until EoF(sp1); Close(sp1); Close(sp2); end; begin assign(sp0,'0'); assign(sp1,'1'); assign(sp2,'2'); assign(sp3,'3'); assign(sp5,'5'); repeat Clrscr; writeln('Edit the list - 1'); writeln('Print the initial list - 2'); writeln('Print the corrected list - 3'); writeln('Students having "2" - 4'); writeln('Students having "3" - 5'); writeln('Students having only "5" - 6'); writeln('Quit the program - 7'); Readln(a); ClrScr; Case a of 1: begin Vvod; Otsev; end; 2: begin Writeln('Initial list:'); Print(sp0); end; 3: begin Writeln('List after the abandonment of weak students:'); Print(sp1); end; 4: begin Writeln('List of students having one "2":'); Dva; Print(sp2); end; 5: begin Writeln('List of students having "3":'); Udov; Print(sp3); end; 6: begin Writeln('List of students having only "5":'); Otl; Print(sp5); end; end; until a=7; end. |
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
Опции темы | |
Опции просмотра | |
|
|