unitdllfunctiontcompilecomplex.pas

酒店管理VB源码

unit UnitDllFunctionTCompileComplex;

       /////////////////////////////////////////////////////////////////////////////////
       //                                                                             //
       //  复学函数动态编译器TCompileComplex类 的dll函数封装  作者:侯思松  2003.3.23  //
       //               有改进意见或发现任何错误请转告我,本人不胜感激。               //
       //                          E-Mail:[e-mail]                           //
       //                         (  转载时请保留本说明:)  )                          //
       //                                                                             //
       /////////////////////////////////////////////////////////////////////////////////

       ///>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>///
       ///  <<功能简介>>:                                                             ///
       ///     TCompileComplex可以在程序运行过程中动态完成复数函数表达式字符串的      ///
       ///  编译执行,(可以带复数参数;动态生成机器码执行,不是解释执行)执行速度超快!!   ///
       ///<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<///

interface
uses
  windows,SysUtils,math,CompileComplex_Hss,Complex_Hss;

  type
    cmcx_Handle = DWord;

  const
    cmcx_Max_ParameterName_Length =256;

  type
    cmcx_TUserParameterList =record
      CName     :array [0..cmcx_Max_ParameterName_Length-1] of Char;  //参数名称
      CAddress  :PTComplex;                                           //参数地址
    end;
  type cmcx_PTUserParameterList = ^cmcx_TUserParameterList;

  //创建复数编译类，成功返回复数编译类句柄，失败返回0; 不用时调用cmcx_CloseTCompileComplex关闭句柄
  //其它函数需要传递该值作为第一个参数
  function  cmcx_CreateTCompileComplex():cmcx_Handle;stdcall;
  
  //关闭复数编译类句柄，释放空间
  function  cmcx_CloseTCmcxHandle(const hcmcx: cmcx_Handle):Longbool;stdcall;

  // 调用函数返回表达式的值(实参数值列表); //等价于 cmcx_SetFunctionParameter + cmcx_GetValue
  procedure cmcx_GetFunctionValue(const hcmcx: cmcx_Handle; const PList: PTComplex ;const PResult: PTComplex);stdcall; // (编译后才能调用)

  // 调用函数返回表达式的值;
  procedure  cmcx_GetValue(const hcmcx: cmcx_Handle;const PResult: PTComplex);stdcall;//(编译后才能调用)

  // 按当前设置的参数表传入参数值(实参数值列表)
  procedure cmcx_SetFunctionParameter(const hcmcx: cmcx_Handle; const PList: PTComplex);stdcall;  // (编译前后都能调用)

  // 设置需要编译的字符串(要编译的字符串,虚参数列表字符串,是否自动编译);
  //    比如：Value:='Sqr(x)+Sqr(y)'; ParameterList:='x,y' ;
  function  cmcx_SetText(const hcmcx: cmcx_Handle; const TextValue:PChar;
                       const ParameterList : PChar;const IfCompile:longbool):longbool;stdcall;//(编译前调用，这是最先要做的)
  // 编译当前字符串
  function  cmcx_Compile(const hcmcx: cmcx_Handle):longbool;stdcall;

  // 测试是否使用了未定义的变量
  function  cmcx_IfHaveUnDefineParameter(const hcmcx: cmcx_Handle):longbool;stdcall; //(编译后才能调用)

  //设置一个外部变量(外部变量名称，外部变量地址); 这样就可以和高级语言或另一个复数编译类共享变量了
  function  cmcx_SetExteriorParameter(const hcmcx: cmcx_Handle;const PName:PChar;const PAddress:PTComplex):longbool;stdcall;
  //(编译前调用,如果是在编译后，需要调用cmcx_RefreshExeAddressCodeInPointer刷新地址)

  // 设置外部数组(数组名称,数组地址);
  function  cmcx_SetExteriorArrayParameter(const hcmcx: cmcx_Handle;const ArrayPName:PChar;const ArrayPAddress:PTComplex):longbool;stdcall;
  //(编译前调用,如果是在编译后，需要调用cmcx_RefreshExeAddressCodeInPointer刷新地址)

  //刷新变更地址  //(设置完所有的外部变量以后需要调用一次该函数)
  procedure cmcx_RefreshExeAddressCodeInPointer(const hcmcx: cmcx_Handle)stdcall;

  // 处理预定义宏(要代换的标识符,代换为的描述字符串); // 可以用来处理常数,甚至定义新的函数!
  //   如 Key:='a'; Value:='-0.5' , 或 Key:='f(x,y)',Value:='Max(x,Sin(y))' 等;
  function  cmcx_Define(const hcmcx: cmcx_Handle;const Key,Value : PChar):longbool;stdcall; //(编译前调用)

  // 处理常数定义(要代换的标识符,代换的值)  // 常数定义, Value必须是一个可计算的值
  //   如 Key:='a'; Value:='2' , 或 Key:='b' , Value:='2*sin(PI/2)' 等;
  //   该功能完全可以用预定义宏(Define)来代替，
  //   但当值为常数时这样处理有可能使最后得到的编译函数速度更快，并加快编译速度
  function  cmcx_DefineConst(const hcmcx: cmcx_Handle;const Key,Value: PChar):longbool;stdcall; //(编译前调用)

  //根据参数名称PName得到参数地址值
  function  cmcx_GetParameterAddress(const hcmcx: cmcx_Handle;const PName:PChar):PTComplex;stdcall;

  //按参数名称PName设置参数值dValue
  function  cmcx_SetParameterN(const hcmcx: cmcx_Handle;const PName:PChar;const dValue:TComplex):longbool;stdcall;

  //按参数地址PAddress设置参数值dValue
  procedure cmcx_SetParameterA(const hcmcx: cmcx_Handle;const PAddress:PTComplex;const dValue:TComplex);stdcall;

  //得到参数PName的值
  procedure cmcx_GetParameterValue(const hcmcx: cmcx_Handle;const PName:PChar;const PResult: PTComplex);stdcall;

  //得到参数的总数目(不包括常数)
  Function  cmcx_GetUserParameterCount(const hcmcx: cmcx_Handle):DWord;stdcall;

  //通过PList返回参数列表(不包括常数)
  procedure cmcx_GetUserParameterList(const hcmcx: cmcx_Handle;const PList:cmcx_PTUserParameterList);stdcall;

  //测试参数PName是否已经存在
  function  cmcx_IfHaveParameter(const hcmcx: cmcx_Handle;const PName:PChar):longBool;stdcall;

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

  procedure cmcx_SetEnabledNote(const hcmcx: cmcx_Handle;const Value:longbool);stdcall;          //是否允许使用注释   (默认false)
  procedure cmcx_SetEnabledOptimizeDiv(const hcmcx: cmcx_Handle;const Value:longbool); stdcall;  //是否要优化常数浮点除法运算  (默认true)
  procedure cmcx_SetEnabledOptimizeStack(const hcmcx: cmcx_Handle;const Value:longbool);stdcall; //是否要优化堆栈  (默认true)
  procedure cmcx_SetEnabledOptimizeConst(const hcmcx: cmcx_Handle;const Value:longbool); stdcall;//是否要优化常数运算 (默认true)
  Function  cmcx_GetVersion():double;stdcall;   // 获得版本号

  function  cmcx_GetErrorCode(const hcmcx: cmcx_Handle):integer;stdcall;  //返回错误代码号
  Function  cmcx_GetExeCodeLength(const hcmcx: cmcx_Handle):integer; stdcall; //返回编译以后的程序指令区代码长度(字节)
  Function  cmcx_GetExeParameterLength(const hcmcx: cmcx_Handle):integer;stdcall;  //返回编译以后的程序数据区代码长度(字节)


  procedure  VB_cmcx_GetValue(const hcmcx: cmcx_Handle;const RReal,RImag :PDouble);stdcall;
  procedure  VB_cmcx_GetFunctionValue(const hcmcx: cmcx_Handle; const PList: PDouble ;const RReal,RImag :PDouble);stdcall; // (编译后才能调用)
  procedure  VB_cmcx_SetFunctionParameter(const hcmcx: cmcx_Handle; const PList: PDouble );stdcall;
  function   VB_cmcx_SetParameterN(const hcmcx: cmcx_Handle;const PName:PChar;const dValueRe,dValueIm:double):longbool;stdcall;
  procedure  VB_cmcx_SetParameterA(const hcmcx: cmcx_Handle;const PAddress:PTComplex;const dValueRe,dValueIm:Double);stdcall;
  procedure  VB_cmcx_GetParameterValueN(const hcmcx: cmcx_Handle;const PName:PChar;const RReal,RImag :PDouble);stdcall;
  procedure  VB_cmcx_GetParameterValueA(const PAddress:PTComplex;const RReal,RImag:PDouble); stdcall;


  (*
  //错误号定义
  const csTCmCx_NoError              =   0;   //没有发现错误!
        csTCmCx_NoKnownError         = 101;   //不知道的错误!
        csTCmCx_NoErrorCode          = 102;   //找不到错误号所对应的错误描述!
        csTCmCx_CompileHexCodeError  = 103;   //编译时指令的十六进制代码错误!
        csTCmCx_HexMod2_EQ_1_Error   = 104;   //编译时传入指令长度错误!
        csTCmCx_PMMarker_Error       = 105;   //编译得到参数名称时发生错误!
        csTCmCx_FMMarker_Error       = 106;   //编译得到函数名称时发生错误!
        csTCmCx_Wording_Error        = 107;   //语法发生错误!
        csTCmCx_Bracket_Error        = 108;   //语法错误,在 ( ) 处!
        csTCmCx_Optimize_Error       = 109;   //编译优化时发生错误!
        csTCmCx_Define_Error         = 110;   //函数编译错误(或超出定义域)!
        csTCmCx_Handwriting_Error    = 111;   //函数书写格式错误!
        
        csTCmCx_ReadFloat_Error      = 113;   //编译读取常数数字时发生错误!
        csTCmCx_ReadMarker_Error     = 114;   //编译读取标识符时发生错误!
        csTCmCx_Read_Error           = 115;   //语法错误,有不识别的字符!
        csTCmCx_Note_Match_Error     = 116;   //注释符号不匹配!  { } 或 /*  */
        csTCmCx_FPList_Error         = 117;   //参数列表错误!
        csTCmCx_IFHandwriting_Error  = 118;   //If函数书写格式错误!
   *)
   
