Типизированный файл (Turbo pascal) почти сделал, но... - Помощь студентам

Marksman_SwAt · 06.05.2014, 16:54

У меня такая задачка, я ее почти сделал, но не до конца:
Создать типизированный файл, содержащий сведения о том, какие из пяти предлагаемых дисциплин по выбору желает слушать студент. Структура записи: фамилия студента, номер группы, пять дисциплин, средний балл успеваемости. Выбираемая дисциплина отмечается символом 1, иначе - пробел. На экран и в отдельный файл вывести списки студентов, желающих прослушать дисциплину Х. Если число желающих превысит 8 человек, то необходимо отобрать студентов, имеющих более высокий балл успеваемости. Значение Х вводится с клавиатуры.

Код:

uses crt;
label start;
        Type discip=record
             fam:string[20];
             grup:string[10];
             bal:byte;
        end;
var f,d: file of discip;
    pac:array[1..10] of discip;
    i,n:integer;
    
    
procedure dobavlenie;
var i:integer;
begin
writeln('Введите количетво студентов ');
     readln(n);
       for i:=1 to n do

          begin
            writeln('Введите данные об ', i ,' студенте ');
             with pac[i] do
              begin
              write('Фамилия ');
              readln(fam);
              write('Группа ');
              readln(grup);
              write('Средний балл ');
              readln(bal);
              end;
          seek(f,filesize(f));
          write(f,pac[i]);
          end;
close(f);
writeln('Запись успешно добавлена!');
writeln('Нажмите <ENTER> для продожения работы...');
readln();
end;


procedure udalenie;
var toDelete:integer;
begin
assign(d,'temp.dat');
rewrite(d);
writeln('Введете номер записи для удаления');
readln(toDelete);
i:=1;
while not EOF(f) do
begin
  read(f,pac[i]);
  if (toDelete <> i) then write(d,pac[i]);
  i:=i+1;
end;
close(f);
close(d);
Erase(f);
Rename(d,'discip.dat');
writeln('Запись успешно удаленна!');
writeln('Нажмите <ENTER> для продожения работы...');
readln();
end;

procedure vyvod;
  var i,j:integer;
begin
writeln('N', 'Фамилия':9, 'Группа':12, 'Средний балл':15);
i:=1;
while not EOF(f) do
begin
  read(f,pac[i]);
  i:=i+1;
end;

for j:=1 to i-1 do
  begin
    with pac[j] do
      writeln(j, fam:10, grup:8, bal:10);
  end;
writeln('Нажмите <ENTER> для продожения работы...');
close(f);
readln();
end;


procedure mainMenu;
begin


Assign(f,'discip.dat');
reset(f);

clrscr;
writeln('Программа для работы с клиентами');
writeln('Выберите пункт');
writeln('1. Добавить запись в файл');
writeln('2. Удалить запись из файла');
writeln('3. Вывод содержимого на экран');
writeln('6. Выход');
writeln();
write('-> ');

end;


{---------------main programm}
begin
start:
mainMenu;
readln(n);
case n of
1: dobavlenie;
2: udalenie;
3: vyvod;
6: exit;
end;
goto start;
end.

Не могу правильно добавить 5-ть дисциплин . И как я понимаю для каждой из 5-ти дисциплины должен быть отдельный файл. Не выходит правильно это все сделать.
Помогите чем можете

ZX Spectrum-128 · 06.05.2014, 18:20

Проверяйте. 4-й пункт только для создания файла.

Код:

uses
  crt;
Type
  discip=record
    fam:string[20];
    grup:string[10];
    bal:byte;
  end;
var
  f,d: file of discip;
  pac:array[1..10] of discip;
  i,n:integer;

procedure dobavlenie;
var
  i:integer;
begin
  writeln('Введите количетво студентов ');
  readln(n);
  for i:=1 to n do
    begin
      writeln('Введите данные об ', i ,' студенте ');
      with pac[i] do
        begin
          write('Фамилия ');
          readln(fam);
          write('Группа ');
          readln(grup);
          write('Средний балл ');
          readln(bal);
        end;
        seek(f,filesize(f));
        write(f,pac[i]);
    end;
  close(f);
  writeln('Запись успешно добавлена!');
  writeln('Нажмите <ENTER> для продожения работы...');
  readln();
