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

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

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

> Работа с динамическим списком, добавление/удаление по номеру
Анна
сообщение 14.03.2006 16:56
Сообщение #1


Бывалая
***

Группа: Пользователи
Сообщений: 290
Пол: Женский
Реальное имя: Анютка

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


Собственно задание в теме smile.gif

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 MainMenu;
begin
clrscr;
GotoXY(20,2);
TextBackground(White);
TextColor(Black);
Writeln('Prog-a dlya raboty s dinam. spiskom');
TextBackground(Black);
TextColor(White);
GotoXY(10,10);
Writeln('0. Konec');
GotoXY(10,11);
Writeln('1. Sozdat spisok');
GotoXY(10,12);
Writeln('2. Ochistit spisok');
GotoXY(10,13);
Writeln('3. Dobavit element');
GotoXY(10,14);
Writeln('4. Prosmotret spisok');
GotoXY(10,15);
Writeln('5. Sortirovka');
GotoXY(20,20);
Write('Vvedite nomer punkta menu (0-5):');
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
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 



- Текстовая версия 20.07.2025 10:57
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"