qrexpr.pas

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

  intEnd := Length(strString);
  while (strString[intStart] = ' ') and (intStart < intEnd) do
    inc(intStart);
  while (strString[intEnd] = ' ') and (intEnd > intStart) do
    dec(intEnd);
  strString := Copy(strString, intStart, intEnd - intStart + 1);
end;

procedure TQREvaluator.FindDelimiter(strArg : string; var Pos : integer);
var
  n : integer;
  FoundDelim : boolean;
  booString : boolean;
  intParenteses : integer;
begin
  if strArg='' then
    Pos := 0
  else
  begin
    FoundDelim := false;
    BooString := false;
    intParenteses := 0;
    N := 1;
    while (N<length(strArg)) and not FoundDelim do
    begin
      case StrArg[N] of
        '(' : if not booString then inc(intParenteses);
        ')' : if not booString then dec(intParenteses);
        '''' : booString := not booString;
      end;
      if (intParenteses=0) and not booString then
        if strArg[N]=ArgSeparator then
        begin
          FoundDelim := true;
          break;
        end;
      inc(N);
    end;
    if FoundDelim then
      Pos := N
    else
      Pos := 0;
  end;
end;

function TQREvaluator.EvalEnvironment(strVariable : string) : TQREvResult;
var
  AElement : TQREvElement;
begin
  if (FEnvironment <> nil) then
  begin
    AElement := FEnvironment.Element(strVariable);
    if AElement is TQREvElementError then
    begin
      AElement.Free;
      AElement := FGlobalEnvironment.Element(strVariable);
    end
  end else
    AElement := FGlobalEnvironment.Element(strVariable);
  FiFo.Put(AElement);
end;

function TQREvaluator.EvalVariable(strVariable : string) : TQREvResult;
var
  SeparatorPos : integer;
  DSName : string;
  FieldName : string;
  aDataSet : TDataSet;
  aField : TField;
  I : integer;
begin
  if assigned(FDataSets) then
  begin
    SeparatorPos := AnsiPos('.', strVariable);
    DSName := AnsiUpperCase(copy(StrVariable, 1, SeparatorPos - 1));
    FieldName := AnsiUpperCase(copy(strVariable, SeparatorPos + 1, length(StrVariable) - SeparatorPos));
    aField := nil;
    aDataSet := nil;
    if length(DSName) > 0 then
    begin
      for I := 0 to FDataSets.Count - 1 do
        if AnsiUpperCase(TDataSet(FDataSets[I]).Name) = DSName then
        begin
          aDataSet := TDataSet(FDataSets[I]);
          break;
        end;
      if aDataSet <> nil then
        aField := aDataSet.FindField(FieldName);
    end else
    begin
      for I := 0 to FDataSets.Count - 1 do
        with TDataSet(FDataSets[I]) do
        begin
          aField := FindField(FieldName);
          if aField <> nil then break;
        end;
    end;
    if aField <> nil then
      FiFo.Put(TQREvElementDataField.CreateField(aField))
    else
      EvalEnvironment(strVariable);
  end else
    EvalEnvironment(strVariable);
end;

function TQREvaluator.EvalString(const strString : string) : TQREvResult;
begin
  result.Kind := resString;
  result.strResult := strString;
  FiFo.Put(TQREvElementString.CreateString(Result.StrResult));
end;

function TQREvaluator.EvalFunction(strFunc : string; const strArg : string) : TQREvResult;
var
  DelimPos : integer;
  aString : string;
  Res : TQREvResult;
  aFunc : TQREvElement;
begin
  StrFunc := AnsiUpperCase(StrFunc);
  aFunc := QRFunctionLibrary.GetFunction(strFunc);
  if AFunc is TQREvElementError then
  begin
    if StrArg = '' then
    begin
      AFunc.Free;
      EvalVariable(StrFunc)
    end else
      FiFo.Put(AFunc);
  end else
  begin
    FiFo.Put(AFunc);
    if not (aFunc is TQREvElementError) then
    begin
      aString := strArg;
      repeat
        FindDelimiter(aString, DelimPos);
        if DelimPos > 0 then
          Res := Evaluate(copy(aString, 1, DelimPos - 1))
        else
          if length(aString) > 0 then Res := Evaluate(aString);
        Delete(aString, 1, DelimPos);
      until DelimPos = 0;
    end;
    FiFo.Put(TQREvElementArgumentEnd.Create);
  end;
end;

function TQREvaluator.EvalConstant(const strConstant : string) : TQREvResult;
var
  N : integer;
  aString : string[255];
begin
  N := 1;
  aString := strConstant;
  while (N <= Length(aString)) and  (aString[N] in ['0'..'9']) do
    inc(N);
  result.Kind := resInt;
  while ((N <= Length(aString)) and (aString[N] in ['0'..'9', '.', 'e', 'E', '+', '-'])) do
  begin
    inc(N);
    result.Kind := resDouble;
  end;
  if N - 1 <> Length(aString) then
    result := ErrorCreate(Format(SqrExpIllegalCharInNumeric, [aString]))
  else
  begin
    if result.Kind = resInt then
    begin
      try
        result.intResult := StrToInt(aString)
      except
        result.Kind := resDouble;
      end;
    end;
    if result.Kind = resDouble then
    begin
      if DecimalSeparator <> '.' then
      begin
        while pos('.', aString) > 0 do
          aString[pos('.', aString)] := DecimalSeparator;
      end;
      try
        result.dblResult := StrToFloat(aString);
      except
        result := ErrorCreate(Format(SqrExpIllegalCharInNumeric, [aString]))
      end;
    end;
  end;
  if result.Kind = resError then
    FiFo.Put(TQREvElementError.Create(Result.strResult))
  else
    FiFo.Put(TQREvElementConstant.CreateConstant(Result));
end;

function TQREvaluator.EvalFunctionExpr(const strFunc : string) : TQREvResult;
var
  argRes : TQREvResult;
  po : integer;
begin
  po := AnsiPos('(', StrFunc);
  if po > 0 then
    if strFunc[length(StrFunc)] = ')' then
      result := EvalFunction(copy(StrFunc, 1, po - 1), copy(StrFunc, po + 1, length(strFunc) - po - 1))
    else
      result := EvalFunction('', '')
  else
  begin
    argRes.Kind := resError;
    result := EvalFunction(StrFunc, '');
  end;
end;

function TQREvaluator.EvalFactor(strFactorExpr : string) : TQREvResult;
var
  aString : string[255];
  aResult : TQREvResult;
begin
  TrimString(strFactorExpr);
  aString := strFactorExpr;
  if (AnsiLowerCase(Copy(strFactorExpr, 1, 3)) = 'not') then
  begin
    aResult := EvalSimpleExpr(Copy(strFactorExpr, 4, Length(strFactorExpr)));
    if aResult.Kind = resBool then
    begin
      Result.booResult := not aResult.booResult;
      Result.Kind := aResult.Kind;
    end else
      Result := ErrorCreate(SqrInvalidNot);
  end else
    case aString[1] of
      'A'..'Z', 'a'..'z' : result := EvalFunctionExpr(strFactorExpr);
      '0'..'9' : result := EvalConstant(strFactorExpr);
      '-' : result := EvalSimpleExpr('0-' + Copy(strFactorExpr, 2, Length(strFactorExpr)));
      '+' : result := EvalFactor(Copy(strFactorExpr, 2, Length(strFactorExpr)));
      '(' : if strFactorExpr[Length(strFactorExpr)] = ')' then
              result := Evaluate(Copy(strFactorExpr, 2, Length(strFactorExpr) - 2))
            else
            begin
              result := ErrorCreate(Format(SqrExpMissing, [')']));
              FiFo.Put(TQREvElementError.Create(Result.strResult));
            end;
      '''' : if aString[Length(strFactorExpr)] = '''' then
               result := EvalString(Copy(strFactorExpr, 2, Length(strFactorExpr) - 2))
             else
             begin
               Result := ErrorCreate(Format(SqrExpMissing, [')']));
               FiFo.Put(TQREvElementError.Create(Result.strResult));
             end;
      '[' : if aString[Length(strFactorExpr)] = ']' then
              result := EvalVariable(Copy(strFactorExpr, 2, Length(strFactorExpr) - 2))
            else
            begin
              Result := ErrorCreate(Format(SqrExpMissing, [']']));
              FiFo.Put(TQREvElementError.Create(Result.strResult));
            end;
    else
    begin
      result := ErrorCreate(Format(SqrExpError, [aString]));
      FiFo.Put(TQREvElementError.Create(Result.strResult));
    end;
  end;
end;

function TQREvaluator.EvalSimpleExpr(const strSimplExpr : string) : TQREvResult;
var
  Op : TQREvOperator;
  intStart,
  intLen : integer;
  Res1,
  Res2 : TQREvResult;
  n : integer;
  intParenteses : integer;
  booFound : boolean;
  booString : boolean;
  booBracket : boolean;
begin
  n := 1;
  Op := TQREvOperator(nil);
  intParenteses := 0;
  booFound := false;
  booString := false;
  booBracket := false;
  intLen := 1;
  while (n < Length(strSimplExpr)) and (not booFound) do
  begin
    booFound := true;
    case strSimplExpr[N] of
      '(' : if not (booString or booBracket) then inc(intParenteses);
      ')' : if not (booString or booBracket) then dec(intParenteses);
      '[' : if not (booString or booBracket) then booBracket := true;
      ']' : if (not booString) and booBracket then booBracket := false;
      '''': if (not booBracket) then booString := not booString;
    end;
    if (intParenteses = 0) and (not (booString or booBracket)) and (N > 1) then
      case strSimplExpr[N] of
        '+' : Op := opPlus;
        '-' : Op := opMinus;
        ' ' : if (AnsiLowercase(copy(strSimplExpr, N + 1, 3)) = 'or ') then
              begin
                Op := opOr;
                intLen := 2;
                inc(N);
              end else
                booFound := false;
      else
        booFound := false;
    end else
      booFound := false;
    inc(N);
  end;
  if booFound then
    intStart := N - 1
  else
    intStart := -1;
  if intStart > 0 then
  begin
    FiFo.Put(TQREvElementOperator.CreateOperator(Op));
    Res1 := EvalTerm(Copy(strSimplExpr, 1, intStart - 1));
    if Op = opMinus then
      Res2 := EvalSimpleExpr(Flip(Copy(strSimplExpr, intStart + intLen, Length(strSimplExpr)), '+', '-'))
    else
      Res2 :=EvalSimpleExpr(Copy(strSimplExpr, intStart + intLen, Length(strSimplExpr)))
  end else
    result := EvalTerm(strSimplExpr);
