qrexpr.pas

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

end;

function TQREvDivFunction.FunctionArguments : string;
begin
    result := '2NN';
end;


function TQREvDivFunction.Calculate : TQREvResult;
var
  v1, v2 : Longint;
begin
  if (ArgList.Count = 2) and
     ((Argument(0).Kind = ResInt) or (Argument(0).Kind = resDouble)) and
     ((Argument(1).Kind = ResInt) or (Argument(1).Kind = resDouble)) then
  begin
    Result.Kind := ResInt;
    if Argument(0).Kind = ResInt then
      v1 := Argument(0).intResult
    else
      v1 := Round(Argument(0).dblResult);
    if Argument(1).Kind = ResInt then
      v2 := Argument(1).intResult
    else
      v2 := Round(Argument(1).dblResult);
    if v2 <> 0 then
      Result.IntResult := v1 div v2
    else
    begin
      Result.Kind := resError;
      Result.strResult := SqrDivisionByZero;
    end
  end else
  begin
    Result.Kind := resError;
    Result.StrResult := Format(SqrExpWrongArguments, ['DIV']);
  end;
end;

{ TQREvStrFunction }

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

function TQREvStrFunction.FunctionName : string;
begin
    result := 'STR';
end;

function TQREvStrFunction.FunctionDescription : string;
begin
    result := 'STR(<X>)|' + SqrStrDesc;
end;

function TQREvStrFunction.FunctionArguments : string;
begin
    result := '7N';
end;


function TQREvStrFunction.Calculate : TQREvResult;
var
  ArgRes : TQREvResult;
begin
  if ArgList.Count = 1 then
  begin
    ArgRes := Argument(0);
    Result.Kind := resString;
    case ArgRes.Kind of
      resInt : Result.strResult := IntToStr(ArgRes.IntResult);
      resDouble : Result.strResult := FloatToStr(ArgRes.DblResult);
      resBool : if ArgRes.booResult then
                result.StrResult := 'True' // Do not translate
              else
                result.StrResult := 'False'; // Do not translate
    else
      result.Kind := resError;
    end
  end else
    Result.Kind := resError;
  if Result.Kind = resError then
    Result.strResult := SqrConversionError;
end;

{ TQREvUpperFunction }

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

function TQREvUpperFunction.FunctionName : string;
begin
    result := 'UPPER';
end;

function TQREvUpperFunction.FunctionDescription : string;
begin
    result := 'UPPER(<X>)|' + SqrUpperDesc;
end;

function TQREvUpperFunction.FunctionArguments : string;
begin
    result := '7S';
end;

function TQREvUpperFunction.Calculate : TQREvResult;
begin
  if (ArgList.Count = 1) and (Argument(0).Kind = resString) then
  begin
    Result.Kind := resString;
    Result.StrResult := AnsiUpperCase(Argument(0).StrResult);
  end else
  begin
    Result.Kind := resError;
    if ArgList.Count = 1 then
      Result.strResult :=Argument(0).strResult
    else
      Result.strResult := Format(SqrMissingArgument, ['UPPER']);
  end;
end;

{ TQREvLowerFunction }

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

function TQREvLowerFunction.FunctionName : string;
begin
    result := 'LOWER';
end;

function TQREvLowerFunction.FunctionDescription : string;
begin
    result := 'LOWER(<X>)|' + SqrLowerDesc;
end;

function TQREvLowerFunction.FunctionArguments : string;
begin
    result := '7S';
end;

function TQREvLowerFunction.Calculate : TQREvResult;
begin
  if (ArgList.Count = 1) and (Argument(0).Kind = resString) then
  begin
    Result.Kind := resString;
    Result.StrResult := AnsiLowerCase(Argument(0).StrResult);
  end else
  begin
    Result.Kind := resError;
    if ArgList.Count = 1 then
      Result.strResult :=Argument(0).strResult
    else
      Result.strResult := Format(SqrMissingArgument, ['LOWER']);
  end;
end;

{ TQREvPrettyFunction }

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

function TQREvPrettyFunction.FunctionName : string;
begin
    result := 'PRETTY';
end;

function TQREvPrettyFunction.FunctionDescription : string;
begin
    result := 'PRETTY(<X>)|' + SqrPrettyDesc;
end;

function TQREvPrettyFunction.FunctionArguments : string;
begin
    result := '7S';
end;

function TQREvPrettyFunction.Calculate : TQREvResult;
begin
  if (ArgList.Count = 1) and (Argument(0).Kind = resString) then
  begin
    Result.Kind := resString;

    if (Length(Argument(0).StrResult) > 0) and (Argument(0).StrResult[1] in LeadBytes) then
      Result.StrResult := AnsiUpperCase(Copy(Argument(0).StrResult, 1, 2)) +
                          AnsiLowerCase(Copy(Argument(0).StrResult, 3, length(Argument(0).StrResult)))
    else
      Result.StrResult := AnsiUpperCase(Copy(Argument(0).StrResult, 1, 1)) +
                          AnsiLowerCase(Copy(Argument(0).StrResult, 2, length(Argument(0).StrResult)));
  end else
  begin
    Result.Kind := resError;
    if ArgList.Count = 1 then
      Result.strResult :=Argument(0).strResult
    else
      Result.strResult := Format(SqrMissingArgument, ['PRETTY']);
  end;
