rm_wawformula.pas

这是一个功能强大

  var
    p: Integer;
    Ref: rptgRef;
    Area: rptgArea;
    Ref3D: rptgRef3D;
    Area3D: rptgArea3D;
    function CompileCellRef (s: String; var rw: Word; var grbitCol: Word): Boolean;
    const
      SymbolA = $41;
      SymbolZ = $5A;
      SymbolsAZ = $1A;
    var
      i: Integer;
      l: Integer;
    begin
     Result := False;
     s := UpperCase(s);
     rw := 0;
     grbitCol := 0;
     l := Length(s);
     for i := l downto 1 do
      if s[i] > '9' then Break;
     if (i = 0) or (l = i) then exit;    //0x163
     rw := StrToInt(Copy(s,i+1,l)) -1;
     if s[i] <> '$' then
      grbitCol := grbitCol or $8000
     else
      begin
       if i = 1 then Exit;
       Dec(i);
      end;
     ValCode := i;
     for i:=i downto 1 do
      if (s[i] > 'Z') or (s[i] < 'A') then Break;
     if (s[i] = '$') then
      begin
      if (i <> 1) then  exit
      end
     else
      begin
      if (i <> 0) then  exit
      else grbitCol := grbitCol or $4000;
      end;
     case ValCode-i of
      1: grbitCol := grbitCol or Word(Word(s[ValCode]) - SymbolA);
      2: begin
         grbitCol := grbitCol or Word((Word(s[ValCode-1])-SymbolA+Byte(1))*Word(25));
         grbitCol := grbitCol or Word(Word(s[ValCode])- SymbolA+Byte(1));
         end;
      else Exit;
     end;
     Result := True;
    end;
  begin
   p := Pos('!',Ident);
   if p > 0 then
    begin
    if Ident[1] = char($27) then
     begin
     for p := 2 to Length(Ident) do
      if Ident[p] = char($27) then Break;
     if ((p >= Length(Ident)) or (Ident[p] <> PChar($21))) then
      SetError(Format(swawFormulaCompileErrorInvalidRangeReference,[Ident]));
     CellRef := Copy(Ident,2,p-2);
     ExtRef := Trim(Copy(Ident,p+1,Length(Ident)));
     end
    else
     begin
     CellRef := Copy(Ident,1,p-1);
     ExtRef := Trim(Copy(Ident,p+1,Length(Ident)));
     end;
    CellRef := Trim(CellRef);
    if CellRef = '' then
      SetError(Format(swawFormulaCompileErrorInvalidRangeReference,[Ident]));
    if CellRef[1] = '[' then
     begin
     for p := 2 to Length(CellRef) do
      if CellRef[p] = ']' then Break;
     if p > Length(CellRef) then
      SetError(Format(swawFormulaCompileErrorInvalidRangeReference,[Ident]));
     ExtBook := Copy(CellRef,2,p-2);
     ExtSheet := Copy(CellRef,p+1,Length(CellRef));
     end
    else
     begin
     ExtBook := '';
     ExtSheet := CellRef;
     end;
    p := Pos(':',ExtRef);
    if p = 0 then
     begin
     if not CompileCellRef(ExtRef, Ref3D.rw, Ref3D.grbitCol) then
      SetError(Format(swawFormulaCompileErrorInvalidCellReference,[ExtRef]));
     Ref3D.ixti := ExtRefs.GetSheetIndex(ExtBook,ExtSheet);
     Addptg(ptgRef3D,@Ref3D,sizeof(rptgRef3D));
     end   
    else
     begin
     if not CompileCellRef(Copy(ExtRef,1,p-1),Area3D.rwFirst,Area3D.grbitColFirst) then
      SetError(Format(swawFormulaCompileErrorInvalidRangeReference,[Ident]))
     else
      begin
      if not CompileCellRef(Copy(ExtRef,p+1,Length(Ident)),Area3D.rwLast,Area3D.grbitColLast) then
       SetError(Format(swawFormulaCompileErrorInvalidRangeReference,[Ident]));
      Area3D.ixti := ExtRefs.GetSheetIndex(ExtBook,ExtSheet);
      Addptg(ptgArea3D,@Area3D,sizeof(rptgArea3D));
      end;
     end;
    end
   else
    begin
    p := Pos(':',Ident);
    if p = 0 then
     begin
     if not CompileCellRef(Ident,Ref.rw,Ref.grbitCol) then
        SetError(Format(swawFormulaCompileErrorInvalidCellReference,[Ident]));
     Addptg(ptgRef,@Ref,sizeof(rptgRef));
     end
    else
     begin 
     if not CompileCellRef(Copy(Ident,1,p-1),Area.rwFirst,Area.grbitColFirst) then
        SetError(Format(swawFormulaCompileErrorInvalidRangeReference,[Ident]))
     else
      begin
      if not CompileCellRef(Copy(Ident,p+1,Length(Ident)),Area.rwLast,Area.grbitColLast) then
        SetError(Format(swawFormulaCompileErrorInvalidRangeReference,[Ident]))
      end;
     Addptg(ptgArea,@Area,sizeof(rptgArea));
     end;
    end;
  end;
  procedure AddptgStr (s: String);
  begin
   NewStrSize := Length(s)* sizeof(WideChar) + sizeof(rptgStr);
   if NewStrSize > CurStrSize then
   begin
    ReallocMem(Str,NewStrSize);
    CurStrSize := NewStrSize;
   end;
   P := PChar(PChar(@Str)+ sizeof(rptgStr));
   Str.cch := FormatStrToWideChar(s,P);
   Str.grbit := 1;
   Addptg(ptgStr,Str,Str.cch shl 1);
  end;
  procedure AddptgInt (n: Word);
  var
    int: rptgInt;
  begin
   int.w := n;
   Addptg(ptgInt,@int,sizeof(int));
  end;
  procedure AddptgNum (n: Double);
  var
    num: rptgNum;
  begin
   num.num := n;
   Addptg(ptgNum,@num,sizeof(num));
  end;
  function GetOperatorIndex (s: String): Integer;
  begin
   for Result :=1 to wawOperatorsCount do
     if s = wawOperatorsInfos[Result].Name then Break;
   if Result > wawOperatorsCount then
     SetError(Format(swawFormulaCompileErrorUnknownOperator,[s]));
  end;
  function GetFunction_iftab (s: String): Integer;
  begin
   for Result := 1 to wawExcelFunctionsCount do
     if AnsiCompareText(s, wawExcelFunctions[Result].FuncName) = 0 then Break;
   if Result > wawExcelFunctionsCount then
    SetError(Format(swawFormulaCompileErrorUnknownFunction,[s]))
   else
    Result := wawExcelFunctions[Result].iftab;
  end;
  function ProcessOperator (OperatorInfoIndex: Integer): pwawOperator;
  var
    Last: pwawOperator;
    oi: pwawOperatorInfo;
    f: Boolean;      //waw
  begin
   Result := pwawOperator(nil);
   oi := @(wawOperatorsInfos[OperatorInfoIndex]);
   Last := FCompileOpStack.Last;
   if (oi.Priority <> 0) and(Last <> nil) and (Last.OperatorInfo.Priority >= oi.Priority) then
    begin
    while (Last <> nil) and (Last.OperatorInfo.Priority >= oi.Priority) do
      begin
      AddptgOperator(Last);
      Last := FCompileOpStack.Pop;
      end;
    end;
   if oi.Priority <> 1 then
    begin
     Result := FCompileOpStack.Push;
     Result.OperatorInfo := oi;
     Result.ParCount := 0;
     Result.OperandExists := False;
    end
   else
    begin
     if Last = nil then
      SetError(swawFormulaCompileErrorInvalidBrackets)
     else
      begin
       f := Last.OperatorInfo.Priority <> 0;
       Last := FCompileOpStack.Pop;
       if Last = nil then
         Addptg(ptgParen,nil,0)
       else
        begin
         if Last.OperatorInfo.Priority <> 9 then
          Addptg(ptgParen,nil,0)
         else
          begin
           if (Last.OperandExists = True) then
             Inc(Last.ParCount)
           else
           begin
           if (Last.ParCount = 0) then
             begin
             if f then
              begin
              Addptg(ptgMissArg,nil,0);
              Inc(Last.ParCount);
              end;
             end
           else
             Inc(Last.ParCount);
           end;
          end;
        end;
      end;
    end;
  end;
