hwexprextliteral.pas

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

unit hwExprExtLiteral;

interface
uses
        TypInfo,
        Classes,
        SysUtils,
        hwExpr;
const
        Err_OnlyBoolean  = '只能返回逻辑值';
        Err_OnlyInteger  = '只能返回整数值';
        Err_OnlyFloat    = '只能返回浮点数';
        Err_OnlyString   = '只能返回字符串';
        Err_OnlyObject   = '只能返回对象';
        Err_OnlyEnum     = '只能返回枚举值';
        Err_CanntBoolean = '不能返回逻辑值';
        Err_CanntInteger = '不能返回整数值';
        Err_CanntFloat   = '不能返回浮点值';
        Err_CanntString  = '不能返回字符串';
        Err_CanntObject  = '不能返回对象';
        Err_OutOfIndex   = '索引值超出范围';

type
        {*** Charmer Create Begin ***}
        { 对外部定义符号的引用，如引用外部定义的常量、变量等。这些变量在程序中
          以Delphi定义变量的标准进行定义，如 var i: integer; i := 100; }
        TExtRefSymLiteral = class(TExpression)
        Private
            FExtSym: Pointer; //指向外部量的指针
            FSymType: TExprType;
            FSymbolName: string;
        Public
            constructor Create(const AIdentifier: string;
                               PSymAddr: Pointer;
                               const AType: TExprType);
            destructor Destroy; Override;
            function AsBoolean: boolean; override;
            function AsFloat: double; override;
            function AsInteger: integer; override;
            function AsObject: TObject; override;
            function AsString: string; override;
            function ExprType: TExprType; override;
            property SymbolName: string read FSymbolName;
        end;


        { 定义的变量符号，用于CompileFunction }
        TVarLiteral = class(TExpression)
        Private
            FSymbolName: string;
            //FValue: Pointer;
            FBlnValue: Boolean;
            FIntValue: Integer;
            FDblValue: double;
            FStrValue: String;
            FObjValue: TObject;
            FExprType: TExprType;
            //FTypeInfo: PTypeInfo;
            FHasValue: Boolean;
            FInitialized: Boolean;
        Public
            constructor Create(const AIdentifier: string; const AType: TExprType);
            destructor  Destroy; override;
            function AsBoolean: Boolean; override;
            function AsInteger: Integer; override;
            function AsString: string; override;
            function AsObject: TObject; override;
            function AsFloat: double; override;
            //function CanReadAs(aType: TExprType): Boolean;
            function ExprType: TExprType; override;
            procedure SetValue(const Value: Boolean); overload;
            procedure SetValue(const Value: Integer); overload;
            procedure SetValue(const Value: double);  overload;
            procedure SetValue(const Value: string);  overload;
            procedure SetValue(const Value: TObject); overload;
            function IsInitialized: Boolean;
            property HasValue: Boolean read FHasValue;
            property SymbolName: string read FSymbolName;
        end;

implementation
{ ============================================================================
  >>>>   Class Implementation Begin                                       <<<<
  >>>>   Class Name  : TExtSymbolLiteral
  >>>>   Description :
  >>>>   Create Date :
  ---------------------------------------------------------------------------- }
constructor TExtRefSymLiteral.Create(const AIdentifier: string;
            PSymAddr: Pointer; const AType: TExprType);
begin
        inherited Create;
        FSymbolName := AIdentifier;
        FSymType := AType;
        FExtSym := PSymAddr;
end;

destructor TExtRefSymLiteral.Destroy;
begin
        inherited Destroy;
end;

function TExtRefSymLiteral.AsBoolean: Boolean;
begin
        if FSymType = ttBoolean then
            Result := Boolean(FExtSym^)
        else
            Raise EExpression.Create(Err_CanntBoolean);
end;

function TExtRefSymLiteral.AsFloat: Double;
begin
        if FSymType = ttFloat then
            Result := Double(FExtSym^)
        else
            Result := inherited AsFloat;
            //Raise EExpression.Create(Err_OnlyFloat);
end;

