compile_calc.pas

进销存·完整的·有数据库的·非常完整·只得参考

Log      10的对数    Log(x)   或者: Log10(x)  ; x>0               Log(100)=2
Log2     2的对数     Log2(x)                  ; x>0               Log2(8)=3

Abs      绝对值      Abs(x)                                       Abs(-2)=2 ; Abs(2)=2
Rev      倒数        Rev(x)                                       Rev(5)=1/5=0.2
Int      取整        Int(x)   或者: Floor(x)                      (不超过x的最大整数) Int(2.3)=2 ; Int(-2.3)=-3
Trunc    截断取整    Trunc(x)                                     (向零取整) Trunc(2.3)=2 ; Trunc(-2.3)=-2
Round    四舍五入    Round(x)                                     (四舍五入取整)  Round(2.51)=3 ; Round(2.49)=2
Sgn      符号函数    Sgn(x)                                       Sgn(-2)=-1 ;  Sgn(0)=0 ; Sgn(2)=1
Hypot    斜边        Hypot(x,y)                                   Hypot(x,y)=Sqrt(x*x+y*y)
Random   随机函数    Random(x) 或者:RND(x)、Rand(x)               Random(2.5)=2.5*a ,其中a为随机数0<=a<1
        (要产生真正的随机数,而不是固定随机数序列,请在创建或编译完成后
         取得表达式值之前调用一次TCopmile.SetRandomize();函数。)

SinH     双曲正弦    SinH(x)                                      SinH(2)=3.62686040784702=(e^2-e^(-2))/2
CosH     双曲余弦    CosH(x)                                      CosH(2)=3.76219569108363=(e^2+e^(-2))/2
TanH     双曲正切    TanH(x)  或者: tgH(x)                        TanH(2)=0.964027580075817=SinH(2)/CosH(2)
ArcSinH  反双曲正弦  ArcSinH(x)                                   ArcSinH(3.62686040784702)=2
ArcCosH  反双曲余弦  ArcCosH(x)         ; x>=1                    ArcCosH(3.76219569108363)=2
ArcTanH  反双曲正切  ArcTanH(x)  或者: ArctgH(x)                  ArcTanH(0.761594155955765)=1
CotH     双曲余切       CotH(x)  或者: CtgH(x)  ;x<>0             CotH(x)=1/TanH(x)
SecH     双曲正割       SecH(x)                                   SecH(x)=1/CosH(x)
CscH     双曲余割       CscH(x)       ;x<>0                       CscH(x)=1/SinH(x)
ArcCotH  反双曲余切函数 ArcCotH(x) 或者: ArcCtgH(x)   ;x<>0       ArcCtgH(x)=ArcTanH(1/X)  //Delphi6 误为 ArcCotH(x)=1/ArcCot(X) !
ArcSecH  反双曲正割函数 ArcSecH(x)      ;0<x<=1                   ArcSecH(x)=ArcCosH(1/X)  //Delphi6 误为 ArcSecH(x)=1/ArcSec(X) !
ArcCscH  反双曲余割函数 ArcCscH(x)      ;x<>0                     ArcCscH(x)=ArcSinH(1/X)  //Delphi6 误为 ArcCscH(x)=1/ArcCsc(X) !

ff       定积分函数  ff(a,b,x,g(x)) 或者: ff(a,b,x,N,g(x))        ff(-1,1,y,Sqrt(1-y*y))=pi/2
         ( ff函数特别说明:
           函数g(x)是关于'x'的表达式(也可以不含有变量x),这里的自变量x与本函数ff以外的x没有关系;

           ff函数表示 对函数 g(x) 从 a 积到 b 积分,
                      x表示以x为积分变量对函数g(x)积分,
                      N (N>0) 表示 把积分区间分成 N 份来积 ,省略 N 时默认为 1000 ;

           积分函数支持多重积分(较慢)
           (注意: 多重积分和积分套嵌不是一个意思)

           比如求单位球体的体积(R=1)
           二重积分表达式为:
           ff(-1,1,x,                          //x从-1到1积分
              ff(-Sqrt(1-x*x),Sqrt(1-x*x),y,   //y从-Sqrt(1-x*x)到sqrt(1-x*x)积分
                 2*Sqrt(1-x*x-y*y)
                )
             )

           =4.18883330446894
           =4*Pi/3
           =ff(-1,1,x,PI*(1-x*x))   // (求单位球体体积的一重积分表达式)
         )

*)

type
  TFunctionList = record
    FName: string; //函数名称
    FAddress: Pointer; //函数地址入口
    FCCount: 0..2; //函数所需参数个数
  end;

type
  TParameterList = record
    CName: string; //参数名称
    CAddress: PExtended; //参数地址
    CIndex: integer; //参数地址序号
    IfConst: boolean; //是否为常数;  false:变量 true:常数
  end;

type
  TT_PTrue = record
    ifConst: boolean; //编译优化常数时  参数性质  是否为常数
    dValue: Extended; //编译优化常数时  参数性质  值
  end;

type
  TExeAddressPMList = record
    ExeIndex: integer; //插入ExeCode的当前位置序号
    PMIndex: integer; //参数序号
  end;

const
  ExendedFormatLength = 16;
  //Extended类型(10字节)的存储长度, 设为16是为了数据对齐(8字节对齐)

