RSS    

   Дипломная работа: Разработка программной системы, обеспечивающей отображение и сравнение в трехмерном пространстве исходных данных из двух матричных форм

procedure TMat.Edit2Change(Sender: TObject);

var

x:Integer;

begin

If TryStrToInt(Edit2.Text,x)

then begin

if x>self.MCurrent^.w then Edit2.Text:=IntToStr(self.MCurrent^.w);

If x<2 then Edit2.Text:='1';

end

else begin

Edit2.Text:='1';

end;

SelPos(self.MCurrent^,LastCCX,UpDown2.Position-1);

GL(self.MCurrent^);

end;

procedure TMat.CalcNormals(x1,y1,z1,x2,y2,z2,x3,y3,z3:Extended; var nx,ny,nz:Extended);

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;

//часть первого, которая не пересеклась со вторым

//окрашиваем в желтый цвет

if Matrix02.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;

//часть второго, которая не пересеклась с первой

//окрашиваем в красный цвет

if Matrix01.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]);

//теперь просчитываем цвета

With self.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]) в отдельных случаях эксплуатация программы допускается при превышении            указанного значения


Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9


Новости


Быстрый поиск

Группа вКонтакте: новости

Пока нет

Новости в Twitter и Facebook

                   

Новости

Обратная связь

Поиск
Обратная связь
Реклама и размещение статей на сайте
© 2010.