label L2cc;
begin
  FCompileOpStack.Reset;
  Str := nil;
  CurStrSize := 0;
  l := Length(s) +1;
  i := 1;
  try
   while i < l do
   begin
    if s[i] in wawFormulaStartIdentChars then
     begin
     if FCompileOpStack.LastFunction <> nil then
       FCompileOpStack.LastFunction.OperandExists := True;
     j := i;
     for i := i to l do
      if not (s[i] in wawFormulaIdentChars) then Break;
     for i := i to l do
      if s[i] > Char($20) then Break;
     b1 := Trim(Copy(s,j,i-j));
     if i <= l then
      begin
      if s[i] = wawFormulaStartBracketChar then
       begin
       FCompileOpStack.LastFunction := ProcessOperator(wawFormulaFunctionOperatorIndex);
       FCompileOpStack.LastFunction.iftab := GetFunction_iftab(b1);
       Continue;
       end;
      end;
     AddptgIdentificator(b1);
     Continue;
     end;

    if s[i] = wawFormulaFuncParamsDelim then
     begin
     if FCompileOpStack.LastFunction = nil then
      SetError(swawFormulaCompileErrorParameterWithoutFunction);
     if FCompileOpStack.LastFunction.OperandExists = False then
      Addptg(ptgMissArg,nil,0);
     Last := FCompileOpStack.Last;
     while Last.OperatorInfo.Priority > 0 do
      begin
      AddptgOperator(Last);
      Last := FCompileOpStack.Pop;
      end;
     FCompileOpStack.LastFunction.OperandExists := False;
     Inc(FCompileOpStack.LastFunction.ParCount);
     Inc(i);
     Continue;
     end;

    if s[i] = wawFormulaPercentOperator then
     begin
     ProcessOperator(wawFormulaPercentOperatorIndex);
     Inc(i);
     Continue;
     end;

    if s[i] in wawFormulaOperatorChars then
     begin
     j := i;
     for i := i to l do
      if not(s[i] in wawFormulaOperatorChars) then Break;
     b1 := Copy(s,j,i-j);
     vi := Length(b1);

     if (vi > 1) and (b1[vi] in wawFormulaUnaryOperators) then
      begin
      ProcessOperator(GetOperatorIndex(Copy(b1,1,vi-1)));
      if b1[vi] = wawFormulaUnaryPlusOperator then
       begin
       ProcessOperator(wawFormulaUnaryPlusOperatorIndex);
       Continue;
       end
      else
       begin
       ProcessOperator(wawFormulaUnaryMinusOperatorIndex);
       Continue;
       end;
      end;

     if (vi = 1) and (b1[1] in wawFormulaUnaryOperators) then
      begin
       for j := j downto 0 do
        if s[j] > Char($20) then Break;
       if j < 1 then goto L2cc;
       case s[j] of
         wawFormulaStartBracketChar: goto L2cc;
         wawFormulaFuncParamsDelim:
