unit1.pas

Numeric Programs

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
//PROGRAM D10R3
//Driver for routine REALFT
uses
  unit2;
  {$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
const
  s1='%13.6f'; s2 = '##';
  NP = 32;  NPP2 = NP + 2;  WIDTH1 = 50;  PI = 3.1415926; EPS = 0.001;
var
  DATA:array[0..34] of real;  SIZE1:array[0..32] of real;
  I,J,N,ISIGN,NLIM:integer;   X,PER,BIG,SCAL1,SMALL:real;
  STR1:String;  F:TextFile;
begin
  //输出计算结果到文件
  AssignFile(F, 'd:\delphi_shu\p10\d10r3.dat');
  Rewrite(F);
  N:= NP div 2;
  Writeln(F, 'Period of sinusoid in channels (2-',FormatFloat(S2,NP),
                                               '; or 0 to stop)');
  PER:= 32;
  Writeln(F,FormatFloat(S2,PER));
  If PER <= 0 Then Exit;
  For I:= 1 To NP do
    DATA[I]:= Cos(2 * PI * (I - 1) / PER);
  REALFT(DATA, N, 1);
  BIG:= -1.e10;
  For I:= 1 To N do
  begin
    SIZE1[I]:= Sqrt(Sqr(DATA[2 * I - 1]) + Sqr(DATA[2 * I]));
    If I = 1 Then SIZE1[I]:= DATA[I];
    If SIZE1[I] > BIG Then BIG:= SIZE1[I];
  end;
  SCAL1:= Width1 / BIG;
  For I:= 1 To N do
  begin
    NLIM:= Trunc(SCAL1 * SIZE1[I] + EPS);
    STR1:='';
    For J:= 1 To NLIM + 1 do
      STR1:=STR1 + '*';
    Writeln(F,'  ',FormatFloat(s2,I),'  ', STR1);
  end;
  REALFT(DATA, N, -1);
  BIG:= -1e10;
  SMALL:= 1e10;
  For I:= 1 To NP do
  begin
    If DATA[I] < SMALL Then SMALL:= DATA[I];
    If DATA[I] > BIG Then BIG:= DATA[I];
  end;
  SCAL1:= Width1 / (BIG - SMALL);
  For I:= 1 To NP do
  begin
    NLIM:= Trunc(SCAL1 * (DATA[I] - SMALL) + EPS);
    STR1:='';
    For J:= 1 To NLIM + 1 do
      STR1:=STR1 + '*';
    Writeln(F,'  ',FormatFloat(s2,I),'  ', STR1);
  end;
  CloseFile(F);
  //屏幕显示计算结果
  memo1.Lines.LoadFromFile('d:\delphi_shu\p10\d10r3.dat');
end;

end.