IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> динамические списки, немного доделать
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 12
Пол: Мужской

Репутация: -  0  +


program kursov;
uses crt;
type
student=record
name,part,prof:string[23]; {имя и инициалы}
number,vozrast:integer; {номер группы}
{ ball:array[1..5] of integer;} {успеваемость}
{srball:real;} {средняя оценка}
end;

var
f1,f2:file of student; {файловая переменная массива}
zap:student;
repeatkey:char;
num:integer; {общее количество записей в массиве}
i,j:integer;
gg,gg2,gg3,sor:longint;
sel:integer; {выбор пункта меню}
sum:longint; {сумма значений полей}
m1,m2:student; {для сортировки записей}
s:boolean; {ключ сортировки}
filename:string; {имя файла с записями}
z:string; {фильтрация пробелов}
pball:string[9]; {Оценки для ввода и вывода}

{описание вспомогательных процедур}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure shapka; {заголовок таблицы}
begin
writeln (' TABLICA ZAPISEU');
writeln;
writeln ('/===============TT==========TT==========TT=========TT=============\');
writeln ('[ fAMILIIA I.O. ][ #okryga ][ vozrast ][ partiia ][ professiia ]');
writeln ('\===============++==========++==========++=========++=============/');
end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure undertable; {низ таблицы}
begin
writeln ('\==================¦===========¦===========¦==========+===========/');
end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure nofile; {отсутствие файла}
begin
clrscr;
writeln;
writeln (' OSHIBKA!');
writeln (' Faul ',filename,' otsytstvyet! Najmite Enter.');
readkey;
end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure opening; {процедура открытия файла с f1}
begin
writeln;
write (' VVedite imia faula ');
readln (filename);
assign (f1,filename);
end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure printing; {процедура вывода текущей строки}
begin
with zap do
begin
write ('¦ ',name:5,' ');
write (number:10,' ');
pball:='';
{формирование строки оценок и вывод на экран}
write (vozrast:10,' ');

write (part:10,' ');
write (prof:10,' ');
writeln;
end;
end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure obmen;
begin
sor:=sor-2;
seek(f1,sor);
write(f1,m2);
write(f1,m1);
sor:=sor+2;
sor:=sor-1;
seek(f1,sor);
end;
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure editforedit; {Процедура выбора пункта изменения и изменения}
begin
repeat
clrscr;
Writeln(' vy xotite izmenit:');
Writeln(' -----------------------');
Writeln(' 1. familiy I.O.');
Writeln(' 2. Nomer okryga');
Writeln(' 3. vozrast');
Writeln(' 4. naimen partii');
Writeln(' 5. professiy');
Writeln(' -----------------------');
Write(' >>');
Readln(sel);
clrscr;
writeln;
writeln (' zapis ',gg);
writeln;
writeln (' vvedite novye dannye: ');
writeln;
case sel of
1:begin
write (' familiia i.o. ');
readln (zap.name);
writeln;
writeln(' familiia v zapisi ',gg,' izmenena');
end;
2:begin
write (' # okryga ');
readln (zap.number);
writeln;
writeln(' # okryga',gg,' izmenen');
end;
3:begin

writeln (' vvedite novyu vozrast');
readln (zap.vozrast);
writeln(' vozrast ',gg,' izmenen');

end;
4:begin
write (' Naim partii ');
readln (zap.part);
writeln;
writeln(' naim partii ',gg,' izmeneno');
end;
5:begin
write (' professiia ');
readln (zap.prof);
writeln;
writeln(' professiia ',gg,' izmenena');
end;
{Подсчет Среднего Балла}
{sum:=0;
for j:=1 to 5 do
sum:=sum+zap.ball[j];
zap.srball:=sum/5; }

{writeln(' vozrast ',gg,' izmenen');
end; }
end;
clrscr;
Writeln;
Write(' vy xotite izmenit chto nibyd eshe ? [Y/N] либо [Д/Н] ');
Readln(repeatkey);
until (UpCase(repeatkey) in ['N','Н']);
seek(f1,gg-1);
write(f1,zap);
end;

{Основные подпрограммы 1-7}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure create; {процедура создания нового файла}{(1 подпрограмма)}
begin
clrscr;
Writeln(' vvedite imia faula');
Write(' ');
Readln(filename);
Assign(f1,filename);
Rewrite(f1);
Writeln(' faul s imenem ',filename,' sozdan. najmite ENTER.');
readkey;
close(f1);
end; {процедура создания нового файла}{(конец 1 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure enter; {процедура добавления записи в файл}{(2 подпрограмма)}
begin
clrscr; {ассоциация с файлом и переход в конец}
writeln (' dobavlenie zapisi v faul');
opening;
{$I-}
reset (f1);
{$I+}
if IOResult=0 then
begin
if not eof(f1) then
begin
gg:=filesize(f1);
seek(f1,gg);
end;
clrscr;
writeln (' vvod zapiseu');
writeln;
write (' vvedite kol-vo zapiseu ');
readln (num);
for i:=1 to num do
begin
clrscr;
writeln;
writeln (' zapis ',i);
with zap do
begin

write (' familiia i.o. ');
readln (name);
write ('# okryga ');
readln (number);

writeln (' vozrast : ');

readln (vozrast);
writeln ('Naimenovanie partii : ');

readln (part);
writeln (' professia ');

readln (prof);
end;



write(f1,zap);
writeln;
end;
close(f1);
end
else nofile;
end; {процедура добавления записи в файл}{(конец 2 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure udalen; {процедура удаления записи}{(3 подпрограмма)}
begin
clrscr;
writeln (' ydalenie zapisi iz faula');
opening;
{$I-}
reset (f1);
{$I+}
if IOResult=0 then
begin
assign (f2,'buf');
rewrite (f2);
clrscr;
writeln (' ydalenie zapisi');
writeln;
write (' vvedite nomer zapisi ');
readln (num);
for i:=1 to num-1 do
begin
read(f1,zap);
write(f2,zap);
end;
read(f1,zap);
while (not(eof(f1))) do
begin
read(f1,zap);
write(f2,zap);
end;
close(f1);
close(f2);
erase(f1);
rename(f2,filename);
clrscr;
Writeln(' zapis ',num,' ydalena. najmite ENTER.');
readkey;
end
else nofile;
end; {процедура удаления записи}{(конец 3 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure edit; {процедура корректировки записи}{(4 подпрограмма)}
begin
clrscr;
repeatkey:=' ';
writeln (' korrektirovka zapisi v faule');
opening;
{$I-}
reset (f1);
{$I+}
if IOResult=0 then
begin
repeat
clrscr;
writeln (' korrektirovka zapisi');
writeln;
write (' vvedite nomer zapisi ');
readln (gg);
seek(f1,gg-1);
read(f1,zap);
editforedit;
clrscr;
Writeln;
Write(' vy xotite izmenit drygyy zapis? [Y/N] libo [Д/Н] ');
Readln(repeatkey);
until (UpCase(repeatkey) in ['N','Н']);
close(f1);
end
else nofile;
end; {процедура корректировки записи}{(конец 4 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure view; {вывод массива на экран}{процедура просмотра файла}{(5 подпрограмма)}
begin
clrscr;
writeln (' prosmotr faula');
opening;
{$I-}
reset (f1);
{$I+}
if IOResult=0 then
begin
clrscr;
shapka;
while (not Eof(f1)) do
begin
read(f1,zap);
with zap do
printing;
end;
undertable;
readkey;
end
else nofile;
end; {вывод массива на экран}{процедура просмотра файла}{(конец 5 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
procedure disp; {процедура вывода на дисплей при условии}{(7 подпрограмма)}
begin
clrscr;
writeln;
opening;
{$I-}
reset (f1);
{$I+}
if IOResult=0 then
begin
clrscr;
shapka;
s:=false;

while (not Eof(f1)) do
begin
read(f1,zap);
with zap do
if vozrast>4 then
begin
printing;
s:=true;
end;
end;
if s=false then writeln ('¦ poisk neydachen ¦ ¦ ¦ ¦');
undertable;
readkey;
end
else nofile;
end; {процедура вывода на дисплей при условии}{(конец 7 подпрограммы)}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
BEGIN
repeat
clrscr;
writeln;
writeln (' ychebnaia praktika');
writeln;
writeln;
writeln (' baza dannyx ======== Kandidaty');
writeln;
writeln (' ------------------------------------');
writeln (' 1. Sozdanie faula');
writeln (' 2. Dobavlenie zapisi v faul');
writeln (' 3. Ydalenie ykazannou zapisi');
writeln (' 4. Korektirovka ykazannou zqapisi');
writeln (' 5. Prosmotr faula');
writeln (' 6. tyt doljen byt poisk');
writeln (' 7. vyxod');
writeln (' ------------------------------------');
writeln;
write (' > ');
readln (sel);
case sel of
1:create;
2:enter;
3:udalen;
4:edit;
5:view;
6:disp;
7:break;
end;
until false;
END.




pomogite plz vmesto procedyry disp sdekat poisk xotia by po imeni
i eshe sdelat' vyxo bez soxraneniia


zaranee spasibo
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 29.03.2024 15:00
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name