end;


procedure udalenie;
var toDelete:integer;
begin
assign(d,'temp.dat');
rewrite(d);
writeln('Введете номер записи для удаления');
readln(toDelete);
i:=1;
while not EOF(f) do
begin
  read(f,pac[i]);
  if (toDelete <> i) then write(d,pac[i]);
  i:=i+1;
end;
close(f);
close(d);
Erase(f);
Rename(d,'discip.dat');
writeln('Запись успешно удаленна!');
writeln('Нажмите <ENTER> для продожения работы...');
readln();
end;

procedure vyvod;
  var i,j:integer;
begin
writeln('N', 'Фамилия':9, 'Группа':12, 'Средний балл':15);
i:=1;
while not EOF(f) do
begin
  read(f,pac[i]);
  i:=i+1;
end;

for j:=1 to i-1 do
  begin
    with pac[j] do
      writeln(j, fam:10, grup:8, bal:10);
  end;
writeln('Нажмите <ENTER> для продожения работы...');
close(f);
readln();
end;

procedure sozd;
begin
  Assign(f,'discip.dat');
  rewrite(f);
  pac[1].fam:='Gates';
  pac[1].grup:='Microsoft';
  pac[1].bal:=0;
  write(f,pac[1]);
  close(f);
end;

procedure mainMenu;
begin
  Assign(f,'discip.dat');
  reset(f);
  clrscr;
  writeln('Программа для работы с клиентами');
  writeln('Выберите пункт');
  writeln('1. Добавить запись в файл');
  writeln('2. Удалить запись из файла');
  writeln('3. Вывод содержимого на экран');
  writeln('4. Cоздание файла');
  writeln('6. Выход');
  writeln();
  write('-> ');
end;

{---------------main programm}
begin
while true do
  begin//start:
    mainMenu;
    readln(n);
    case n of
      1: dobavlenie;
      2: udalenie;
      3: vyvod;
      4: sozd;
      6: exit;
    end;
  end;
//goto start;
end.

Marksman_SwAt · 06.05.2014, 18:36

Наверное вы не так поняли. В этом варианте нет ошибок, только осталось довать еще одну процедуру для пяти дисциплин.

ZX Spectrum-128 · 06.05.2014, 18:40

Нет. Не понял. Добавить оценки по пяти дисциплинам/предметам? Или что?
Так нужно?

Код:

  Type discip=record
             fam:string[20];
             grup:string[10];
             bal:byte;
             predmety:array [1..5] of char;
        end;

Вроде понял. Сейчас доделаю.

Надеюсь, я теперь правильно понял?

Код:

uses
  crt;
Type
  discip=record
    fam:string[20];
    grup:string[10];
    predmety:array [1..5] of char;
    bal:real;
  end;
var
  f,d: file of discip;
  pac:array[1..10] of discip;
  i,n:integer;

procedure dobavlenie;
var
  j,i:integer;
begin
  writeln('Введите количетво студентов ');
  readln(n);
  for i:=1 to n do
    begin
      writeln('Введите данные об ', i ,' студенте ');
      with pac[i] do
        begin
          write('Фамилия ');
          readln(fam);
          write('Группа ');
          readln(grup);
          write('Средний балл ');
          readln(bal);
          for j:=1 to 5 do
            begin
              write(j,'-я дисциплина: ');
              readln(predmety[j]);
            end;
        end;
        seek(f,filesize(f));
        write(f,pac[i]);
    end;
  close(f);
  writeln('Запись успешно добавлена!');
  writeln('Нажмите <ENTER> для продожения работы...');
  readln();
end;


procedure udalenie;
var toDelete:integer;
begin
assign(d,'temp.dat');
rewrite(d);
writeln('Введете номер записи для удаления');
readln(toDelete);
i:=1;
while not EOF(f) do
begin
  read(f,pac[i]);
  if (toDelete <> i) then write(d,pac[i]);
  i:=i+1;
