unit1.pas

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

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;
Function FUNC(X:real):real;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
//PROGRAM D8R1
//Driver for routine EULSUM
uses
  unit2;
  {$R *.DFM}
var
  F:TextFile;
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;

Function FUNC(X:real):real;
begin
    FUNC:=BESSJ0(X);
end;

Procedure SCRSHO;
const
    s1 = '%10.6f';  s2 = '%4.1f';
var
    ISCR,JSCR,I,J,JZ:integer;  X,X1,X2,DX,YBIG,YSML,DYJ:real;
    Y:array[0..60] of real;
    SCR:array of array of string;
    BLANK,ZERO,YY,XX,FF,STR1,STR2:string;
begin
    SetLength(SCR,61,22);
    ISCR:=60;
    JSCR:=21;
    BLANK:=' ';
    ZERO:='-';
    YY:='1';
    XX:='-';
    FF:='x';
    //Enter X1,X2 (X1=X2 to stop)
    X1:=-5; 
    X2:=5; 
    If X1 = X2 Then Exit ;
    For J:=1 To JSCR do
    begin
        SCR[1, J]:=YY;
        SCR[ISCR, J]:=YY;
    end;
    For I:=2 To ISCR - 1 do
    begin
        SCR[I, 1]:=XX;
        SCR[I, JSCR]:=XX;
        For J:=2 To JSCR - 1 do
            SCR[I, J]:=BLANK;
    end;
    DX:=(X2 - X1) / (ISCR - 1);
    X:=X1;
    YBIG:=0 ;
    YSML:=YBIG;
    For I:=1 To ISCR do
    begin
        Y[I]:=FUNC(X);
        If Y[I] < YSML Then YSML:=Y[I];
        If Y[I] > YBIG Then YBIG:=Y[I];
        X:=X + DX;
    end; 
    If YBIG = YSML Then YBIG:=YSML + 1 ;
    DYJ:=(JSCR - 1) / (YBIG - YSML);
    JZ:=1 - Round(YSML * DYJ);
    For I:=1 To ISCR do
    begin
        SCR[I, JZ]:=ZERO;
        J:=1 + Round((Y[I] - YSML) * DYJ);
        SCR[I, J]:=FF;
    End;
    STR1:=' ';
    For I:=1 To ISCR do
        STR1:= STR1+SCR[I, JSCR];
    Writeln(F,Format(s1,[YBIG]),' ',STR1);
    For J:=JSCR - 1 DownTo 2 do
    begin
        STR2:=' ';
        For I:=1 To ISCR do
            STR2:= STR2+SCR[I, J];
        Writeln(F,'           ',STR2);
        //Writeln(F);
    End;
    STR1:=' ';
    For I:=1 To ISCR do
        STR1:= STR1+SCR[I, 1];
    Writeln(F,Format(s1,[YSML]),' ',STR1);
    Writeln(F,'           ',Format(s2,[X1]),
    '                                                      ',Format(s2,[X2]));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  //输出计算结果到文件
  AssignFile(F, 'd:\delphi_shu\p8\d8r1.dat');
  Rewrite(F);
  Writeln(F, '      Graph of the Bessel Function J0:');
  Writeln(F);
  SCRSHO;
  CloseFile(F);
  //屏幕显示计算结果
  memo1.Lines.LoadFromFile('d:\delphi_shu\p8\d8r1.dat');
end;
end.