type
  TCompile = class // <<数学函数动态编译器TCompile类>>

  private {私有}

    FEnabledNote: boolean;
    procedure SetEnabledNote(Value: boolean);

  public

    //>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>//
    //    <<对外可见成员 即 接口部分>>    //
    //<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<//

    //Enabled   :boolean;    // 是否有效

    property EnabledNote: Boolean read FEnabledNote write SetEnabledNote default
      false;
    //类的属性:是否允许使用注释

    function SetText(const Value: string): boolean;
    //设置需要编译的字符串Value

    function GetText(): string;
    //获得当前编译的字符串

    function GetValue(): Extended; overload;
    //返回表达式的值 。
    procedure GetValue(var x: Extended); overload;
    //返回表达式的值 ,通过 x 返回。

    function GetParameterAddress(const PName: string): PExtended;
    //根据参数名称PName得到参数地址值
    function SetParameter(const PName: string; const dValue: Extended): boolean;
      overload;
    //按参数名称PName设置参数值dValue
    procedure SetParameter(const PAddress: PExtended; const dValue: Extended);
      overload;
    //按参数地址PAddress设置参数值dValue
    function GetParameterValue(const PName: string): Extended;
    //得到参数PName的值
    function GetParameterCount(): integer;
    //得到参数的总数目(包括常数)
    procedure GetParameterList(var PList: array of TParameterList);
    //通过PList返回参数列表
    function IfHaveParameter(const PName: string): boolean; overload;
    //测试参数PName是否已经存在
    function IfHaveParameter(const dValue: Extended; var cName: string): boolean;
      overload;
    //测试常数dValue是否已经存在 并通过cName返回常数名称

    function GetError(): string;
    //返回错误描述
    function GetErrorCode(): integer;
    //返回错误代码号
    function GetErrorGB(const xErrorCode {错误代码号}: integer): string;
      overload;
    //返回错误描述(中文简体) 要更改错误描述或翻译为其他语言时请改写此函数
    function GetErrorBIG5(const xErrorCode: integer): string; overload;
    //返回错误描述(中文繁体) 这是给的例子
    function GetErrorEnglish(const xErrorCode: integer): string; overload;
    //返回错误描述(英文) 这是给的例子,英语水平有限,希望有大虾更正:)
    function GetExeCodeLength(): integer;
    //返回编译以后的程序指令区代码长度(字节)
    function GetExeParameterLength(): integer;
    //返回编译以后的程序数据区代码长度(字节)

    procedure SetRandomize(); overload;
    //设置随机函数Rnd()的初始种子值为完全随机种子(系统用当前精确到毫秒的时间设置)
    procedure SetRandomize(const RandomSeed: integer); overload;
    //设置随机函数Rnd()的初始种子值

  private

    { Private declarations }

    {私有数据}

    FExeText: string; //表达式
    ErrorCode: integer; //错误描述代码

    RndSeed: array[0..1] of integer; //随机函数种子值

    FunctionList: array[0..128 - 1] of TFunctionList;
    //函数列表,已经有60多个函数了(包括别名)
    PFunctionList: integer; //当前函数信息插入函数列表位置

    FunctionStack: array of string; //函数符号调用堆栈
    PFunctionStack: integer; //函数符号调用堆栈 当前插入位置

    ExeAddressCode: array of byte; //编译以后的执行码
    PExeAddressCode: integer; //当前插入机器指令位置

    ExeAddressList: array of integer; //记录指针位置列表(因为积分函数用到)
    PExeAddressList: integer; //当前插入位置

    ExeAddressPMList: array of TExeAddressPMList;
    //记录指针位置列表(因为参数存储地址用到)
    PExeAddressPMList: integer; //当前插入位置

    ExeAddressTempData: array[0..16 * 1024 - 1] of byte; //临时数据交换地址
    ExeAddressStack: array[0..16 * 1024 - 1] of byte; //数据堆栈地址

    ParameterList: array of TParameterList; //参数列表
    PParameterList: integer; //保存参数列表当前插入位置

    ExeParameter: array of byte; //编译后 参数储存空间
    PExeParameter: integer; //编译后 参数地址 ,当前分配参数位置
    //PExeParameterList:=@ExeParameter[PExeParameter]

    TF00: string; // 比较符号优先级时 Tf00 用来保存上一次的符号

    T_ff_sys_ConstN: integer; //积分变量 序号

    T_PTrueNow: TT_PTrue; //编译优化常数时  当前参数性质
    T_PTrueOld: TT_PTrue; //编译优化常数时  上一个参数性质
    T_PTrueNowList: array of TT_PTrue; //编译优化常数时  参数性质堆栈
    PT_PTrueNowList: integer; //当前参数性质堆栈插入位置

    CompileInPFirst: integer; //第几次调用CompileInP()

    {私有函数}
    procedure Clear();
    function Compile(): boolean; //编译
    function Parsing(var str: string): boolean; //第一遍翻译
    procedure CompileInP(const PName: string); //编译 参数堆栈插入参数
    procedure CompileInPReNew(const dValue: Extended; const Pm: integer);
    //编译 参数堆栈插入参数 (替换)
    procedure CompileOutP(); //编译 弹出参数
    procedure CompileInF(const FName: string); //编译 函数调用
    function GetSign(var str: string): string; //返回 str 的第一个算数符
    function CompareSign(const FName1: string; const FName2: string): integer;
    //比较符号的优先级
    procedure CheckWording(const T1: string; const T2: string);