Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
21
Добавлен:
28.06.2014
Размер:
4.7 Кб
Скачать
unit UType;

interface

uses Graphics, SkinCtrls, controls, CommCtrl;
function booltoint(bool: boolean): integer;


type
TMatrixC = class
public
Matrix: array of array of integer;
col: integer;
row: integer;
constructor create(m: integer = 1; n: integer = 1);
constructor assign(mx: TMatrixC);
//destructor destroy;
function Det: integer;
function Per: integer;
function Alg(i: integer = 1; j: integer = 1): TMatrixC;
// class operator Multiply(k: integer; b: TMatrixC): TMatrixC;
// class operator Negative(mx: TMatrixC): TMatrixC;
end;

Type Tmatrix = ^TmatrixC;


type
Colorarray = record // Тип для переменной, в которой будут храниться цвета для отрисовки
colorV: Tcolor;
movev: Tcolor;
dragv: Tcolor;
delv: Tcolor;
colore: Tcolor;
mevee: Tcolor;
dele: Tcolor;
Rect: Tcolor;
NA: Tcolor;
selV: Tcolor;
sele: Tcolor;
delta: integer;
rad: integer;
ShowNameV: boolean; // Выводить ли вершины, ребра, веса
ShownameE: boolean;
ShowVes: boolean;
sizefont: integer; // Размер шрифта

move: boolean; // Блок нужен для изменения масштаба
scale: integer;
x0: integer;
y0: integer;
dx, dy: integer;
xm, ym: integer;

he, wi: integer; // Размеры канвы

filesave: string; // Файл с натройками
end;

type
Tarrcol = ^Colorarray;

type TVC = class // Тип для вершины
x: integer; // Координаты для отриовки
y: integer;
color: Tcolor; // Цвет при раскраске
status: Tcolor; // Цвет при наведении\удалении (Для отрисовки)
comment: string; // Коммент к вершине()
move: boolean; // флаг - тру при перемещении.
end;
type TV = ^TVC;
type TRC = class // Тип для ребра
p1: TV; // 2 вершины, которые он соедияет
p2: TV;
ves: integer; // Вес ребра
potok: integer;
status: Tcolor; // Для отрисовки
function nasi6: boolean;
end;
type TR = ^TRC;
var
G_SaveAllRoute: boolean = false;
G_SaveAllIMGRoute: boolean = false;
G_DrawRoute: boolean = false;
G_searchRoute: boolean = false;

G_SaveAllOstov: boolean = false;
G_SaveAllIMGOstov: boolean = false;
G_DrawOSTOV: boolean = false;
G_searchOstov: boolean = false;

G_Arrcol: Tarrcol;
G_Process: boolean = false;
implementation

uses math;

constructor TMatrixC.create(m: integer = 1; n: integer = 1);
begin
setlength(Matrix, m + 1, n + 1);
col := m;
row := n;
end;

function TMatrixC.Alg(i: integer = 1; j: integer = 1): TMatrixC;
var
ic, jc: integer;
tmp: TMatrixC;
begin
result := nil;
if (self <> nil) and(i < col) and (j < row) and (i >= 1) and (j >= 1) then
begin
result := TMatrixC.create(col - 1, row - 1);
for ic := 1 to min(i - 1, col) do
begin
for jc := 1 to min(j - 1, row) do
result.Matrix[ic][jc] := Matrix[ic][jc];
for jc := j + 1 to row do
result.Matrix[ic][jc - 1] := Matrix[ic][jc];
end;
for ic := i + 1 to col do
begin
for jc := 1 to min(j - 1, row) do
result.Matrix[ic - 1][jc] := Matrix[ic][jc];
for jc := j + 1 to row do
result.Matrix[ic - 1][jc - 1] := Matrix[ic][jc];
end;
end;
end;

function TMatrixC.Det: integer;
var
i, k, p: integer;
begin
//result:=0;
if (Self <> nil) and (row = col) then
if row = 1 then
result := Matrix[1, 1]
else if row = 2 then
result:=matrix[1,1]*matrix[2,2]-matrix[1,2]*matrix[2,1]
else if row > 2 then begin
k := 1;
p := 0;
for i := 1 to row do
begin
p := p + k * matrix[1, i]* Alg(1, i).Det;
k := -k;
end;
result:=p;
end;
end;

function TMatrixC.Per: integer;
var
i, p: integer;
begin
if row = col then
begin
p := 0;
result := 0;
for i := 1 to col do
result := result + Alg(1, i).Per;
end;

end;

constructor TMatrixC.assign(mx: TMatrixC);
var
i, j: integer;
begin
create(mx.col, mx.row);
for i := 1 to col do
for j := 1 to row do
Matrix[i, j] := mx.Matrix[i, j];
end;

function TRC.nasi6: boolean;
begin
result:=(ves=potok);
end;

{destructor TMatrixC.destroy;
begin
setlength(Matrix,0,0);
matrix:=nil;
Free;
end; }
{
class operator TMatrixC.Multiply(k: integer; b: TMatrixC): TMatrixC;
var i, j: integer;
begin
for i := 1 to col do
for j := 1 to row do
matrix[i, j]:=k*matrix[i, j];
end;
}

function booltoint(bool: boolean): integer;
begin
if bool then result := 1
else result := 0;
end;
end.
Соседние файлы в папке Программа для построения и анализа графов