用于开发税务票据管理的软件

源代码在线查看: unit2.pas

软件大小: 36519 K
上传用户: jill
关键词: 软件
下载地址: 免注册下载 普通下载 VIP

相关代码

				unit Unit2;
				
				interface
				USES
				  unit1;
				Function BESSJ0(X:real):real;
				Procedure ZBRAK(X1, X2:real; N:integer;
				                        var XB1, XB2:array of real;var NB:integer);
				
				implementation
				Function BESSJ0(X:real):real;
				var
				   AAA,BBB,CCC,Y,AX,Z,DDD,EEE,XX:real;
				const
				  P1=1;                    P2=-0.001098628627;
				  P3=0.2734510407e-4;      P4=-0.2073370639e-5;
				  P5=2.093887211E-07;
				  Q1=-0.1562499995e-1;     Q2=0.1430488765e-3;
				  Q3=-0.6911147651e-5;     Q4=7.621095161E-07;
				  Q5=-9.34945152E-08;
				  R1=57568490574;          R2=-13362590354;
				  R3=651619640.7;          R4=-11214424.18;
				  R5=77392.33017;          R6=-184.9052456;
				  S1=57568490411;          S2=1029532985;
				  S3=9494680.718;          S4=59272.64853;
				  S5=267.8532712;          S6=1;
				begin
				  If Abs(X) < 8 Then
				    begin
				      Y:=X * X;
				      BBB:=Y* (R4+ Y* (R5+ Y* R6));
				      AAA:=R1+ Y* (R2+ Y* (R3+ BBB));
				      CCC:=Y* (S3+ Y* (S4+ Y* (S5+ Y* S6)));
				      BESSJ0:= AAA / (S1+ Y* (S2+ CCC));
				    end
				  Else
				    begin
				      AX:=Abs(X);
				      Z:=8/ AX;
				      Y:=Z* Z;
				      XX:= AX- 0.785398164;
				      CCC:=Y* (P3+ Y* (P4+ Y* P5));
				      AAA:=P1+ Y* (P2+ CCC);
				      DDD:=Y* (Q3+ Y* (Q4+ Y* Q5));
				      EEE:=Z* Sin(XX) * (Q1+ Y* (Q2+ DDD));
				      BESSJ0:= Sqrt(0.636619772 / AX) * (Cos(XX) * AAA- EEE);
				    End;
				End;
				
				Procedure ZBRAK(X1, X2:real; N:integer;
				                        var XB1, XB2:array of real;var NB:integer);
				var
				    NBB,I:integer;   X,DX,FP,FC:real;
				begin
				    NBB:=NB;
				    NB:=0;
				    X:=X1;
				    DX:=(X2 - X1) / N;
				    FP:=FUN(X);
				    For I:=1 To N do
				    begin
				        X:=X + DX;
				        FC:=FUN(X);
				        If FC * FP < 0  Then
				        begin
				            NB:=NB + 1;
				            XB1[NB]:=X - DX;
				            XB2[NB]:=X;
				        end;
				        FP:=FC;
				        If NBB = NB Then Exit;
				    end; 
				end;
				
				end.
				 			

相关资源