end;
close(f);
close(d);
Erase(f);
Rename(d,'discip.dat');
writeln('Запись успешно удаленна!');
writeln('Нажмите <ENTER> для продожения работы...');
readln();
end;

procedure vyvod;
var
  x,i,j:integer;
begin
  write('Выберите номер дисциплины для вывода списка студентов (1-5): ');
  readln(x);
  writeln('N', 'Фамилия':9, 'Группа':12, 'Средний балл':15);
  i:=1;
  while not EOF(f) do
    begin
      read(f,pac[i]);
      i:=i+1;
     end;
  for j:=1 to i-1 do
    begin
      with pac[j] do
        if predmety[x]='1' then
          writeln(j, fam:10, grup:8, bal:10:2,predmety[x]:8);
    end;
  writeln('Нажмите <ENTER> для продожения работы...');
  close(f);
  readln();
end;

procedure sozd;
begin
  Assign(f,'discip.dat');
  rewrite(f);
  pac[1].fam:='Gates';
  pac[1].grup:='Microsoft';
  pac[1].bal:=0.0;
  pac[1].predmety[1]:=' ';
  pac[1].predmety[2]:=' ';
  pac[1].predmety[3]:=' ';
  pac[1].predmety[4]:=' ';
  pac[1].predmety[5]:=' ';
  write(f,pac[1]);
  close(f);
end;

procedure mainMenu;
begin
  Assign(f,'discip.dat');
  reset(f);
  clrscr;
  writeln('Программа для работы с клиентами');
  writeln('Выберите пункт');
  writeln('1. Добавить запись в файл');
  writeln('2. Удалить запись из файла');
  writeln('3. Вывод содержимого на экран');
  writeln('4. Cоздание файла');
  writeln('6. Выход');
  writeln();
  write('-> ');
end;

{---------------main programm}
begin
while true do
  begin//start:
    mainMenu;
    readln(n);
    case n of
      1: dobavlenie;
      2: udalenie;
      3: vyvod;
      4: sozd;
      6: exit;
    end;
  end;
//goto start;
end.

Marksman_SwAt · 06.05.2014, 18:48

Должно быть пять предметов. Если студент желает слушать то ставим 1, если нет, то пробел. А потом вводим конкретный предмет и должен выводится список студентов которые его хотят слушать ( если больше 8-и студентов, то нужно отобрать у кого балл выше)

Marksman_SwAt · 06.05.2014, 18:53

У меня есть пример как эти предметы должны выбираться:
(!!!Запускать нужно во Free Pascal!!!)

Код:

program Stud;


uses
  Crt;

type
  Discipline = Record
               Name : String[15];
               Vybor : Boolean;
               End;
  Student = record
            fam : string[20];
            Group : integer;
            Sr_Ball : Real;
            Disciplins : Array[1..5] Of Discipline;
            end;
Const
  DiscList : Array[1..5] Of String[15] = ('Ђ«ЈҐЎа*','ЃЁ®«®ЈЁп','”Ё§ЁЄ*','•Ё¬Ёп','€*д®а¬*вЁЄ*');
var
  Students        : array of Student;
  factfile        : file of Student;
  Students_Count  : integer;
  filename        : string = 'Students.dat';
  ansver          : Integer;

procedure MakeFile;
var
  i,j : integer;
  new_one : Student;
  ch : Char;
begin
  Writeln('‘®§¤*о д*©«');

  Write('Љ®«ЁзҐбвў® бвг¤Ґ*в®ў : ');
  Readln(Students_Count);

  Assign(factfile, filename);
  Rewrite(factfile);

  for i := 1 to Students_Count do
  Begin
   WriteLn(i:3);
   Write('”*¬Ё«Ёп: '); Readln(new_one.fam);
   Write('ѓагЇЇ*: '); Readln(new_one.Group);
   Write('‘аҐ¤*Ё© Ў*««: ');
   Readln(new_one.Sr_Ball);
   WriteLn('‚лЎ®а ¤ЁбжЁЇ«Ё*: 1 - ўлЎ®а, Їа®ЎҐ« - *Ґв');
   For j:=1 To 5 Do
   Begin
     Write('   '+DiscList[j]+': '); Readln(ch);
     new_one.Disciplins[j].Name:=DiscList[j];
     new_one.Disciplins[j].Vybor:=(ch='1');
   End;
   Write(factfile, new_one);
  End;

  Close(factfile);
