Написание программы, выполняющей операции со связным списком

Страницы работы

8 страниц (Word-файл)

Содержание работы

Лабораторная работа №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.

Похожие материалы

Информация о работе