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

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

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

 
 Ответить  Открыть новую тему 
> динамические списки, narod pomogite pliiiizzz srochno I NEED HELP !!!
сообщение
Сообщение #1


Новичок
*

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

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


vot tekst programmy :
 
program list;
uses CRT;

type pt = ^elem;
elem = record
info : byte;
next : pt;
end;

function getprelastel (list:pt):pt;
var nextel:pt;
begin
if (list<>NIL) then (* Если список не пуст *)
begin
nextel:=list;
repeat
list:=nextel; (* Перейти к следующему элементу списка *)
if (list^.next<>NIL) then
nextel:=list^.next;
until (nextel^.next=NIL); (* Пока следующий за данным элемент списка не будет последним *)
getprelastel:=list; (* Вернуть найденый элемент *)
end
else (* Иначе, если список пуст *)
getprelastel:=NIL; (* Вернуть указатель на пустой список *)
end;

function getlastel (list:pt):pt;
begin
if (list<>NIL) then (* Если список не пуст, то: *)
begin
while (list^.next<>NIL) do (* Пока текущий элемент списка не последний*)
list:=list^.next; (*Перейти к следующему элементу *)
getlastel:=list; (* Вернуть найденый элемент *)
end
else (* Иначе *)
getlastel:=NIL; (* Вернуть указатель на пустой список *)
end;

function searchel (list:pt;info:byte):pt;
begin
if (list<>NIL) then (* Если список не пуст *)
begin
while ((list^.next<>NIL) and (list^.info<>info)) do (* Пока текущий элемент не последний и не искомый *)
list:=list^.next; (* Переходить к следующему элементу списка *)
if (list^.info<>info) then (* Если искомый элемент не найден*)
searchel:=NIL (*вернуть указатель на пустой список *)
else (* Иначе *)
searchel:=list; (* Вернуть указатель на этот элемент *)
end
else (* Иначе *)
begin
searchel:=NIL; (* Вернуть указатель на пустой список *)
end;
end;

function searchpreel (list:pt;info:byte):pt;
var nextel:pt;
begin
if (list<>NIL) then (* Если список не пуст *)
begin
nextel:=list;
repeat
list:=nextel; (* Переходить к следующему элементу списка *)
if (list^.next<>NIL) then
nextel:=list^.next;
until ((nextel^.next=NIL) or (nextel^.info=info)); (* Пока следующий за текущим элемент- не последний или искомый *)
if (nextel^.info<>info) or (nextel=list) then (* Если нужный нам элемент не найден или в списке 1 элемент *)
searchpreel:=NIL (* Вернуть указатель на пустой список *)
else (* Иначе *)
searchpreel:=list; (* Вернуть указатель на найденый элемент *)
end
else (* Иначе, если список пуст *)
begin
searchpreel:=NIL; (* Вернуть указатель на пустой список *)
end;
end;

function getelem(elname:string):byte;
var ret:byte;
begin
write('vvedite ',elname,' : ');
readln(ret);
getelem:=ret;
end;

procedure addtobegin (var list:pt;info:byte);
var newelem:pt;
begin
new(newelem); (* Создать в памяти новый элемент *)
newelem^.info:=info;
newelem^.next:=list; (* Присоединить к этому элементу список *)
list:=newelem; (* Вернуть его, как начало нового списка *)
end;

procedure addafter (listel:pt;info:byte);
var newelem:pt;
begin
if (listel<>NIL) then (* Если список не пуст *)
begin
new(newelem); (* Создать в памяти новый элемент *)
newelem^.info:=info;
newelem^.next:=listel^.next; (* Вставить элемент между заданным элементом и следующим *)
listel^.next:=newelem;
end;
end;

procedure addtoend (var list:pt;info:byte);
begin
if (list=NIL) then (* Если список пуст *)
addtobegin(list,info) (* Добавить элемент в начало, создав новый список *)
else (* Иначе *)
addafter(getlastel(list),info); (* Добавить элемент после последнего *)
end;

