Правила форума
Прочтите прежде чем задавать вопрос!
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 !!!!
