qrexpr.pas

delphi7报表打印控件源码 可以设计报表

    result := EvalSimpleExpr(strExpr);
end;

procedure TQREvaluator.Prepare(const strExpr : string);
var
  Value : TQREvResult;
begin
  if Prepared then Unprepare;
  QRGlobalEnvironment.Prepare;
  FiFo := TQRFiFo.Create;
  if strExpr = '' then
    Value := Evaluate(''' ''')
  else
    Value := Evaluate(strExpr);
  Prepared := true;
end;

procedure TQREvaluator.UnPrepare;
begin
  FiFo.Free;
  QRGlobalEnvironment.Unprepare;
  Prepared := false;
end;

procedure TQREvaluator.Reset;
var
  I : integer;
begin
  for I := 0 to FiFo.FiFo.Count - 1 do
    TQREvElement(FiFo.FiFo[I]).Reset;
end;

function TQREvaluator.Value : TQREvResult;
var
  F : TObject;
begin
  if not Prepared then
    Raise Exception.Create(SqrEvalNotPrepared);
  FiFo.Start;
  F := FiFo.Get;
  if F = nil then
    Result.Kind := resError
  else
    Result := TQREvElement(F).Value(FiFo);
end;

procedure TQREvaluator.DoAggregate;
begin
  Aggregate := true;
  Value;
  Aggregate := false;
end;

function TQREvaluator.AsString : string;
var
  AValue : TQREvResult;
begin
  AValue := Value;
  case AValue.Kind of
    resString : Result := AValue.StrResult;
    resInt : Result := IntToStr(AValue.IntResult);
    resDouble : Result := FloatToStr(AValue.DblResult);
    resBool : if AValue.booResult then
                   Result := SqrTrue
                 else
                   Result := SqrFalse;
  else
    Raise Exception.Create(Format(SqrExpError, [AValue.strResult]));
  end;
end;

function TQREvaluator.AsInteger : integer;
var
  AValue : TQREvResult;
begin
  AValue := Value;
  case AValue.Kind of
    resInt : Result := AValue.IntResult;
    resDouble : Result := Round(AValue.DblResult);
  else
    Raise Exception.Create(Format(SqrNotValue, [SqrExpNumeric]));
  end;
end;

function TQREvaluator.AsFloat : extended;
var
  AValue : TQREvResult;
begin
  AValue := Value;
  case AValue.Kind of
    resInt : Result := AValue.IntResult;
    resDouble : Result := AValue.DblResult;
  else
    Raise Exception.Create(Format(SqrNotValue, [SqrExpNumeric]));
  end;
end;

function TQREvaluator.AsBoolean : boolean;
var
  AValue : TQREvResult;
begin
  AValue := Value;
  case AValue.Kind of
    resBool : Result := AValue.BooResult;
    resString : if AnsiUppercase(AValue.StrResult) = 'TRUE' then // Do not translate
                  Result := true
                else
                  if AnsiUppercase(AValue.StrResult) = 'FALSE' then // Do not translate
                    Result := false
                  else
                    Raise Exception.Create(Format(SqrNotValue, [SqrExpBoolean]));
  else
    Raise Exception.Create(Format(SqrNotValue, [SqrExpBoolean]));
  end;
end;

function TQREvaluator.AsVariant : Variant;
var
  AValue : TQREvResult;
begin
  AValue := Value;
  case AValue.Kind of
    resString : Result := AValue.StrResult;
    resInt : Result := AValue.IntResult;
    resDouble : Result := AValue.dblResult;
    resBool : Result := AValue.BooResult;
  else
    Raise Exception.Create(Format(SqrExpError, [AValue.StrResult]));
  end;
end;

function TQREvaluator.GetIsAggreg : boolean;
var
  I : integer;
begin
  Result := false;
  for I := 0 to FiFo.FiFo.Count - 1 do
    Result := Result or TQREvElement(FiFo.FiFo[I]).IsAggreg;
end;

function TQREvaluator.GetAggregate : boolean;
begin
  Result := FiFo.Aggreg;
end;