procedure addbefore (listel:pt;info:byte);
var newelem:pt;
begin
if (listel<>NIL) then (* Если список не пуст *)
begin
new(newelem); (* Создать в памяти новый элемент *)
newelem^.info:=listel^.info; (* Скопировать в него заданный элемент списка *)
listel^.info:=info; (* Записать в заданный элемент списка элемент для добавления *)
newelem^.next:=listel^.next; (* Вставить заданный элемент списка после добавленного *)
listel^.next:=newelem;
end;
end;

procedure delfirstel(var list:pt);
var temp:pt;
begin
if (list<>NIL) then (* Если список не пуст *)
begin
temp:=list; (* Сохранить в памяти адрес первого элемента *)
list:=list^.next; (* Отрезать от списка первый элемент *)
dispose(temp); (* Убрать первый элемент из памяти *)
end;
end;

procedure dellastel(var list:pt);
var temp:pt;
begin
if (list<>NIL) then (* Если список не пуст, то *)
if (list^.next=NIL) then (* Если в списке один элемент *)
delfirstel(list) (* Удалить его *)
else (* Иначе *)
begin
temp:=getprelastel(list); (* Найти предпоследний элемент списка *)
dispose(temp^.next); (* Удалить следующий за ним *)
temp^.next:=NIL;
end;
end;

procedure delel(var list:pt;el:pt);
var temp:pt;
begin
if ((list<>NIL) and (el<>NIL)) then (* Если дан элемент для удаления и список не пуст *)
begin
if (el^.next=NIL) then (* Если элемент, который нужно удалить - последний в списке *)
if (list^.next=NIL) then (* И если он ещё и единственный *)
delfirstel(list) (* Удалить его, то есть первый элемент *)
else (* Иначе, если он не единственный *)
dellastel(list) (* Удалить его, то есть последний элемен *)
else
begin
temp:=el^.next; (* Скопировать в этот элемент следующий за ним *)
el^.info:=temp^.info;
el^.next:=temp^.next;
dispose(temp); (* Удалить следующий за этим элемент *)
end;
end;
end;

procedure delbefore(var list:pt;info:byte);
var temp:pt;
begin
if (list<>NIL) then (* Если список не пуст *)
begin
temp:=searchpreel(list,info); (* Найти элемент, предшествующий искомому *)
delel(list,temp); (* И удалить его *)
end;
end;

procedure delafter(var list:pt;info:byte);
var temp:pt;
begin
if (list<>NIL) then (* Если список, не пуст *)
begin
temp:=searchel(list,info); (* Найти искомый элемент *)
temp:=temp^.next; (* И удалить следующий за ним *)
delel(list,temp)
end;
end;

procedure printlist (list:pt);
begin
clrscr;
if (list=NIL) then (* Если список пуст *)
writeln('spisok pyst!') (* Сообщить об этом *)
else
while (list<>NIL) do (* Пока текущий элемент списка не последний *)
begin
write(list^.info); (* Распечатать его *)
list:=list^.next; (* Перейти к следующему элементу *)
if (list<>NIL) then
write(',')
else
write('.');
end;
readkey;
end;

procedure checkel(list:pt;info:byte);
begin
if (searchel(list,info)<>NIL) then
writeln('element ',info,' syshestvyet.')
else
writeln('element ',info,' ne syshestvyet.');
readkey;
end;

procedure showmenu;
begin
clrscr;
Writeln('1) dobavit el-t v konec spiska');
Writeln('2) raspechatat spisok');
Writeln('3) nauti, syshestvye li tkazannyu el-t v spiske');
Writeln('4) ydalit ykazannyu el-t iz spiska');
Writeln('5) vyxod ');
Writeln;
Write('vash vybor: ');
end;

var root: pt;
selection : byte;