end;

procedure AddRecords;
var
  i,j     : integer;
  new_one : Student;
  ch : Char;
begin
  Write('„®Ў*ўЁвм §*ЇЁбҐ© : ');
  Readln(Students_Count);

  Assign(factfile, filename);
  Reset(factfile);
  Seek(factfile, FileSize(factfile));
  for i := 1 to Students_Count do
  Begin
    WriteLn(i:3);
    Write('”*¬Ё«Ёп: '); Readln(new_one.fam);
    Write('ѓагЇЇ*: '); Readln(new_one.Group);
    Write('‘аҐ¤*Ё© Ў*««: '); Readln(new_one.Sr_Ball);
    WriteLn('‚лЎ®а ¤ЁбжЁЇ«Ё*: 1 - ўлЎ®а, Їа®ЎҐ« - *Ґв');
    For j:=1 To 5 Do
    Begin
      Write('   '+DiscList[j]+': '); Readln(ch);
      new_one.Disciplins[j].Name:=DiscList[j];
      new_one.Disciplins[j].Vybor:=(ch='1');
    End;
    Write(factfile, new_one);
  End;
  Close(factfile);
end;

procedure FindStudents;
Var
  i,j : Integer;
  next_worker   : Student;
  Discipl : String;
  Flag : Boolean;
Begin
  Repeat
    Write('‡*¤*©вҐ ¤ЁбжЁЇ«Ё*г ¤«п Ї®ЁбЄ*: ');
    ReadLn(Discipl);
    For i:=1 to 5 Do
    If DiscList[i]=Discipl Then
    Begin
      Flag:=True;
      Break;
    End;
    If Not Flag Then
    Begin
      Write('’*Є®© ¤ЁбжЁЇ«Ё*л *Ґв. Џ®Їа®Ўг©вҐ Ґйс.');
      ReadLn;
    End;
  Until Flag;
  //ЏҐаҐ*®б ¤***ле д*©«* ў ¬*ббЁў
  Assign(factfile, filename);
  Reset(factfile);
  SetLength(Students, FileSize(factfile));

  Students_Count:=0;
  While not EOF(factfile) do
  Begin
    Read(factfile,next_worker);
    //Ѓг¤Ґ¬ ЇҐаҐ*®бЁвм в®«мЄ® ¦Ґ«*ойЁе Їа®б«ги*вм ¤ЁбжЁЇ«Ё*г
    Flag:=False;
    For i:=1 To 5 Do
    With next_worker.Disciplins[i] Do
    If Name=Discipl Then
    Begin
      Flag:=Vybor;
      Break;
    End;

    If Flag Then
    Begin
      Students[Students_Count]:=next_worker;
      Inc(Students_Count);
    End;
  End;
  Close(factfile);
  If Students_Count>8 Then
  //Ѓг¤Ґ¬ ®вЎЁа*вм б **ЁЎ®«миЁ¬ баҐ¤*Ё¬ Ў*««®¬
  //Ќг¦*® б®авЁа®ў*вм
  For i:=0 To 7 Do
  For j:=i+1 To Students_Count-1 Do
  If Students[i].Sr_Ball<Students[j].Sr_Ball Then
  Begin
    next_worker:=Students[i];
    Students[i]:=Students[j];
    Students[j]:=next_worker;
  End;
  //‚л¤*¤Ё¬ ** нЄа** ЇҐаўле 8 ®в®Ўа***ле
  j:=Students_Count-1;
  If j>7 Then j:=7;
  For i:=0 To j Do
  With Students[i] Do
  WriteLn(fam:20,Group:5,Sr_Ball:10:2);

  Finalize(Students);
End;

//‚л¤*з* д*©«* ** нЄа**
procedure PrintFile;
var
  j : Integer;
  next_worker   : Student;
  ch : Char;
