динамические списки, narod pomogite pliiiizzz srochno I NEED HELP !!! Опции

[kreator]

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 !!!!