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)
сообщение
Сообщение #2


Гость






Цитата
Подумываю её упростить ... что можете сказать?
Ты хочешь упростить программу, но оставить ТУ ЖЕ функциональность? Так тут практически нечего упрощать... Разве что...

Меню... Пункты меню описываешь в массиве строк и выводишь в цикле, вместо того чтобы каждую строку выводить отдельно...
 К началу страницы 
+ Ответить 

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

 





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