implementation


function  cmcx_CreateTCompileComplex():cmcx_Handle;stdcall;
begin
  result:=DWord(TCompileComplex.Create());
end;

function  cmcx_CloseTCmcxHandle(const hcmcx: cmcx_Handle):Longbool;stdcall;
begin
  if (hcmcx<>0) and (TCompileComplex(hcmcx) is TCompileComplex) then
  begin
    try
      TCompileComplex(hcmcx).Free;
      result:=true;
    except
      result:=false;
    end;
  end
  else
    result:=false;
end;

procedure cmcx_GetValue(const hcmcx: cmcx_Handle;const PResult: PTComplex);stdcall;
begin
  PResult^:=TCompileComplex(hcmcx).GetValue();
end;

procedure  cmcx_GetFunctionValue(const hcmcx: cmcx_Handle; const PList: PTComplex ;const PResult: PTComplex);stdcall;
type
  PArrayTComplex=array of TComplex;
begin
  PResult^:=TCompileComplex(hcmcx).GetFunctionValue(PArrayTComplex(PList));
end;

procedure cmcx_SetFunctionParameter(const hcmcx: cmcx_Handle; const PList: PTComplex);stdcall;
type
  PArrayTComplex=array of TComplex;
begin
  TCompileComplex(hcmcx).SetFunctionParameter(PArrayTComplex(PList));
end;

function  cmcx_SetText(const hcmcx: cmcx_Handle; const TextValue:PChar;
                       const ParameterList : PChar;const IfCompile:longbool):longbool;stdcall;
begin
  result:=TCompileComplex(hcmcx).SetText(TextValue,ParameterList,IfCompile);
end;

function  cmcx_Compile(const hcmcx: cmcx_Handle):longbool;stdcall;
begin
  result:=TCompileComplex(hcmcx).Compile();
end;


function  cmcx_IfHaveUnDefineParameter(const hcmcx: cmcx_Handle):longbool;stdcall;
begin
  result:=TCompileComplex(hcmcx).IfHaveUnDefineParameter();
end;

function  cmcx_SetExteriorParameter(const hcmcx: cmcx_Handle;const PName:PChar;const PAddress:PTComplex):longbool;stdcall;
begin
  result:=TCompileComplex(hcmcx).SetExteriorParameter(PName,PAddress);
end;

function  cmcx_SetExteriorArrayParameter(const hcmcx: cmcx_Handle;const ArrayPName:PChar;const ArrayPAddress:PTComplex):longbool;stdcall;