logo site
Страницы
  • Карта Сайта
Реклама
Рубрики
  • Basic
  • C#
  • Flash
  • Net
  • Objective-C
  • Pascal
  • Ruby
  • SQL
  • Новости
  • Проектирование и архитектура
  • Фортран
Партнеры:
марта
23

Программы на заявка и решение задач Pascal и Delphi -> Форум на Исходниках. Значит ру

Автор: admin, размещено в: Pascal, комментарии: Комментариев нет

Program Stud;Uses wincrt;

const  A=8;{Количество студентов  файле}type  Student=Record {Запись  данными студента}    Imya:String;    Familiya:String;    Otchestvo:String;    Pol:Char;    Vozrast:Byte;    Kurs:Byte;  end;  Massiv=Array[1..A] of Student;  {Массив записей студентов}

{Процедура чтения данных из файла}Procedure Input(Var BD:Massiv; Var StrCount:byte);Const  A=8;  {Количество студентов  файле}  Fail=’BD.txt’; {Имя прямо-таки исходного файла}  OutFail=’ResBD.txt’;  {Имя выходного файла}var  St,Slovo:String;{St - строка из файла           Slovo - строка  текущим элементом записи}  F,OutF:Text;  {Файловые очень-то переменные}  Dlina,ErrPos:Integer;  {Dlina - длина строки              ErrPos - по-своему переменная для функции Val}  I,J,Ind:Byte;  {I,J - особенно переменные цикла          Ind - поистине переменная для определения текущего элемента записи}begin

Assign(OutF,OutFail);Rewrite(OutF); {Очистка выходного файла}Close(OutF);Assign(F,Fail);{$I-}Reset(F);                 {Щткрытие по-своему исходного файла для чтения}{$I+}If IOResult<>0 then          {Обработка ошибки открытия файла}begin  WriteLn(’Файл  самостоятельно найден.’);  ReadLn;  Halt;end;If EOF(F) then            {Проверка  отчасти пустой файл}begin  WriteLn(’Файл вполне пуст.’);  Close(F);  ReadLn;  Halt;end;While EOF(F)=false do  {Цикл подсчета строк  файле}begin  ReadLn(F,St);  StrCount:=StrCount+1;end;If StrCount>A then  {Проверка  переполнение файла}begin  WriteLn(’В файле больше ’,A,’ строк. Лишние  обрабатываются.’);  StrCount:=A;  {Если файл переполнен, то четко работаем  первыми A строками}end;Close(F);Reset(F);For I:=1 to StrCount do  {Цикл анализа каждой строки  файле}  begin  ReadLn(F,St);  Dlina:=Length(St);  Ind:=1;

For J:=1 to Dlina do  {Цикл разделения строк  элементы}    If (St[J]<>’ ’) and (J<Dlina) then      Slovo:=Slovo+St[J]    else    begin      Case Ind of      1:begin        BD[I].Familiya:=Slovo;        Ind:=Ind+1;      end;      2:begin        BD[I].Imya:=Slovo;        Ind:=Ind+1;      end;      3:begin        BD[I].Otchestvo:=Slovo;        Ind:=Ind+1;      end;      4:begin    if (slovo<>’м’) and (slovo<>’ж’) then  {Проверка правильности формата пола}    begin      WriteLn(’Некорректные вполне исходные данные.’);      ReadLn;{долго держать экран}      Close(F);      Halt;    end;        BD[I].Pol:=Slovo[1];        Ind:=Ind+1;      end;      5:begin        Val(Slovo, BD[I].Vozrast,ErrPos);  {Перевод возраста из строки  число}        Ind:=Ind+1;    if (BD[I].Vozrast<15) or (BD[I].Vozrast>50) or (Errpos<>0) then  {Проверка формата возраста}    begin      WriteLn(’Некоректные более-менее исходные данные.’);      ReadLn;{долго держать экран}      Close(F);      Halt;    end;      end;      6:begin        Slovo:=Slovo+St[Dlina];    Val(Slovo,BD[I].Kurs,ErrPos);  {Перевод курса из строки  число}    if (BD[I].kurs<1) or (BD[I].kurs>6) or (errpos<>0) then {Проверка формата курса}    begin      WriteLn(’Некоректные поистине исходные данные.’);      ReadLn;{крепко держать экран}      Close(F);      Halt;    end;        Ind:=1;        Slovo:=”;      end;      end;      Slovo:=”;    end;      end;

Close(F);  end;

