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

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

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

> Работа с динамическим списком, добавление/удаление по номеру
сообщение
Сообщение #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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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


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

 





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