Используемые модули в программе

Модуль crt, является стандартным модулем и в описании не нуждается.

Модуль vector был подключен в основную программу, составлялся мною непосредственно для выполнения курсовых работ.

unit vector;

interface

const vec=10;

num:array[1..4] of string[25]=('Задание 1 ',

'Задание 2 ','Задание 3 ','Выход из программы...');

pun:array[1..3] of string[7]=('Пункт 1','Пункт 2','Пункт 3');

type matrix=array[1..vec,1..vec] of real;

sim=set of char;

procedure vvod(name:string; k:integer; i,j:byte; var Q:matrix);

procedure mulion(name:string; m,k,n:byte; var p,o:matrix);

{Процедура wind зарисовывает окошко с заданными размерами и цветом фона

и букв которые будут находиться в нем}

{a,b,c,d,e,f-целого типа, где a,b-определяют левый верхний угол, c,d-

определяют правый нижний угол, е - задает цвет фона, f-цвет текста}

procedure wind(a,b,c,d,e,f:byte);

procedure kursmenu(k:byte);

{Функция sum возвращает сумму элементов матрицы}

{n,m-целого типа определят размер матрицы}

{d-массив из вещественных чисел}

function sum(n,m:byte; var d:matrix):real;

{Функция Pmax возвращает максимальное значение из трех данных}

{x,y,z-значения вещественного типа из которых производится отбор}

function Pmax(x,y,z:real):real;

{Процудура UMN умножает элементы, указанного столбца на заданное число

и преобразованную матрицу записывает в конец указанного файла}

{P-переменная вещественного типа на которую умножатся элементы столбца

матрицы}

{n,m,h-переменные целого типа, где n,h размеры матрицы, m определяет

столбец над которым выполняется действие умножение}

{x-массив вещественных чисел}

procedure UMN(name:string; p:real; n,m,h:byte; var x:matrix);

function menus:byte;

procedure punkt(k,j:byte);

procedure music(i:integer);

{Процедура signal воспроизводит сигнал с определенной частотой и задержкой}

procedure signal;

{Процедура prnot0 производит умножение всех ненулевых элементов матрицы

и записывает в указанный файл}

{name-является переменной строкового типа используется

для указания пути размещения файла}

{n,m-целого типа определят размер матрицы}

procedure prnot0(name,name1:string; k,n,m,logik:byte);

implementation

uses crt;

procedure vvod;

var fa:text; t,h:byte; x:real;

begin

assign(fa,name);

reset(fa);

if k>0 then for t:=1 to k do read(fa,x);

for t:=1 to i do

for h:=1 to j do read(fa, q[t,h]);

close(fa);

end;

procedure mulion;

var i,t,h:byte; x,s:real; f:text;

begin

assign(f,name);

append(f);

for i:=1 to m do begin writeln(f);

for t:=1 to n do begin

s:=0;

for h:=1 to k do

s:=s+p[i,h]*o[h,t];

write(f,s:8:2);

end;

end;

writeln(f);

close(f);

end;

function sum;

var i,j:byte; s:real;

begin

{Считаем сумму из элементов матрицы}

s:=0;

for i:=1 to n do

for j:=1 to m do s:=s+d[i,j];

sum:=s;

end;

function Pmax;

begin

Pmax:=x;

if (x<y)and(z<y) then Pmax:=y;

if (z>x)and(z>y) then Pmax:=z;

end;

procedure UMN;

var i,j:byte; f:text; y:real;

begin

{Присваиваем файловой переменной конкретный файл на диске}

assign(f,name);

{Открываем файл для записи}

append(f);

{Невидимый указатель перемещаем в конец файла}

for i:=1 to n do x[i,m]:=x[i,m]*p;

writeln(f);

{Выводим в файл преобразованный массив}

for i:=1 to n do begin writeln(f);

for j:=1 to h do write(f,x[i,j]:8:2);

end;

{Закрываем файл}

close(f);

end;

procedure wind;

begin

window(a,b,c,d);

textbackground(e);

clrscr; textcolor(f);

end;

procedure music;

var j:byte;

begin

j:=1;

repeat

j:=j+1;

sound(100*j); delay(i);

nosound;

if j=20 then j:=1;

until keypressed;

end;

procedure signal;

begin

sound(2000);

delay(10000); nosound;

delay(2000);

end;

procedure kursmenu;

var i:byte;

begin

for i:=1 to 4 do begin

gotoxy(2,0+i*2);

textbackground(3);

if i=k then begin

textattr:=10;

highvideo;

write(num[i]);

normvideo; textcolor(1);

end

else write(num[i]);

end;

end;

procedure punkt;

var i:byte;

begin

for i:=1 to 4 do begin

gotoxy(25,0+i*2+j);

if i=k then begin

textbackground(3);

textattr:=12;

highvideo;

write(pun[i]);

normvideo; textcolor(10);

end

else write(pun[i]);

end;

end;

function menus;

var k,m:byte; ch,cm:char;

Begin

wind(1,1,80,25,3,9);

k:=1; kursmenu(k);

repeat

ch:=readkey;

if ch=#72 then k:=k-1;

if ch=#80 then k:=k+1;

if k=0 then k:=4;

if k=5 then k:=1;

kursmenu(k);

if (ch=#77)and(k=1) then begin punkt(1,0); m:=1;

repeat

cm:=readkey;

if cm=#72 then m:=m-1;

if cm=#80 then m:=m+1;

if m=0 then m:=3;

if m=4 then m:=1;

if cm=#13 then menus:=m;

punkt(m,0);

if cm=#75 then begin m:=0; break; end;

until cm=#13;

wind(1,1,80,25,3,9);

end;

if (ch=#77)and(k=2) then begin punkt(1,2); m:=1;

repeat

cm:=readkey;

if cm=#72 then m:=m-1;

if cm=#80 then m:=m+1;

if m=0 then m:=3;

if m=4 then m:=1;

if cm=#13 then menus:=m+3;

punkt(m,2);

if cm=#75 then begin m:=0; break; end;

until cm=#13;

wind(1,1,80,25,3,9);

end;

if (ch=#77)and(k=3) then begin punkt(1,4); m:=1;

repeat

cm:=readkey;

if cm=#72 then m:=m-1;

if cm=#80 then m:=m+1;

if m=0 then m:=3;

if m=4 then m:=1;

if cm=#13 then menus:=m+6;

punkt(m,4);

if cm=#75 then begin m:=0; break; end;

until cm=#13;

wind(1,1,80,25,3,9);

end;

kursmenu(k);

if (ch=#13)and(k=4) then exit;

until cm=#13;

end;

procedure prnot0;

var i,j:byte; x,p:real; f,fa:text; q:matrix;

begin

{Присваеваем файловым переменным конкретные файлы на диске}

assign(f,name);

assign(fa,name1);

{Открываем файл для записи}

append(f);

{Открываем файл для чтения}

reset(fa);

if logik=1 then for i:=1 to k do read(fa,x);

for i:=1 to n do

for j:=1 to m do read(fa,q[i,j]);

{Находим произведение элементов удовлетворяющих условию}

close(fa);

p:=1;

for i:=1 to n do

for j:=1 to m do if q[i,j]<>0 then p:=p*q[i,j];

writeln(f,p:8:13);

{Закрываем файлы}

close(f);

end;

end.