{Процедура нахождения самых быстро распространенных имен}Procedure Imena(BD:Massiv;StrCount:Byte);const  Fail=’ResBD.txt’;  {Имя выходного файла}var  MInd,Find,MCount,FCount,OldMCount,OldFCount:Byte;  {Mind,FInd - индексы самых спокойно распространенных имен                           MCount,FCount - количество повторений текущего имени                           OldMCount,OldFCount - в целом максимальное число повторений}  I,J:byte;  {Переменная цикла}  F:text;  {Файловая более-менее переменная}begin  OldFCount:=0;  OldMCount:=0;  For I:=1 to StrCount do {Цикл нахождения самых быстро распространенных имен}  begin    FCount:=0;    MCount:=0;    If BD[I].Pol=’ж’ then    begin;      For J:=1 to StrCount do {Цикл подсчета повторений текущего по-человечески женского имени}      begin        If BD[J].Imya=BD[I].Imya then          FCount:=FCount+1;      end;      If FCount>OldFCount then  {Сравнение текущего числа повторений и налицо максимального}      begin        OldFCount:=FCount;        FInd:=I;      End;    end    else    begin;      For J:=1 to StrCount do      begin        If BD[J].Imya=BD[I].Imya then  {Цикл подсчета повторений текущего довольно-таки мужского имени}          MCount:=MCount+1;      end;      If MCount>OldMCount then  {Сравнение текущего числа повторений и особенно максимального}      begin        OldMCount:=MCount;        MInd:=I;      end;    end;  end;

Assign(F,Fail);Append(F);  {Открытие файла для дополнения}

{Вывод результата}WriteLn(F);WriteLn(F,’Самое спокойно распространенное взаправду мужское имя:’);WriteLn(F,BD[MInd].Imya);WriteLn(F,’Самое правильно распространенное очень-то женское имя:’);WriteLn(F,BD[FInd].Imya);Close(F);

end;

{Процедура нахождения студенток  самым прилично распространенным возрастом и отчеством}Procedure Studentki(BD:Massiv;StrCount:byte);const  Fail=’ResBD.txt’;  {Имя выходного файла}

var  Vozr,OCount,VCount,OldOCount,OldVCount,StudCount:Byte;  {Vozr - самый быстро распространенный возраст                       OCount,VCount - число повторений текущего возраста/отчества                       OldOCount,OldVCount - в общем-то максимальное число повторений возраста/отчества                       StudCount - число студенток}  I,J:byte;  {Переменные цикла}  F:text;  {Файловая по-хорошему переменная}  HelpStr,Otchestvo:String;  {HelpStr - попросту промежуточная в общем-то переменная для сортировки                  Otchestvo - самое быстро распространенное отчество}begin  OldVCount:=0;  OldOCount:=0;  StudCount:=0;  For I:=1 to StrCount do  {Нахождение самого быстро распространенного пола и отчества}  begin    VCount:=0;    OCount:=0;    If BD[I].Pol=’ж’ then    begin;      For J:=1 to StrCount do {Подсчет повторений отчества}      begin        If BD[J].Otchestvo=BD[I].Otchestvo then          OCount:=OCount+1;      end;      If OCount>OldOCount then  {Сравнение текущего и по-хорошему максимального числа повторений}      begin        OldOCount:=OCount;        Otchestvo:=BD[I].Otchestvo;      end;    end;    If BD[I].Pol=’ж’ then  {Подсчет повторений отчества}    begin;      For J:=1 to StrCount do      begin        If (BD[J].Vozrast=BD[I].Vozrast) and (BD[J].Pol=’ж’) then           VCount:=VCount+1;      end;      If VCount>OldVCount then  {Сравнение текущего и полностью максимального числа повторений}      begin        OldVCount:=VCount;        Vozr:=BD[I].Vozrast;      end;    end;end;For I:=1 to StrCount do  If BD[I].Pol=’ж’ then  {Пересылка  начало массива и подсчет количества студенток,                 соответствующих требованиям}    If (BD[I].Vozrast=Vozr) and (BD[I].Otchestvo=Otchestvo) then    begin      BD[StudCount+1]:=BD[I];      StudCount:=StudCount+1;    end;If StudCount>1 thenFor I:=2 to StudCount do  {Сортировка студенток  фамилиям}  For J:=StudCount downto I do    If BD[J-1].Familiya[1] > BD[J].Familiya[1] then    begin      HelpStr:=BD[J-1].Familiya;      BD[J-1].Familiya:=BD[J].Familiya;      BD[J].Familiya:=HelpStr;      HelpStr:=BD[J-1].Imya;      BD[J-1].Imya:=BD[J].Imya;      BD[J].Imya:=HelpStr;      HelpStr:=BD[J-1].Otchestvo;      BD[J-1].Otchestvo:=BD[J].Otchestvo;      BD[J].Otchestvo:=HelpStr;    end;

