Дипломная работа: Разработка программной системы, обеспечивающей отображение и сравнение в трехмерном пространстве исходных данных из двух матричных форм
end;
//-----------------------------------------------------------------------------
function TMat.LoadMatrixFromBitmap(filename:string; var Matrix:TMatrix):boolean;
var
i,j :Integer;
ss : string;
begin
Result := false;
if not FileExists(filename) then exit;
with Matrix do
begin
bmp.Width:=0;
bmp.Height:=0;
bmp.LoadFromFile(OpenPictureDialog1.FileName);
w:=bmp.Width;
UpDown1.Max:=w;
UpDown2.Max:=w;
LastCCX:=w div 2;
LastCCY:=w div 2;
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);
end;
ss:='';
ListBox1.Items.Clear;
for i:=0 to w-1 do
begin
for j:=0 to w-1 do
begin
vx[i,j]:=(GetRValue(bmp.Canvas.Pixels[i,j])+
GetGValue(bmp.Canvas.Pixels[i,j])+
GetBValue(bmp.Canvas.Pixels[i,j]))/50;
if vx[i,j]>10 then vx[i,j]:=9+(random(99)+1)/100;
ss:=ss+FormatFloat('0.00', vx[i,j])+' ';
cx[i,j,1]:=GetRValue(bmp.Canvas.Pixels[i,j])/255;
cx[i,j,2]:=GetGValue(bmp.Canvas.Pixels[i,j])/255;
cx[i,j,3]:=GetBValue(bmp.Canvas.Pixels[i,j])/255;
cc[i,j,1]:=GetRValue(bmp.Canvas.Pixels[i,j])/255;
cc[i,j,2]:=GetGValue(bmp.Canvas.Pixels[i,j])/255;
cc[i,j,3]:=GetBValue(bmp.Canvas.Pixels[i,j])/255;
end;
ListBox1.Items.Add(ss);
ss:='';
end;
Zcoord :=w*2;
SelPos(Matrix, LastCCX, LastCCY);
UpDown1.Position:=LastCCX;
UpDown2.Position:=LastCCY;
end;
Result := true;
end;
function TMat.LoadMatrixFromDtFile(filename:string; var Matrix:TMatrix):boolean;
var
i,x,y,j,k,posp,posbar:Integer;
spr,sfl,ss,formfl:String;
Fres : TFloatRec;
Conv : Extended ;
coint :integer;
ValStr :Extended;
begin
Result := false;
if not FileExists(filename) then exit;
with Matrix do
begin
LBData.Items.Clear;
bar.Position:=0;
progress.Visible:=True;
progress.Update;
LBData.Items.LoadFromFile(FileName);
if LBData.Items.Count>5 then
begin
bar.Position:=5;
bar.Update;
w:=LBData.Items.Count;
UpDown1.Max:=w;
UpDown2.Max:=w;
LastCCX:=w div 2;
LastCCY:=w div 2;
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]:=0;
nx[i,y,1]:=0;
nx[i,y,2]:=0;
nx[i,y,3]:=0;
cx[i,y,1]:=0;
cx[i,y,2]:=0;
cx[i,y,3]:=0;
cc[i,y,1]:=0;
cc[i,y,2]:=0;
cc[i,y,3]:=0;
end;
end;
yess:=True;
mess:='';
for y :=0 to w-1 do
begin
spr:=LBData.Items[y];
x:=0;
while (((pos(' ',spr)>0) or (Length(spr)>0)) and (Yess=True) and (x<w)) do
begin
posp:=pos(' ',spr);
If (posp>0) then
begin
sfl:=trim (copy(spr,0,posp));
delete(spr,1,posp);
ValStr:=strtofloatdef(sfl,-100);
If (ValStr=-100) then
begin
yess:=False;
if (Length(mess)=0) then mess:='Неверное значение'+#13#10+'строка '+ IntToStr(y+1)+#13#10+'позиция '+IntToStr(x+1)+#13#10+'['+sfl+']';
break;
end;
If ((ValStr<-10) or (ValStr>10)) then
begin
yess:=False;
if (Length(mess)=0) then mess:='Значение >10, либо <-10'+#13#10+'строка '+ IntToStr(y+1)+#13#10+'позиция '+IntToStr(x+1)+#13#10+'['+sfl+']';
break;
end else vx[x,y]:=ValStr;
end else
begin
spr:=Trim(spr);
ValStr:=strtofloatdef(spr,-100);
If (ValStr=-100) then
begin
yess:=False;
if (Length(mess)=0) then mess:='Неверное значение'+#13#10+'строка '+ IntToStr(y+1)+#13#10+'позиция '+IntToStr(x+1)+#13#10+'['+spr+']';
break;
end;
If ((ValStr<-10) or (ValStr>10)) then
begin
yess:=False;
if (Length(mess)=0) then mess:='Значение >10, либо <-10'+#13#10+'строка '+ IntToStr(y+1)+#13#10+'позиция '+IntToStr(x+1)+#13#10+'['+spr+']';
break;
end else vx[x,y]:=ValStr;
spr:='';
end;
inc(x);
end;
formfl := FormatFloat('0',70*(((y+1)*(x))/(w*w)));
coint:=StrToInt(formfl);
bar.Position:=5+coint;
bar.Update;
// mat.Caption :=mat.Caption+inttostr(x)+' ';
if (x<w) then
begin
Yess:=false;
if (Length(mess)=0) then mess:='строка '+ IntToStr(y+1)+#13#10+'короткая, либо излишек строк в файле';
break;
end;
if (spr<>'') then
begin
Yess:=false;
if (Length(mess)=0) then mess:='строка '+ IntToStr(y+1)+#13#10+'длинная, либо недостаточно строк в файле';
break;
end;
end;
end else
begin
Yess:=false;
mess:='Форма должна иметь'+#13#10+'размер более чем 5х5';
end;
if Yess=true then
begin
bar.Position:=90;
bar.Update;
for i:=0 to w-1 do
begin
for j:=0 to w-1 do
begin
cx[i,j,1]:=(vx[i,j]+1)/9;
cx[i,j,2]:=1-vx[i,j+1]/9;
cx[i,j,3]:=0;
cc[i,j,1]:=(vx[i,j]+1)/9;
cc[i,j,2]:=1-vx[i,j+1]/9;
cc[i,j,3]:=0;
end;
end;
for i:=0 to w-1 do
for j:=0 to w-1 do
for k:=1 to 3 do
nx[i,j,k]:=1;
for i:=0 to w-2 do
for j:=0 to w-2 do
begin
CalcNormals(i,vx[i,j],j,
i+1,vx[i+1,j],j,
i+1,vx[i+1,j+1],j+1,
nx[i,j,1],nx[i,j,2],nx[i,j,3]);
end;
bar.Position:=100;
bar.Update;
Zcoord :=w*2;
XRot:=90;
YRot:=0;
UpDown1.Position:=LastCCX;
UpDown2.Position:=LastCCY;
SelPos(Matrix,LastCCX, LastCCY);
progress.Hide;
Panel4.Show;
end;
end;
Result := Yess;
end;
//-----------------------------------------------------------------------------
procedure TMat.bmp1Click(Sender: TObject);
begin
try
if OpenPictureDialog1.Execute then
if FileExists(OpenPictureDialog1.FileName) then
begin
self.LoadMatrixFromBitmap(OpenPictureDialog1.FileName,self.MCurrent^);
self.GL(self.MCurrent^);
end else
MessageBox(Handle,
PAnsiChar('Файл '+OpenPictureDialog1.FileName+' не найден'),
'Ошибка',MB_OK or MB_ICONERROR);
except
MessageBox(Handle,
PAnsiChar('Ошибка во время загрузки файла '+
OpenPictureDialog1.FileName),
'Ошибка',MB_OK or MB_ICONERROR);
end;
end;
procedure TMat.Panel4MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
MouseButton :=1;
Xcoord := X;
Ycoord := Y;
end;
if Button = mbRight then
begin
MouseButton :=2;
Zcoord := Y;
end;
end;
procedure TMat.Panel4MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if MouseButton = 1 then
begin
xRot := xRot + (Y - Ycoord) div 2; // moving up and down = rot around X-axis
yRot := yRot + (X - Xcoord)div 2;
Xcoord := X;
Ycoord := Y;
GL(self.MCurrent^);
end;
if MouseButton = 2 then
begin
Depth :=Depth - (Y-ZCoord) div 3;
Zcoord := Y;
GL(self.MCurrent^);
end;
// caption:=inttostr(xRot)+':'+inttostr(yRot);
end;
procedure TMat.Panel4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
MouseButton :=0;
end;
procedure TMat.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if Ord(Key)<>8 then if ((key<'0') or (key>'9')) then Key:=#0;
end;
procedure TMat.Edit1Change(Sender: TObject);
var
x:Integer;
begin
If TryStrToInt(Edit1.Text,x)
then begin
if x>self.MCurrent^.w then Edit1.Text:=IntToStr(self.MCurrent^.w);
If x<2 then Edit1.Text:='1';
end
else begin
Edit1.Text:='1';
end;
SelPos(self.MCurrent^,UpDown1.Position-1,LastCCY);
GL(self.MCurrent^);
end;
procedure TMat.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
if Ord(Key)<>8 then if ((key<'0') or (key>'9')) then Key:=#0;
end;
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]) в отдельных случаях эксплуатация программы допускается при превышении указанного значения