begin
  Writeln('‚л¤*з* д*©«* ** нЄа**');
  Assign(factfile, filename);
  Reset(factfile);
  while not EOF(factfile) do
  begin
    Read(factfile, next_worker);
    WriteLn('”*¬Ё«Ёп: ',next_worker.fam);
    WriteLn('ѓагЇЇ*: ',next_worker.Group);
    WriteLn('‘аҐ¤*Ё© Ў*««: ',next_worker.Sr_Ball:10:2);
    For j:=1 To 5 Do
    Begin
      Write('   '+next_worker.Disciplins[j].Name:15);
      ch:=' ';
      If next_worker.Disciplins[j].Vybor Then ch:='1';
      WriteLn('   ',ch);
    End;
  end;
  Close(factfile);
end;

begin
  repeat
    Writeln(' ЊҐ*о:');
    Writeln('1) ‘®§¤**ЁҐ д*©«*');
    Writeln('2) „®Ў*ўЁвм §*ЇЁбЁ');
    Writeln('3) ‚л¤*з* д*©«* ** нЄа**');
    Writeln('4) Џ®ЁбЄ ¦Ґ«*ойЁе Їа®б«ги*вм ¤ЁбжЁЇ«Ё*г');
    Writeln('5) ‚ле®¤');

    Writeln; Writeln; Write('‚*и ўлЎ®а: ');
    Readln(ansver);
    case ansver of
      1 : MakeFile;
      2 : AddRecords;
      3 : PrintFile;
      4 : FindStudents;
      5 : Break;
      else
        Writeln('’*Є®Ј® Їг*Єв* *Ґв! Џ®Їа®Ўг©вҐ ҐиҐ')
    end;
    Readln;
    Writeln; Writeln;
  until false;
  readln;
end.

эта задача делалась для Delphi, тут переделано под Паскаль но мне это не совсем подходит, нужно чтобы в обычном паскале работало, как я писал раньше

ZX Spectrum-128 · 06.05.2014, 19:13

Я подредактировал предыдущую запись. Код там. Проверяйте.

Marksman_SwAt · 06.05.2014, 19:29

Цитата:

Сообщение от ZX Spectrum-128

Надеюсь, я теперь правильно понял?

Да, действительно так. Спасибо агромное за помощь.

ZX Spectrum-128 · 06.05.2014, 19:31

Цитата:

Сообщение от Marksman_SwAt

Да, действительно так. Спасибо агромное за помощь.

Не сделан вывод по ограничению 8 чел. Теперь вы поняли, как это делается. Сами доделаете.

Marksman_SwAt · 06.05.2014, 19:42

Ну чуть подкаректировал:

Код:

uses
  crt;
Type
  discip=record
    fam:string[20];
    grup:string[10];
    predmety:array [1..5] of char;
    bal:real;
  end;
var
  f,d: file of discip;
  stud:array[1..10] of discip;
  i,n:integer;

procedure dobavlenie;
var
  j,i:integer;
begin
  writeln('Введите количетво студентов ');
  readln(n);
  for i:=1 to n do
    begin
      writeln('Введите данные об ', i ,' студенте ');
      with stud[i] do
        begin
          write('Фамилия ');
          readln(fam);
          write('Группа ');
          readln(grup);
          write('Средний балл ');
          readln(bal);
          for j:=1 to 5 do
            begin
              write(j,'-я дисциплина: ');
              readln(predmety[j]);
            end;
        end;
        seek(f,filesize(f));
        write(f,stud[i]);
    end;
  close(f);
  writeln('Запись успешно добавлена!');
  writeln('Нажмите <ENTER> для продожения работы...');
  readln();
end;


procedure udalenie;
var toDelete:integer;
begin
assign(d,'temp.dat');
rewrite(d);
writeln('Введете номер записи для удаления');
readln(toDelete);
i:=1;
while not EOF(f) do
begin
  read(f,stud[i]);
  if (toDelete <> i) then write(d,stud[i]);
  i:=i+1;
end;
close(f);
close(d);
Erase(f);
Rename(d,'discip.dat');
writeln('Запись успешно удаленна!');
writeln('Нажмите <ENTER> для продожения работы...');
readln();
end;