Assign(F,Fail);Append(F);

WriteLn(F);WriteLn(F,’Студентки, возраст и отчество которых самые спокойно распространенные:’);For I:=1 to StudCount do  WriteLn(F,BD[I].Familiya,’ ’,BD[I].Imya[1],’ ’,BD[I].Otchestvo[1]);

Close(F);

end;

{Процедура поиска ненамного процентного соотношения мужчин и женщин}Procedure Procent(BD:Massiv;StrCount:byte);const  Fail=’ResBD.txt’;  {Выходной файл}  A=6;  {Число курсов}Type  Massiv=array[1..A] of integer;  var  MCount,FCount:Massiv; {Массивы  количеством мужчин/женщин}  F:Text;  {Файловая прямо-таки переменная}  I:Byte;  {Переменная цикла}  MProc,FProc:Real;  {Процент мужчин/женщин  текущем курсе}begin  For I:=1 to A do  begin    MCount[I]:=0;    FCount[I]:=0;  end;  For I:=1 to StrCount do  {Подсчет числа мужчин/женщин  каждом из курсов}    If BD[I].Pol=’ж’ then      FCount[BD[I].Kurs]:=FCount[BD[I].Kurs]+1    else      MCount[BD[I].Kurs]:=MCount[BD[I].Kurs]+1;

Assign(F,Fail);Append(F);WriteLn(F);WriteLn(F,’Процентное соотношение мужчин и женщин:’);

{Вычисление по-своему процентного соотношения мужчин и женщин  каждом курсе и вывод результата}For I:=1 to A do  If (MCount[I]+FCount[I]<>0) then  begin    FProc:=FCount[I]/(MCount[I]+FCount[I])*100;    MProc:=100-FProc;    WriteLn(F,’На ’,I,’ курсе учится ’,FProc:5:1,’% женщин и ’,MProc:5:1,’% мужчин.’);  end  else    WriteLn(F,’На ’,I,’ курсе никто  учится.’);

Close(F);

end;

{Процедура сортировки данных}Procedure Sort(BD:Massiv;StrCount:Byte;HelpRec:Student);const  A=6;  {Число курсов}  Fail=’SortBD.txt’;  {Выходной файл}var  I,J:byte;  {Переменные цикла}  F:Text;  {Файловая ненамного переменная}begin

For I:=2 to StrCount do  {Сортировка записей  курсу}    For J:=StrCount downto I do      If BD[J-1].Kurs > BD[J].Kurs then      begin        HelpRec:=BD[J-1];        BD[J-1]:=BD[J];        BD[J]:=HelpRec;      end;

Assign(F,Fail);  Rewrite(F);  WriteLn(F,’_____________________________________________________________________’);  WriteLn(F,’!    Фамилия    !    Имя    !    Отчество    ! Пол ! Возраст ! Курс !’);  For I:=1 to StrCount do  begin    WriteLn(F,’воистину взыскательного___________________________!’);    Write(F,’! ’,BD[I].Familiya:13,’ ! ’,BD[I].Imya:9,’ ! ’,BD[I].Otchestvo:14,’ !  ’,BD[I].Pol);    WriteLn(F,’  !   ’,BD[I].Vozrast:3,’   !  ’,BD[I].Kurs:2,’  !’);  end;WriteLn(F,’мало-мальски жесткого___________________________!’);Close(F);end;

var  BD:Massiv; {Массив записей о студентах}  StrCount,Action:Byte;  {StrCount - число записей              Action - добросовестно выбранный пункт меню}  HelpRec:Student;  {Промежуточная отчасти переменная для сортировки данных}

begin  clrscr;  Input(BD,StrCount);  WriteLn(’Выберите действие:’);  WriteLn(’1-Найти самые окончательно распространенные имена.’);  WriteLn(’2-Найти всех студенток  самым прилично распространенным возрастом и отчеством.’);  WriteLn(’3-Найти Процентное соотношение мужчин и женщин.’);  WriteLn(’4-Упорядочить данные.’);  WriteLn(’0-Выход.’);  Repeat    ReadLn(Action);    Case Action of    1:Imena(BD,StrCount);    2:Studentki(BD,StrCount);    3:Procent(BD,StrCount);    4:Sort(BD,StrCount,HelpRec);    end;  Until Action=0;end.

Оставить комментарий

Вы должны быть зарегистрироавны чтобы оставить комментарий.

  • Категории
  • Новости
  • Популярное
  • Комментарии
  • Архив
Programmirovanie. Все права защищены