begin
root:=NIL; (* Создать пустой список *)
repeat
showmenu; (* Показать меню *)
readln(selection); (* Ввести с клавиатуры пункт меню *)
writeln;
case selection of (* Выполнить действие, затребованное пользователем *)
1: addtoend(root,getelem('znachenie el-ta'));
2: printlist(root);
3: checkel(root,getelem('znachenie iskomogo el-ta'));
4: delel(root,searchel(root,getelem('znachenie el-ta dlia ydalenia')));
5: clrscr;
end;
until selection=5; (* Если пользователь выбрал не выход, повторить *)
end.








pomogite plz peredelat' ety programmy tak ,chtoby ona brala znacheniia iz faula i v faule byli ne cifry a v s tolbik familiia professiia NAprimer :
ivanov stroitel
petrov kamenshik
geutz programist
i eshe dobavit' vyxod s soxraneniem i podklychit' modyl' zastavki vnachale vot etou progi :

Uses Graph,crt;
VAR
x1, y1, x2, y2:integer;
GraphDriver,GraphMode:integer;
procedure L(x1, y1, x2, y2:word);
begin
SetColor(random(17));
Line (x1, y1, x2, y2);
end;
Begin
repeat
randomize;
GraphDriver:=detect;
InitGraph(GraphDriver, GraphMode, 'c:\bp\bgi\');

delay(49999);
SetBkColor(random(16));
delay(40000);

x1:=200; y1:=100; x2:=500; y2:=100; L (x1, y1, x2, y2); delay(40000);
x1:=500; y1:=100; x2:=500; y2:=400; L (x1, y1, x2, y2); delay(40000);
x1:=500; y1:=400; x2:=200; y2:=400; L (x1, y1, x2, y2); delay(40000);
x1:=200; y1:=400; x2:=200; y2:=100; L (x1, y1, x2, y2); delay(40000);
x1:=200; y1:=250; x2:=350; y2:=100; L (x1, y1, x2, y2); delay(40000);
x1:=350; y1:=100; x2:=500; y2:=250; L (x1, y1, x2, y2); delay(40000);
x1:=500; y1:=250; x2:=350; y2:=400; L (x1, y1, x2, y2); delay(40000);
x1:=350; y1:=400; x2:=200; y2:=250; L (x1, y1, x2, y2); delay(40000);
x1:=275; y1:=250; x2:=350; y2:=175; L (x1, y1, x2, y2); delay(40000);
x1:=275; y1:=250; x2:=350; y2:=325; L (x1, y1, x2, y2); delay(40000);
x1:=350; y1:=325; x2:=425; y2:=250; L (x1, y1, x2, y2); delay(40000);
x1:=425; y1:=250; x2:=350; y2:=175; L (x1, y1, x2, y2); delay(40000);
x1:=200; y1:=175; x2:=275; y2:=175; L (x1, y1, x2, y2); delay(40000);
x1:=275; y1:=175; x2:=275; y2:=100; L (x1, y1, x2, y2); delay(40000);
x1:=425; y1:=100; x2:=425; y2:=175; L (x1, y1, x2, y2); delay(40000);
x1:=425; y1:=175; x2:=500; y2:=175; L (x1, y1, x2, y2); delay(40000);
x1:=200; y1:=325; x2:=275; y2:=325; L (x1, y1, x2, y2); delay(40000);
x1:=275; y1:=325; x2:=275; y2:=400; L (x1, y1, x2, y2); delay(40000);
x1:=425; y1:=400; x2:=425; y2:=325; L (x1, y1, x2, y2); delay(40000);
x1:=425; y1:=325; x2:=500; y2:=325; L (x1, y1, x2, y2); delay(40000);
delay(40000);
setcolor(getbkcolor);
{ floodfill(350,250,17);
delay(40000);
delay(40000);
delay(40000);
floodfill(250,350,17);
setcolor(12);
floodfill(230,130,17);
floodfill(450,350,17);
floodfill(450,140,17);
delay(40000);
delay(40000); }
delay(40000);
delay(40000);
clrscr;
until KeyPressed;


read(x1);
CloseGraph;
End.



NAROD POJALYUSTA POMOGITE OCHEN' SROCHNO NADO , A TO K SESSII NE DOPYSTIAT , HELP ME !!!!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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