procedure vyvod;
var
  x,i,j:integer;
begin
  write('Выберите номер дисциплины для вывода списка студентов (1-5): ');
  readln(x);
  writeln('N', 'Фамилия':9, 'Группа':12, 'Средний балл':15);
  i:=1;
  while not EOF(f) do
    begin
      read(f,stud[i]);
      i:=i+1;
     end;
  for j:=1 to i-1 do
    begin
      with stud[j] do
        if predmety[x]='1' then
          writeln(j, fam:10, grup:8, bal:10:2,predmety[x]:8);
          {if j>8 then }
    end;
  writeln('Нажмите <ENTER> для продожения работы...');
  close(f);
  readln();
end;

procedure vyvod1;
  var i,j:integer;
begin
writeln('N', 'Фамилия':9, 'Группа':12, 'Средний балл':15);
i:=1;
while not EOF(f) do
begin
  read(f,stud[i]);
  i:=i+1;
end;

for j:=1 to i-1 do
  begin
    with stud[j] do
      writeln(j, fam:10, grup:8, bal:10:2);
  end;
writeln('Нажмите <ENTER> для продожения работы...');
close(f);
readln();
end;

procedure sozd;
begin
  Assign(f,'discip.dat');
  rewrite(f);
  stud[1].fam:='-------';
  stud[1].grup:='------';
  stud[1].bal:=0.0;
  stud[1].predmety[1]:=' ';
  stud[1].predmety[2]:=' ';
  stud[1].predmety[3]:=' ';
  stud[1].predmety[4]:=' ';
  stud[1].predmety[5]:=' ';
  write(f,stud[1]);
  close(f);
end;

procedure mainMenu;
begin
  Assign(f,'discip.dat');
  reset(f);
  clrscr;
  writeln('Программа для работы с клиентами');
  writeln('Выберите пункт');
  writeln('1. Cоздание файла');
  writeln('2. Добавить запись в файл');
  writeln('3. Поиск желающих прослушать дисциплину');
  writeln('4. Вывод на экран всех студентов');
  writeln('0. Удалить запись из файла');
  writeln('5. Выход');
  writeln();
  write('-> ');
end;

{---------------main programm}
begin
while true do
  begin//start:
    mainMenu;
    readln(n);
    case n of
      2: dobavlenie;
      0: udalenie;
      3: vyvod;
      1: sozd;
      4: vyvod1;
      5: exit;
    end;
  end;
//goto start;
end.

Хотел чтобы каждый предмет в отдельности назывался, ну да ладно, не важно.
Сейчас попробую добавить это условие, для ограничения у кого бал маленький

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Типизированный файл -> удаление Pascal ABC	Vla00	Помощь студентам	0	30.04.2012 02:46
Заполнить типизированный файл целыми числами, увеличить вдвое компоненты файла, стоящие после максимального (turbo pascal)	Irishka_F	Помощь студентам	3	30.01.2012 23:36
Типизированный файл Pascal. Работа с данными.	Jimmy_93	Помощь студентам	0	26.05.2011 16:35
Первую почти сделал	Ko$	Помощь студентам	0	16.03.2011 14:18
[Pascal]типизированный файл+записи	Fuaran8989	Помощь студентам	4	30.11.2008 14:01

06.05.2014, 18:36	#3
Marksman_SwAt Пользователь Регистрация: 01.05.2014 Сообщений: 19	Наверное вы не так поняли. В этом варианте нет ошибок, только осталось довать еще одну процедуру для пяти дисциплин.

06.05.2014, 18:48	#5
Marksman_SwAt Пользователь Регистрация: 01.05.2014 Сообщений: 19	Должно быть пять предметов. Если студент желает слушать то ставим 1, если нет, то пробел. А потом вводим конкретный предмет и должен выводится список студентов которые его хотят слушать ( если больше 8-и студентов, то нужно отобрать у кого балл выше)

06.05.2014, 19:13	#7
ZX Spectrum-128 Участник клуба Регистрация: 05.11.2013 Сообщений: 1,601	Я подредактировал предыдущую запись. Код там. Проверяйте.