[Delphi] Modèle avec XLWDOS

merci bcp

au fait, ds cette fonction, je dois juste utiliser une petite partie qu consiste a detedter qq points bien précis.

si ce n'est pas assez clair, je peu poster le tt, ou bien on pourra discuter directement sur msn

encore merci.




function contpartg(d:integer):string;
var x,y,z,x1,x2,x3,x4,x5,y1,y2,y3,y4,p1,p2,p3,t1,zd,zv,zc,w1,w2,w3,w4,w5,z1,nbcontour:integer;
e1,e3,e4,e5,i,j,j2,e8,k,p4,p5,p6,l1,l2,w6,mn:integer;
a,b,c,v,t,m,n,e6,e2,e7,g,d1,min,cos:real;
s,s1,str25,tre:string;
u1,u2:boolean;
label etiq,etiq1,etiq2,etiq3,etiq4,etiq5;
begin
k:=conteurguache(d);
for nbcontour:=0to 500 do
begin
pcur[nbcontour].xx:=0;
pcur[nbcontour].yy:=0;
pcur[nbcontour].zz:=0;
end;
x:=strtoint(XLWDOSform1.Edit2.Text);
y:=strtoint(XLWDOSform1.Edit3.Text);
l1:=mat5[d,0].xx;
l2:=mat5[d,0].yy;
//x3:=round(k/x);
y1:=cntg[0].yy;
y2:=cntg[0].xx;
y3:=cntg[k].yy;
y4:=cntg[k].xx;
pcur[0].xx:=y2;
pcur[0].yy:=y1;
pcur[0].zz:=0;
x5:=0;z:=1;
//for x4:=1 to x3-1 do
while (x5+x+x)<=k do
begin //1
p1:=cntg[x5].xx;p6:=cntg[x5+x+x].yy;
p2:=cntg[x5+x].xx;p5:=cntg[x5+x].yy;
p3:=cntg[x5+x+x].xx;p4:=cntg[x5].yy;
if x5+x+x>k then goto etiq4;
a:=sqrt(sqr(p1-p2)+sqr(p4-p5));
b:=sqrt(sqr(p3-p2)+sqr(p6-p5));
c:=sqrt(sqr(p3-p1)+sqr(p6-p4));
cos:=((((a*a)+(b*b))-(c*c))/(2*a*b));
if cos>1 then cos:=1 else if cos<-1 then cos:=-1;
try
v:=arccos(cos);
except
on EInvalidOp do begin
try
str25:=formatfloat('0.0000',cos);
cos:=strtofloat(str25);
v:=arccos(cos);
except
on EInvalidOp do v:=pi+0.05;
end;
end;
end;
//v:=ArcCos(cos);
tre:='';
tre:='P'+inttostr(d+1)+':gauche Pt('+inttostr(p2)+','+inttostr(p5)+') : Pt1('+inttostr(p1)+','+inttostr(p4)+') et Pt2('+inttostr(p3)+','+inttostr(p6)+') <'+floattostr(round(t))+'>';
XLWDOSform5.Memo1.Lines.Add(tre);
t:=radtodeg(v);
if y>t then begin //2
if z=1 then begin //a
pcur[z].xx:=p2;
pcur[z].yy:=p5;
pcur[z].zz:=x5+x;
z:=z+1;min:=t;mn:=x5+1;
end //a
else begin //b
if mn=x5 then begin //c
if min<=t then mn:=x5+1
else begin //d
pcur[z-1].xx:=p2;
pcur[z-1].yy:=p5;
pcur[z-1].zz:=x5+x;
min:=t;mn:=x5+1;
end; //d
end //c
else begin //e
pcur[z].xx:=p2;
pcur[z].yy:=p5;
pcur[z].zz:=x5+x;
z:=z+1;min:=t;mn:=x5+1;
end; //e
end; //b
end; //2
etiq4:
x5:=x5+1;//form1.Edit4.Text:=form1.Edit4.Text+'-'+inttostr(x5);
end; //1
pcur[z].xx:=y4;
pcur[z].yy:=y3;
pcur[z].zz:=k;
/////////////////
if z>1 then for mn:=1 to z-1 do colorpointy(pcur[mn].xx,pcur[mn].yy);
/////////////////
if z=1 then begin //3
s:='<L> ';zd:=1;zv:=1;zc:=1;
if (y1=y3)and(y2<>y4)then goto etiq5;
if y2<>y4 then begin
m:=(y1-y3)/(y2-y4);
n:=((y1*y4)-(y3*y2))/(y4-y2);
end;
for x3:=0 to k do
begin //5
x4:=cntg[x3].xx;
if y2=y4 then t1:=y2
else begin
x5:=cntg[x3].yy;
t1:=round((x5-n)/m);
end;
if(t1=x4)then begin zd:=zd+1;goto etiq;end;
if t1<x4 then begin zc:=zc+1;goto etiq;end;
if t1>x4 then zv:=zv+1;
etiq:
end; //5
if zd>zc then if zd>zv then begin //15
if y2=y4 then s:=s+'R 90 '+inttostr((l2-l1)+1)+' </L>'
else begin //16
etiq5:
a:=sqrt(sqr(y3-y1)+sqr(y4-y2));
c:=y3-y1;
if y4<y2 then begin //17
b:=y2-y4;
cos:=(((a*a)+(b*b))-(c*c))/(2*a*b);
if cos>1 then cos:=1 else if cos<-1 then cos:=-1;
try
v:=arccos(cos);
except
on EInvalidOp do begin
try
str25:=formatfloat('0.0000',cos);
cos:=strtofloat(str25);
v:=arccos(cos);
except
on EInvalidOp do v:=pi+0.05;
end;
end;
end;
//v:= ArcCos(cos);
t:=radtodeg(v);
if y3=y1 then s:=s+'R '+inttostr(round(t))+' '+inttostr(y2-y4+1)+' </L>'
else s:=s+'R '+inttostr(round(t))+' '+inttostr((l2-l1)+1)+' </L>';
end //17
else begin //18
b:=y4-y2;
cos:=(((a*a)+(b*b))-(c*c))/(2*a*b);
if cos>1 then cos:=1 else if cos<-1 then cos:=-1;
try
v:=arccos(cos);
except
on EInvalidOp do begin
try
str25:=formatfloat('0.0000',cos);
cos:=strtofloat(str25);
v:=arccos(cos);
except
on EInvalidOp do v:=pi+0.05;
end;
end;
end;
//v:= ArcCos(cos);
t:=180-round(radtodeg(v));
if y3=y1 then s:=s+'R '+inttostr(round(t))+' '+inttostr(y4-y2+1)+' </L>'
else s:=s+'R '+inttostr(round(t))+' '+inttostr((l2-l1)+1)+' </L>';
end //18
end; //16
end //15
else begin //6
s1:=degrecv(y1,y2,y3,y4,k,m,n);
if y4=y2 then s:=s+'CV '+s1+' '+'90 '+inttostr((l2-l1)+1)+' </L>'
else
begin //19
a:=sqrt(sqr(y3-y1)+sqr(y4-y2));
c:=y3-y1;
if y4<y2 then begin //7
b:=y2-y4;
cos:=(((a*a)+(b*b))-(c*c))/(2*a*b);
if cos>1 then cos:=1 else if cos<-1 then cos:=-1;
try
v:=arccos(cos);
except
on EInvalidOp do begin
try
str25:=formatfloat('0.0000',cos);
cos:=strtofloat(str25);
v:=arccos(cos);
except
on EInvalidOp do v:=pi+0.05;
end;
end;
end;
//v:= ArcCos(cos);
t:=radtodeg(v);
s:=s+'CV '+s1+' '+inttostr(round(t))+' '+inttostr((l2-l1)+1)+' </L>';
end //7
else begin //8
b:=y4-y2;
cos:=(((a*a)+(b*b))-(c*c))/(2*a*b);
if cos>1 then cos:=1 else if cos<-1 then cos:=-1;
try
v:=arccos(cos);
except
on EInvalidOp do begin
try
str25:=formatfloat('0.0000',cos);
cos:=strtofloat(str25);
v:=arccos(cos);
except
on EInvalidOp do v:=pi+0.05;
end;
end;
end;
//v:= ArcCos(cos);
t:=180-round(radtodeg(v));
s:=s+'CV '+s1+' '+inttostr(round(t))+' '+inttostr((l2-l1)+1)+' </L>';
end //8
end; //19
end //6
else if zc>zv then begin //12
s1:=degrecc(y1,y2,y3,y4,k,m,n);
if y4=y2 then s:=s+'CC '+s1+' '+'90 '+inttostr((l2-l1)+1)+' </L>'
else
begin //20
a:=sqrt(sqr(y3-y1)+sqr(y4-y2));
c:=y3-y1;
if y4<y2 then begin //13
b:=y2-y4;
cos:=(((a*a)+(b*b))-(c*c))/(2*a*b);
if cos>1 then cos:=1 else if cos<-1 then cos:=-1;
try
v:=arccos(cos);
except
on EInvalidOp do begin
try
str25:=formatfloat('0.0000',cos);
cos:=strtofloat(str25);
v:=arccos(cos);
except
on EInvalidOp do v:=pi+0.05;
end;
end;
end;
//v:= ArcCos(cos);
t:=radtodeg(v);
s:=s+'CC '+s1+' '+inttostr(round(t))+' '+inttostr((l2-l1)+1)+' </L>';
end //13
else begin //14
b:=y4-y2;
cos:=(((a*a)+(b*b))-(c*c))/(2*a*b);
if cos>1 then cos:=1 else if cos<-1 then cos:=-1;
try
v:=arccos(cos);
except
on EInvalidOp do begin
try
str25:=formatfloat('0.0000',cos);
cos:=strtofloat(str25);
v:=arccos(cos);
except
on EInvalidOp do v:=pi+0.05;
end;
end;
end;
//v:= ArcCos(cos);
t:=180-round(radtodeg(v));
s:=s+'CC '+s1+' '+inttostr(round(t))+' '+inttostr((l2-l1)+1)+' </L>';
end; //14
end; //20
end //12
else begin //9
s1:=degrecv(y1,y2,y3,y4,k,m,n);
if y4=y2 then s:=s+'CV '+s1+' '+'90 '+inttostr((l2-l1)+1)+' </L>'
else
begin //21
a:=sqrt(sqr(y3-y1)+sqr(y4-y2));
c:=y3-y1;
if y4<y2 then begin //10
b:=y2-y4;
cos:=(((a*a)+(b*b))-(c*c))/(2*a*b);
if cos>1 then cos:=1 else if cos<-1 then cos:=-1;
try
v:=arccos(cos);
except
on EInvalidOp do begin
try
str25:=formatfloat('0.0000',cos);
cos:=strtofloat(str25);
v:=arccos(cos);
except
on EInvalidOp do v:=pi+0.05;
end;
end;
end;
//v:= ArcCos(cos);
t:=radtodeg(v);
s:=s+'CV '+s1+' '+inttostr(round(t))+' '+inttostr((l2-l1)+1)+' </L>';
end //10
else begin //11
b:=y4-y2;
cos:=(((a*a)+(b*b))-(c*c))/(2*a*b);
if cos>1 then cos:=1 else if cos<-1 then cos:=-1;
try
v:=arccos(cos);
except
on EInvalidOp do begin
try
str25:=formatfloat('0.0000',cos);
cos:=strtofloat(str25);
v:=arccos(cos);
except
on EInvalidOp do v:=pi+0.05;
end;
end;
end;
//v:= ArcCos(cos);
t:=180-round(radtodeg(v));
s:=s+'CV '+s1+' '+inttostr(round(t))+' '+inttostr((l2-l1)+1)+' </L>';
end //11
end; //21
end //9
end //3
else begin //4
s:='<L> ';
for z1:=0 to z-1 do
begin //3
zd:=1;zv:=1;zc:=1;
w1:=pcur[z1].yy;
w2:=pcur[z1].xx;
w3:=pcur[z1+1].yy;
w4:=pcur[z1+1].xx;
w5:=pcur[z1].zz;
w6:=pcur[z1+1].zz;
if w2<>w4 then begin
m:=(w1-w3)/(w2-w4);
n:=((w1*w4)-(w3*w2))/(w4-w2);
end;
if w1=w3 then goto etiq3
else
/////////////////////
for x3:=0 to w6-w5 do
begin //5
x4:=cntg[w5+x3].xx;
if w2=w4 then t1:=w2
else begin
x5:=cntg[w5+x3].yy;
t1:=round((x5-n)/m);
end;
if(t1=x4)then begin zd:=zd+1;goto etiq1;end;
if t1<x4 then begin zc:=zc+1;goto etiq1;end;
if t1>x4 then zv:=zv+1;
etiq1:
end; //5
/////////////////////
if zd>zc then if zd>zv then begin //15
if w2=w4 then s:=s+'R 90 '+inttostr((w3-w1)+1)+' '
else begin //16
etiq3:
a:=sqrt(sqr(w3-w1)+sqr(w4-w2));
c:=w3-w1;
if w4<w2 then begin //17
b:=w2-w4;
cos:=(((a*a)+(b*b))-(c*c))/(2*a*b);
if cos>1 then cos:=1 else if cos<-1 then cos:=-1;
try
v:=arccos(cos);
except
on EInvalidOp do begin
try
str25:=formatfloat('0.0000',cos);
cos:=strtofloat(str25);
v:=arccos(cos);
except
on EInvalidOp do v:=pi+0.05;
end;
end;
end;
//v:= ArcCos(cos);
t:=radtodeg(v);
if w3=w1 then s:=s+'R '+inttostr(round(t))+' '+inttostr((w2-w4)+1)+' '
else s:=s+'R '+inttostr(round(t))+' '+inttostr(w3-w1+1)+' ';
end //17
else begin //18
b:=w4-w2;
cos:=(((a*a)+(b*b))-(c*c))/(2*a*b);
if cos>1 then cos:=1 else if cos<-1 then cos:=-1;
try
v:=arccos(cos);
except
on EInvalidOp do begin
try
str25:=formatfloat('0.0000',cos);
cos:=strtofloat(str25);
v:=arccos(cos);
except
on EInvalidOp do v:=pi+0.05;
end;
end;
end;
//v:= ArcCos(cos);
t:=180-round(radtodeg(v));
if w3=w1 then s:=s+'R '+inttostr(round(t))+' '+inttostr((w4-w2)+1)+' '
else s:=s+'R '+inttostr(round(t))+' '+inttostr(w3-w1+1)+' ';
end //18
end; //16
end //15
else begin //6
s1:=degrecv1(w1,w2,w3,w4,w5,w6,m,n);
if w4=w2 then s:=s+'CV '+s1+' 90 '+inttostr(w3-w1+1)+' '
else
begin //19
a:=sqrt(sqr(w3-w1)+sqr(w4-w2));
c:=w3-w1;
if w4<w2 then begin //7
b:=w2-w4;
cos:=(((a*a)+(b*b))-(c*c))/(2*a*b);
if cos>1 then cos:=1 else if cos<-1 then cos:=-1;
try
v:=arccos(cos);
except
on EInvalidOp do begin
try
str25:=formatfloat('0.0000',cos);
cos:=strtofloat(str25);
v:=arccos(cos);
except
on EInvalidOp do v:=pi+0.05;
end;
end;
end;
//v:= ArcCos(cos);
t:=radtodeg(v);
s:=s+'CV '+s1+' '+inttostr(round(t))+' '+inttostr(w3-w1+1)+' ';
end //7
else begin //8
b:=w4-w2;
cos:=(((a*a)+(b*b))-(c*c))/(2*a*b);
if cos>1 then cos:=1 else if cos<-1 then cos:=-1;
try
v:=arccos(cos);
except
on EInvalidOp do begin
try
str25:=formatfloat('0.0000',cos);
cos:=strtofloat(str25);
v:=arccos(cos);
except
on EInvalidOp do v:=pi+0.05;
end;
end;
end;
//v:= ArcCos(cos);
t:=180-round(radtodeg(v));
s:=s+'CV '+s1+' '+inttostr(round(t))+' '+inttostr(w3-w1+1)+' ';
end //8
end; //19
end //6
else if zc>zv then begin //12
s1:=degrecc1(w1,w2,w3,w4,w5,w6,m,n);
if w4=w2 then s:=s+'CC '+s1+' '+'90 '+inttostr(w3-w1+1)+' '
else
begin //20
a:=sqrt(sqr(w3-w1)+sqr(w4-w2));
c:=w3-w1;
if w4<w2 then begin //13
b:=w2-w4;
cos:=(((a*a)+(b*b))-(c*c))/(2*a*b);
if cos>1 then cos:=1 else if cos<-1 then cos:=-1;
try
v:=arccos(cos);
except
on EInvalidOp do begin
try
str25:=formatfloat('0.0000',cos);
cos:=strtofloat(str25);
v:=arccos(cos);
except
on EInvalidOp do v:=pi+0.05;
end;
end;
end;
//v:= ArcCos(cos);
t:=radtodeg(v);
s:=s+'CC '+s1+' '+inttostr(round(t))+' '+inttostr(w3-w1+1)+' ';
end //13
else begin //14
b:=w4-w2;
cos:=(((a*a)+(b*b))-(c*c))/(2*a*b);
if cos>1 then cos:=1 else if cos<-1 then cos:=-1;
try
v:=arccos(cos);
except
on EInvalidOp do begin
try
str25:=formatfloat('0.0000',cos);
cos:=strtofloat(str25);
v:=arccos(cos);
except
on EInvalidOp do v:=pi+0.05;
end;
end;
end;
//v:= ArcCos(cos);
t:=180-round(radtodeg(v));
s:=s+'CC '+s1+' '+inttostr(round(t))+' '+inttostr(w3-w1+1)+' ';
end; //14
end; //20
end //12
else begin //9
s1:=degrecv1(w1,w2,w3,w4,w5,w6,m,n);
if w4=w2 then s:=s+'CV '+s1+' 90 '+inttostr(w3-w1+1)+' '
else
begin //21
a:=sqrt(sqr(w3-w1)+sqr(w4-w2));
c:=w3-w1;
if w4<w2 then begin //10
b:=w2-w4;
cos:=(((a*a)+(b*b))-(c*c))/(2*a*b);
if cos>1 then cos:=1 else if cos<-1 then cos:=-1;
try
v:=arccos(cos);
except
on EInvalidOp do begin
try
str25:=formatfloat('0.0000',cos);
cos:=strtofloat(str25);
v:=arccos(cos);
except
on EInvalidOp do v:=pi+0.05;
end;
end;
end;
//v:= ArcCos(cos);
t:=radtodeg(v);
s:=s+'CV '+s1+' '+inttostr(round(t))+' '+inttostr(w3-w1+1)+' ';
end //10
else begin //11
b:=w4-w2;
cos:=(((a*a)+(b*b))-(c*c))/(2*a*b);
if cos>1 then cos:=1 else if cos<-1 then cos:=-1;
try
v:=arccos(cos);
except
on EInvalidOp do begin
try
str25:=formatfloat('0.0000',cos);
cos:=strtofloat(str25);
v:=arccos(cos);
except
on EInvalidOp do v:=pi+0.05;
end;
end;
end;
//v:= ArcCos(cos);
t:=180-round(radtodeg(v));
s:=s+'CV '+s1+' '+inttostr(round(t))+' '+inttostr(w3-w1+1)+' ';
end //11
end; //21
end //9
end; //3

s:=s+'</L>';
end; //4
contpartg:=s;
end;

au fait, l'application elle mème c'est le XLWDOS que je dois intégrer ds mon application, mais pour l'instant, j'ai juste besoin de comprendre qq truc, et commen en mm temps, je suis entrain d'apprndre a programmer en delphi, c un peu difficile pr moi.
si ça ne vs dérange pas, je vs donne mon adresse msn et dés que vs pourrez, je vs envois le tt et je vs explik ou se situe mon probleme