var
wrki: Double;
vx1,vy1,vz1,vx2,vy2,vz2: Double;
begin
vx1:=x1-x2;
vy1:=y1-y2;
vz1:=z1-z2;
vx2:=x2-x3;
vy2:=y2-y3;
vz2:=z2-z3;
wrki:=sqrt(sqr(vy1*vz2-vz1*vy2)+sqr(vz1*vx2-vx1*vz2)+sqr(vx1*vy2-vy1*vx2));
nx:=-(vy1 * vz2 - vz1 * vy2)/wrki;
ny:=-(vz1 * vx2 - vx1 * vz2)/wrki;
nz:=-(vx1 * vy2 - vy1 * vx2)/wrki;
end;
procedure TMat.Button1Click(Sender: TObject);
begin
ListBox1.Items.SaveToFile(ChangeFileExt(Application.ExeName,'.txt'));
end;
procedure TMat.Init();
begin
Edit1.OnChange :=Edit1Change;
Edit1.OnKeyPress :=Edit1KeyPress;
Edit2.OnChange :=Edit2Change;
Edit2.OnKeyPress :=Edit2KeyPress;
Panel4.OnMouseDown :=Panel4MouseDown;
Panel4.OnMouseMove :=Panel4MouseMove;
Panel4.OnMouseUp :=Panel4MouseUp;
end;
procedure TMat.Button3Click(Sender: TObject);
begin
About.ShowModal;
end;
procedure TMat.Button4Click(Sender: TObject);
begin
Edit1.OnChange :=nil;
Edit1.OnKeyPress :=nil;
Edit2.OnChange :=nil;
Edit2.OnKeyPress :=nil;
Panel4.OnMouseDown :=nil;
Panel4.OnMouseMove :=nil;
Panel4.OnMouseUp :=nil;
Close;
end;
//проводим анализ данных, точки совпадения красным, ниже синим, выше зеленым
function TMat.MakeAnalysMatrixData(Matrix01,Matrix02:TMatrix; var Matrix03:TMatrix):boolean;
var
i,j,k,y:integer;
begin
Result := false;
//инициализация результ. матрицы
Matrix03.w := Matrix01.w;
with Matrix03 do
begin
SetLength(vx,w);
SetLength(nx,w);
SetLength(cx,w);
SetLength(cc,w);
for i:=0 to w-1 do
begin
SetLength(vx[i],w);
SetLength(nx[i],w);
SetLength(cx[i],w);
SetLength(cc[i],w);
for y :=0 to w-1 do
begin
vx[i,y]:=Matrix01.vx[i,y];
nx[i,y,1]:=Matrix01.nx[i,y,1];
nx[i,y,2]:=Matrix01.nx[i,y,2];
nx[i,y,3]:=Matrix01.nx[i,y,3];
cx[i,y,1]:=Matrix01.cx[i,y,1];
cx[i,y,2]:=Matrix01.cx[i,y,2];
cx[i,y,3]:=Matrix01.cx[i,y,3];
cc[i,y,1]:=Matrix01.cc[i,y,1];
cc[i,y,2]:=Matrix01.cc[i,y,2];
cc[i,y,3]:=Matrix01.cc[i,y,3];
cx[i,y,1]:=255;
cx[i,y,2]:=255;
cx[i,y,3]:=255;
//часть первого, которая не пересеклась со вторым
//окрашиваем в желтый цвет
ifMatrix02.vx[i,y] = 0 then
begin
cx[i,y,1]:=(vx[i,y]+1)/6;
cx[i,y,2]:=(vx[i,y]+1)/6;
cx[i,y,3]:=0;
end;
//часть второго, которая не пересеклась с первой
//окрашиваем в красный цвет
ifMatrix01.vx[i,y] = 0 then
begin
vx[i,y]:=Matrix02.vx[i,y];
cx[i,y,1]:=(vx[i,y]+1)/6;
cx[i,y,2]:=0;
cx[i,y,3]:=0;
end;
//если нет поверхностей => зеленый
if (Matrix01.vx[i,y] = 0)
and (Matrix02.vx[i,y] = 0)then
begin
cx[i,y,1]:=0;
cx[i,y,2]:=(vx[i,y]+1)/2;
cx[i,y,3]:=0;
end;
//совпадающие обозначае зеленым цветом
if (Matrix01.vx[i,y] = Matrix02.vx[i,y])
and (Matrix01.vx[i,y] <> 0)
and (Matrix02.vx[i,y] <> 0)then
begin
cx[i,y,1]:=0;
cx[i,y,2]:=(vx[i,y]+1)/2;
cx[i,y,3]:=0;
end;
//те, которые выше - делаем зеленым
if (Matrix01.vx[i,y] < Matrix02.vx[i,y])
and (Matrix01.vx[i,y] <> 0)
and (Matrix02.vx[i,y] <> 0)then
begin
vx[i,y]:=Matrix02.vx[i,y];
cx[i,y,1]:=0;
cx[i,y,2]:=(vx[i,y]+1)/2;;
cx[i,y,3]:=0;
end;
//те, которые ниже будут синим
if (Matrix01.vx[i,y] > Matrix02.vx[i,y])
and (Matrix01.vx[i,y] <> 0)
and (Matrix02.vx[i,y] <> 0)then
begin
cx[i,y,1]:=(vx[i,y]+1)/6;
cx[i,y,2]:=0;
cx[i,y,3]:=0;
end;
cc[i,y,1]:=cx[i,y,1];
cc[i,y,2]:=cx[i,y,2];
cc[i,y,3]:=cx[i,y,3];
end;
end;
end;
{
w:Integer; //размерность матрицы
vx:Array of Array of Extended;//массив вершин
nx:Array of Array of Array[1..3] of Extended;//массив нормалей
cx:Array of Array of Array[1..3] of GLfloat;//массив цветов
cc:Array of Array of Array[1..3] of GLfloat;//массив цветов
}
Result := true;
end;
procedure TMat.cb_SurfaceClick(Sender: TObject);
begin
GL(self.MCurrent^);
end;
procedure TMat.Button2Click(Sender: TObject);
begin
//возможно, режим анализа поверхностей
if self.ComboBoxMatrix.ItemIndex = 2 then
begin
if not self.MakeAnalysMatrixData(self.myMatrix01, self.myMatrix02, self.myMatrix03) then
begin
ShowMessage('Не удалось провести анализ поверхностей!');
end;
self.GL(self.MCurrent^);
exit;
end;
Panel4.Hide;
FoDialog.InitialDir:=ExtractFilePath(Application.ExeName);
If FoDialog.Execute then
begin
if self.LoadMatrixFromDtFile(FoDialog.FileName,self.MCurrent^) then
begin
self.GL(self.MCurrent^);
end else //Yess=false
begin
progress.Hide;
MessageBox(Handle,PAnsiChar('Ошибка в файле данных!'+#13#10+self.mess),PAnsiChar('Ошибка'),MB_OK or MB_ICONINFORMATION);
Panel4.Hide;
// w:=0;
end;
end;
end;
procedure TMat.ComboBoxMatrixChange(Sender: TObject);
begin
if self.ComboBoxMatrix.ItemIndex = 0 then self.MCurrent := @self.myMatrix01;
if self.ComboBoxMatrix.ItemIndex = 1 then self.MCurrent := @self.myMatrix02;
if self.ComboBoxMatrix.ItemIndex = 2 then self.MCurrent := @self.myMatrix03;
self.Button2.Caption := 'Загрузить';
if self.ComboBoxMatrix.ItemIndex = 2 then self.Button2.Caption := 'Провести анализ';
self.GL(self.MCurrent^);
exit;
end;
procedure TMat.Edit3Change(Sender: TObject);
var
pos_x:integer;
pos_y:integer;
value:real;
begin
//изменение значения вершины
pos_x := self.UpDown1.Position-1;
pos_y := self.UpDown2.Position-1;
value := StrToFloatDef(self.Edit3.Text,-1000);
if value > -1000 then
self.MCurrent^.vx[pos_x,pos_y] := value;
// else
// self.Edit3.Text := FloatToStr(self.MCurrent^.vx[pos_x,pos_y]);
//теперь просчитываем цвета
Withself.MCurrent^ do
begin
cx[pos_x,pos_y,1]:=(vx[pos_x,pos_y]+1)/9;
cx[pos_x,pos_y,2]:=1-vx[pos_x,pos_y+1]/9;
cx[pos_x,pos_y,3]:=0;
cc[pos_x,pos_y,1]:=(vx[pos_x,pos_y]+1)/9;
cc[pos_x,pos_y,2]:=1-vx[pos_x,pos_y+1]/9;
cc[pos_x,pos_y,3]:=0;
end;
//после изменений перерисовываем
self.GL(self.MCurrent^);
exit;
end;
procedure TMat.BitBtnSaveClick(Sender: TObject);
var
Spisok:TStringList;
stroka:string;
k,y:integer;
begin
//button "save" click
if self.MCurrent^.w = 0 then
begin
ShowMessage('Матрица не загружена!');
exit;
end;
if self.SaveDialogMain.FileName = '' then
self.SaveDialogMain.InitialDir := ExtractFileDir(ParamStr(0));
if not self.SaveDialogMain.Execute() then exit;
//---------------------------------------------
Spisok := TStringList.Create();
with self.MCurrent^ do
begin
for y:= 0 to w-1 do
begin
stroka := '';
for k:= 0 to w-1 do
begin
stroka := stroka + ' ' + FloatToStr(vx[k,y]);
continue;
end;
stroka := trim(stroka);
Spisok.Add(stroka);
end;
end;
Spisok.SaveToFile(self.SaveDialogMain.FileName);
Spisok.Free();
//---------------------------------------------
ShowMessage('Матрица была сохранена.');
exit;
end;
end.
);
var
Spisok:TStringList;
stroka:string;
k,y:integer;
begin
//button "save" click
if self.MCurrent^.w = 0 then
begin
ShowMessage('Матрица не загружена!');
exit;
end;
if self.SaveDialogMain.FileName = '' then
self.SaveDialogMain.InitialDir := ExtractFileDir(ParamStr(0));
if not self.SaveDialogMain.Execute() then exit;
//---------------------------------------------
Spisok := TStringList.Create();
with self.MCurrent^ do
begin
for y:= 0 to w-1 do
begin
stroka := '';
for k:= 0 to w-1 do
begin
stroka := stroka + ' ' + FloatToStr(vx[k,y]);
continue;
end;
stroka := trim(stroka);
Spisok.Add(stroka);
end;
end;
Spisok.SaveToFile(self.SaveDialogMain.FileName);
Spisok.Free();
//---------------------------------------------
ShowMessage('Матрицабыласохранена.');
exit;
end;
end.
[1]) Расчет обобщенного показателя производится в соответствии с методикой оценки качества программного обеспечения, разработанной на кафедре оценки эффективности Военной академии воздушно-космической обороны.
[2])в отдельных случаях эксплуатация программы допускается при превышении указанного значения