calculateformula2.pas

一个经典的读写Excel的控件

    Rout := ARow + Shortint(Rin);
  if (Rin and $4000) = 0 then
    Cout := Cin
  else
    Cout := ACol + Shortint(Cin);
end;

procedure DecodeArea8(Cin,Rin: integer; var Cout,Rout: integer);
begin
  if (Cin and $4000) = 0 then
    Cout := Shortint(Cin and $FF)
  else
    Cout := ACol + Shortint(Cin and $FF);
  if (Cin and $8000) = 0 then
    Rout := Rin
  else
    Rout := ARow + Smallint(Rin);
end;

procedure DoFunction(Id, ArgCount: integer);
var
  i: integer;
  S: string;
  Calculated: boolean;
  ArrArgs: array of TFormulaValue;
  Res: TFormulaValue;
begin
  Calculated := True;
  SetLength(ArrArgs,ArgCount);
  for i := 0 to ArgCount - 1 do
    ArrArgs[ArgCount - i - 1] := VStack.Pop;

  FVSetError(Res,errError);

  if Id < 255 then begin
    case TFunctionId(Id) of
       fiRound:  Res := DoROUND(XLS,ArrArgs);
       fiLookup: Res := DoLOOKUP(XLS,ArrArgs);
//       999: Res := DoVLOOKUP(XLS,ArrArgs); // Just to prevent a compiler warning...
       else
         Calculated := False;
    end;
    S := ExcelFunctions[Id].Name
  end
  else // if VStack.Pop = varString then
    S := VStack.Pop.vString;
  if not Calculated and Assigned(XLS.OnFunction) then
    XLS.OnFunction(XLS,S,ArrArgs,Res);

  if (Res.ValType = fvError) and (Res.vError = errError) then
    raise Exception.Create('Unknown function ' + S)
  else
    VStack.Push(Res);
  SetLength(ArrArgs,0);
end;

begin
  Result.vError := errError;
  InSheet := False;
  VStack := TVarStack.Create(XLS,ASheetIndex);
  P := Buf;
  pArray := Pointer(Integer(P) + Len);
  while (Integer(P) - Integer(Buf)) < Len do begin
    case Byte(P^) of
      0: Break;
      ptgExp:
      begin
        asm inc P end;
        raise Exception.Create('Illegal ptg in formula');
      end;
      ptgAdd,ptgSub,ptgMul,ptgDiv,ptgPower,ptgConcat,ptgLT,ptgLE,ptgEQ,ptgGE,
      ptgGT,ptgNE,ptgIsect,ptgUnion,ptgRange,ptgUplus,ptgUminus,ptgPercent:
      begin
        VStack.Operator(Byte(P^));
        P := Pointer(Integer(P) + 1);
      end;
      ptgParen:
      begin
        asm inc P end;
      end;
      ptgMissArg:
      begin
        asm inc P end;
