Лабораторная работа №5
Связанный список
Второй семестр
Выполнил: Поповцев Сергей. Группа И-351
Задание
Написать программу выполняющую следующие операции:
1. добавление к связанному списку.
2. удаление из св. списка.
3. поиск
4. вывод связанного списка
5. выход.
Организовать это меню.
Формат записи: база данных для склада:
Наименование товара, номенклатурный номер, номер накладной, дата накладной, приход, расход.
Программа
program lab5;
uses crt;
const
nmin=2;
k=5;
a:array[1..k] of string=(
'output',
'add',
'search',
'delete',
'exit');
type
bazarec=record
naitov:string[20];
nomnom:integer;
nomnak:integer;
datnak:string[20];
prih:real;
rash:real;
end;
pitem=^item;
item=record
data:bazarec;
next:pitem;
pred:pitem;
end;
arr=array[1..nmin] of pitem; {„«п еа ҐЁп ®¬Ґа®ў ©¤Ґле}
ptrarr=^arr;
var
first,last:pitem;
fndrec:ptrarr;
choose:byte;
numfnd:word;
check:boolean;
procedure Menu(n,LeftX,LeftY,RightX,RightY:byte; a:array of string; var result:byte);
var
i,nowPoz:byte;
choose:boolean;
answer:char;
begin
nowPoz:=0;
choose:=false;
window(LeftX,LeftY,RightX,RightY);
Repeat
clrscr;
For i:=0 to n-1 do
if i=nowPoz then
begin
textattr:=$06;
WriteLn(chr(16),' ',a[i],' ':(14-length(a[i])),chr(17));
end
else
begin
textAttr:=$07;
WriteLn(' ',a[i]);
end;
answer:=readkey;
Case answer of
#80{Down} :If nowPoz<n-1 then
nowPoz:=nowPoz+1
Else
nowPoz:=0;
#72{Up} :If nowPoz>0 then
nowPoz:=nowPoz-1
Else
nowPoz:=n-1;
#13{Enter}:begin
result:=nowPoz+1;
choose:=true
end;
end;
Until choose;
textattr:=$07;
clrscr;
window(1,1,80,25);
end;
procedure Add(var first,last:pitem);
var
now:pitem;
i,j:integer;
c:char;
begin
Repeat
clrscr;
WriteLn('input record:');
new(now);
if now=nil then
begin
WriteLn('not enough memory!!!');
readkey;
exit
end;
With now^.data do
begin
Write(' input naimenovanie tovara: ');
Readln(naitov);
Write(' input nomenklaturiniy nomer: ');
Readln(nomnom);
Write(' input nomer nakladnoi: ');
Readln(nomnak);
Write(' input data nakladnoi: ');
Readln(datnak);
Write(' input prihod: ');
Readln(prih);
Write(' input rashod: ');
Readln(rash);
end;
if first=nil then
begin
first:=now;
now^.pred:=nil
end
else
begin
last^.next:=now;
now^.pred:=last;
end;
last:=now;
now^.next:=nil;
WriteLn;
Write('input more records? (y/n) ');
ReadLn(c);
Until upcase(c)='N';
end;
procedure outtab(first,last:pitem;f:boolean;k:word;mas:ptrarr);
var
i:word;
now:pitem;
begin
if first=nil then
begin
WriteLn('you must input record before out!');
readkey;
exit;
end;
now:=first;
i:=1;
clrscr;
WriteLn('ЙННННЛННННННННЛНННННННННННЛНННННННННННЛНННННННННННЛННННННННЛНННННННН»');
WriteLn('є є naim є nomenklat є nomer є data є prihod є rashod є');
WriteLn('є ь є tovara є number є nakladnoi є nakladnoi є є є');
WriteLn('МННННОННННННННОНННННННННННОНННННННННННОНННННННННННОННННННННОНННННННН№');
if not f then
while now<>nil do
begin
with now^.data do
WriteLn('є ',i:2,' є ',naitov:6,' є ',nomnom:9,' є ',nomnak:9,' є ',datnak:9,' є ',prih:6:2,' є',rash:7:2,' є');
now:=now^.next;
if now<>nil then
WriteLn('ЗДДДДЧДДДДДДДДЧДДДДДДДДДДДЧДДДДДДДДДДДЧДДДДДДДДДДДЧДДДДДДДДЧДДДДДДДД¶');
inc(i);
if i mod 10 = 0 then
begin
readkey;
clrscr;
writeln;
end;
end
else
For i:=1 to k do
begin
now:=mas^[i];
with now^.data do
WriteLn('є ',i:2,' є ',naitov:6,' є ',nomnom:9,' є ',nomnak:9,' є ',datnak:9,' є ',prih:6:2,' є',rash:7:2,' є');
if i<>k then
WriteLn('ЗДДДДЧДДДДДДДДЧДДДДДДДДДДДЧДДДДДДДДДДДЧДДДДДДДДДДДЧДДДДДДДДЧДДДДДДДД¶');
end;
if i mod 10 = 0 then
begin
readkey;
clrscr;
writeln;
end;
WriteLn('УДДДДРДДДДДДДДРДДДДДДДДДДДРДДДДДДДДДДДРДДДДДДДДДДДРДДДДДДДДРДДДДДДДДЅ');
end;
procedure search(first,last:pitem;var check:boolean;var k:word;var masf:ptrarr);
var
i:word;
now:pitem;
answ:string[15];
begin
clrscr;
if first=nil then
begin
WriteLn('you must input record before search!');
readkey;
exit;
end;
Write('input naimenovanie : ');
ReadLn(answ);
k:=0;
now:=first;
check:=false;
while now<>nil do
begin
if now^.data.naitov=answ then
begin
check:=true;
inc(k);
masf^[k]:=now
end;
now:=now^.next
end
end;
procedure Delete(var first,last:pitem);
var
now:pitem;
l:word;
f:char;
begin
clrscr;
if first=nil then
begin
WriteLn('you must input record before !');
readkey;
exit;
end;
search(first,last,check,numfnd,fndrec);
if numfnd=0 then
begin
WriteLn('record not found!');
readkey;
exit
end;
WriteLn('for delete');
outtab(first,last,true,numfnd,fndrec);
Write('what record you wanna delete? ');
ReadLn(l);
if (l>numfnd)or(l<1) then
begin
WriteLn('this record is not from list!');
readkey;
exit
end;
clrscr;
now:=fndrec^[l];
with now^.data do
begin
WriteLn('naimenovanie - ',naitov);
WriteLn('nomenkl number - ',nomnom);
WriteLn('nomer nakladnoi - ',nomnak);
WriteLn('data nakladnoi - ',datnak);
WriteLn('prihod - ',prih:0:2);
WriteLn('rashod - ',rash:0:2);
end;
Write('really delete? (y/n): ');
Readln(f);
if upcase(f)<>'Y' then
exit;
if (now=first) and (now=last) then
begin
first:=nil;
last:=nil;
end
else
if now=first then
begin
first:=now^.next;
first^.pred:= nil
end
else
if now=last then
begin
last:=now^.pred;
last^.next:=nil
end
else
begin
now^.pred^.next:=now^.next;
now^.next^.pred:=now^.pred
end;
dispose(now);
WriteLn('record deleted');
WriteLn('press any key');
end;
begin
new(fndrec);
if fndrec=nil then
begin
WriteLn('you have not enough memory!!!');
readkey;
exit
end;
first:=nil;
last:=nil;
repeat
clrscr;
Writeln('programm labN5: ');
Writeln('shooce the button: ');
Menu(k,1,WhereY+1,25,WhereY+1+k,a,choose);
case choose of
1:begin
clrscr;
outtab(first,last,false,numfnd,fndrec);
end;
2:Add(first,last);
3:begin
search(first,last,check,numfnd,fndrec);
if check=false then
begin
writeln('incorect naimenovanie');
readkey
end
else
begin
clrscr;
outtab(first,last,true,numfnd,fndrec)
end
end;
4:Delete(first,last);
5:begin
dispose(fndrec);
exit;
end;
end;
readkey;
Until false;
end.
Уважаемый посетитель!
Чтобы распечатать файл, скачайте его (в формате Word).
Ссылка на скачивание - внизу страницы.