L2cc:     begin
          if b1[vi] = wawFormulaUnaryPlusOperator then
           begin
           ProcessOperator(wawFormulaUnaryPlusOperatorIndex);
           Continue;
           end
          else
           begin
           ProcessOperator(wawFormulaUnaryMinusOperatorIndex);
           Continue;
           end;
          end
         else
          begin
          ProcessOperator(GetOperatorIndex(b1));
          Continue;
          end;
       end;
      end;
     ProcessOperator(GetOperatorIndex(b1));
     Continue;
     end;

    if s[i] = wawFormulaStartBracketChar then
     begin
     ProcessOperator(wawFormulaStartBracketOperatorIndex);
     Inc(i);
     Continue;
     end;

    if s[i] = wawFormulaEndBracketChar then
     begin
     ProcessOperator(wawFormulaEndBracketOperatorIndex);
     Inc(i);
     Continue;
     end;

    if s[i] = wawFormulaStringChar then
     begin
     if FCompileOpStack.LastFunction <> nil then
      FCompileOpStack.LastFunction.iftab := 1;
     Inc(i);
     j:=i;
     for i := i to l do
      if s[i] = wawFormulaStringChar then Break;
     if i > l then
      SetError(swawFormulaCompileErrorInvalidString);
     AddptgStr(Copy(s,j,i-j));
     Continue;
     end;

    if s[i] in wawFormulaNumberChars then
     begin
     if FCompileOpStack.LastFunction <> nil then
      FCompileOpStack.LastFunction.iftab := 1;
     j := i;
     for i := i to l do
      if not(s[i] in wawFormulaNumberChars) then Break;
     b1 := Copy(s,j,i-j);
     val(b1,vi,valcode);
     if ( valcode = 0) and (vi < $FFFF) then
      begin
      AddptgInt(vi);
      Continue;
      end;
     if TextToFloat(PChar(b1),vd,fvExtended) = True then
      begin
      AddptgNum(vd);
      Continue;
      end
     else
      begin
      SetError(Format(swawFormulaCompileErrorInvalidNumber,[b1]));
      Continue;
      end;
     end;

    if s[i] > Char($20) then
     SetError(Format(swawFormulaCompileErrorInvalidSymbol,[b1]));
    Inc(i);
   end;
   Last := FCompileOpStack.Last;
   while FCompileOpStack.Last <> nil do
   begin
     if Last.OperatorInfo.Priority = 0 then
      SetError(swawFormulaCompileErrorInvalidBrackets);
     AddptgOperator(Last);
     Last := FCompileOpStack.Pop;
   end;
  finally
  end;
  if Str <> nil then FreeMem(Str);
end;

end.