我干脃把部分程序贴上来
unit js;
interface
type
Thp_data=array of array[0..3]of single;
function mytan(q:Extended):Extended;
procedure P_js(hp_data:Thp_data;rt:single;var pp1,p1,p2,p3:Extended);
procedure L_A_H_W_JS(hp_data:Thp_data;rt:Extended;var l,a,w,h1,h2:Tdata_array);
function Q_JS(hp_data:Thp_data;rt,c1,k:single):single;
function K_JS(hp_data:Thp_data;c,Q,rt:Extended;dz:integer):Extended;
function C_JS(hp_data:Thp_data;rt,Q,k1:Extended):Extended;
function u_js(a1,a2,Q:single):single;
implementation
function mytan(q:Extended):Extended;
begin
result:=sin(q)/cos(q);
end;
procedure L_A_w_JS(hp_data:Thp_data;rt:Extended;var l,a,w:Tdata_array);
var hpn,i:integer;
ly,x,sy,sw:tdata_array;
begin
hpn:=length(hp_data)-1;
setlength(l,hpn);
setlength(a,hpn);
setlength(w,hpn);
xyy(hp_data,x,sy,ly,sw);
FOR I := 0 TO hpN-1do
begin
l:= SQRT((ly - ly[i+1])*(ly - ly[i+1]) + (x - x[i+1]) * (x - x[i+1]));
a:= arcTaN((ly - ly[i+1]) / (x[i+1] - x));
W:= ABS((sy[i+1] + sy - ly - ly[i+1]) * (x[i+1] - x) *0.5 * rt);
end;
end;
procedure P_js(hp_data:Thp_data;rt:single;var pp1,p1,p2,p3:Extended);
var m,n,pp2,pp3,s:Extended;
hpn,i:integer;
w,l,a:tdata_array;
begin
L_A_w_JS(hp_data,rt,l,a,w);
hpn:=length(hp_data)-1;
pp1:=0;
pp2:=0;
pp3:=0;
p2:=0;
p3:=0;
p1:=0;
FOR I:=0 TO hpN-1do
begin
if a>=0then
begin
m:=W*SIN(a)*COS(a);
pp1:=pp1+m;
n:=W*COS(a)*COS(a);
pp2:=pp2+n;
s:=l*COS(a);
pp3:=pp3+s;
end
else
begin
m:=ABS(W*SIN(a)*COS(a));
p1:=p1+m;
n:=W*COS(a)*COS(a);
p2:=p2+n;
s:=ABS(l*COS(a));
p3:=p3+s;
end;
end;
p2:=p2+pp2;
p3:=p3+pp3;
end;
function C_JS(hp_data:Thp_data;rt,Q,k1:Extended):Extended;
var pp1,p1,p2,p3:Extended;
begin
p_js(hp_data,rt,pp1,p1,p2,p3);
result:=(pp1*k1-p1-p2*myTan(Q* pi / 180))/p3;
end;
function Q_JS(hp_data:Thp_data;rt,c1,k:single):single;
var pp1,p1,p2,p3,q,aa:Extended;
begin
p_js(hp_data,rt,pp1,p1,p2,p3);
Q:= arcTaN((pp1 * k - p1 - c1 * p3) / p2);
Q:= trunc(Q * 180 / pi * 10 + 0.5) / 10 ;
//
result:=Q;
end;
function u_js(a1,a2,Q:single):single;
var t1,t2:single;
begin
t1:=Q * pi / 180;
t2:=myTAN(Q * pi / 180);
result:= COS(a1 - a2) - abs(SIN(a1 - a2) * myTAN(Q * pi / 180));
// result:= COS(a[I-1] - a) - abs(SIN(a[I-1] - a) * TAN(Q * pi / 180));
end;
function K_JS(hp_data:Thp_data;c,Q,rt:Extended;dz:integer):Extended;
var
i,hpn:integer;
u,r1,t1,deg,f:single;
w,l,a,r,t:tdata_array;
begin
hpn:=length(hp_data)-1;
L_A_w_JS(hp_data,rt,l,a,w);
setlength(r,hpn);
setlength(t,hpn);
IF dz = 0 then
deg:= 0 ;
IF dz =4 then
deg:= 0.016 ;
IF dz =5 then
deg:= 0.032 ;
IF dz =6 then
deg:= 0.065 ;
FOR I := 0 TO hpn-1 do
begin
F:=deg*W;
R1 := (W * COS(a)- F * SIN(a)) * myTAN(Q* pi / 180) + C* l;
T1:= W * SIN(a)+ F * COS(a);
if i=0 then
begin
u:= 0;
R[0]:= R1;
T[0]:=T1;
end
else
begin
u:=u_js(a[I-1],a,Q);
R:= R[I-1] * u + R1;
T:= T[I-1] * u + T1;
end;
end;
result:= trunc(100 * R[I-1] / T[I-1] + 0.5) / 100;
end;
end.