function TExtRefSymLiteral.AsInteger: integer;
begin
        if FSymType = ttInteger then
            Result := Integer(FExtSym^)
        else
            Result := Inherited AsInteger;
            //Raise EExpression.Create(Err_OnlyInteger);
end;

function TExtRefSymLiteral.AsObject: TObject;
begin
        if FSymType = ttObject then
            Result := TObject(FExtSym^)
        else
            raise EExpression.Create(Err_CanntObject);
end;

function TExtRefSymLiteral.AsString: string;
begin
        if FSymType = ttString then
            Result := String(FExtSym^)
        else
            Result := inherited AsString;
            //raise EExpression.Create(Err_OnlyString);
end;

function TExtRefSymLiteral.ExprType: TExprType;
begin
        Result := FSymType;
end;

{ ============================================================================
  >>>>   Class Implementation Begin                                       <<<<
  >>>>   Class Name  : TVarLiteral
  >>>>   Description :
  >>>>   Create Date :
  ---------------------------------------------------------------------------- }
constructor TVarLiteral.Create(const AIdentifier: string; const AType: TExprType);
begin
        inherited Create;
        FSymbolName := AIdentifier;
        FHasValue := False;
        FInitialized := True;
        FExprType := AType;
end;

destructor TVarLiteral.Destroy;
begin
        inherited Destroy;
end;

//function TVarLiteral.CanReadAs(aType: TExprType):Boolean;
//begin
//        Result := aType = FExprType;
//end;

function TVarLiteral.ExprType: TExprType;
begin
        Result := FExprType;
end;

function TVarLiteral.IsInitialized: Boolean;
begin
        result := FInitialized;
end;

function TVarLiteral.AsBoolean: Boolean;
begin
        if FExprType = ttBoolean then Result := FBlnValue
        else raise EExpression.Create(Err_CanntBoolean);
end;

function TVarLiteral.AsInteger: integer;
begin
        if FExprType = ttInteger then Result := FIntValue
        else Result := inherited AsInteger;
end;

function TVarLiteral.AsString: string;
begin
        if FExprType = ttString then Result := FStrValue
        else Result := inherited AsString;
end;

function TVarLiteral.AsObject: TObject;
begin
        if FExprType = ttObject then Result := FObjValue
        else raise EExpression.Create(Err_CanntObject);
end;

function TVarLiteral.AsFloat: double;
begin
        if FExprType = ttFloat then REsult := FDblValue
        else Result := inherited AsFloat;
end;

const  Err_SetValue = '变量%s的数据类型为%s，不能将%s类型的数据赋值给它';

procedure TVarLiteral.SetValue(const Value: Boolean);
begin
        if FExprType = ttBoolean then FBlnValue:= Value
        else
            raise EExpression.CreateFmt(Err_SetValue,
                [FSymbolName,
                ExprTypeName[FExprType],
                ExprTypeName[ttBoolean]]);
end;

procedure TVarLiteral.SetValue(const Value: Integer);
begin
        if FExprType = ttInteger then FIntValue:= Value
        else
            raise EExpression.CreateFmt(Err_SetValue,
                [FSymbolName,
                ExprTypeName[FExprType],
                ExprTypeName[ttInteger]]);
end;
procedure TVarLiteral.SetValue(const Value: double);
begin
        if FExprType = ttFloat then FDblValue := Value
        else
            raise EExpression.CreateFmt(Err_SetValue,
                [FSymbolName,
                ExprTypeName[FExprType],
                ExprTypeName[ttFloat]]);
end;
procedure TVarLiteral.SetValue(const Value: string);
begin
        if FExprType = ttString then FStrValue := Value
        else
            raise EExpression.CreateFmt(Err_SetValue,
                [FSymbolName,
                ExprTypeName[FExprType],
                ExprTypeName[ttString]]);
end;
procedure TVarLiteral.SetValue(const Value: TObject);
begin
        if FExprType = ttObject then FObjValue := Value
        else
            raise EExpression.CreateFmt(Err_SetValue,
                [FSymbolName,
                ExprTypeName[FExprType],
                ExprTypeName[ttObject]]);
end;

end.