procedure TQREvaluator.SetAggregate(Value : boolean);
begin
  FiFo.Aggreg := Value;
end;

function TQREvaluator.Calculate(const strExpr : string) : TQREvResult;
begin
  Prepare(strExpr);
  result := Value;
  UnPrepare;
end;

{ Expression evaluator functions }

{ TQREvTrue }

type
  TQREvTrue = class(TQREvElementFunction)
  public
    function Calculate : TQREvResult; override;
    function FunctionName : string; override;
    function FunctionDescription : string; override;
    function FunctionArguments : string; override;
  end;

  TQREvFalse = class(TQREvElementFunction)
  public
    function Calculate : TQREvResult; override;
    function FunctionName : string; override;
    function FunctionDescription : string; override;
    function FunctionArguments : string; override;
  end;
  
function TQREvTrue.FunctionName : string;
begin
    result := 'TRUE';
end;

function TQREvTrue.FunctionDescription : string;
begin
    result := 'TRUE|' + SqrBoolDesc;
end;

function TQREvTrue.FunctionArguments : string;
begin
    result := '5';
end;

function TQREvFalse.FunctionName : string;
begin
    result := 'FALSE';
end;

function TQREvFalse.FunctionDescription : string;
begin
    result := 'FALSE|' + SqrBoolDesc;
end;

function TQREvFalse.FunctionArguments : string;
begin
    result := '5';
end;


function TQREvTrue.Calculate : TQREvResult;
begin
  if ArgList.Count = 0 then
  begin
    Result.Kind := resBool;
    Result.booResult := true;
  end else
    Result := ErrorCreate(SqrExpTooManyArgs);
end;

function TQREvFalse.Calculate : TQREvResult;
begin
  if ArgList.Count = 0 then
  begin
    Result.Kind := resBool;
    Result.booResult := false;
  end else
    Result := ErrorCreate(SqrExpTooManyArgs);
end;

{ TQREvIfFunction }

type
  TQREvIfFunction = class(TQREvElementFunction)
  public
    function Calculate : TQREvResult; override;
    function FunctionName : string; override;
    function FunctionDescription : string; override;
    function FunctionArguments : string; override;
  end;

function TQREvIfFunction.FunctionName : string;
begin
    result := 'IF';
end;

function TQREvIfFunction.FunctionDescription : string;
begin
    result := 'IF(<Exp>, <X>, <Y>)|' + SqrIfDesc;
end;

function TQREvIfFunction.FunctionArguments : string;
begin
    result := '5BVV';
end;


function TQREvIfFunction.Calculate : TQREvResult;
begin
  if (ArgList.Count = 3) and (Argument(0).Kind = resBool) then
  begin
    if Argument(0).BooResult then
      Result := Argument(1)
    else
      Result := Argument(2);
  end else
    Result := ErrorCreate(Format(SqrExpWrongArguments, ['IF'])); // Do not translate
end;

{ TQREvTypeOfFunction }

type
  TQREvTypeOfFunction = class(TQREvElementFunction)
  public
    function Calculate : TQREvResult; override;
    function FunctionName : string; override;
    function FunctionDescription : string; override;
    function FunctionArguments : string; override;
  end;

function TQREvTypeOfFunction.FunctionName : string;
begin
    result := 'TYPEOF';
end;

function TQREvTypeOfFunction.FunctionDescription : string;
begin
    result := 'TYPEOF(<Exp>)|' + SqrTypeOfDesc;
end;

function TQREvTypeOfFunction.FunctionArguments : string;
begin
    result := '6N';
end;


function TQREvTypeOfFunction.Calculate : TQREvResult;
begin
  Result.Kind := resString;
  if ArgList.Count = 1 then
  begin
    case Argument(0).Kind of
      resInt : Result.StrResult := 'INTEGER';    // Do not translate
      resDouble : Result.StrResult := 'FLOAT';   // Do not translate
      resString : Result.StrResult := 'STRING';  // Do not translate
      resBool : Result.StrResult := 'BOOLEAN';   // Do not translate
      resError : Result.StrResult := 'ERROR';    // Do not translate
    else
      Result := ErrorCreate(SqrExpUnknownType);
    end
  end else
    Result := ErrorCreate(Format(SqrExpWrongArguments, ['TypeOf'])); // Do not translate
