gauss.pas

带有MathParser控件的高斯积分,可以计算各种复合函数的积分

unit gauss;

interface

uses
  Windows, Messages, SysUtils, StrUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, Spin, ComCtrls, Parser, sgr_def, sgr_data;

type
  TForm1 = class(TForm)
    formule: TComboBox;
    run: TButton;
    sg: TStringGrid;
    clear: TButton;
    MathParser: TMathParser;
    exit: TButton;
    Label1: TLabel;
    Memo: TMemo;
    XYPlot: Tsp_XYPlot;
    graph: TButton;
    func: Tsp_XYLine;
    shadow: Tsp_XYLine;
    X_Axis: Tsp_XYLine;
    function F(t: String):real;
    procedure FormCreate(Sender: TObject);
    procedure graphClick(Sender: TObject);
    procedure runClick(Sender: TObject);
    procedure clearClick(Sender: TObject);
    procedure exitClick(Sender: TObject);
    procedure MathParserGetVar(Sender: TObject; VarName: String;
      var Value: Extended; var Found: Boolean);
    procedure MathParserParseError(Sender: TObject; ParseError: Integer);
    procedure XYPlotClick(Sender: TObject);
    procedure MemoClick(Sender: TObject);
    
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Upper,Lower,UpperLimit,LowerLimit,FMax,FMin,IntegralVal:real;
  A:array[2..6,1..6] of real = ((1.0,1.0,0,0,0,0),(0.5555556,0.8888889,0.5555556,0,0,0),(0.3478548,0.6521452,0.3478548,0.6521452,0,0),(0.2369269,0.4786287,0.5688889,0.2369269,0.4786287,0),(0.17132449,0.36076157,0.46791393,0.17132449,0.36076157,0.46791393));
  X:array[2..6,1..6] of real = ((0.5773503,-0.5773503,0,0,0,0),(0.7745967,0,-0.7745967,0,0,0),(0.8611363,0.3399810,-0.8611363,-0.3399810,0,0),(0.9061798,0.5384693,0,-0.9061798,-0.5384693,0),(0.93246951,0.66120939,0.23861919,-0.93246951,-0.66120939,-0.23861919));
  Const Pi:real = 3.1415926536;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
Var
  MyList: TStringList;
begin
  formule.Text:='sqr(x)';
  MyList:= TStringList.Create;
  try
    MyList.Add('sqr(x)');
    MyList.Add('sqrt(x)');
    MyList.Add('sin(x)');
    MyList.Add('cos(x)');
    MyList.Add('exp(x)');
    MyList.Add('ln(x)');
    MyList.Add('(exp(x)-exp(-x))/2');
    MyList.Add('(exp(x)+exp(-x))/2');
    formule.Items.AddStrings(MyList);
  finally
    MyList.Free;
  end;
  memo.Text:='本程序运用了 MathParser 控件，如下函数可任意复合、嵌套：abs(x),sin(x),cos(x),atan(x),exp(x),ln(x),sqr(x),sqrt(x),round(x)(取小数部函数),trunc(x)(取整数部函数)(圆周率为 Pi)。'+#13#10;
  sg.Cells[0,0]:='节点：';
  sg.Cells[0,1]:='下限：';
  sg.Cells[0,2]:='上限：';
  sg.Cells[1,0]:='6';

end;

procedure TForm1.clearClick(Sender: TObject);
begin
  memo.Text:='本程序运用了 MathParser 控件，如下函数可任意复合、嵌套：abs(x),sin(x),cos(x),atan(x),exp(x),ln(x),sqr(x),sqrt(x),round(x)(取小数部函数),trunc(x)(取整数部函数)(圆周率为 Pi)。'+#13#10;
end;

procedure TForm1.exitClick(Sender: TObject);
begin
  close;
end;

procedure TForm1.MathParserGetVar(Sender: TObject; VarName: String;
  var Value: Extended; var Found: Boolean);
begin
  Found := True;
  if (VarName = 'Upper') then
    Value := Upper
  else if (VarName = 'Lower') then
    Value := Lower
  else if (VarName = 'Pi') then
    Value := Pi
  else
    Found := False;
end;

function TForm1.F(t:string):real;
begin
  with MathParser do
  begin
    if AnsiContainsStr(formule.Text,'exp') then
    begin
      ParseString:=AnsiReplaceText(formule.Text,'exp','ep');
      ParseString:=AnsiReplaceText(ParseString,'x','('+t+')');
      ParseString:=AnsiReplaceText(ParseString,'ep','exp');
    end
    else ParseString:=AnsiReplaceText(formule.Text,'x',t);
    parse;
    if FMax<ParseValue then
      FMax:=ParseValue;
    if FMin>ParseValue then
      FMin:=ParseValue;
    F:=ParseValue;
  end;
