hwexpr.pas

用于Delphi程序中嵌入公式解析

        NDF : array [TDF] of PChar =
              ('NOW', 'DATE', 'TIME', 'DAYOFWEEK', 'DATETOSTR',
               'TIMETOSTR', 'DATETIMETOSTR', 'ENCODETIME', 'ENCODEDATE', 'INCMONTH',
               'STRTODATE', 'STRTOTIME', 'STRTODATETIME', 'ISLEAPYEAR', 'FORMATDATETIME',
               'YEAR', 'MONTH', 'DAT', 'HOUR', 'MINUTE', 'SECOND');

{ ============================================================================
  >>>>   Class Implementation Begin                                       <<<<
  >>>>   Class Name  : 标准字符串函数。包括UpperCase, LowerCase, Copy
  >>>>   Description :
  >>>>   Create Date :
  ---------------------------------------------------------------------------- }
constructor TStringExpression.Create(aParameterList : TParameterList; aOperator  : TSF);
begin
        inherited Create(aParameterList);
        Operator:= aOperator
end;
{-----------------------------------------------------------------------------
     >>>>  TStringExpression.AsInteger   <<<<  Begin
-----------------------------------------------------------------------------}
function TStringExpression.AsInteger: integer;
begin
        case Operator of
            sfPos: Result   := Pos(Param[0].AsString, Param[1].AsString);
            sfLength: Result:= Length(Param[0].AsString);
            else
                Result:= inherited AsInteger
        end
end;
{-----------------------------------------------------------------------------
     >>>>  TStringExpression.AsString   <<<<  Begin
-----------------------------------------------------------------------------}
function TStringExpression.AsString: string;
begin
        case Operator of
            sfUpper: Result:= UpperCase(Param[0].AsString);
            sfLower: Result:= LowerCase(Param[0].AsString);
            sfCopy: Result :=  Copy(Param[0].AsString, Param[1].AsInteger, Param[2].AsInteger);
            else
                Result:= inherited AsString;
        end
end;
{-----------------------------------------------------------------------------
     >>>>  TStringExpression.ExprType   <<<<  Begin
-----------------------------------------------------------------------------}
function TStringExpression.ExprType: TExprType;
begin
        case Operator of
            sfUpper, sfLower, sfCopy: Result:= ttString;
            else
                Result:= ttInteger;
        end
end;
{-----------------------------------------------------------------------------
     >>>>  TStringExpression.TestParameters   <<<<  Begin
-----------------------------------------------------------------------------}
function TStringExpression.TestParameters: boolean;
begin
        case Operator of
            sfUpper, sfLower, sfLength:
                Result:= (ParameterCount = 1) and
                    Param[0].CanReadAs(ttString);
            sfCopy:
                Result:= (ParameterCount = 3) and
                    Param[0].CanReadAs(ttString) and
                    (Param[1].ExprType = ttInteger) and
                    (Param[2].ExprType = ttInteger);
            sfPos:
                Result:= (ParameterCount = 2) and
                    Param[0].CanReadAs(ttString) and
                    Param[1].CanReadAs(ttString);
            else
                Result:= False;
        end;
end;

{ ============================================================================
  >>>>   Class Implementation Begin                                       <<<<
  >>>>   Class Name  : TMathExpression
  >>>>   Description : 标准数学函数，包括Abs, ArcTan, Cos, Sin, Exp, Frac,
                       Int, Ln, Pi, Sqr, Sqrt等 
  >>>>   Create Date :
  ---------------------------------------------------------------------------- }
constructor TMathExpression.Create(aParameterList : TParameterList;
        aOperator :         TMF);
begin
        inherited Create(aParameterList);
        Operator:= aOperator
end;
{-----------------------------------------------------------------------------
     >>>>  TMathExpression.AsFloat   <<<<  Begin
-----------------------------------------------------------------------------}
function TMathExpression.AsFloat: double;
begin
        case Operator of
            mfAbs: Result   := Abs(Param[0].AsFloat);
            mfArcTan: Result:= ArcTan(Param[0].AsFloat);
            mfCos: Result   := Cos(Param[0].AsFloat);
            mfExp: Result   := Exp(Param[0].AsFloat);
            mfFrac: Result  := Frac(Param[0].AsFloat);
            mfInt: Result   := Int(Param[0].AsFloat);
            mfLn: Result    := Ln(Param[0].AsFloat);
            mfPi: Result    := Pi;
            mfSin: Result   := Sin(Param[0].AsFloat);
            mfSqr: Result   := Sqr(Param[0].AsFloat);
            mfSqrt: Result  := Sqrt(Param[0].AsFloat);
            mfPower: Result :=  Exp(Param[1].AsFloat * Ln(Param[0].AsFloat))
        else
            Result:= inherited AsFloat;
        end
