Дипломная работа: Разработка программной системы, обеспечивающей отображение и сравнение в трехмерном пространстве исходных данных из двух матричных форм
s:string;
begin
if (Matrix.w>0) then
begin
for fx := 0 to Matrix.w-1 do
begin
Matrix.cx[LastCCx,fx,1]:=Matrix.cc[LastCCx,fx,1];
Matrix.cx[LastCCx,fx,2]:=Matrix.cc[LastCCx,fx,2];
Matrix.cx[LastCCx,fx,3]:=Matrix.cc[LastCCx,fx,3];
Matrix.cx[fx,LastCCy,1]:=Matrix.cc[fx,LastCCy,1];
Matrix.cx[fx,LastCCy,2]:=Matrix.cc[fx,LastCCy,2];
Matrix.cx[fx,LastCCy,3]:=Matrix.cc[fx,LastCCy,3];
Matrix.cx[xx,fx,1]:=1;
Matrix.cx[xx,fx,2]:=1;
Matrix.cx[xx,fx,3]:=1;
Matrix.cx[fx,yy,1]:=1;
Matrix.cx[fx,yy,2]:=1;
Matrix.cx[fx,yy,3]:=1;
end;
LastCCx:=xx;
LastCCy:=yy;
s:=FormatFloat('0.00', Matrix.vx[LastCCx,LastCCy]);
// if Matrix.vx[LastCCx,LastCCy] < 0 then s:= '-'+s;
// Edit3.Text:=FloatToStr(Round(Matrix.vx[LastCCx,LastCCy]*100)/100);
Edit3.Text := s;
end; трехмерный изображение матричный графический
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;
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9