end;

{ TQREvTimeFunction }

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

function TQREvTimeFunction.FunctionName : string;
begin
    result := 'TIME';
end;

function TQREvTimeFunction.FunctionDescription : string;
begin
    result := 'TIME|' + SqrTimeDesc;
end;

function TQREvTimeFunction.FunctionArguments : string;
begin
    result := '1';
end;
function TQREvTimeFunction.Calculate : TQREvResult;
begin
  if ArgList.Count = 0 then
  begin
    Result.Kind := resString;
    Result.StrResult := TimeToStr(Now);
  end else
    Result.Kind := resError;
end;

{ TQREvTimeFunction }

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

function TQREvDateFunction.FunctionName : string;
begin
    result := 'DATE';
end;

function TQREvDateFunction.FunctionDescription : string;
begin
    result := 'DATE|' + SqrDateDesc;
end;

function TQREvDateFunction.FunctionArguments : string;
begin
    result := '1';
end;


function TQREvDateFunction.Calculate : TQREvResult;
begin
  if ArgList.Count=0 then
  begin
    Result.Kind := resString;
    Result.StrResult := DateToStr(Date);
  end else
    Result.Kind := resError;
end;

{ TQREvCopyFunction }

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

function TQREvCopyFunction.FunctionName : string;
begin
    result := 'COPY';
end;

function TQREvCopyFunction.FunctionDescription : string;
begin
    result := 'COPY(<X>, <St>,<Len>)|' + SqrCopyDesc;
end;

function TQREvCopyFunction.FunctionArguments : string;
begin
    result := '7SNN';
end;


function TQREvCopyFunction.Calculate : TQREvResult;
var
  Start, Len : integer;
begin
  if (ArgList.Count = 3) and
    (Argument(0).Kind = resString) and
    (Argument(1).Kind = resInt) and
    (Argument(2).Kind = resInt) then
  begin
    Start := Argument(1).IntResult;
    Len   := Argument(2).IntResult;
    if (Start = 0) then Start := 1;
    if (ByteType(Argument(0).strResult, Start) = mbTrailByte) and (Len > 0) then
    begin
      Inc(Start);
      Dec(Len);
    end;
    if (ByteType(Argument(0).strResult, Start + Len - 1) = mbLeadByte) and (Len > 0) then Dec(Len);
    Result.StrResult := copy(Argument(0).strResult, Start, Len);
    Result.Kind := resString;
  end else
    Result.Kind := resError;
end;

{ TQREvFormatNumericFunction }

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

function TQREvFormatNumericFunction.FunctionName : string;
begin
  Result := 'FORMATNUMERIC';
end;

function TQREvFormatNumericFunction.FunctionDescription : string;
begin
  Result := 'FORMATNUMERIC(<F>,<N>)|'+SqrFormatNumericDesc;
end;

function TQREvFormatNumericFunction.FunctionArguments : string;
begin
  Result := '7SN';
end;


function TQREvFormatNumericFunction.Calculate : TQREvResult;
begin
  if (ArgList.Count = 2) and
     ((Argument(1).Kind = resInt) or (Argument(1).Kind = resDouble)) and
     (Argument(0).Kind = resString) then
  begin
    Result.Kind := resString;
    try
      if Argument(1).Kind = resInt then
        Result.StrResult := FormatFloat(Argument(0).StrResult, Argument(1).IntResult * 1.0)
      else
        Result.StrResult := FormatFloat(Argument(0).StrResult, Argument(1).DblResult);
    except
      Result.Kind := resError;
      Result.StrResult := SqrInvalidFormatnumeric;
    end;
  end else
    Result.Kind := resError;
end;

{ TQREvSumFunction }

type
  TQREvSumFunction = class(TQREvElementFunction)
  private
    SumResult : TQREvResult;
    ResAssigned : boolean;
  public
    constructor Create; override;
    procedure Aggregate; override;
    function Calculate : TQREvResult; override;
    procedure Reset; override;
    function FunctionName : string; override;
    function FunctionDescription : string; override;
    function FunctionArguments : string; override;
  end;

constructor TQREvSumFunction.Create;
begin
  inherited Create;
  ResAssigned := false;
  IsAggreg := true;
end;

function TQREvSumFunction.FunctionName : string;
begin
    result := 'SUM';
end;

function TQREvSumFunction.FunctionDescription : string;
begin
    result := 'SUM(<X>)|' + SqrSumDesc;
end;

function TQREvSumFunction.FunctionArguments : string;
begin
    result := '3N';
end;

procedure TQREvSumFunction.Reset;
begin
  ResAssigned := false;
end;

procedure TQREvSumFunction.Aggregate;
var
  aValue : TQREvResult;
begin
  if ArgList.Count = 1 then
  begin
    aValue := Argument(0);
    if ResAssigned then
    begin
      case aValue.Kind of
        resInt : SumResult.IntResult := SumResult.IntResult + aValue.IntResult;
        resDouble : SumResult.dblResult := SumResult.dblResult + aValue.dblResult;
        resString : SumResult.Kind := resError;
      end;
    end else
    begin
      SumResult.Kind := aValue.Kind;
      case aValue.Kind of
        resInt : SumResult.IntResult := aValue.IntResult;
        resDouble : SumResult.dblResult := aValue.dblResult;
      else
        SumResult.Kind := resError;