Компьютерный форум
Правила
Вернуться   Компьютерный форум > Форум программистов > Языки программирования > Pascal
Перезагрузить страницу помогите исправить ошибки, очень прошу...проблемы с курсовой
Ответ
 
Опции темы Опции просмотра
  (#1 (permalink)) Старый
tanuha_smile tanuha_smile вне форума
начинающий программист
 
Сообщений: 30
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 22.02.2011
Angry помогите исправить ошибки, очень прошу...проблемы с курсовой - 23.02.2011, 13:28

Program abc;
{Задача:
Дана структура: Ф.И.О., год рождения, пол, национальность.
1.записать сначала женщин, а затем мужчин.
2.вывести женщин и мужчин предпенсионного возраста.}
uses crt;
type
ludi=record;
fio:string [15];
dr:integer;
pol:char;
nac:string [19];
end;
mas= array [1..90] of ludi;
var
imfile:string [25];
f:file of ludi;
a:mas;
d:ludi;
ch:char;
n:byte;
i,j:byte;
pm:byte;

procedure vvod(var d:ludi);
begin
writeln('введите ко-во людей');
readln (n);
writeln('введите ФИО, год рождения, национальность, пол');
for i:=1 to n do
begin
readln(d.fio);
readln(d.dr);
readln(d.nac);
readln(d.pol);
end;
end;
procedure zfile;
begin
clrscr;
rewrite(f); {Файл бази відкрито для створення}
repeat
vvod(d); {В циклі повторюється процедура вводу і відповіно запису в файл}
write(f,d);
writeln('еще вводить?д/н');
readln(ch);
until upcase(ch)='Н'; {Цикл продовжуєтся поки не відмовится користувач}
close(f); {Файл записується із ОЗУ на диск}
end;

{Процедура считування інформації по літакам з файлу в масив}
procedure readf(var n:byte; var a:mas);
var
i,j:byte; {Параметри циклу}
begin
reset(f);
i:=1;
while not eof(f) do
begin
read(f, a[i]);
i:=i+1;
end;
close(f);
n:=i; {Запам_ятовуєтся кількість елементів}
end;


procedure prosm ;
var i:byte;
begin
readf(n,a);
writeln(' ______________________________________________');
writeln('!Ф.И.О. ! г.рож.! пол ! национальность !');
writeln(' ______________________________________________');
for i:=1 to n-1 do

writeln('!',d.fio:15,'!',d.dr:7,'!',d.pol:5,'!',d. nac:16,'!');
writeln(' ______________________________________________');
end;



procedure dob;
var ch:char; {змінна для вибору ТАК/НІ}
begin
reset(f); {файл відкрито для читання}
repeat
seek(f,filesize(f)); {Записуємо в кінець файлу}
vvod(d);
write(f,d);
writeln('Ѓг¤ЁвҐ ўў®¤ЁвЁ йҐ? д/н');
readln(ch);
until upcase(ch)='Н';
close(f); {Файл записується із ОЗУ на диск}
end;

{Процедура корегування інформації по літаках}
procedure kor;
var nkz : byte; {Номер корегуємого запису}
begin
prosm; {Процедура просмотру загальних відомостей по літаках для вибору номеру корегуємого запису}
reset(f);
repeat
writeln('‚введите номер коректируемой записи');
readln(nkz); {Користувач вводить корегуємого запису}
seek(f,nkz-1); {Записуємо інформацію поверх вибраного блоку}
vvod(d);
write(f,d);
writeln('eще будете коректировать? д/н');
read(ch);
until upcase(ch)='Н';
close(f); {Файл записується із ОЗУ на диск}
end;

procedure ud;
var
i,nuz:byte;
begin
readf (n,a);
repeat
write ('введите номер удаляемой записи-');
readln(nuz);
a[nuz].fio:='***';
write('удалять еще? (д/н)-');
readln(ch);
until upcase (ch)='Н';
rewrite (f);
for i:=1 to n do
if a[i].fio<>'***' then
write (f,a[i]);
close(f);
end;

procedure obr2( var a:mas);
var
tg,dr:integer;
fl: boolean;
begin
readf(n,a);
writeln('введите текущий год');
readln(tg);
fl:=true;
for i:=1 to n do
if (tg- dr=54) then
begin
writeln(' ______________________________________________');
writeln('!Ф.И.О. ! г.рож.! пол ! национальность !');
writeln(' ______________________________________________');
for i:=1 to n do
writeln('!',a[i].fio:15,'!',a[i].dr:7,'!',a[i].pol:5,'!',a[i].nac:16,'!');
writeln('!________________________________________ _____!');
end;
if fl then writeln('таких нет!!!');
end;

BEGIN
clrscr;
repeat
writeln ('введите имя файла');
readln(imfile);
assign(f,imfile);
writeln('0.ввод') ;
writeln ('1.запись в файл');
writeln('2.просмтр файла');
writeln('3.добавление файла');
writeln('4.коректировка файла');
writeln('5.удаление файла');
writeln('6.чтение файла');
writeln('7.ВЫХОД');
writeln('8.обработка 2');
writeln('введите нужный пункт меню');
readln(pm);
case pm of
1:zfile;
2:prosm;
3:dob;
4:kor;
5:ud;
6:readf(n,a);
7:exit;
8:obr2(a);
end;
writeln('еще будете работать?y/n');
readln(ch);
until upcase (ch)='Н';
END.
Ответить с цитированием
Ads
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
НАРОД ОЧЕНЬ ПРОШУ ПОМОГИТЕ!!!!!!!!!! Rock Zombie Любые вопросы от новичков 6 27.02.2012 17:39
Помогите пожалуйста с решением задачи.Очень прошу. Алекс307595 Pascal 0 22.12.2011 13:37
Как исправить ошибки в курсовой работе Верона Delphi 3 21.05.2011 16:45
turbo pascal. помогите пожалуйста! очень прошу. очень надо . завтра сдать. klubni4ka Pascal 2 13.01.2011 13:33
Помогите наити и исправить ошибки...Please!!! 111 Pascal 0 11.01.2011 21:03
Прошу помочь оценить мою сборочку!!! Очень прошу!!! Alexandr_D Оценка конфигурации 25 04.12.2010 21:35
Очень прошу помогите!!!!! dEmol1sh Pascal 10 27.10.2010 13:18
пОМОГИТЕ ВЫБРАТЬ КАРТУ ... ОЧЕНЬ ПРОШУ! LEONARDO_ Видеокарты 54 02.06.2010 20:28
Помогите исправить ошибки приложений. olesya-guber Любые вопросы от новичков 11 28.07.2008 12:14
помогите... очень прошу anksynamyn Pascal 4 09.01.2008 09:49
Помогите со статой по отдельным элементам базы. Очень прошу! SkyInTheSea PHP 9 11.12.2004 03:30



Powered by vBulletin® Version 3.8.7
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Нardforum.ru - компьютерный форум и программирование, форум программистов