end;
{-----------------------------------------------------------------------------
     >>>>  TMathExpression.AsInteger   <<<<  Begin
-----------------------------------------------------------------------------}
function TMathExpression.AsInteger: integer;
begin
        case Operator of
            mfTrunc: Result:= Trunc(Param[0].AsFloat);
            mfRound: Result:= Round(Param[0].AsFloat);
            mfAbs: Result  := Abs(Param[0].AsInteger);
        else
                Result:= inherited AsInteger;
        end
end;
{-----------------------------------------------------------------------------
     >>>>  TMathExpression.ExprType   <<<<  Begin
-----------------------------------------------------------------------------}
function TMathExpression.ExprType: TExprType;
begin
        case Operator of
            mfTrunc, mfRound: Result:= ttInteger;
            else
                Result:= ttFloat;
        end
end;
{-----------------------------------------------------------------------------
     >>>>  TMathExpression.TestParameters   <<<<  Begin
-----------------------------------------------------------------------------}
function TMathExpression.TestParameters: boolean;
begin
        Result:= True;
        case Operator of
            mfTrunc, mfRound, mfArcTan, mfCos, mfExp, mfFrac, mfInt,
            mfLn, mfSin, mfSqr, mfSqrt, mfAbs:
                begin
                    Result:= (ParameterCount = 1) and
                        Param[0].CanReadAs(ttFloat);
                end;
            mfPower:
                begin
                    Result:= (ParameterCount = 2) and
                        Param[0].CanReadAs(ttFloat) and
                        Param[1].CanReadAs(ttFloat);
                end;
        end
end;
{ ============================================================================
  >>>>   Class Implementation Begin                                       <<<<
  >>>>   Class Name  : TDateTimeExpression
  >>>>   Description :
  >>>>   Create Date :
  ---------------------------------------------------------------------------- }
constructor TDateTimeExpression.Create(aParameterList: TParameterList; aOperator: TDF);
begin
        inherited Create(aParameterList);
        Operator := aOperator;
end;
{-----------------------------------------------------------------------------
     >>>>  TDateTimeExpression.TestParameters   <<<<  Begin
-----------------------------------------------------------------------------}
function TDateTimeExpression.TestParameters: Boolean;
begin
        Result := True;
        case Operator of    //
            dfNow, dfDate, dfTime :
                Result := (ParameterList = nil) or (ParameterCount = 0);

            dfStrToDate, dfStrToTime, dfStrToDateTime :
                Result := (ParameterCount = 1) and (Param[0].CanReadAs(ttString));

            dfDateToStr, dfTimeToStr, dfDateTimeToStr,
            dfDayOfWeek, dfYear, dfMonth, dfDay,
            dfHour, dfMinute, dfSecond:
                Result := (ParameterCount = 1) and (Param[0].CanReadAs(ttDateTime));

            dfIsLeapYear:
                Result := (ParameterCount = 1) and (Param[0].CanReadAs(ttInteger));
                
            dfEncodeDate :
                Result := (ParameterCount = 3)
                          and (Param[0].CanReadAs(ttInteger))
                          and (Param[1].CanReadAs(ttInteger))
                          and (Param[2].CanReadAs(ttInteger));
            dfEncodeTime:
                Result := (ParameterCount = 4)
                          and (Param[0].CanReadAs(ttInteger))
                          and (Param[1].CanReadAs(ttInteger))
                          and (Param[2].CanReadAs(ttInteger))
                          and (Param[3].CanReadAs(ttInteger));
            dfIncMonth:
                Result := (ParameterCount = 2)
                          and (Param[0].CanReadAs(ttDateTime))
                          and (param[1].CanReadAs(ttInteger));
            dfFormatDateTime:
                Result := (ParameterCount = 2)
                          and (Param[0].CanReadAs(ttString))
                          and (Param[1].CanReadAs(ttDateTime));
        end;    // case