end;

{ TQREvIntFunction }

type
  TQREvIntFunction = class(TQREvElementFunction)
  public
    function Calculate : TQREvResult; override;
    function FunctionName : string; override;
    function FunctionDescription : string; override;
    function FunctionArguments : string; override;
  end;

function TQREvIntFunction.FunctionName : string;
begin
    result := 'INT';
end;

function TQREvIntFunction.FunctionDescription : string;
begin
    result := 'INT(<X>)|' + SqrIntDesc;
end;

function TQREvIntFunction.FunctionArguments : string;
begin
    result := '2N';
end;

function TQREvIntFunction.Calculate : TQREvResult;
begin
  Result.Kind := resInt;
  if ArgList.Count = 1 then
  begin
    case Argument(0).Kind of
      resInt : Result.IntResult := Argument(0).IntResult;
      resDouble : Result.IntResult := Round(Int(Argument(0).DblResult));
    else
      Result := ErrorCreate(Format(SqrExpWrongArguments, ['INT'])); // Do not translate
    end
  end else
    Result := ErrorCreate(Format(SqrExpWrongArguments, ['INT'])); // Do not translate
end;

{ TQREvFracFunction }

type
  TQREvFracFunction = class(TQREvElementFunction)
  public
    function Calculate : TQREvResult; override;
    function FunctionName : string; override;
    function FunctionDescription : string; override;
    function FunctionArguments : string; override;
  end;

function TQREvFracFunction.FunctionName : string;
begin
    result := 'FRAC';
end;

function TQREvFracFunction.FunctionDescription : string;
begin
    result := 'FRAC(<X>)|' + SqrFracDesc;
end;

function TQREvFracFunction.FunctionArguments : string;
begin
    result := '2N';
end;


function TQREvFracFunction.Calculate : TQREvResult;
begin
  Result.Kind := resDouble;
  if ArgList.Count = 1 then
  begin
    case Argument(0).Kind of
      resInt : Result.DblResult := 0;
      resDouble : Result.DblResult := Frac(Argument(0).DblResult);
    else
      Result.Kind := resError;
    end
  end else
    Result.Kind := resError;
end;

{ TQREvSQRTFunction }

type
  TQREvSQRTFunction = class(TQREvElementFunction)
  public
    function Calculate : TQREvResult; override;
    function FunctionName : string; override;
    function FunctionDescription : string; override;
    function FunctionArguments : string; override;
  end;

function TQREvSQRTFunction.FunctionName : string;
begin
    result := 'SQRT';
end;

function TQREvSQRTFunction.FunctionDescription : string;
begin
    result := 'SQRT(<X>)|' + SqrSqrtDesc;
end;

function TQREvSQRTFunction.FunctionArguments : string;
begin
    result := '2N';
end;


function TQREvSQRTFunction.Calculate : TQREvResult;
begin
  Result.Kind := resDouble;
  if ArgList.Count = 1 then
  begin
    try
      case Argument(0).Kind of
        resInt : Result.DblResult := SQRT(Argument(0).IntResult);
        resDouble : Result.DblResult := SQRT(Argument(0).DblResult);
      else
        Result.Kind := resError;
      end
    except
      Result.Kind := resError
    end;
  end else
    Result.Kind := resError;
  if Result.Kind = resError then
    Result.StrResult := SqrSQRTInvalid;
end;

type
  TQREvDivFunction = class(TQREvElementFunction)
  public
    function Calculate : TQREvResult; override;
    function FunctionName : string; override;
    function FunctionDescription : string; override;
    function FunctionArguments : string; override;
  end;

function TQREvDivFunction.FunctionName : string;
begin
    result := 'DIV';
end;

function TQREvDivFunction.FunctionDescription : string;
begin
    result := 'DIV(<X>, <Y>) | ' + SqrDivDesc;