Написание программы для работы с массивом и связанным списком

program cursovik;

Uses crt,menu,obj,grafika;

var

answer:char;

Base:PMyObj;

f:boolean;

begin

zastavka;

f:=false;

repeat

repeat

menuwrite;

answer:=readkey;

case answer of '1':Base:=new(PMass,Init); '2':Base:=new(PMatr,Init); '3':Base:=new(PSpisok,Init); '0':f:=true;

end;

until answer in ['0'..'3'];

if f=false then

begin

clrscr;

writeln('  Введённые данные: '); Base^.Out;

Base^.Sort;

clrscr;

writeln('  Обработанные данные: '); Base^.Out;

dispose(Base,Done);

end;

until f;

end.

unit grafika;

interface

uses crt,graph;

procedure zastavka;

implementation

procedure zastavka;

label ExitGraph;

const

s1='Курсовая работа по информатике';

s2='         ( I курс ).';

s3='   Студент – Калеев С.В.';

s4='         Группа А-121';

s5=' Преподователь – Григорьева Т.А.';

s6='Press any key ...';

var

DriverVar,ModeVar,x,x1,y,y2,h,l:integer;

p:pointer;

s:string;

Ro:real;

procedure Pik;

begin     Sound(70);Delay(1000);Nosound;Delay(27000);

end;

procedure FSpiral(var x,y:integer; var Ro:real); var

Fi:real;

begin

Fi:=Ro*3;

x:=x+Round(Ro*Cos(Fi)*7); y:=y+Round(Ro*Sin(Fi)*7);

Ro:=Ro+0.08;

end;

procedure kot(x,y:integer);

procedure WriteEye(x,y:integer);

begin

Ellipse(x,y,0,360,10,5);

Circle(x,y,5);

Circle(x,y,2);

end;

begin

Circle(x,y,50);

Line(x-22,y-46,x-49,y-81); Line(x-49,y-81,x-45,y-24); Line(x+22,y-46,x+49,y-81); Line(x+49,y-81,x+45,y-24); Line(x-29,y-40,x-39,y-51); Line(x-39,y-51,x-38,y-32); Line(x+29,y-40,x+39,y-51); Line(x+39,y-51,x+38,y-32); WriteEye(x+20,y-15);

WriteEye(x-20,y-15); Ellipse(x,y+5,0,180,12,5); Arc(x-12,y+17,0,90,12); Arc(x+12,y+17,90,180,12); Ellipse(x,y+25,180,360,12,5);

end;

procedure MoveText(var y2:integer; s:string); var

y1,lx,ly:integer;

begin

h:=TextHeight(s);l:=TextWidth(s); SetTextStyle(0,HorizDir,1); y1:=GetMaxY-h-2;y2:=y2+h+3; lx:=x1+l;ly:=y1+h;

OutTextXY(x1,y1,s); GetMem(p,ImageSize(x1,y1,lx,ly));

GetImage(x1,y1,lx,ly,p^); PutImage(x1,y1,p^,XorPut);

Repeat

if keypressed then Exit; PutImage(x1,y1,p^,XorPut); Delay(1000); PutImage(x1,y1,p^,XorPut);

y1:=y1-3;

Until (y1<=y2);

PutImage(x1,y1,p^,XorPut);

end;

procedure MoveTextEnd(s:string);

var

lx,ly,Xmax,dy:integer;

begin

SetTextStyle(4,HorizDir,3); h:=TextHeight(s)+10;l:=TextWidth(s); Xmax:=GetMaxX;x:=2;y:=GetMaxY-100; lx:=x+l;ly:=y+h;

OutTextXY(x,y,s); GetMem(p,ImageSize(x,y,lx,ly)); GetImage(x,y,lx,ly,p^); PutImage(x,y,p^,XorPut);

dy:=3;

Repeat

PutImage(x,y,p^,XorPut);

Delay(1500);

PutImage(x,y,p^,XorPut);

if (x<2) or (x>Xmax-l-2) then dy:=-dy; x:=x+dy;

Until Keypressed;

end;

begin

DriverVar:=detect; InitGraph(DriverVar,Modevar,''); x:=GetMaxX;y:=GetMaxY;

SetBkColor(1);

RecTangle(0,0,x,y);

x:=x div 2;y:=(y div 2)+60;

Ro:=1;

while (x<=GetMaxX-135) do

begin

if keypressed then goto ExitGraph; FSpiral(x,y,Ro);

Kot(x,y);

Delay(4500+Round(Ro)*50);

SetColor(black);

Kot(x,y);

SetColor(white);

end;

Kot(x,y);

Delay(5000); Ellipse(x-100,y-50,0,360,10,8);Pik; Ellipse(x-185,y-60,0,360,30,20);Pik; x:=x-380;y:=y-100; Ellipse(x,y,0,360,130,90);Pik; x1:=x-119;y2:=y-27;

MoveText(y2,s1);

MoveText(y2,s2);

MoveText(y2,s3);

MoveText(y2,s4);

MoveText(y2,s5);

if keypressed then goto ExitGraph;

Ellipse(x,y,0,360,127,88);Pik; MoveTextEnd(s6);

ExitGraph:

CloseGraph; end;

begin

end.

unit menu;

interface

uses crt;

procedure Menuwrite;

implementation

procedure MenuWrite;

begin

clrscr;

writeln;

writeln('                     Курсовая работа по информатике ( I курс ).'); GotoXY(1,7);

writeln('                                Главное меню.');

writeln;

GotoXY(1,10);

