3D STÉRÉOSCOPIQUE. FAITES DE LA 3D À PARTIR DE DEUX PHOTOS.

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.