//        Stack.Add('');
      end;
      ptgStr:
      begin
        asm inc P end;
        B := Byte(P^);
        SetLength(S,B);
        asm inc P end;
        O := Byte(P^);
        S := ByteStrToWideString(P,B);
        if (O and $01) = $01 then
          P := Pointer(Integer(P) + B * 2 + 1)
        else
          P := Pointer(Integer(P) + B + 1);
        VStack.Push(S);
{
        if XLS.Version >= xvExcel97 then
          asm inc P end;
}
      end;
      ptgAttr:
      begin
        asm inc P end;
        if (Byte(P^) and $04) = $04 then begin
          asm inc P end;
          P := Pointer(Integer(P) + (Word(P^) + 2) * SizeOf(word) - 3);
        end
        else if (Byte(P^) and $10) = $10 then begin
          VStack.SumRef;
        end;
        if XLS.Version < xvExcel30 then
          asm add P,2 end
        else
          asm add P,3 end;
      end;
      ptgSheet:
      begin
        InSheet := True;
        asm add P,11 end;
      end;
      ptgEndSheet:
      begin
        InSheet := False;
        asm add P,5 end;
      end;
      ptgErr:
      begin
        asm inc P end;
        VStack.Push(ErrorCodeToText(Byte(P^)));
        asm inc P end;
      end;
      ptgBool:
      begin
        asm inc P end;
        if Byte(P^) = 0 then
          VStack.Push(False)
        else
          VStack.Push(True);
        asm inc P end;
      end;
      ptgInt:
      begin
        asm inc P end;
        VStack.Push(Smallint(P^));
        asm add P,2 end;
      end;
      ptgNum:
      begin
        asm inc P end;
        VStack.Push(Double(P^));
        asm add P,8 end;
      end;
      ptgRef,ptgRefV,ptgRefA:
      begin
        asm inc P end;
        if XLS.Version < xvExcel97 then with PPTGRef7(P)^ do begin
          VStack.Push(XLS.Sheets[ASheetIndex].AsFloat[Col,Row and $3FFF]);
          P := Pointer(Integer(P) + SizeOf(TPTGRef7));
        end
        else with PPTGRef8(P)^ do begin
          if not (coNotCalcDependent in Options) and (XLS.Sheets[ASheetIndex].CellType[Col and $3FFF,Row] in TFormulaCellType) and not TFormulaCell(XLS.Sheets[ASheetIndex].Cell[Col and $3FFF,Row]).Calculated then
            VStack.Push(XLS.Sheets[ASheetIndex].XCalculate(Col and $3FFF,Row))
          else
            VStack.Push(XLS.Sheets[ASheetIndex].AsFormulaValue[Col and $3FFF,Row]);
          P := Pointer(Integer(P) + SizeOf(TPTGRef8));
        end;
      end;
      ptgRefN,ptgRefNV,ptgRefNA:
      begin
        asm inc P end;
        if XLS.Version < xvExcel97 then with PPTGRef7(P)^ do begin
          DecodeArea7(Col,Row,C,R);
          VStack.PushRef(C,R);
          P := Pointer(Integer(P) + SizeOf(TPTGRef7));
        end
        else with PPTGRef8(P)^ do begin
          DecodeArea8(Col,Row,C,R);
          VStack.PushRef(C,R);
          P := Pointer(Integer(P) + SizeOf(TPTGRef8));
        end;
      end;
      ptgArea,ptgAreaV,ptgAreaA:
      begin
        asm inc P end;
        if XLS.Version < xvExcel97 then with PPTGArea7(P)^ do begin
          VStack.PushArea(Col1,Row1 and $3FFF,Col2,Row2 and $3FFF);
          P := Pointer(Integer(P) + SizeOf(TPTGArea7));
        end
        else with PPTGArea8(P)^ do begin
          VStack.PushArea(Col1 and $3FFF,Row1,Col2 and $3FFF,Row2);
          P := Pointer(Integer(P) + SizeOf(TPTGArea8));
        end;
      end;
      ptgAreaN,ptgAreaNV,ptgAreaNA:
      begin
        asm inc P end;
        if XLS.Version < xvExcel97 then with PPTGArea7(P)^ do begin
          DecodeArea7(Col1,Row1,C,R);
          varRef.vArea[0] := C;
          varRef.vArea[1] := R;
          DecodeArea7(Col2,Row2,C,R);
          varRef.vArea[2] := C;
          varRef.vArea[3] := R;
        end
        else with PPTGArea8(P)^ do begin
          DecodeArea8(Col1,Row1,C,R);
          varRef.vArea[0] := C;
          varRef.vArea[1] := R;
          DecodeArea8(Col2,Row2,C,R);
          varRef.vArea[2] := C;
          varRef.vArea[3] := R;
        end;
        VStack.Push(varRef);
      end;
      ptgRefErr,ptgRefErrV,ptgRefErrA:
      begin
        asm add P,4 end;
        if XLS.Version >= xvExcel97 then
          asm inc P end;
        VStack.Push('#REF!');
      end;
      ptgAreaErr,ptgAreaErrV,ptgAreaErrA:
      begin
        asm add P,7 end;
        if XLS.Version >= xvExcel97 then
          asm add P,2 end;
        VStack.Push('#REF!');
      end;
      ptgName,ptgNameV,ptgNameA:
      begin
        asm inc P end;
        if XLS.Version < xvExcel50 then with PPTGName7(P)^ do begin
          if InSheet then
            VStack.Push('[EXTERNNAME]' { XLS.ExternNames[NameIndex] } )
          else
            VStack.Push('[NAME]' { XLS.Names[NameIndex] } );
          P := Pointer(Integer(P) + SizeOf(TPTGName7) - 4);
        end
        else if XLS.Version < xvExcel97 then with PPTGName7(P)^ do begin
          raise Exception.Create('XXX ptgName');
{
          with XLS.NameDefs.WorkbookNames[NameIndex - 1] do
            VStack.Push(CalculateFmla(XLS,NameDef,NameDefLen,ACol,ARow,ASheetIndex));
}
          P := Pointer(Integer(P) + SizeOf(TPTGName7));
        end
        else with PPTGName8(P)^ do begin
          with XLS.InternalNames[NameIndex - 1] do
            VStack.Push(CalculateFmla(XLS,NameDef,Length(NameDef),ACol,ARow,ASheetIndex,Options));
          P := Pointer(Integer(P) + SizeOf(TPTGName8));
        end;
      end;
      ptgNameX,ptgNameXV,ptgNameXA:
      begin
        asm inc P end;
        if XLS.Version < xvExcel97 then with PPTGNameX7(P)^ do begin
          VStack.Push(XLS.FormulaHandler.GetName(ntExternName,ExtSheet,NameIndex,0,0));
          P := Pointer(Integer(P) + SizeOf(TPTGNameX7));
        end
        else with PPTGNameX8(P)^ do begin
          i := XLS.FormulaHandler.ExternalNames.IsSelf(ExtSheet);
          if i >= 0 then begin
            with XLS.InternalNames[NameIndex] do begin
              if NameIsCell then
                VStack.Push(XLS.Sheets[i].AsString[Col1,Row1])
              else if NameIsArea then
                VStack.PushArea(Col1,Row1,Col2,Row2);
            end;
          end
          else
            VStack.Push(XLS.GetExternNameValue(ExtSheet,NameIndex));
          P := Pointer(Integer(P) + SizeOf(TPTGNameX8));
        end;
      end;
      ptgArray,ptgArrayV,ptgArrayA:
      begin
        asm inc P end;