end;

function TQREvaluator.EvalTerm(const strTermExpr : string) : TQREvResult;
var
  Op : TQREvOperator;
  intStart,
  intLen : integer;
  Res1,
  Res2 : TQREvResult;
  N : integer;
  booString : boolean;
  booFound : boolean;
  booBracket : boolean;
  intParenteses : integer;
begin
  n := 1;
  Op := TQREvOperator(nil);
  intParenteses := 0;
  booFound := false;
  booString := false;
  booBracket := false;
  intLen := 1;
  while (N < Length(strTermExpr)) and (not booFound) do
  begin
    booFound := true;
    case strTermExpr[N] of
      '(' : if not (booString or booBracket) then inc(intParenteses);
      ')' : if not (booString or booBracket) then dec(intParenteses);
      '[' : if not (booString or booBracket) then booBracket := true;
      ']' : if (not booString) and booBracket then booBracket := false;
      '''': if (not booBracket) then booString := not booString;
    end;
    if (intParenteses = 0) and (not (booString or booBracket)) and (N > 1) then
    begin
      case strTermExpr[N] of
        '*' : Op := opMul;
        '/' : Op := opDiv;
        ' ' : if (AnsiLowercase(copy(strTermExpr, n + 1, 4)) = 'and ') then
              begin
                Op := opAnd;
                IntLen := 3;
                inc(N);
              end else
                booFound := false;
      else
        booFound := false;
    end;
  end else
    booFound := false;
    inc(N);
  end;
  if booFound then
    intStart := N - 1
  else
    intStart := -1;
  if intStart > 0 then
  begin
    FiFo.Put(TQREvElementOperator.CreateOperator(Op));
    Res1 := EvalFactor(Copy(strTermExpr, 1, intStart - 1));
    if Op = opDiv then
      Res2 := EvalTerm(Flip(Copy(strTermExpr, intStart + intLen, Length(strTermExpr)), '*', '/'))
    else
      Res2 := EvalTerm(Copy(strTermExpr, intStart + intLen, Length(strTermExpr)));
  end else
    result := EvalFactor(strTermExpr);
end;

function TQREvaluator.Evaluate(const strExpr : string) : TQREvResult;
var
  n : integer;
  booFound : boolean;
  intParenteses : integer;
  booString : boolean;
  booBracket : boolean;
  Op : TQREvOperator;
  intStart,
  intLen : integer;
  Res1,
  Res2 : TQREvResult;
begin
  Op := OpEqual;
  n := 1;
  intParenteses := 0;
  booFound := false;
  intLen := 1;
  booString := false;
  booBracket := false;
  while (n < Length(strExpr)) and (not booFound) do
  begin
    booFound := true;
    case StrExpr[N] of
      '(' : if not (booString or booBracket) then inc(intParenteses);
      ')' : if not (booString or booBracket) then dec(intParenteses);
      '[' : if not (booString or booBracket) then booBracket := true;
      ']' : if (not booString ) and booBracket then booBracket := false;
      '''': if (not booBracket) then booString := not booString;
    end;
    if (intParenteses = 0) and (n > 1) and not (booString  or booBracket) then
      case StrExpr[N] of
        '<' : begin
                if StrExpr[N + 1] = '>' then
                begin
                  Op := opUnequal;
                  intLen := 2;
                end else
                  if StrExpr[N + 1] = '=' then
                  begin
                    Op := opLessOrEqual;
                    intLen := 2;
                  end else
                    Op := opLess;
                end;
        '>' : if StrExpr[N + 1] = '=' then
              begin
                Op := opGreaterOrEqual;
                intLen := 2;
              end else
                Op := opGreater;
        '=' : Op := opEqual;
      else
        booFound := false;
      end
    else
      booFound := false;
    inc(N);
  end;
  if booFound then
    IntStart := n - 1
  else
    IntStart := -1;
  if intStart > 0 then
  begin
    FiFo.Put(TQREvElementOperator.CreateOperator(Op));
    Res1 := EvalSimpleExpr(Copy(strExpr, 1, intStart - 1));
    Res2 := EvalSimpleExpr(Copy(strExpr, intStart + intLen, Length(strExpr)));
  end else