www.pudn.com > 172020781.rar > Mesh.pas
unit Mesh;
interface
uses
Windows, Messages, Classes, Graphics, Forms, ExtCtrls, Menus,
Controls, Dialogs, SysUtils, OpenGL;
Type
TGLNrm=array[0..2] of glfloat;
TGLvrt=record
crd:TGLNrm;
nrm:TGLNrm;
end;
TGLfcs=record
vrt:array[0..2]of word;
nrm:TGLNrm;
end;
TGLMesh1 = class
mCfg:record
smt:boolean;
mde:glenum;
end;
cVrt:longint; //Кол. вр.
cFcs:longint; //Кол. гр.
Vrts:array of TGLVrt; //Массив вершин
Fcss:array of TGLFcs; //Массив граней
n:array of byte;
public
procedure calc_normals_fr;
procedure calc_normals_sm;
procedure load_lst_obj(var f:textfile);
procedure load_gms_obj(var f:textfile);
procedure Save_Lst_obj(var f:textfile);
procedure loadfromfile_lst(filename:string);
procedure loadfromfile_gms(filename:string);
procedure Save_To_file_lst(filename:string);
procedure clear;
procedure draw;
end;
function get_Normal_fl(var p1,p2,p3:TGLNrm):TGLNrm;
implementation
procedure TGLMesh1.clear;
begin
cvrt:=0; cFcs:=0;
freeMem(Vrts);
freeMem(Fcss);
end;
procedure TGLMesh1.Save_To_file_lst(filename:string);
var f:textfile;
begin
assignfile(f,filename);
rewrite(f);
Save_Lst_obj(f);
closefile(f);
end;
procedure TGLMesh1.load_lst_obj(var f:textfile);
var i:integer;
begin
readln(f,cVrt);
getmem(n,sizeof(integer)*cVrt);
GetMem(Vrts,cVrt*SizeOf(TGLVrt));
for i:=0 to cVrt-1 do
readln(f,Vrts[i].crd[0],Vrts[i].crd[1],Vrts[i].crd[2]);
readln(f,cFcs);
GetMem(Fcss,cFcs*SizeOf(TGLFcs));
for i:=0 to cFcs-1 do
readln(f,Fcss[i].vrt[0],Fcss[i].vrt[1],Fcss[i].vrt[2]);
calc_normals_fr;
calc_normals_sm;
end;
procedure TGLMesh1.Save_Lst_obj(var f:textfile);
var i:integer;
j:byte;
begin
writeln(f,cVrt:10);
for i:=0 to cVrt-1 do
writeln(f,Vrts[i].crd[0]:9:4,Vrts[i].crd[1]:9:4,Vrts[i].crd[2]:9:4);
writeln(f,cFcs:10);
for i:=0 to cFcs-1 do
writeln(f,Fcss[i].vrt[0]:6,Fcss[i].vrt[1]:6,Fcss[i].vrt[2]:6);
end;
procedure TGLMesh1.load_gms_obj(var f:textfile);
var s:string;
i,j:integer;
c:glfloat;
begin
readln(f,s);
if s='TriMesh()' then
begin
readln(f,s);
readln(f,i,j); cVrt:=i; cFcs:=j;
GetMem(Vrts,cVrt*SizeOf(TGLVrt));
GetMem(Fcss,cFcs*SizeOf(TGLFcs));
readln(f,s); //вершины
for i:=0 to cVrt-1 do
begin
read(f,c); vrts[i].crd[0]:=c/20;
read(f,c); vrts[i].crd[1]:=c/20;
readln(f,c); vrts[i].crd[2]:=c/20;
end;
readln(f,s);
readln(f,s); //грани
for i:=0 to cFcs-1 do
begin
read(f,j); fcss[i].vrt[0]:=j-1;
read(f,j); fcss[i].vrt[1]:=j-1;
readln(f,j); fcss[i].vrt[2]:=j-1;
end;
readln(f,s);
readln(f,s); //гр. нрм.
for i:=0 to cFcs-1 do
begin
read(f,c); //fcss[i].nrm[0]:=c;
read(f,c); //fcss[i].nrm[1]:=c;
readln(f,c); //fcss[i].nrm[2]:=c;
end;
readln(f,s);
readln(f,s); //сгл. нрм.
for i:=0 to cVrt-1 do
begin
read(f,c); //vrts[i].nrm[0]:=c;
read(f,c); //vrts[i].nrm[1]:=c;
readln(f,c); //vrts[i].nrm[2]:=c;
end;
readln(f,s);
readln(f,s);
calc_normals_fr;
calc_normals_sm;
end;
end;
procedure TGLMesh1.loadfromfile_gms(filename:string);
var f:textfile;
s:string;
label m1;
begin
assignfile(f,filename);
reset(f);
repeat
ReadLn(f, S);
if s='New object' then
begin
load_gms_obj(f);
goto m1;
end;
until (eof(f));
m1:
closefile(f);
end;
procedure TGLMesh1.loadfromfile_lst(filename:string);
var f:textfile;
s:string;
label m1;
begin
assignfile(f,filename);
reset(f);
load_lst_obj(f);
closefile(f);
end;
procedure TGLMesh1.calc_normals_fr;
var i:integer;
begin
for i:=0 to cFcs-1 do
begin
fcss[i].nrm:=get_Normal_fl(vrts[fcss[i].vrt[0]].crd,
vrts[fcss[i].vrt[1]].crd,vrts[fcss[i].vrt[2]].crd);
end;
end;
procedure TGLMesh1.calc_normals_sm;
var i,j:integer;
begin
for i:=0 to cVrt-1 do
begin
Vrts[i].nrm[0]:=0;
Vrts[i].nrm[1]:=0;
Vrts[i].nrm[2]:=0;
n[i]:=0;
end;
for i:=0 to cFcs-1 do
begin
for j:=0 to 2 do
begin
Vrts[Fcss[i].vrt[j]].nrm[0]:=Vrts[Fcss[i].vrt[j]].nrm[0]+Fcss[i].nrm[0];
Vrts[Fcss[i].vrt[j]].nrm[1]:=Vrts[Fcss[i].vrt[j]].nrm[1]+Fcss[i].nrm[1];
Vrts[Fcss[i].vrt[j]].nrm[2]:=Vrts[Fcss[i].vrt[j]].nrm[2]+Fcss[i].nrm[2];
n[Fcss[i].vrt[j]]:=n[Fcss[i].vrt[j]]+1;
end;
end;
for i:=0 to cVrt-1 do
begin
Vrts[i].nrm[0]:=Vrts[i].nrm[0]/n[i];
Vrts[i].nrm[1]:=Vrts[i].nrm[1]/n[i];
Vrts[i].nrm[2]:=Vrts[i].nrm[2]/n[i];
n[i]:=0;
end;
end;
procedure TGLMesh1.draw;
var i:integer;
begin
for i:=0 to cFcs-1 do
begin
glBegin(mcfg.mde);
if MCfg.smt=false then glNormal3fv(@fcss[i].nrm);
if MCfg.smt=true then glNormal3fv(@vrts[fcss[i].vrt[0]].nrm);
glVertex3fv(@vrts[fcss[i].vrt[0]].crd);
if MCfg.smt=true then glNormal3fv(@vrts[fcss[i].vrt[1]].nrm);
glVertex3fv(@vrts[fcss[i].vrt[1]].crd);
if MCfg.smt=true then glNormal3fv(@vrts[fcss[i].vrt[2]].nrm);
glVertex3fv(@vrts[fcss[i].vrt[2]].crd);
glend;
end;
end;
function get_Normal_fl(var p1,p2,p3:TGLNrm):TGLNrm;
var
wrki, vx1, vy1, vz1, vx2, vy2, vz2 : GLfloat;
nx, ny, nz : GLfloat;
wrkVector : tpoint;
f:textfile;
begin
vx1 := p1[0] - p2[0];
vy1 := p1[1] - p2[1];
vz1 := p1[2] - p2[2];
vx2 := p2[0] - p3[0];
vy2 := p2[1] - p3[1];
vz2 := p2[2] - p3[2];
// вектор перпендикулярен центру треугольника
nx := vy1 * vz2 - vz1 * vy2;
ny := vz1 * vx2 - vx1 * vz2;
nz := vx1 * vy2 - vy1 * vx2;
// получаем унитарный вектор единичной длины
wrki := sqrt (nx * nx + ny * ny + nz * nz);
If wrki = 0 then wrki := 1; // для предотвращения деления на ноль
get_Normal_fl[0] := nx/ wrki;
get_Normal_fl[1] := ny/ wrki;
get_Normal_fl[2] := nz/ wrki;
end;
end.