//        P2 := Pointer(Integer(PBuf) + PRecFORMULA(PBuf)^.ParseLen);


//        S := GetArray;
//        Stack.Add(Copy(S,1,Length(S) - 1) + '}');
        P := Pointer(Integer(P) + 7);
      end;
      ptgFunc,ptgFuncV,ptgFuncA:
      begin
        asm inc P end;
        if (XLS.Version >= xvExcel40) and (word(P^) <= High(ExcelFunctions)) then begin
          if not VStack.Func(TFunctionId(word(P^))) then
            DoFunction(byte(P^),ExcelFunctions[byte(P^)].Min);
          asm add P,1 end;
        end
        else if XLS.Version <= xvExcel30 then
          DoFunction(byte(P^),ExcelFunctions[byte(P^)].Min)
        else begin
          VStack.Push('?<' + IntToStr(Word(P^)) + '>?');
          asm add P,1 end;
        end;
        asm add P,1 end;
      end;
      ptgFuncVar,ptgFuncVarV,ptgFuncVarA:
      begin
        j := 0;
        asm inc P end;
        i := Byte(P^) and $7F;
        asm inc P end;
        if (XLS.Version >= xvExcel50) and (word(P^) <= High(ExcelFunctions)) then
          j := word(P^) and $7FFF
        else if XLS.Version < xvExcel50 then
          j := byte(P^);

        if j <= Integer(High(TFunctionId)) then
          VStack.FuncVar(TFunctionId(j),i)
        else
          DoFunction(j,i);

        asm add P,1 end;
        if XLS.Version = xvExcel40 then
          asm add P,1 end;
        if XLS.Version >= xvExcel50 then
          asm add P,1 end;
      end;
      ptgRef3d,ptgRef3dV,ptgRef3dA,ptgRefErr3d,ptgRefErr3dV,ptgRefErr3dA:
      begin
        i := Byte(P^);
        asm inc P end;
        if XLS.Version >= xvExcel97 then with PPTGRef3d8(P)^ do begin
          if i in [ptgRefErr3d,ptgRefErr3dV] then
            S := '!#REF!'
          else
            VStack.Push(XLS.GetNameValue(Index,Col and $3FFF,Row));
          P := Pointer(Integer(P) + SizeOf(TPTGRef3d8));
        end
        else with PPTGRef3d7(P)^ do begin
          if Smallint(Index) >= 0 then
            S := XLS.FormulaHandler.GetName(ntExternSheet,Index,-1,0,0)
          else
            S := '';
          if (IndexFirst = $FFFF) or (IndexLast = $FFFF) then
            S := S + '[DELETED]'
          else if IndexFirst = IndexLast then
            S := S + XLS.Sheets[IndexLast].Name
          else
            S := S + XLS.Sheets[IndexFirst].Name + ':' + XLS.Sheets[IndexLast].Name;
          if i in [ptgRefErr3d,ptgRefErr3dV] then
            VStack.Push(S + '!#REF!')
          else
            VStack.Push(S + '!' + ColRowToRefStr(Col,Row and $3FFF,(Row and $4000) = 0,(Row and $8000) = 0));
          P := Pointer(Integer(P) + SizeOf(TPTGRef3d7));
        end;
      end;
      ptgArea3d,ptgArea3dV,ptgArea3dA,ptgAreaErr3d,ptgAreaErr3dV,ptgAreaErr3dA:
      begin
        i := Byte(P^);
        asm inc P end;
        if XLS.Version >= xvExcel97 then with PPTGArea3d8(P)^ do begin
          if Index < XLS.Sheets.Count then
            S := XLS.Sheets[Index].Name
          else
            S := '<??? Ref3d>';
          if i in [ptgAreaErr3d,ptgAreaErr3dV] then
            S := S + '!#REF!'
          else
            VStack.PushXArea(Col1 and $3FFF,Row1,Col2 and $3FFF,Row2,Index);
          P := Pointer(Integer(P) + SizeOf(TPTGArea3d8));
        end
        else with PPTGArea3d7(P)^ do begin
          if Smallint(SheetIndex) >= 0 then
            S := '[EXTERN ???]:'
          else
            S := '';
          if (IndexFirst = $FFFF) or (IndexLast = $FFFF) then
            S := S + '[DELETED]'
          else if IndexFirst = IndexLast then
            S := S + XLS.Sheets[IndexLast].Name
          else
            S := S + XLS.Sheets[IndexFirst].Name + ':' + XLS.Sheets[IndexLast].Name;
          if i in [ptgAreaErr3d,ptgAreaErr3dV] then
            VStack.Push(S + '!#REF!')
          else
            VStack.PushXArea(Col1,Row1 and $3FFF,Col2,Row2 and $3FFF,SheetIndex);
          P := Pointer(Integer(P) + SizeOf(TPTGArea3d7));
        end;
      end;
      else begin
        VStack.Push(Format('Unknown ptg[%.2X]',[Byte(P^)]));
        Break;
      end;
    end;
  end;
  Result := VStack.Pop;
  VStack.Free;
end;

procedure TVarStack.Push(Value: double);
begin
  IncStack;
  FVSetFloat(FStack[FStackPtr],Value);
end;

procedure TVarStack.Push(Value: WideString);
begin
  IncStack;
  FVSetString(FStack[FStackPtr],Value);
end;

procedure TVarStack.Push(Value: boolean);
begin
  IncStack;
  FVSetBoolean(FStack[FStackPtr],Value);
end;

procedure TVarStack.PushArea(Col1, Row1, Col2, Row2: word);
begin
  IncStack;
  FVSetArea(FStack[FStackPtr],Col1, Row1, Col2, Row2);
end;

procedure TVarStack.PushRef(Col, Row: word);
begin
  IncStack;
  FVSetRef(FStack[FStackPtr],Col, Row);
end;

procedure TVarStack.PushXArea(Col1, Row1, Col2, Row2, Sheet: word);
begin
  IncStack;
  FVSetXArea(FStack[FStackPtr],Col1, Row1, Col2, Row2, Sheet);
end;

{
procedure TVarStack.PushXRef(Col, Row, Sheet: word);
begin
  IncStack;
  FVSetXRef(FStack[FStackPtr],Col, Row, Sheet);
end;
}

end.