Soyez le premier à donner votre avis sur cette source.
Vue 9 347 fois - Téléchargée 1 048 fois
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.
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.