скачать рефераты
  RSS    

Меню

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

скачать рефераты

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

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


Страницы: 1, 2, 3, 4, 5


Новости

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

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

Пока нет

Новости в Twitter и Facebook

  скачать рефераты              скачать рефераты

Новости

скачать рефераты

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

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