writeln('     -------------------------¬');

writeln('                         ¦ 1 - Работа с массивом  ¦');

writeln('     +------------------------+');

writeln('                         ¦ 2 - Работа с матрицей  ¦');

writeln('     +------------------------+');

writeln('                         ¦ 3 - Работа со связанным¦');

writeln('                         ¦                списком ¦');

writeln('     +------------------------+');

writeln('                         ¦ 0 - Выход              ¦');

writeln('     L-------------------------');

GotoXY(1,22);

writeln('                         Выберите нужный вариант.');

end;

begin

end.

unit obj;

interface

uses crt;

const

stmax=20;

comax=20;

type

Pmassiv=^massiv;

Pmatrix=^matrix;

massiv=Array [1..stmax] of real; matrix=Array [1..stmax,1..comax] of real; plist=^list;

list = record

data:real;

next:plist;

end;

PMyObj=^MyObject;

MyObject=Object

CONSTRUCTOR Init;

PROCEDURE Sort; virtual;

PROCEDURE Out; virtual; DESTRUCTOR Done; virtual;

End;

PMass=^Mass;

Mass=Object (MyObject)

a:Pmassiv;

stmax:integer;

CONSTRUCTOR Init;

PROCEDURE Sort; virtual; PROCEDURE Out; virtual; DESTRUCTOR Done; virtual;

End;

PMatr=^Matr;

Matr=Object (MyObject)

b:Pmatrix; stmax,comax:integer; CONSTRUCTOR Init; PROCEDURE Sort; virtual; PROCEDURE Out; virtual; DESTRUCTOR Done; virtual;

End;

PSpisok=^Spisok; Spisok=Object (MyObject)

first:plist;

hp:pointer;

CONSTRUCTOR Init;

PROCEDURE Sort; virtual; PROCEDURE Out; virtual; DESTRUCTOR Done; virtual;

end;

var

st,co,m,n,i:integer;

hp:pointer; implementation

CONSTRUCTOR MyObject.Init; Begin

End;

PROCEDURE MyObject.Sort;

Begin

End;

PROCEDURE MyObject.Out;

Begin

End;

DESTRUCTOR MyObject.Done;

Begin

End;

CONSTRUCTOR Mass.Init;

Begin

clrscr;

new(a);

write ('  Введите кол-во элементов массива: ');

readln(Stmax);

writeln('  Введите массив: ');

for st:=1 to Stmax do

begin

write('a[',st,']= ');

readln(a^[st]);

end;

End;

PROCEDURE Mass.Sort;

Var

f:boolean;

c:real;

Begin

m:=Stmax;

repeat

m:=m-1;

f:=true;

for st:=1 to m do

if a^[st]<a^[st+1] then

begin

c:=a^[st];

a^[st]:=a^[st+1];

a^[st+1]:=c;

f:=false

end;

until f

End;

PROCEDURE Mass.Out;

Begin

for st:=1 to stmax do write('  ',a^[st]:6:4,'  '); readkey;

writeln;

End;

DESTRUCTOR Mass.Done;

Begin

dispose(a);

clrscr;

End;

CONSTRUCTOR Matr.Init;

Begin

clrscr;

new(b);

write('Введите кол-во строк матрицы: '); readln(stmax);

write('Введите кол-во столбцов матрицы: ');

readln(comax);

for st:=1 to stmax do

for co:=1 to comax do

begin

write('a[',st,',',co,']= '); readln(b^[st,co]);

end;

End;

PROCEDURE Matr.Sort;

Var

c:real;

f:boolean;

Begin

for co:=1 to comax do

begin

m:=stmax;

repeat

m:=m-1;

f:=true;

for st:=1 to stmax do

if b^[st,co]<b^[st+1,co] then

begin

c:=b^[st,co]; b^[st,co]:=b^[st+1,co]; b^[st+1,co]:=c;

f:=false

end

until f

end;

End;

PROCEDURE Matr.Out;

Begin

writeln;

for st:=1 to stmax do

begin

for co:=1 to comax do write(b^[st,co]:6:4,' '); writeln;

end;

readkey;

End;

DESTRUCTOR Matr.Done;

Begin

dispose(b);

clrscr;

End;

CONSTRUCTOR Spisok.Init;

var

buff,buff1,buff2:plist;

Begin

clrscr;

Mark(hp);

write('  Введите кол-во элементов списка: ');

readln(n);

first:=nil;

for i:=1 to n do

begin

new(buff);

write(i,'-й элемент: ');

read(buff^.data);

new(buff1);

buff1^.next:=nil;

buff1^.data:=buff^.data;

if first=nil then first:=buff1

else buff2^.next:=buff1;

buff2:=buff1;

end;

end;

PROCEDURE Spisok.Sort;

Var

f:boolean;

buff,buff2:plist;

c:real;

begin

m:=n;

repeat

m:=m-1;

f:=true;

buff2:=first;

for i:=1 to m do

while buff2<>nil do

begin buff:=buff2^.next;

if buff2^.data<buff^.data then

begin

c:=buff2^.data; buff2^.data:=buff^.data; buff^.data:=c;

f:=false;

end;

buff2:=buff2^.next;

end;

until f

end;

PROCEDURE Spisok.Out;

var

pos:plist;

begin

pos:=first;

for i:=1 to n do

begin

writeln (i,'-й элемент: ',pos^.data:6:4); pos:=pos^.next;

end;

readkey;

end;

DESTRUCTOR Spisok.Done;

begin

release(hp);

clrscr;

end;

begin

end.