end;

procedure TForm1.graphClick(Sender: TObject);
var
  j:integer;
  p:real;
begin
  with MathParser do
  begin
    FMax:=0;
    FMin:=0;
    func.Clear;
    shadow.Clear;
    X_Axis.Clear;
    XYPlot.Visible:=true;
    memo.Visible:=false;
    for j:=0 to 60 do
    begin
      p:=j*(UpperLimit-LowerLimit)/60+LowerLimit;
      F(FloatToStr(p));
      if j mod 2 = 1 then
      begin
        shadow.AddXY(p,0);
        shadow.AddXY(p,ParseValue);
      end
      else begin
        shadow.AddXY(p,ParseValue);
        shadow.AddXY(p,0);
      end;
      func.AddXY(p,ParseValue);
    end;
    F(FloatToStr(LowerLimit));
    X_Axis.AddXY(LowerLimit,ParseValue);
    X_Axis.AddXY(LowerLimit,0);

    X_Axis.AddXY(UpperLimit,0);
    F(FloatToStr(UpperLimit));
    X_Axis.AddXY(UpperLimit,ParseValue);
    if IntegralVal<0 then
      shadow.LineAttr.Style:=psDot
    else shadow.LineAttr.Style:=psSolid;
  end;
  XYPlot.Visible:=true;
  memo.Visible:=false;
  graph.Enabled:=false;
end;


procedure TForm1.runClick(Sender: TObject);
var
  node,i: Integer;
  t:string;
begin
  XYPlot.Visible:=false;
  memo.Visible:=true;
  node:=StrToInt(sg.Cells[1,0]);
  with MathParser do
  begin
    integralVal:=0;
    ParseError:=false;
    if (sg.Cells[1,2]='') or (sg.Cells[1,1]='') then
    begin
      showmessage('UpperLimit or LowerLimit value expected!');
      ParseError:=true;
    end
    else begin
      ParseString:=sg.Cells[1,2];
      Parse;
      UpperLimit:=ParseValue;
      ParseString:=sg.Cells[1,1];
      Parse;
      LowerLimit:=ParseValue;
    end;
    Upper:= (UpperLimit-LowerLimit)/2;
    Lower:= (UpperLimit+LowerLimit)/2;
    if (node > 6) or (node < 2) then
    begin
      showmessage('Node in 2 ~ 6 expected!');
      ParseError:=true;
    end;
    
    for i:=1 to node do
    begin
      if ParseError then
      begin
        memo.Text:='Stoped by error, inspect each item!'+#13#10+#13#10+memo.Text;
        break;
      end;
      t:='(Upper*'+FloatToStr(X[node,i])+'+Lower)';
      integralVal:=integralVal+A[node,i]*Upper*F(t);
    end;
    if abs(integralVal)<1E-10 then
      integralVal:=0;

    if ParseError=false then
      memo.Text:='当取节点数为 '+IntToStr(node)+' 时，F(x)在 '+FloatToStr(LowerLimit)+' 到 '+FloatToStr(UpperLimit)+' 上的积分值等于： '+FloatToStr(integralVal)+#13#10+#13#10+memo.Text;
  end;
  graph.Enabled:=true;
end;

procedure TForm1.MathParserParseError(Sender: TObject;
  ParseError: Integer);
var
  Msg : string;
begin
  case ParseError of
    1 : Msg := 'Parser stack overflow.';
    2 : Msg := 'Bad cell range.';
    3 : Msg := 'Expected expression.';
    4 : Msg := 'Expected operator.';
    5 : Msg := 'Expected opening parenthesis.';
    6 : Msg := 'Expected operator or closing parenthesis.';
    7 : Msg := 'Invalidad numeric expression.';
  end; { case }
  Msg := Msg + ' Position in string: ' + IntToStr(MathParser.Position);
  MessageDlg(Msg, mtError, [mbOk], 0);
  {formule.SelStart := Pred(MathParser.Position);
  formule.SelLength := 0;}
end;



procedure TForm1.XYPlotClick(Sender: TObject);
begin
  XYPlot.Visible:=false;
  memo.Visible:=true;
end;

procedure TForm1.MemoClick(Sender: TObject);
begin
  XYPlot.Visible:=true;
  memo.Visible:=false;
end;

end.