Помощь - Поиск - Пользователи - Календарь
Полная версия: Работа с динамическим списком
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Анна
Собственно задание в теме 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
Цитата
Подумываю её упростить ... что можете сказать?
Ты хочешь упростить программу, но оставить ТУ ЖЕ функциональность? Так тут практически нечего упрощать... Разве что...

Меню... Пункты меню описываешь в массиве строк и выводишь в цикле, вместо того чтобы каждую строку выводить отдельно...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.