Технический форум

Технический форум (http://www.tehnari.ru/)
-   Помощь студентам (http://www.tehnari.ru/f41/)
-   -   Паскаль, программа, помощь в корректировке (http://www.tehnari.ru/f41/t96656/)

julia.avdes 29.05.2014 22:28

Паскаль, программа, помощь в корректировке
 
Здравствуйте!
Задание:
Сводная ведомость результатов экзаменационной сессии студенческой группы находится в файле на диске и для каждого студента содержит фамилию, инициалы и оценки по пяти предметам. Количество студентов в группе не превышает 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;


записывает в файл, но не могу додумать как составить процедуру вывода всех студентов, студентов отличников итд.

Буду благодарна любой помощи, даже маленькой подсказки.

poiu 29.05.2014 23:46

я весь код не читал конечно (не люблю разбираться в чужом коде), нго могу предложить след. вариант. раз число студиков не велико, можно забить все это дело в массив. mas: array[1..20] of student. а в студент дописать поле средний балл (по которому и найдутся отличники), а количество записей массива - количество студиков.
надеюсь доходчиво высказал теорию.

Vladimir_S 30.05.2014 11:58

Всё, чем могу помочь - предложить свой, полностью отлаженный вариант решения задачи:
Код:

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.



Часовой пояс GMT +4, время: 14:38.

Powered by vBulletin® Version 4.5.3
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.