FXPELIVE
Member | Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Z2_A.PAS
Код: {однонаправленные списки}
program Z2;
Uses
Crt;
Const
FileName='DiscsIn.txt';
l=50;
Type
PtrRec=^Rec;
Rec=Record
Name:String[40];
Box:Byte;
pNext:PtrRec;
pPrev:PtrRec;
End;
Var
f:Text; n:Word; err:Integer;
pBegin,pAux,pCKey:PtrRec;
procedure ReadFromFile;
Var i:Byte;
Begin
pAux:=Nil; PCKey:=Nil;
Assign(f,FileName);
{$I-} Reset(f); {$I+}
if (IOResult=0) then begin
New(pBegin);
pBegin^.pNext:=Nil; pBegin^.pPrev:=Nil;
Readln(f,pBegin^.Name); {в поле Name заглавного звена будем хранить число N}
pAux:=pBegin;
i:=0;
while not(eof(f)) Do
begin
inc(i);
New(pAux^.pNext);
pAux^.pNext^.pPrev:=pAux;
pAux:=pAux^.pNext;
pAux^.pNext:=Nil; pAux^.pPrev:=Nil;
pAux^.Box:=0; pAux^.Name:='';
Readln(f,pAux^.Name);
pAux^.Box:=i;
end; pBegin^.Box:=i;
Close(f);
end else Writeln('ошибка при открытии файла');
End;
procedure Print;
var i:Byte;
Begin
pAux:=Nil; PCKey:=Nil;
if pBegin<>Nil then begin
pAux:=pBegin^.pNext;
while pAux<>Nil do
begin
WriteLn(pAux^.Name,'-',pAux^.Box);
pAux:=pAux^.pNext;
end;
end else Writeln('Список пуст');
End;
procedure Clean;
Begin
pAux:=Nil; PCKey:=Nil;
pCKey:=pBegin;
while pCKey<>Nil do
begin
pAux:=pCKey;
pCKey:=pCKey^.pNext;
Dispose(pAux);
end;
End;
procedure Act;
var i:Byte;
Begin
pAux:=Nil; PCKey:=Nil;
if pBegin<>Nil then begin
{Если мы в конце списка то пробежимся с конца иначе пойдем вперед
pAux.^pPrev=pBegin pAux^.pNext=Nil;
}
clrscr;
pAux:=pBegin;
while pAux^.pNext<>Nil do
begin
pAux:=pAux^.pNext;
pAux^.Box:=pAux^.pNext^.Box;
pAux^.pNext^.Box:=0;
if(pAux^.Box=0) then Writeln(pAux^.Name, ' - * ') else
Writeln(pAux^.Name,' - ',pAux^.pNext^.Name);
end;
end else writeln('ошибка: возможно вы работаете с несуществующим списком');
End;
BEGIN
ClrScr;
ReadFromFile;
Print;
Writeln('--------------');
Act;
Clean;
write('...'); ReadKey;
END. |
Z2_B.PAS
Код: { В-14 Задача 2 (с исп/ двунаправленных списков) }
program Z2;
Uses
Crt;
Const
FileName='DiscsIn.txt'; {будем считыват из файла }
l=50; {по 50 символов со строки}
Type
PtrRec=^Rec;
Rec=Record
Name:String[40]; {сюда будем помещать название игры}
Box:Byte; {а сюда номер коробки с этой игрой}
pNext:PtrRec;
pPrev:PtrRec;
End;
Var
f:Text; n:Word; err:Integer;
pBegin,pAux,pCKey:PtrRec;
procedure ReadFromFile; {процедурка чтения из файла}
Var i:Byte;
Begin
pAux:=Nil; PCKey:=Nil;
Assign(f,FileName);
{$I-} Reset(f); {$I+}
if (IOResult=0) then begin
New(pBegin); {выделяем место для заглавного звена}
pBegin^.pNext:=Nil; pBegin^.pPrev:=Nil;
Readln(f,pBegin^.Name); {в поле Name заглавного звена будем хранить число N}
pAux:=pBegin;
i:=0;
while not(eof(f)) Do {пока не закончится файл}
begin
inc(i);
New(pAux^.pNext); {выделяем место очередному звену }
pAux^.pNext^.pPrev:=pAux; {связываем его с предыдущем элементом}
pAux:=pAux^.pNext; {цепочки }
pAux^.pNext:=Nil; pAux^.pPrev:=Nil;
pAux^.Box:=0; pAux^.Name:='';
Readln(f,pAux^.Name);
pAux^.Box:=i;
end; pBegin^.Box:=i;
Close(f);
end else Writeln('ошибка при открытии файла');
End;
procedure Print; {процедура вывода содержимого списка}
var i:Byte;
Begin
pAux:=Nil; PCKey:=Nil;
if pBegin<>Nil then begin {если заглавное звено есть }
pAux:=pBegin^.pNext; {то начинаем... }
while pAux<>Nil do {пока текущий элемент имеет адрес отличный от нил}
begin
WriteLn(pAux^.Name,'-',pAux^.Box);
pAux:=pAux^.pNext;
end;
end else Writeln('Список пуст');
End;
procedure Clean; {процедура чистки памяти, занятой списком}
Begin
pAux:=Nil; PCKey:=Nil;
pCKey:=pBegin;
while pCKey<>Nil do {пока не дощли до конца}
begin
pAux:=pCKey;
pCKey:=pCKey^.pNext;
Dispose(pAux); {грохаем звенья}
end;
End;
procedure Replace(var FirstPtr,SecoundPtr: PtrRec);
var TempPtr:PtrRec;
Begin
TempPtr:=Nil;
TempPtr:=FirstPtr;
FirstPtr:=SecoundPtr;
SecoundPtr:=TempPtr;
End;
procedure Game;
Begin
pAux:=pBegin^.PNext;
Replace(pAux,pAux^.pNext);
End;
procedure Act;
var i:Byte;
Begin
pAux:=Nil; PCKey:=Nil;
if pBegin<>Nil then begin
{Если мы в конце списка то пробежимся с конца иначе пойдем вперед
pAux.^pPrev=pBegin pAux^.pNext=Nil;
}
clrscr;
pAux:=pBegin;
while pAux^.pNext<>Nil do
begin
pAux:=pAux^.pNext;
pAux^.Box:=pAux^.pNext^.Box;
pAux^.pNext^.Box:=0;
if(pAux^.Box=0) then Writeln(pAux^.Name, ' - * ') else
Writeln(pAux^.Name,' - ',pAux^.pNext^.Name);
end;
end else writeln('ошибка: возможно вы работаете с несуществующим списком');
End;
BEGIN
ClrScr;
ReadFromFile;
Print;
Writeln('--------------');
{Act;} Game;
Clean;
write('...'); ReadKey;
END. |
|
Всего записей: 348 | Зарегистр. 27-04-2006 | Отправлено: 11:33 22-05-2011 | Исправлено: FXPELIVE, 13:12 22-05-2011 |
|