end;
{-----------------------------------------------------------------------------
     >>>>  TDateTimeExpression.AsDateTime   <<<<  Begin
-----------------------------------------------------------------------------}
function TDateTimeExpression.AsDateTime: TDateTime;
begin
        case Operator of        //
            dfNow           : Result := Now;
            dfDate          : Result := Date;
            dfTime          : Result := Time;
            dfStrToDate     : Result := StrToDate(Param[0].AsString);
            dfStrToTime     : Result := StrToTime(Param[0].AsString);
            dfStrToDateTime : Result := StrToDateTime(Param[0].AsString);
            dfEncodeDate    :
                Result := EncodeDate(Param[0].AsInteger,
                                     Param[1].AsInteger,
                                     Param[2].AsInteger);
                                     
            dfEncodeTime    :
                Result := EncodeTime(Param[0].AsInteger,
                                     Param[1].AsInteger,
                                     Param[2].AsInteger,
                                     Param[3].AsInteger);

            dfIncMonth      : Result := IncMonth(Param[0].AsDateTime, Param[1].AsInteger);
        else
            Result := inherited AsDateTime;
        end;        // case
end;
{-----------------------------------------------------------------------------
     >>>>  TDateTimeExpression.AsString   <<<<  Begin
-----------------------------------------------------------------------------}
function TDateTimeExpression.AsString: string;
begin
        case Operator of        //
            dfDateToStr      : Result := DateToStr(Param[0].AsDateTime);
            dfTimeToStr      : Result := TimeToStr(Param[0].AsDateTime);
            dfDateTimeToStr  : Result := DateTimeToStr(Param[0].AsDateTime);
            dfFormatDateTime : Result := FormatDateTime(Param[0].AsString, Param[1].AsDateTime);
        else
            Result := inherited AsString;
        end;        // case
end;
{-----------------------------------------------------------------------------
     >>>>  TDateTimeExpression.AsInteger   <<<<  Begin
-----------------------------------------------------------------------------}
function TDateTimeExpression.AsInteger: integer;
var     iYear, iMonth, iDay, iHour, iMinute, iSecond, iMSec: word;
begin
        Result := 0;
        case Operator of        //
            dfDayOfWeek : Result := DayOfWeek(Param[0].AsDateTime);
            dfYear, dfMonth, dfDay :
            begin
                DecodeDate(Param[0].AsDateTime, iYear, iMonth, iDay);
                case Operator of        //
                    dfYear  : Result := iYear;
                    dfMonth : Result := iMonth;
                    dfDay   : Result := iDay;
                end;        // case
            end;

            dfHour, dfMinute, dfSecond:
            begin
                DecodeTime(Param[0].AsDateTime, iHour, iMinute, iSecond, iMSec);
                case Operator of        //
                    dfHour   : Result := iHour;
                    dfMinute : Result := iMinute;
                    dfSecond : Result := iSecond;
                end;        // case
            end;
        else
            Result := inherited AsInteger;
        end;        // case
end;
{-----------------------------------------------------------------------------
     >>>>  TDateTimeExpression.AsBoolean   <<<<  Begin
-----------------------------------------------------------------------------}
function TDateTimeExpression.AsBoolean: Boolean;
begin
        if Operator = dfIsLeapYear then
            Result := IsLeapYear(Word(Param[0].AsInteger))
        else Result := inherited AsBoolean;
end;
{-----------------------------------------------------------------------------
     >>>>  TDateTimeExpression.ExprType   <<<<  Begin
-----------------------------------------------------------------------------}
function TDateTimeExpression.ExprType: TExprType;
begin
        case Operator of        //
            dfNow, dfDate, dfTime, dfStrToDate,
            dfStrToTime, dfStrToDateTime, dfEncodeDate,
            dfEncodeTime, dfIncMonth :
                Result := ttDateTime;

            dfDayOfWeek, dfYear, dfMonth,
            dfDay, dfHour, dfMinute, dfSecond :
                Result := ttInteger;

            dfTimeToStr, dfDateToStr,
            dfDateTimeToStr, dfFormatDateTime :
                Result := ttString;

            dfIsLeapYear :
                Result := ttBoolean;
        end;        // case
end;

{ ============================================================================
  >>>>   Class Implementation Begin                                       <<<<
  >>>>   Class Name  : TTypeCase
  >>>>   Description : 类型转换函数，提供简单的基本数据类型转换
  >>>>   Create Date :
  ---------------------------------------------------------------------------- }
constructor TTypeCast.Create(aParameterList : TParameterList;
        aOperator :         TExprType);
begin
        if aOperator = ttEnumerated then
            raise EExpression.Create('不能转换为枚举型');
        if aParameterList.Count = 1 then
            OperandType:= aParameterList.Param[0].ExprType
        else
            raise EExpression.Create('TypeCase的参数无效');

        if (aOperator = ttObject) and
            (OperandType <> ttObject) then
            IncompatibleTypes(aOperator, OperandType);
  
        { Object类型可以串