1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code]. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Работа с динамическим списком, добавление/удаление по номеру
program DinList; uses crt; type PItem = ^TItem; TItem = record Number:integer; Next:PItem; end; var First:PItem; Num:char;
Function GetLast: PItem; var Temp:PItem; begin Temp:=First; while Assigned(Temp^.Next) do Temp:=Temp^.Next; GetLast:=Temp; end;
Function AddItem: PItem; var Temp:PItem; begin AddItem:=nil; New(Temp); FillChar(Temp^, SizeOf(Temp^),0); if not Assigned(Temp) then Exit; if not Assigned(First) then First:=Temp else GetLast^.Next:=Temp; AddItem:=Temp; end;
procedure FillItem(Item:PItem); var s:string; v:integer; Code:integer; begin if not Assigned(Item) then Exit; Writeln('vvedite chislo'); Readln(s); Val(s,v,Code); if Code = 0 then Item^.Number:=v; end;
procedure ClearList; var Temp:PItem; Next:PItem; begin Temp:=First; while Assigned(Temp) do begin Next:=Temp^.Next; Dispose(Temp); Temp:=Next; end; First:=nil; end;
procedure FillList; const InpL:set of char = ['Y','y','D','d',#13]; var c:char; begin clrscr; ClearList; Writeln('Zapolnenie spiska'); repeat FillItem(AddItem); Writeln('Prodolgit vvod? y/n'); until not (ReadKey in InpL); end;
procedure List; var Temp:PItem; x,y:byte; begin clrscr; Temp:=First; GotoXY(1,2); while Assigned(Temp) do begin Writeln(Temp^.Number); x:=whereX; y:=whereY; GotoXY(1,1); Writeln('Nagmite lubuy klavishu'); GotoXY(x,y); Temp:=Temp^.Next; ReadKey; end; Writeln('konec spiska'); ReadKey; end;
procedure Sortirovka; var Temp:PItem; begin clrscr; Temp:=First; while Temp <>nil do begin Temp:=First; if odd(Temp^.Number) then dispose(Temp); First:=Temp^.next; end; end;
begin First:=nil; repeat MainMenu; Num:=ReadKey; case Num of '1':FillList; '2':ClearList; '3':begin clrscr; FillItem(AddItem); end; '4':List; '5':Sortirovka; end; until Num = '0'; ClearList; end.
Не знаю как сделать добавление ПО НОМЕРУ, и удаление тоже ...
Сообщение отредактировано: volvo - 6.11.2006 17:44