3d stéréoscopique. faites de la 3d à partir de deux photos.
Description
Ce programme est basé sur l'utilisation de photos pour réaliser simplement des modéles 3D.
A partir de deux photos décalés d'un objet vous réalisez grâce au programme un modèle 3D de votre objet en quelques clics de souris.
Ainsi vous pouvez modéliser par exemple votre visage( à condition de posséder un appareil photo numérique).
Attention pour que le code source fonctionne et pour le modifier, vous devez installer le composant M3D que j'ai deja installé sur le site.
Le zip fournit contient l'ensemble des fichiers delphi du projet mais aussi l'executable au cas ou vous ne posséderiez pas le composant.
N'hésitez pas à me poser des questions si vous trouvez que mon code n'est pas clair et signalez moi les bugs.
La partie 3D est géré par mon moteur 3D (M3D) normalement disponible sur ce site.
Important:Pour faire fonctionner l'exemple dézippez le fichier dans c:\windows et suivez les indications (décompréssez les jpegs).
A partir de deux photos décalés d'un objet vous réalisez grâce au programme un modèle 3D de votre objet en quelques clics de souris.
Ainsi vous pouvez modéliser par exemple votre visage( à condition de posséder un appareil photo numérique).
Attention pour que le code source fonctionne et pour le modifier, vous devez installer le composant M3D que j'ai deja installé sur le site.
Le zip fournit contient l'ensemble des fichiers delphi du projet mais aussi l'executable au cas ou vous ne posséderiez pas le composant.
N'hésitez pas à me poser des questions si vous trouvez que mon code n'est pas clair et signalez moi les bugs.
Source / Exemple :
unit surfcplx;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ExtDlgs, ComCtrls, M3D;
type
Tligne2=record //alg 1
num:word;etat:byte;
end;
Ttriligne=array[1..800,1..800] of Tligne2; //alg 1
Tpoly=record
x1,y1,z1,x2,y2,z2,x3,y3,z3:extended; //etape 2
p1,p2,p3:word;
end;
Ttrait=record
x1,y1,x2,y2,coef:extended;
end;
Tligne=record //alg 2
p1,p2:word;
poly1,poly2:word;
end;
Tmligne=array[1..1000] of tligne; //etape2
Tintersec=record
dist:extended;
etat:byte;
end;
Ttampligne=array[1..800] of word; //alg 1
Tmultiligne=array[1..800,1..800] of Tintersec; //alg 1+2
Tpoint = record
x,y,z:extended;
end;
Tpol = record
x1,y1,z1,x2,y2,z2,x3,y3,z3:extended;
xt1,yt1,xt2,yt2,xt3,yt3:word;
end;
TForm1 = class(TForm)
M3D1: TM3D;
Image2: TImage;
Image1: TImage;
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Button3: TButton;
Button4: TButton;
Timer1: TTimer;
OpenPictureDialog1: TOpenPictureDialog;
Button5: TButton;
Button6: TButton;
Edit4: TEdit;
Edit5: TEdit;
Label4: TLabel;
Label5: TLabel;
Button12: TButton;
Button13: TButton;
Button14: TButton;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
TrackBar1: TTrackBar;
TrackBar2: TTrackBar;
TrackBar3: TTrackBar;
Image3: TImage;
Label6: TLabel;
Image4: TImage;
Image5: TImage;
Image6: TImage;
Image7: TImage;
Button7: TButton;
SavePictureDialog1: TSavePictureDialog;
procedure etape1;
procedure devinepolygones;
function coupe(p1,p2,p3,p4:word):boolean;
function coupe2(p1,p2,p3:word;x4u,y4u:extended):boolean;
function coupe3(p1,p2,tn:word):boolean;
function defsens(x1u,y1u,x2u,y2u,x3u,y3u:extended):shortint;
function detangle(x1,y1,x2,y2,x3,y3:extended):extended;
function dehors(x1,y1:extended):boolean;
procedure sauvesurface(fichier:string);
procedure chargesurface(fichier:string);
procedure appercu;
procedure fragmente(dist:extended);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button4Click(Sender: TObject);
procedure timer(Sender: TObject);
procedure M3D1Mousemove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
//procedure Button7Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure Button10Click(Sender: TObject);
procedure Button11Click(Sender: TObject);
procedure Button12Click(Sender: TObject);
procedure Button13Click(Sender: TObject);
procedure Button14Click(Sender: TObject);
procedure Button15Click(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure TrackBar2Change(Sender: TObject);
procedure TrackBar3Change(Sender: TObject);
procedure Image3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image7MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image6MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image5MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button7pClick(Sender: TObject);
procedure Button7Click(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
mat3d,mat3d2:array[1..1000] of Tpoint;
contour:array[1..200] of Tpoint;
nc,np,nf:word;
trctr:boolean;
matligne:^Tmultiligne;
lfin:^Tmligne;
matpoly:array[1..1000] of Tpoly ;
cli,ctr,cpo:dword;
mligne:^Ttriligne;
tampligne:^Ttampligne;
multrait:array[1..1500] of Ttrait;
ntrait,v1,v2,pcour:word;
masq,appuie,dehor,bloque:boolean;
btm1,btm2:tbitmap;
l,dE,z0,vr:extended;
decx,decy:word;
rendu,im1,im2:string;
m1,m2:array[1..100] of byte;
matsav:array[1..1000] of tpol;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var n:word;
begin
image1.canvas.Pen.color:=clgreen;
image1.canvas.moveTo(round(mat3d[1].x),round(mat3d[1].y));
for n:=2 to nc-1 do begin
image1.canvas.lineTo(round(mat3d[n].x),round(mat3d[n].y));
end;
image1.canvas.lineTo(round(mat3d[1].x),round(mat3d[1].y));
if trctr then begin
edit1.text:=inttostr(nf);
edit3.text:=inttostr(ntrait);
// v1:=np+nc-2;v2:=ntrait;
end;
trctr:=False;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
etape1;
devinepolygones;
l:=(trackbar1.Position);
z0:=(trackbar2.Position);
appercu;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
m3d1.creer;
m3d1.Moteur.coulfond:=$5fff;
trctr:=True;nc:=1;np:=1;
new(matligne);new(lfin);cli:=0;ctr:=0;cpo:=1;
new(mligne);new(tampligne);
btm1:=tbitmap.create;
btm2:=tbitmap.create;
//btm1.LoadFromFile('c:\windows\Britney 06.BMP');
m3d1.camera.champ:=200;
m3d1.camera.decz:=40;
m3d1.Moteur.coulfond:=$1234;
m3d1.ChargeReflexions(1,'C:\Windows\Bureau\camille\rech\surfaces complexes\fichiers 3D\light.lum');
//m3d1.ChargeReflexions(1,'C:\Windows\Bureau\camille\rech\surfaces complexes\fichiers 3D\diffus.lum');
rendu:='texnormal';
l:=20;
dE:=15;
z0:=5;
vr:=1;
decx:=0;
decy:=0;
with m3d1.camera do begin
posx:=0;
posy:=0;
posz:=0;
perspective:=400;
end;
m3d1.assignbitmap(2,320,240,image3.picture.bitmap);
btm1.LoadFromFile('C:\Windows\exemple1\Ressources\masque1.bmp');
m3d1.chargetexture(0,'C:\Windows\exemple1\Ressources\masque1.bmp');
im1:='C:\Windows\exemple1\Ressources\masque1.bmp';
//charge l'exemple
btm2.LoadFromFile('C:\Windows\exemple1\Ressources\masque2.bmp');
im2:='C:\Windows\exemple1\Ressources\masque2.bmp';
chargesurface('C:\Windows\exemple1\Ressources\masque.sur');
etape1;
devinepolygones; //relie les points en polygones
l:=(trackbar1.Position);
z0:=(trackbar2.Position);
appercu; //calcul le rendu
dehor:=True;
bloque:=False;
//image3.canvas.Font
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
image1.canvas.Brush.color:=clwhite;
btm1.canvas.rectangle(0,0,512,512);
btm2.canvas.rectangle(0,0,512,512);
m3d1.objet.taille:=0;
nc:=1;np:=1;cli:=0;ctr:=0;
trctr:=true;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
//m3d1.dpoint(1,x,300-y,0);
//m3d1.rafraichis(1);
//image1.Canvas.Draw(0,0,btm1);
image1.canvas.Pixels[x,y]:=1;
//image1.canvas.pen.color:=clred;
//image1.Canvas.Ellipse(x-2,y-2,x+2,y+2);
if trctr then begin
mat3d[nc].x:=x+decx;
mat3d[nc].y:=y+decy;
//mat3d[nc].z:=l*dE/(z0);
mat3d2[nc].x:=x+decx;
mat3d2[nc].y:=y+decy;
inc(nc);masq:=True;
end;
if trctr=False then begin
if dehors(x+decx,y+decy)=false then begin
mat3d[np+nc-1].x:=x+decx;
mat3d[np+nc-1].y:=y+decy;
// mat3d[np+nc-1].z:=l*dE/(z0);
mat3d2[np+nc-1].x:=x+decx;
mat3d2[np+nc-1].y:=y+decy;
inc(np);masq:=False;
end
else begin
showmessage('Point en dehors du contour');
end;
end;
end;
procedure TForm1.Image7MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var n:dword;
begin
if (decx>4) then decx:=decx-4;
image1.canvas.CopyRect(rect(0,0,500,400),btm1.Canvas,rect(decx,decy,decx+500,decy+400));
image1.canvas.pen.color:=clred;
image1.canvas.brush.color:=clwhite;
for n:=1 to nc+np-2 do begin
image1.Canvas.Ellipse(round(mat3d[n].x)-2-decx,round(mat3d[n].y-decy)-2,round(mat3d[n].x)+2-decx,round(mat3d[n].y)+2-decy);
end;
image2.canvas.CopyRect(rect(0,0,500,400),btm2.Canvas,rect(decx,decy,decx+500,decy+400));
image2.canvas.pen.color:=clred;
image2.canvas.brush.color:=clwhite;
for n:=1 to nc+np-2 do begin
image2.Canvas.Ellipse(round(mat3d2[n].x)-2-decx,round(mat3d2[n].y-decy)-2,round(mat3d2[n].x)+2-decx,round(mat3d2[n].y)+2-decy);
end;
end;
procedure TForm1.Image6MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var n:dword;
begin
decx:=decx+4;
image1.canvas.CopyRect(rect(0,0,500,400),btm1.Canvas,rect(decx,decy,decx+500,decy+400));
image1.canvas.pen.color:=clred;
image1.canvas.brush.color:=clwhite;
for n:=1 to nc+np-2 do begin
image1.Canvas.Ellipse(round(mat3d[n].x)-2-decx,round(mat3d[n].y-decy)-2,round(mat3d[n].x)+2-decx,round(mat3d[n].y)+2-decy);
end;
image2.canvas.CopyRect(rect(0,0,500,400),btm2.Canvas,rect(decx,decy,decx+500,decy+400));
image2.canvas.pen.color:=clred;
image2.canvas.brush.color:=clwhite;
for n:=1 to nc+np-2 do begin
image2.Canvas.Ellipse(round(mat3d2[n].x)-2-decx,round(mat3d2[n].y-decy)-2,round(mat3d2[n].x)+2-decx,round(mat3d2[n].y)+2-decy);
end;
end;
procedure TForm1.Image4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var n:dword;
begin
decy:=decy+4;
image1.canvas.CopyRect(rect(0,0,500,400),btm1.Canvas,rect(decx,decy,decx+500,decy+400));
//image1.Canvas.Draw(decx,decy,btm1);
image1.canvas.pen.color:=clred;
image1.canvas.brush.color:=clwhite;
for n:=1 to nc+np-2 do begin
image1.Canvas.Ellipse(round(mat3d[n].x)-2-decx,round(mat3d[n].y-decy)-2,round(mat3d[n].x)+2-decx,round(mat3d[n].y)+2-decy);
end;
image2.canvas.CopyRect(rect(0,0,500,400),btm2.Canvas,rect(decx,decy,decx+500,decy+400));
image2.canvas.pen.color:=clred;
image2.canvas.brush.color:=clwhite;
for n:=1 to nc+np-2 do begin
image2.Canvas.Ellipse(round(mat3d2[n].x)-2-decx,round(mat3d2[n].y-decy)-2,round(mat3d2[n].x)+2-decx,round(mat3d2[n].y)+2-decy);
end;
end;
procedure TForm1.Image5MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var n:dword;
begin
if (decy>4) then decy:=decy-4;
image1.canvas.CopyRect(rect(0,0,500,400),btm1.Canvas,rect(decx,decy,decx+500,decy+400));
//image1.Canvas.Draw(decx,decy,btm1);
image1.canvas.pen.color:=clred;
image1.canvas.brush.color:=clwhite;
for n:=1 to nc+np-2 do begin
image1.Canvas.Ellipse(round(mat3d[n].x)-2-decx,round(mat3d[n].y-decy)-2,round(mat3d[n].x)+2-decx,round(mat3d[n].y)+2-decy);
end;
image2.canvas.CopyRect(rect(0,0,500,400),btm2.Canvas,rect(decx,decy,decx+500,decy+400));
image2.canvas.pen.color:=clred;
image2.canvas.brush.color:=clwhite;
for n:=1 to nc+np-2 do begin
image2.Canvas.Ellipse(round(mat3d2[n].x)-2-decx,round(mat3d2[n].y-decy)-2,round(mat3d2[n].x)+2-decx,round(mat3d2[n].y)+2-decy);
end;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var n:dword;
begin
//image1.Canvas.Draw(decx,decy,btm1);
image1.canvas.CopyRect(rect(0,0,500,400),btm1.Canvas,rect(decx,decy,decx+500,decy+400));
image1.canvas.pen.color:=clred;
image1.canvas.brush.color:=clwhite;
for n:=1 to nc+np-2 do begin
// image1.canvas.Pixels[round(mat3d[n].x),round(mat3d[n].y)]:=1;
image1.Canvas.Ellipse(round(mat3d[n].x)-2-decx,round(mat3d[n].y)-2-decy,round(mat3d[n].x)+2-decx,round(mat3d[n].y)+2-decy);
end;
end;
procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var n:dword;
begin
image2.canvas.CopyRect(rect(0,0,500,400),btm2.Canvas,rect(decx,decy,decx+500,decy+400));
image2.canvas.pen.color:=clred;
image2.canvas.brush.color:=clwhite;
for n:=1 to nc+np-2 do begin
if n<>pcour then begin
//image2.canvas.Pixels[round(mat3d2[n].x),round(mat3d2[n].y)]:=1;
image2.Canvas.Ellipse(round(mat3d2[n].x)-2-decx,round(mat3d2[n].y)-2-decy,round(mat3d2[n].x)+2-decx,round(mat3d2[n].y)+2-decy);
end;
end;
image2.canvas.pen.color:=clblue;
image1.canvas.pen.color:=clblue;
if (appuie) and (pcour<>0) then begin
image2.Canvas.Ellipse(x-2,y-2,x+2,y+2);
image1.Canvas.Ellipse(round(mat3d[pcour].x)-2-decx,round(mat3d[pcour].y)-2-decy,round(mat3d[pcour].x)+2-decx,round(mat3d[pcour].y)+2-decy);
end;
end;
procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var n:dword;
begin
appuie:=True;
pcour:=0;
for n:=1 to (np+nc-2) do begin
if (abs(mat3d2[n].x-(x+decx))<=4) and (abs(mat3d2[n].y-(y+decy))<=4) then pcour:=n;
end;
end;
procedure TForm1.Image2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var x1,y1:extended;
begin
appuie:=false;
x1:=mat3d[pcour].x;y1:=mat3d[pcour].y;
mat3d2[pcour].x:=x+decx;mat3d2[pcour].y:=y+decy;
image2.canvas.pen.color:=clred;
image2.Canvas.Ellipse(x-2,y-2,x+2,y+2);
//mat3d[pcour].z:=l*dE/(z0+x1-(x+decx));
pcour:=0;
end;
procedure TForm1.Button4Click(Sender: TObject);
var n:dword;
begin
for n:=1 to cpo do begin
m3d1.structure[n].polarite:=-1*m3d1.structure[n].polarite;
end;
with m3d1 do begin
moteur.coulfond:=$1234;
rend(rendu,1);
moteur.coulfond:=$ffff;
camera.zoom:=8;
rend('coloré',2);
rafraichis(1);
rafraichis(2);
end;
{with m3d1 do begin
with objet do begin
taille:=cpo;
nom:='suface1';
end;
//chargetexture(0,'c:\windows\Britney 06.bmp');
// chargetexture(1,'c:\windows\Britney 06.bmp');
//chargetexture(0,'c:\windows\Britney 06.bmp');
for n:=1 to cpo do begin
structure^[n].xt1:=round(matpoly[n].x1);structure^[n].xt2:=round(matpoly[n].x2);structure^[n].xt3:=round(matpoly[n].x3);
structure^[n].yt1:=round(matpoly[n].y1);structure^[n].yt2:=round(matpoly[n].y2);structure^[n].yt3:=round(matpoly[n].y3);
structure^[n].y1:=matpoly[n].x1/20;structure^[n].y2:=matpoly[n].x2/20;structure^[n].y3:=matpoly[n].x3/20;
structure^[n].x1:=matpoly[n].y1/20;structure^[n].x2:=matpoly[n].y2/20;structure^[n].x3:=matpoly[n].y3/20;
structure^[n].z1:=matpoly[n].z1/20;structure^[n].z2:=matpoly[n].z2/20;structure^[n].z3:=matpoly[n].z3/20;
structure^[n].texture:=1;
//polarite:=1;
end;
rend('texnormal',1);
rafraichis(1);
end; }
end;
procedure TForm1.timer(Sender: TObject);
begin
with m3d1 do begin
if (dehor=False) then begin
moteur.coulfond:=$1234;
//moteur.raftamp:=True;
rend(rendu,1);
{moteur.raftamp:=False;
rend('fildefer',1); }
//camera.decy:=camera.decy+9;
moteur.coulfond:=$ffff;
camera.zoom:=8;
// rend('pcav',2);
// moteur.raftamp:=True;
rend('coloré',2);
// camera.decy:=camera.decy-9;
//Moteur.grandecran:=True;
rafraichis(1);
//Moteur.grandecran:=False;
rafraichis(2);
form1.caption:='M3D:'+floattostr(m3d1.IPS)+' IPS.';
end;
end;
end;
procedure TForm1.M3D1Mousemove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if bloque=False then begin
m3d1.alpha:=x/40;
m3d1.tetha:=y/40;
end;
dehor:=False;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
with m3d1 do begin
{if key=105 then deplacey(vr);
if key=99 then deplacey(-vr);
if key=102 then deplacex(vr);
if key=100 then deplacex(-vr);
if key=104 then deplacez(vr);
if key=101 then deplacez(-vr); }
if key=221 then deplacey(vr);
if key=192 then deplacey(-vr);
if key=77 then deplacex(vr);
if key=75 then deplacex(-vr);
if key=79 then deplacez(vr);
if key=76 then deplacez(-vr);
if key=83 then begin
if bloque then bloque:=False
else bloque:=True;
end;
with camera do begin
if key=105 then decx:=decx-vr;
if key=99 then decx:=decx+vr;
if key=102 then decy:=decy-vr; //x et y
if key=100 then decy:=decy+vr;
if key=104 then perspective:=round(perspective*1.1); //z
if key=101 then perspective:=round(perspective/1.1);
end;
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
{ m3d1.alpha:=x/50;
m3d1.tetha:=y/50; }
dehor:=True;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
if openpicturedialog1.execute then begin
btm1.LoadFromFile(openpicturedialog1.FileName);
m3d1.chargetexture(0,openpicturedialog1.FileName);
im1:=openpicturedialog1.FileName;
end;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
if openpicturedialog1.execute then begin
btm2.LoadFromFile(openpicturedialog1.FileName);
im2:=openpicturedialog1.FileName;
end;
end;
procedure TForm1.Button8Click(Sender: TObject);
var n:dword;
begin
if (decy>4) then decy:=decy-4;
image1.canvas.CopyRect(rect(0,0,500,400),btm1.Canvas,rect(decx,decy,decx+500,decy+400));
//image1.Canvas.Draw(decx,decy,btm1);
image1.canvas.pen.color:=clred;
image1.canvas.brush.color:=clwhite;
for n:=1 to nc+np-2 do begin
image1.Canvas.Ellipse(round(mat3d[n].x)-2-decx,round(mat3d[n].y-decy)-2,round(mat3d[n].x)+2-decx,round(mat3d[n].y)+2-decy);
end;
image2.canvas.CopyRect(rect(0,0,500,400),btm2.Canvas,rect(decx,decy,decx+500,decy+400));
image2.canvas.pen.color:=clred;
image2.canvas.brush.color:=clwhite;
for n:=1 to nc+np-2 do begin
image2.Canvas.Ellipse(round(mat3d2[n].x)-2-decx,round(mat3d2[n].y-decy)-2,round(mat3d2[n].x)+2-decx,round(mat3d2[n].y)+2-decy);
end;
end;
{procedure TForm1.Button7Click(Sender: TObject);
var n:dword;
begin
decy:=decy+4;
image1.canvas.CopyRect(rect(0,0,500,400),btm1.Canvas,rect(decx,decy,decx+500,decy+400));
//image1.Canvas.Draw(decx,decy,btm1);
image1.canvas.pen.color:=clred;
image1.canvas.brush.color:=clwhite;
for n:=1 to nc+np-2 do begin
image1.Canvas.Ellipse(round(mat3d[n].x)-2-decx,round(mat3d[n].y-decy)-2,round(mat3d[n].x)+2-decx,round(mat3d[n].y)+2-decy);
end;
image2.canvas.CopyRect(rect(0,0,500,400),btm2.Canvas,rect(decx,decy,decx+500,decy+400));
image2.canvas.pen.color:=clred;
image2.canvas.brush.color:=clwhite;
for n:=1 to nc+np-2 do begin
image2.Canvas.Ellipse(round(mat3d2[n].x)-2-decx,round(mat3d2[n].y-decy)-2,round(mat3d2[n].x)+2-decx,round(mat3d2[n].y)+2-decy);
end;
end; }
procedure TForm1.Button9Click(Sender: TObject);
var n:dword;
begin
if (decx>4) then decx:=decx-4;
image1.canvas.CopyRect(rect(0,0,500,400),btm1.Canvas,rect(decx,decy,decx+500,decy+400));
image1.canvas.pen.color:=clred;
image1.canvas.brush.color:=clwhite;
for n:=1 to nc+np-2 do begin
image1.Canvas.Ellipse(round(mat3d[n].x)-2-decx,round(mat3d[n].y-decy)-2,round(mat3d[n].x)+2-decx,round(mat3d[n].y)+2-decy);
end;
image2.canvas.CopyRect(rect(0,0,500,400),btm2.Canvas,rect(decx,decy,decx+500,decy+400));
image2.canvas.pen.color:=clred;
image2.canvas.brush.color:=clwhite;
for n:=1 to nc+np-2 do begin
image2.Canvas.Ellipse(round(mat3d2[n].x)-2-decx,round(mat3d2[n].y-decy)-2,round(mat3d2[n].x)+2-decx,round(mat3d2[n].y)+2-decy);
end;
end;
procedure TForm1.Button10Click(Sender: TObject);
var n:dword;
begin
decx:=decx+4;
image1.canvas.CopyRect(rect(0,0,500,400),btm1.Canvas,rect(decx,decy,decx+500,decy+400));
image1.canvas.pen.color:=clred;
image1.canvas.brush.color:=clwhite;
for n:=1 to nc+np-2 do begin
image1.Canvas.Ellipse(round(mat3d[n].x)-2-decx,round(mat3d[n].y-decy)-2,round(mat3d[n].x)+2-decx,round(mat3d[n].y)+2-decy);
end;
image2.canvas.CopyRect(rect(0,0,500,400),btm2.Canvas,rect(decx,decy,decx+500,decy+400));
image2.canvas.pen.color:=clred;
image2.canvas.brush.color:=clwhite;
for n:=1 to nc+np-2 do begin
image2.Canvas.Ellipse(round(mat3d2[n].x)-2-decx,round(mat3d2[n].y-decy)-2,round(mat3d2[n].x)+2-decx,round(mat3d2[n].y)+2-decy);
end;
end;
procedure TForm1.Button12Click(Sender: TObject);
var lo:word;
var typ:string;
begin
if savedialog1.Execute then begin
{m3d1.SauveTextures(1,savedialog1.filename);
m3d1.SauveStructure(savedialog1.filename);
m3d1.SauveObjet(savedialog1.filename);
lo:=length(savedialog1.filename);
typ:=Copy(savedialog1.filename,lo-3, 4); }
// typ:=savedialog1.filterindex;
if savedialog1.filterindex=1 then sauvesurface(savedialog1.filename);
if savedialog1.filterindex=2 then begin
m3d1.SauveTextures(1,savedialog1.filename);
m3d1.SauveStructure(savedialog1.filename);
m3d1.SauveObjet(savedialog1.filename);
end;
end;
end;
procedure TForm1.Button13Click(Sender: TObject);
var lo:word;
var typ:string;
begin
if opendialog1.Execute then begin
lo:=length(opendialog1.filename);
typ:=Copy(opendialog1.filename,lo-3, 4);
if typ='.O3D' then m3d1.ChargeObjet(opendialog1.filename); //chargement d'un objet 3D (géré par M3D)
if typ='.sur' then chargesurface(opendialog1.filename); //chargement d'une surface (interne)
//chargesurface(opendialog1.filename);
end;
end;
procedure TForm1.Button14Click(Sender: TObject);
label l1;
begin
if rendu='fildefer' then begin
rendu:='texnormal';goto l1;
end;
if rendu='texnormal' then begin
rendu:='texombré';goto l1;
end;
if rendu='texombré' then begin
rendu:='ombré';goto l1;
end;
if rendu='ombré' then begin
rendu:='pcav';goto l1;
end;
if rendu='pcav' then begin
rendu:='coloré';goto l1;
end;
if rendu='coloré' then begin
rendu:='fildefer';goto l1;
end;
l1:
with m3d1 do begin
moteur.coulfond:=$1234;
rend(rendu,1);
moteur.coulfond:=$ffff;
camera.zoom:=8;
rend('coloré',2);
rafraichis(1);
rafraichis(2);
end;
end;
procedure Tform1.sauvesurface(fichier:string);
var
fi:file;
t1,t2,n:word;
begin
t1:=length(im1);t2:=length(im2);
for n:=1 to t1 do begin
m1[n]:=ord(im1[n]);
end;
for n:=1 to t2 do begin
m2[n]:=ord(im2[n]);
end;
AssignFile(fi,fichier+'.sur');
Rewrite(fi, 1);
Blockwrite(fi,t1,2);
Blockwrite(fi,t2,2);
Blockwrite(fi,m1,t1);
Blockwrite(fi,m2,t2);
Blockwrite(fi,nc,2);
Blockwrite(fi,np,2);
Blockwrite(fi,mat3d,(np+nc-2)*30);
Blockwrite(fi,mat3d2,(np+nc-2)*30);
CloseFile(Fi);
end;
procedure Tform1.chargesurface(fichier:string);
var
fi:file;
t1,t2,n:word;
begin
AssignFile(Fi,fichier);
Reset(Fi,1);
Blockread(fi,t1,2);
Blockread(fi,t2,2);
Blockread(fi,m1,t1);
Blockread(fi,m2,t2);
Blockread(fi,nc,2);
Blockread(fi,np,2);
Blockread(fi,mat3d,(np+nc-2)*30);
Blockread(fi,mat3d2,(np+nc-2)*30);
CloseFile(Fi);
im1:='';im2:='';
for n:=1 to t1 do begin
im1:=im1+chr(m1[n]);
end;
for n:=1 to t2 do begin
im2:=im2+chr(m2[n]);
end;
btm1.LoadFromFile(im1);
m3d1.chargetexture(0,im1);
btm2.LoadFromFile(im2);
trctr:=false;
end;
procedure TForm1.Button15Click(Sender: TObject);
begin
if savedialog1.Execute then begin
m3d1.SauveTextures(1,savedialog1.filename);
m3d1.SauveStructure(savedialog1.filename);
m3d1.SauveObjet(savedialog1.filename);
end;
end;
procedure TForm1.appercu;
var
n,q1,q2,q3:dword;
mx,my,mz:extended;
begin
with m3d1 do begin
//m3d1.Moteur.raftamp:=false;
for n:=1 to cpo do begin
//mat3d[n].z:=l*dE/(z0+mat3d[n].x-mat3d2[n].x);
q1:=matpoly[n].p1;q2:=matpoly[n].p2;q3:=matpoly[n].p3;
structure^[n].z1:=l*dE/((z0+mat3d[q1].x-mat3d2[q1].x+1E-5)*20); //recalcul des profondeurs
structure^[n].z2:=l*dE/((z0+mat3d[q2].x-mat3d2[q2].x+1E-5)*20);
structure^[n].z3:=l*dE/((z0+mat3d[q3].x-mat3d2[q3].x+1E-5)*20);
end;
with objet do begin
taille:=cpo;
nom:='suface1';
end;
//chargetexture(0,'c:\windows\Britney 06.bmp');
// chargetexture(1,'c:\windows\Britney 06.bmp');
//chargetexture(0,'c:\windows\Britney 06.bmp');
{ for n:=1 to 100 do begin
m3d1.voirtexture(1);
end;}
for n:=1 to cpo do begin
structure^[n].xt1:=round(matpoly[n].x1);structure^[n].xt2:=round(matpoly[n].x2);structure^[n].xt3:=round(matpoly[n].x3);
structure^[n].yt1:=round(matpoly[n].y1);structure^[n].yt2:=round(matpoly[n].y2);structure^[n].yt3:=round(matpoly[n].y3);
structure^[n].y1:=-matpoly[n].x1/20;structure^[n].y2:=-matpoly[n].x2/20;structure^[n].y3:=-matpoly[n].x3/20;
structure^[n].x1:=matpoly[n].y1/20;structure^[n].x2:=matpoly[n].y2/20;structure^[n].x3:=matpoly[n].y3/20;
//structure^[n].z1:=matpoly[n].z1/20;structure^[n].z2:=matpoly[n].z2/20;structure^[n].z3:=matpoly[n].z3/20;
structure^[n].texture:=0;structure^[n].couleur:=random($ffff);
with structure^[n] do begin
polarite:=-defsens(x1,y1,x2,y2,x3,y3);
end;
//polarite:=1;
end;
mx:=0;my:=0;mz:=0;
for n:=1 to cpo do begin
with structure^[n] do begin
mx:=mx+x1+x2+x3;
my:=my+y1+y2+y3;
mz:=mz+z1+z2+z3;
end;
end;
mx:=mx/(3*cpo);
my:=my/(3*cpo);
mz:=mz/(3*cpo);
{ with camera do begin
{posx:=mx;
posy:=my;
posz:=mz;
end;}
for n:=1 to cpo do begin
with structure^[n] do begin
x1:=x1-mx;x2:=x2-mx;x3:=x3-mx; //recentrage de l'objet en son centre de gravite
y1:=y1-my;y2:=y2-my;y3:=y3-my;
z1:=z1-mz;z2:=z2-mz;z3:=z3-mz;
end;
end;
for n:=1 to cpo do begin
matsav[n].x1:=structure^[n].x1;matsav[n].x2:=structure^[n].x2;matsav[n].x3:=structure^[n].x3;
matsav[n].y1:=structure^[n].y1;matsav[n].y2:=structure^[n].y2;matsav[n].y3:=structure^[n].y3;
matsav[n].z1:=structure^[n].z1;matsav[n].z2:=structure^[n].z2;matsav[n].z3:=structure^[n].z3; //sauvegarde de la structure
matsav[n].xt1:=structure^[n].xt1;matsav[n].xt2:=structure^[n].xt2;matsav[n].xt3:=structure^[n].xt3;
matsav[n].yt1:=structure^[n].yt1;matsav[n].yt2:=structure^[n].yt2;matsav[n].yt3:=structure^[n].xt3;
end;
{ rend(rendu,1);
rafraichis(1); }
end;
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
l:=(trackbar1.Position);
z0:=(trackbar2.Position);
edit4.text:=floattostr(l);
edit5.text:=floattostr(z0);
appercu;
with m3d1 do begin
moteur.coulfond:=$1234;
rend(rendu,1);
moteur.coulfond:=$ffff;
camera.zoom:=8;
rend('coloré',2);
rafraichis(1);
rafraichis(2);
end;
end;
procedure TForm1.TrackBar2Change(Sender: TObject);
begin
l:=(trackbar1.Position);
z0:=(trackbar2.Position);
edit4.text:=floattostr(l);
edit5.text:=floattostr(z0);
appercu;
with m3d1 do begin
moteur.coulfond:=$1234;
rend(rendu,1);
moteur.coulfond:=$ffff;
camera.zoom:=8;
rend('coloré',2);
rafraichis(1);
rafraichis(2);
end;
end;
procedure TForm1.fragmente(dist:extended);
var n:dword;
var x1,x2,x3,y1,y2,y3,z1,z2,z3,mx,my,mz,a,b:extended;
begin
with m3d1 do begin
for n:=1 to cpo do begin
x1:=matsav[n].x1;x2:=matsav[n].x2;x3:=matsav[n].x3;
y1:=matsav[n].y1;y2:=matsav[n].y2;y3:=matsav[n].y3;
z1:=matsav[n].z1;z2:=matsav[n].z2;z3:=matsav[n].z3;
mx:=(x1+x2+x3)/3;my:=(y1+y2+y3)/3;mz:=(z1+z2+z3)/3;
structure^[n].x1:=mx*dist+x1;structure^[n].x2:=mx*dist+x2;structure^[n].x3:=mx*dist+x3;
structure^[n].y1:=my*dist+y1;structure^[n].y2:=my*dist+y2;structure^[n].y3:=my*dist+y3;
structure^[n].z1:=mz*dist+z1;structure^[n].z2:=mz*dist+z2;structure^[n].z3:=mz*dist+z3;
end;
end;
end;
procedure TForm1.Button11Click(Sender: TObject);
var n,p1,p2,p3:dword;
begin
fragmente(1.3);
m3d1.rend(rendu,1);
m3d1.rafraichis(1);
end;
procedure TForm1.TrackBar3Change(Sender: TObject);
begin
fragmente((TrackBar3.position-400)/100);
with m3d1 do begin
moteur.coulfond:=$1234;
rend(rendu,1);
moteur.coulfond:=$ffff;
camera.zoom:=8;
rend('coloré',2);
rafraichis(1);
rafraichis(2);
end;
{m3d1.rend(rendu,1);
m3d1.rafraichis(1); }
end;
procedure TForm1.Image3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if bloque=False then begin
m3d1.alpha:=x/40;
m3d1.tetha:=y/40;
end;
dehor:=False;
end;
procedure TForm1.Button7Click(Sender: TObject);
var svimg:Tbitmap;
begin
svimg:=tbitmap.Create;
svimg.width:=506;
svimg.height:=352;
if SavePictureDialog1.Execute then begin
SavePictureDialog1.title:='Sauvegarder le rendu';
svimg.Canvas.copyrect(rect(0,0,506,352),m3d1.canvas,rect(0,0,506,352));
svimg.savetofile(SavePictureDialog1.filename+'.bmp');
end;
svimg.Destroy;
end;
procedure TForm1.Image3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var p:word;
begin
p:=m3d1.numpoly(2,x,y);
m3d1.structure[p].couleur:=$ffff-m3d1.structure[p].couleur; //couleur invérsé du polygone sélectionné
end;
/////////////////////////////////////////////Partie désitinée à relier les points en une surface uniforme faite de triangle//////////////////////////////////////
procedure TForm1.etape1;
var m,n,p,q:dword;
var d,dmin,da,al,ai,xm,ym:extended;
var npol,mpol,tpol,tlim:word;
var g:boolean;
var sens,sensi:shortint;
label l1,l2,l3;
begin
cli:=0;ctr:=0;ntrait:=0;
nf:=np+nc-2;
m3d1.canvas.pen.width:=1;m3d1.canvas.Pen.color:=clblack;
for p:=1 to nf do begin
for n:=1 to nf do begin
d:=sqrt(sqr(mat3d[n].x-mat3d[p].x)+sqr(mat3d[n].y-mat3d[p].y)); //calcul de toutes les distances du contour
Matligne^[n,p].dist:=d;Matligne^[p,n].dist:=d;
Matligne^[n,p].etat:=0;Matligne^[p,n].etat:=0;
if (n=p) then begin
Matligne^[p,n].etat:=2;Matligne^[n,p].etat:=2;
end;
end;
end;
Matligne^[1,2].etat:=1;Matligne^[2,1].etat:=1;
for n:=2 to nc-1 do begin
Matligne^[n-1,n].etat:=1;Matligne^[n,n-1].etat:=1;
lfin[n-1].p1:=n-1;lfin[n-1].p2:=n;
end;
Matligne^[nc-1,1].etat:=1;Matligne^[1,nc-1].etat:=1;
lfin[nc-1].p1:=nc-1;lfin[nc-1].p2:=1;
ctr:=nc-1;
ntrait:=nc-1;
for n:=1 to ntrait-1 do begin
multrait[n].x1:=mat3d[n].x;multrait[n].y1:=mat3d[n].y;
multrait[n].x2:=mat3d[n+1].x;multrait[n].y2:=mat3d[n+1].y;
if (multrait[n].x1-multrait[n].x2)<>0 then multrait[n].coef:=(multrait[n].y1-multrait[n].y2)/(multrait[n].x1-multrait[n].x2)
else multrait[n].coef:=314159265;
end;
multrait[ntrait].x1:=mat3d[ntrait].x;multrait[ntrait].y1:=mat3d[ntrait].y;
multrait[ntrait].x2:=mat3d[1].x;multrait[ntrait].y2:=mat3d[1].y;
if (multrait[ntrait].x1-multrait[ntrait].x2)<>0 then multrait[ntrait].coef:=(multrait[ntrait].y1-multrait[ntrait].y2)/(multrait[ntrait].x1-multrait[ntrait].x2)
else multrait[ntrait].coef:=314159265;
al:=0;
ai:=detangle(mat3d[1].x,mat3d[1].y,mat3d[2].x,mat3d[2].y,mat3d[nc-1].x,mat3d[nc-1].y);
for n:=2 to nc-2 do begin
da:=detangle(mat3d[1].x,mat3d[1].y,mat3d[n].x,mat3d[n].y,mat3d[n+1].x,mat3d[n+1].y);
al:=al+da;
end;
if al<0 then sens:=1;
if al>0 then sens:=-1;
edit2.text:=floattostr(abs(al-ai))+' '+inttostr(sens);
p:=3; //a partir du point p
for p:=1 to nc-1 do begin
for n:=1 to nc-1 do begin //1 //chercher les segments [pn] qui sortent du contour
al:=0;
if Matligne^[p,n].etat=0 then begin//2
for m:=1 to nc-2 do begin//3 //et qui ne coupent pas les segments [mm+1]
if coupe(p,n,m,m+1) then begin //4
Matligne^[p,n].etat:=2;Matligne^[n,p].etat:=2;
goto l2;
end; //4
//on verifie qu'elle ne coupe aucune droite du contour
end; //3
if coupe(p,n,1,nc-1) then begin //4
Matligne^[p,n].etat:=2;Matligne^[n,p].etat:=2;
goto l2;
end;
xm:=(mat3d[p].x+mat3d[n].x)/2;
ym:=(mat3d[p].y+mat3d[n].y)/2;
//ai:=detangle(mat3d[1].x,mat3d[1].y,mat3d[2].x,mat3d[2].y,mat3d[nc-1].x,mat3d[nc-1].y);
for q:=1 to nc-2 do begin
da:=detangle(xm,ym,mat3d[q].x,mat3d[q].y,mat3d[q+1].x,mat3d[q+1].y);
al:=al+da;
end;
da:=detangle(xm,ym,mat3d[nc-1].x,mat3d[nc-1].y,mat3d[1].x,mat3d[1].y);
al:=al+da;
//sensi:=defsens(mat3d[p].x,mat3d[p].y,mat3d[round((p+n)/2)].x,mat3d[round((p+n)/2)].y,xm,ym) //puis on verifie qu'elle ne sort pas du cadre
if abs(al)<1 then begin
Matligne^[p,n].etat:=2;Matligne^[n,p].etat:=2;
end;
l2:
end; //2
end; //1
end;
for p:=1 to nc-1 do begin
tampligne^[p]:=65535;
for n:=1 to nc-1 do begin
tampligne^[n]:=round(matligne^[p,n].dist*10);
end;
for n:=1 to nc-1 do begin
mpol:=65534;
for q:=1 to nc-1 do begin
tpol:=tampligne^[q]; //tri de matligne dans mligne
if (tpol<mpol) then begin
mpol:=tpol;
npol:=q;
end;
end;
tampligne^[npol]:=65535;
mligne^[p,n-1].num:=npol;
mligne^[p,n-1].etat:=matligne^[p,npol].etat;
end;
end;
for n:=1 to nc-2 do begin
for m:=1 to nc-2 do begin //relie l'ensemble des points a son n-ieme plus proche
p:=mligne^[m,n].num;
if Matligne^[m,p].etat=0 then begin
for q:=1 to ntrait do begin // q=point le n-ieme plus proche de m
if {coupe2(m,p,q)} coupe3(m,p,q) then begin // on verifie que [pm] ne coupe pas la q-ieme ligne deja existante
//mligne^[m,n].etat:=2;
Matligne^[m,p].etat:=2;Matligne^[p,m].etat:=2;
// g:=coupe3(m,p,q);
goto l1;
end;
end;
//mligne^[m,n].etat:=1;
Matligne^[m,p].etat:=1;Matligne^[p,m].etat:=1;
inc(ntrait);
with multrait[ntrait] do begin
x1:=mat3d[m].x;y1:=mat3d[m].y;
x2:=mat3d[p].x;y2:=mat3d[p].y;
if (x1-x2)<>0 then coef:=(y1-y2)/(x1-x2)
else coef:=314159265;
end;
l1:
end;
end;
// if ntrait>tlim then break;
end;
edit1.text:=inttostr(nf);
edit3.text:=inttostr(ntrait);
//if masq=False then begin
//m3d1.canvas.rectangle(0,0,640,480);
m3d1.canvas.Pen.color:=clblue;
tlim:=(np-1)*3+ntrait;
for p:=1 to nf do begin
for n:=1 to nf do begin
if (Matligne^[n,p].etat=1) then begin
Matligne^[n,p].etat:=0;Matligne^[p,n].etat:=0;
end;
end;
end;
Matligne^[1,2].etat:=1;Matligne^[2,1].etat:=1;
for n:=2 to nc-1 do begin
Matligne^[n-1,n].etat:=1;Matligne^[n,n-1].etat:=1;
end;
Matligne^[nc-1,1].etat:=1;Matligne^[1,nc-1].etat:=1;
ntrait:=nc-1;
for n:=1 to ntrait-1 do begin
multrait[n].x1:=mat3d[n].x;multrait[n].y1:=mat3d[n].y;
multrait[n].x2:=mat3d[n+1].x;multrait[n].y2:=mat3d[n+1].y;
if (multrait[n].x1-multrait[n].x2)<>0 then multrait[n].coef:=(multrait[n].y1-multrait[n].y2)/(multrait[n].x1-multrait[n].x2)
else multrait[n].coef:=314159265;
end;
multrait[ntrait].x1:=mat3d[ntrait].x;multrait[ntrait].y1:=mat3d[ntrait].y;
multrait[ntrait].x2:=mat3d[1].x;multrait[ntrait].y2:=mat3d[1].y;
if (multrait[ntrait].x1-multrait[ntrait].x2)<>0 then multrait[ntrait].coef:=(multrait[ntrait].y1-multrait[ntrait].y2)/(multrait[ntrait].x1-multrait[ntrait].x2)
else multrait[ntrait].coef:=314159265;
{ tlim:=(nf-v1)*3+v2;
v1:=np+nc-2;v2:=ntrait; }
//tlim:=10000;
p:=3;
for p:=1 to nf do begin
tampligne^[p]:=65535;
for n:=1 to nf do begin
tampligne^[n]:=round(matligne^[p,n].dist*10);
end;
for n:=1 to nf do begin
mpol:=65534;
for q:=1 to nf do begin
tpol:=tampligne^[q]; //tri de matligne dans mligne
if (tpol<mpol) then begin
mpol:=tpol;
npol:=q;
end;
end;
tampligne^[npol]:=65535;
mligne^[p,n-1].num:=npol;
mligne^[p,n-1].etat:=matligne^[p,npol].etat;
end;
end;
ntrait:=nc-1;
n:=5;
for n:=1 to nf-1 do begin
for m:=1 to nf-1 do begin //relie l'ensemble des points a son n-ieme plus proche
p:=mligne^[m,n].num;
if Matligne^[m,p].etat=0 then begin
for q:=1 to ntrait do begin // q=point le n-ieme plus proche de m
if {coupe2(m,p,q)} coupe3(m,p,q) then begin // on verifie que [pm] ne coupe pas la q-ieme ligne deja existante
//mligne^[m,n].etat:=2;
Matligne^[m,p].etat:=2;Matligne^[p,m].etat:=2;
// g:=coupe3(m,p,q);
goto l3;
end;
end;
//mligne^[m,n].etat:=1;
Matligne^[m,p].etat:=1;Matligne^[p,m].etat:=1;
inc(ntrait);inc(ctr);lfin[ctr].p1:=m;lfin[ctr].p2:=p;
with multrait[ntrait] do begin
x1:=mat3d[m].x;y1:=mat3d[m].y;
x2:=mat3d[p].x;y2:=mat3d[p].y;
if (x1-x2)<>0 then coef:=(y1-y2)/(x1-x2)
else coef:=314159265;
end;
if (ntrait>tlim) then break;
l3:
end;
if (ntrait>tlim) then break;
end;
// if ntrait>tlim then break;
end;
edit1.text:=inttostr(nf);
edit3.text:=inttostr(ntrait);
end;
procedure TForm1.devinepolygones;
var n,p,m,q,r,c1,c2,c3,pols,o:dword;
var xm,ym:extended;
label l4;
label l5;
begin
cpo:=1;
for n:=1 to ctr do begin
lfin[n].poly1:=0;lfin[n].poly2:=0;
matpoly[n].x1:=10000;matpoly[n].x2:=11000;matpoly[n].x3:=12000;
end;
for p:=1 to ctr do begin //en partant de la droite lfin[p]
pols:=lfin[p].poly1;
//p:=3;
c1:=lfin[p].p1;
c2:=lfin[p].p2;
for n:=1 to ctr do begin //b1 //on cherche 2 droites lfin[n] et lfin[m] pour que l'ensemble forme un triangle
if (lfin[n].p1=c1) or (lfin[n].p2=c1) then begin //b2
if (lfin[n].p1=c1) then c3:=lfin[n].p2;
if (lfin[n].p2=c1) then c3:=lfin[n].p1;
for m:=1 to ctr do begin //b3
if (((lfin[m].p1=c3) and (lfin[m].p2=c2)) or ((lfin[m].p1=c2) and (lfin[m].p2=c3))) then begin //b4
for q:=1 to cpo do begin
if (mat3d[c1].x=matpoly[q].x1) and (mat3d[c2].x=matpoly[q].x2) and (mat3d[c3].x=matpoly[q].x3) then goto l4;
if (mat3d[c1].x=matpoly[q].x2) and (mat3d[c2].x=matpoly[q].x3) and (mat3d[c3].x=matpoly[q].x1) then goto l4;
if (mat3d[c1].x=matpoly[q].x3) and (mat3d[c2].x=matpoly[q].x2) and (mat3d[c3].x=matpoly[q].x1) then goto l4; //on verifie que ce triangle n'existe pas deja sous d'autres formes
if (mat3d[c1].x=matpoly[q].x1) and (mat3d[c2].x=matpoly[q].x3) and (mat3d[c3].x=matpoly[q].x2) then goto l4;
if (mat3d[c1].x=matpoly[q].x2) and (mat3d[c2].x=matpoly[q].x1) and (mat3d[c3].x=matpoly[q].x3) then goto l4;
if (mat3d[c1].x=matpoly[q].x3) and (mat3d[c2].x=matpoly[q].x1) and (mat3d[c3].x=matpoly[q].x2) then goto l4;
end;
{ 1 2 3
2 3 1
3 2 1
1 3 2
2 1 3
3 1 2 }
xm:=(mat3d[c1].x+mat3d[c2].x)/2;
ym:=(mat3d[c1].y+mat3d[c2].y)/2;
for q:=1 to ctr do begin
if ((lfin[q].p2<>c3) and (lfin[q].p1<>c3)) and ((lfin[q].p1<>c2) or (lfin[q].p2<>c1)) and ((lfin[q].p1<>c1) or (lfin[q].p2<>c2)) then begin
if coupe2(lfin[q].p1,lfin[q].p2,c3,xm,ym) then goto l4;
end;
end;
matpoly[cpo].x1:=mat3d[c1].x;matpoly[cpo].y1:=mat3d[c1].y;//matpoly[cpo].z1:=mat3d[c1].z;
matpoly[cpo].x2:=mat3d[c2].x;matpoly[cpo].y2:=mat3d[c2].y;//matpoly[cpo].z2:=mat3d[c2].z;
matpoly[cpo].x3:=mat3d[c3].x;matpoly[cpo].y3:=mat3d[c3].y;//matpoly[cpo].z3:=mat3d[c3].z;
matpoly[cpo].p1:=c1;matpoly[cpo].p2:=c2;matpoly[cpo].p3:=c3;
// image1.canvas.Pen.color:=clblack;
//image1.canvas.Brush.color:=random($ffffff);
//image1.canvas.Polygon([point(round(matpoly[cpo].x1),round(matpoly[cpo].y1)),point(round(matpoly[cpo].x2),round(matpoly[cpo].y2)),point(round(matpoly[cpo].x3),round(matpoly[cpo].y3))]);
inc(cpo);
goto l5;
l4:
{matpoly[cpo].x1:=mat3d[c1].x;matpoly[cpo].y1:=mat3d[c1].y;matpoly[cpo].z1:=mat3d[c1].z;
matpoly[cpo].x2:=mat3d[c2].x;matpoly[cpo].y2:=mat3d[c2].y;matpoly[cpo].z2:=mat3d[c2].z;
matpoly[cpo].x3:=mat3d[c3].x;matpoly[cpo].y3:=mat3d[c3].y;matpoly[cpo].z3:=mat3d[c3].z; }
l5:
end; //f4
end; //f3
end; //f2
end; //f1
end;
dec(cpo);
edit2.text:=inttostr(cpo);
end;
function TForm1.coupe3(p1,p2,tn:word):boolean;
var n,pn:word;
var d1,d2,b1,b2,xi,x1,y1,x2,y2,x3,x4,y3,y4:extended;
var entre1,entre2:boolean;
begin
inc(cli);pn:=tn;
x1:=mat3d[p1].x;y1:=mat3d[p1].y;
x2:=mat3d[p2].x;y2:=mat3d[p2].y;
x3:=multrait[pn].x1;y3:=multrait[pn].y1;
x4:=multrait[pn].x2;y4:=multrait[pn].y2;
coupe3:=false;entre1:=false;entre2:=false;
if (x1=x2) or (x3=x4) then begin
d1:=(x1-x2)/(y1-y2+1E-8);
d2:=(x3-x4)/(y3-y4+3E-8);
b1:=x1-d1*y1;
b2:=x3-d2*y3;
xi:=(b2-b1)/(d1-d2+2E-8);
if (y3<xi) and (y4>xi) then entre1:=True;
if (y3>xi) and (y4<xi) then entre1:=True;
if ((x3=x1) and (y3=y1)) or ((x3=x2) and (y3=y2)) or ((x4=x1) and (y4=y1)) or ((x4=x2) and (y4=y2)) then entre1:=false;
if (y1<xi) and (y2>xi) then entre2:=True;
if (y1>xi) and (y2<xi) then entre2:=True;
end
else begin
d1:=(y1-y2)/(x1-x2);
//d2:=(y3-y4)/(x3-x4);
d2:=multrait[pn].coef;
b1:=y1-d1*x1;
b2:=y3-d2*x3;
xi:=(b2-b1)/(d1-d2+1E-8);
if (x3<xi) and (x4>xi) then entre1:=True;
if (x3>xi) and (x4<xi) then entre1:=True;
if ((x3=x1) and (y3=y1)) or ((x3=x2) and (y3=y2)) or ((x4=x1) and (y4=y1)) or ((x4=x2) and (y4=y2)) then entre1:=false;
if (x1<xi) and (x2>xi) then entre2:=True;
if (x1>xi) and (x2<xi) then entre2:=True;
end;
if (entre1=true) and (entre2=true) then coupe3:=true;
end;
function TForm1.coupe2(p1,p2,p3:word;x4u,y4u:extended):boolean;
var n:word;
var d1,d2,b1,b2,xi,x1,y1,x2,y2,x3,x4,y3,y4:extended;
var entre1,entre2:boolean;
begin
inc(cli);
x1:=mat3d[p1].x;y1:=mat3d[p1].y;
x2:=mat3d[p2].x;y2:=mat3d[p2].y;
x3:=mat3d[p3].x;y3:=mat3d[p3].y;
coupe2:=false;entre1:=false;entre2:=false;
if (x1=x2) or (x3=x4u) then begin
d1:=(x1-x2)/(y1-y2+1E-8);
d2:=(x3-x4u)/(y3-y4u+3E-8);
b1:=x1-d1*y1;
b2:=x3-d2*y3;
xi:=(b2-b1)/(d1-d2+2E-8);
if (y3<xi) and (y4u>xi) then entre1:=True;
if (y3>xi) and (y4u<xi) then entre1:=True;
// if ((x3=x1) and (y3=y1)) or ((x3=x2) and (y3=y2)) or ((x4u=x1) and (y4u=y1)) or ((x4u=x2) and (y4u=y2)) then entre1:=false;
if (y1<xi) and (y2>xi) then entre2:=True;
if (y1>xi) and (y2<xi) then entre2:=True;
end
else begin
d1:=(y1-y2)/(x1-x2);
d2:=(y3-y4u)/(x3-x4u);
b1:=y1-d1*x1;
b2:=y3-d2*x3;
xi:=(b2-b1)/(d1-d2+1E-8);
if (x3<xi) and (x4u>xi) then entre1:=True;
if (x3>xi) and (x4u<xi) then entre1:=True;
//if ((x3=x1) and (y3=y1)) or ((x3=x2) and (y3=y2)) or ((x4u=x1) and (y4u=y1)) or ((x4u=x2) and (y4u=y2)) then entre1:=false;
if (x1<xi) and (x2>xi) then entre2:=True;
if (x1>xi) and (x2<xi) then entre2:=True;
end;
if (entre1=true) and (entre2=true) then coupe2:=true;
{
d1*x1+b1=y1
b1=y1-d1*x1
d1*xi+b1=d2*xi+b2
(d1-d2)*xi=(b2-b1)
xi=(b2-b1)/(d1-d2) }
end;
function TForm1.coupe(p1,p2,p3,p4:word):boolean;
var n:word;
var d1,d2,b1,b2,xi,x1,y1,x2,y2,x3,x4,y3,y4:extended;
var entre1,entre2:boolean;
begin
inc(cli);
x1:=mat3d[p1].x;y1:=mat3d[p1].y;
x2:=mat3d[p2].x;y2:=mat3d[p2].y;
x3:=mat3d[p3].x;y3:=mat3d[p3].y;
x4:=mat3d[p4].x;y4:=mat3d[p4].y;
coupe:=false;entre1:=false;entre2:=false;
if (x1=x2) or (x3=x4) then begin
d1:=(x1-x2)/(y1-y2+1E-8);
d2:=(x3-x4)/(y3-y4+3E-8);
b1:=x1-d1*y1;
b2:=x3-d2*y3;
xi:=(b2-b1)/(d1-d2+2E-8);
if (y3<xi) and (y4>xi) then entre1:=True;
if (y3>xi) and (y4<xi) then entre1:=True;
if ((x3=x1) and (y3=y1)) or ((x3=x2) and (y3=y2)) or ((x4=x1) and (y4=y1)) or ((x4=x2) and (y4=y2)) then entre1:=false;
if (y1<xi) and (y2>xi) then entre2:=True;
if (y1>xi) and (y2<xi) then entre2:=True;
end
else begin
d1:=(y1-y2)/(x1-x2);
d2:=(y3-y4)/(x3-x4);
b1:=y1-d1*x1;
b2:=y3-d2*x3;
xi:=(b2-b1)/(d1-d2+1E-8);
if (x3<xi) and (x4>xi) then entre1:=True;
if (x3>xi) and (x4<xi) then entre1:=True;
if ((x3=x1) and (y3=y1)) or ((x3=x2) and (y3=y2)) or ((x4=x1) and (y4=y1)) or ((x4=x2) and (y4=y2)) then entre1:=false;
if (x1<xi) and (x2>xi) then entre2:=True;
if (x1>xi) and (x2<xi) then entre2:=True;
end;
if (entre1=true) and (entre2=true) then coupe:=true;
{
d1*x1+b1=y1
b1=y1-d1*x1
d1*xi+b1=d2*xi+b2
(d1-d2)*xi=(b2-b1)
xi=(b2-b1)/(d1-d2) }
end;
function tform1.defsens(x1u,y1u,x2u,y2u,x3u,y3u:extended):shortint;
var au,bu,yu:extended;
var se,ses:integer;
var sor,sens:boolean;
begin
ses:=1;
if ses<>0 then begin
if (y1u>y2u) and (y1u>y3u) then begin
if ((x2u-x1u)*(x3u-x1u)<0) then begin
if (x2u<x3u) then se:=1;
if (x3u<=x2u) then se:=-1;
end;
if (x2u<x1u) and (x3u<x1u) then begin
au:=(y1u-y2u)/(x1u-x2u);
bu:=y2u-au*x2u;
yu:=au*x3u+bu;
if (y3u<yu) then se:=1;
if (y3u>yu) then se:=-1;
if y3u=yu then se:=0;
end;
if (x2u>x1u) and (x3u>x1u) then begin
au:=(y1u-y2u)/(x1u-x2u);
bu:=y2u-au*x2u;
yu:=au*x3u+bu;
if (y3u<yu) then se:=-1;
if (y3u>yu) then se:=1;
if y3u=yu then se:=0;
end;
if (x1u=x2u) then begin
if (x3u<x2u) then se:=-1;
if (x3u>x2u) then se:=1;
se:=0;
end;
end;
if (y1u<y2u) and (y2u>y3u) then begin
if ((x1u-x2u)*(x3u-x2u)<0) then begin
if (x3u<x1u) then se:=1;
if (x1u<=x3u) then se:=-1;
end;
if (x1u<x2u) and (x3u<x2u) then begin
au:=(y2u-y3u)/(x2u-x3u);
bu:=y3u-au*x3u;
yu:=au*x1u+bu;
if (y1u<yu) then se:=1;
if (y1u>yu) then se:=-1;
if y1u=yu then se:=0;
end;
if (x1u>x2u) and (x3u>x2u) then begin
au:=(y2u-y3u)/(x2u-x3u);
bu:=y3u-au*x3u;
yu:=au*x1u+bu;
if (y1u<yu) then se:=-1;
if (y1u>yu) then se:=1;
if y1u=yu then se:=0;
end;
if (x2u=x3u) then begin
if (x1u<x2u) then se:=-1;
if (x1u>x2u) then se:=1;
se:=0;
end;
end;
if (y3u>y1u) and (y3u>y2u) then begin
if ((x1u-x3u)*(x2u-x3u)<0) then begin
if (x1u<x2u) then se:=1;
if (x2u<=x1u) then se:=-1;
end;
if (x1u<x3u) and (x2u<x3u) then begin
au:=(y3u-y1u)/(x3u-x1u);
bu:=y1u-au*x1u;
yu:=au*x2u+bu;
if (y2u<yu) then se:=1;
if (y2u>yu) then se:=-1;
if y2u=yu then se:=0;
end;
if (x1u>x3u) and (x2u>x3u) then begin
au:=(y3u-y1u)/(x3u-x1u);
bu:=y1u-au*x1u;
yu:=au*x2u+bu;
if (y2u<yu) then se:=-1;
if (y2u>yu) then se:=1;
if y2u=yu then se:=0;
end;
if (x3u=x1u) then begin
if (x2u<x1u) then se:=-1;
if (x2u>x1u) then se:=1;
se:=0;
end;
end;
if (y1u=y2u) or (y1u=y3u) or (y2u=y3u) then se:=0;
if (x1u=x2u) or (x1u=x3u) or (x2u=x3u) then se:=0;
if (se*ses=-1) then sens:=false;
if (se*ses=1) or (ses=0) then begin
sens:=true;
// inc(polyd);
end;
end;
if sens then defsens:=1
else defsens:=-1;
if se=0 then defsens:=0;
end;
function TForm1.detangle(x1,y1,x2,y2,x3,y3:extended):extended;
var a,b,a2,b2,xi,yi,l1,l2,angle,x1p,y1p,x2p,y2p,x3p,y3p:extended;
var si:shortint;
begin
x1p:=x1+1E-3;y1p:=y1+1E-3;
x2p:=x2+2E-3;y2p:=y2+2E-3;
x3p:=x3+3E-3;y3p:=y3+3E-3;
if (x3p-x1p)<>0 then begin
if (y3p-y1p)<>0 then begin
a:=(y3p-y1p)/(x3p-x1p);
b:=y1p-a*x1p; //y1=a*x1+b
a2:=-1/a;
b2:=y2p-a2*x2p; //y2=a*x1+b
xi:=(b2-b)/(a-a2); //a*x+b=a2*x+b2
yi:=a*xi+b;
l1:=sqrt(sqr(yi-y2p)+sqr(xi-x2p));
l2:=sqrt(sqr(yi-y1p)+sqr(xi-x1p));
angle:=Arctan(l1/l2);
if (y3p-y1p)*(yi-y1p)<0 then angle :=pi-angle;
si:=defsens(x1p,y1p,x2p,y2p,x3p,y3p);
detangle:=si*angle*180/pi;
end
else begin
l1:=abs(y3p-y2p);
l2:=abs(x2p-x1p);
angle:=Arctan(l1/l2);
if (x3p-x1p)*(xi-x1p)<0 then angle :=pi-angle;
si:=defsens(x1p,y1p,x2p,y2p,x3p,y3p);
detangle:=si*angle*180/pi;
end;
end
else begin
l1:=abs(x2p-x1p);
l2:=abs(y2p-y1p);
angle:=Arctan(l1/l2);
if (y3p-y1p)*(yi-y1p)<0 then angle :=pi-angle;
si:=defsens(x1p,y1p,x2p,y2p,x3p,y3p);
detangle:=si*angle*180/pi;
end;
end;
function TForm1.dehors(x1,y1:extended):boolean;
var q:dword;
var al,da:extended;
begin
dehors:=False;
al:=0;
for q:=1 to nc-2 do begin
da:=detangle(x1,y1,mat3d[q].x,mat3d[q].y,mat3d[q+1].x,mat3d[q+1].y);
al:=al+da;
end;
da:=detangle(x1,y1,mat3d[nc-1].x,mat3d[nc-1].y,mat3d[1].x,mat3d[1].y);
al:=al+da;
if abs(al)<1 then dehors:=True;
end;
procedure TForm1.Button7pClick(Sender: TObject);
var n:dword;
begin
for n:=1 to 1000000 do begin
image1.Picture.Bitmap.Canvas.Pixels[2,2]:=53;
end;
end;
end.
Conclusion :
La partie 3D est géré par mon moteur 3D (M3D) normalement disponible sur ce site.
Important:Pour faire fonctionner l'exemple dézippez le fichier dans c:\windows et suivez les indications (décompréssez les jpegs).
Codes Sources
A voir également
- 3d stéréoscopique. faites de la 3d à partir de deux photos.
- Visualiseur 3d 2d - Forum C# / .NET
- Changement de repère 3d ✓ - Forum Visual Basic
- Passer d'un repère 3D à l'écran ✓ - Forum C++ & C++ .NET
- Dessin 3d facile cube - Forum C / C++ / C++.NET
- Opengl 3d - Forum C / C++ / C++.NET
Du même auteur (cs_cam91)
-
Jonglage en notation siteswap
-
Synchronisez vos sous-titres
-
Jeu: randonné virtuelle en montagne.
-
Modeleur 3d: fabriquez des objets 3d simplements à partir de primitives (cube,cylindre...), appliquez leurs ensuite des text
-
Quelques routines graphiques performantes (négatif d'une image,balance rvb,noir et blanc)
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.