decodeformula2.pas

一个经典的读写Excel的控件

          V := SizeOf(TPTGRef8);
        end
        else begin
          DecodeArea7(PPTGRef7(P).Col,PPTGRef7(P).Row,C,R);
          PPTGRef7(P).Row := (PPTGRef7(P).Row and $C000) + R;
          PPTGRef7(P).Col := C;
          V := SizeOf(TPTGRef7);
        end;
      end;
      ptgAreaN,      {2D}
      ptgAreaNV,     {4D}
      ptgAreaNA      {6D} : begin
        case Byte(P^) of
          ptgAreaN:  Byte(P^) := ptgArea;
          ptgAreaNV: Byte(P^) := ptgAreaV;
          ptgAreaNA: Byte(P^) := ptgAreaA;
        end;
        asm inc P end;
        if BIFF8 then begin
          DecodeArea8(PPTGArea8(P).Col1,PPTGArea8(P).Row1,C,R);
          PPTGArea8(P).Row1 := R;
          PPTGArea8(P).Col1 := (PPTGArea8(P).Col1 and $C000) + C;

          DecodeArea8(PPTGArea8(P).Col2,PPTGArea8(P).Row2,C,R);
          PPTGArea8(P).Row2 := R;
          PPTGArea8(P).Col2 := (PPTGArea8(P).Col2 and $C000) + C;
          V := SizeOf(TPTGArea8);
        end
        else begin
          DecodeArea7(PPTGArea7(P).Col1,PPTGArea7(P).Row1,C,R);
          PPTGArea7(P).Row1 := (PPTGArea7(P).Row1 and $C000) + R;
          PPTGArea7(P).Col1 := C;

          DecodeArea7(PPTGArea7(P).Col2,PPTGArea7(P).Row2,C,R);
          PPTGArea7(P).Row2 := (PPTGArea7(P).Row2 and $C000) + R;
          PPTGArea7(P).Col2 := C;
          V := SizeOf(TPTGArea7);
        end;
      end;

      ptgNameX       {39} ,
      ptgNameXV      {59} ,
      ptgNameXA      {79} : if BIFF8 then V := 7 else V := 25;

      ptgRef3d       {3A} ,
      ptgRef3dV      {5A} ,
      ptgRef3dA      {7A} : if BIFF8 then V := 7 else V := 17;

      ptgArea3d      {3B} ,
      ptgArea3dV     {5B} ,
      ptgArea3dA     {7B} : if BIFF8 then V := 11 else V := 21;

      ptgRefErr3d    {3C} ,
      ptgRefErr3dV   {5C} ,
      ptgRefErr3dA   {7C} : if BIFF8 then V := 7 else V := 17;

      ptgAreaErr3d   {3D} ,
      ptgAreaErr3dV  {5D} ,
      ptgAreaErr3dA  {7D} : if BIFF8 then V := 11 else V := 21;

      ptgFuncCEV     {58} : V := 3; // Not sure how to handle these.
      ptgFuncCEA     {78} : V := 3;
      else
        raise Exception.CreateFmt('Unknown ptg[%.2X] in Shared Formula',[Byte(P^)]);
//        V := 1;
    end;
    P := Pointer(Integer(P) + V);
  end;
end;

{ TFormulaRef }

constructor TFormulaRef.Create(Pg: byte; Ref: PByteArray; Abs: TAbsoluteRefs; C1, R1, C2, R2: word; Sht: integer);
begin
  FPTG := Pg;
  FRef := Ref;
  FAbsRef := Abs;
  FCol1 := C1;
  FRow1 := R1;
  FCol2 := C2;
  FRow2 := R2;
  FSheet := Sht
end;

function TFormulaRef.GetIsArea: boolean;
begin
  Result := FPTG in [ptgArea,ptgArea3d];
end;

{ TFormulaRefs }

procedure TFormulaRefs.Add(Pg: byte; Ref: PByteArray; Abs: TAbsoluteRefs; C1, R1, C2, R2: word; Sht: integer);
var
  FmlaRef: TFormulaRef;
begin
  FmlaRef := TFormulaRef.Create(Pg,Ref,Abs,C1,R1,C2,R2,Sht);
  inherited Add(FmlaRef);
end;

procedure TFormulaRefs.FindRefs(BIFF8: boolean; Buf: Pointer; Len: integer);
var
  V,C1,R1,C2,R2: integer;
  Ok: boolean;
  P,P2: PByteArray;
begin
  P := Buf;
  while (Integer(P) - Integer(Buf)) < Len do begin
    case P[0] of
      ptgExp         {01} : V := 1;
      ptgTbl         {02} : V := 5;
      ptgAdd         {03} : V := 1;
      ptgSub         {04} : V := 1;
      ptgMul         {05} : V := 1;
      ptgDiv         {06} : V := 1;
      ptgPower       {07} : V := 1;
      ptgConcat      {08} : V := 1;
      ptgLT          {09} : V := 1;
      ptgLE          {0A} : V := 1;
      ptgEQ          {0B} : V := 1;
      ptgGE          {0C} : V := 1;
      ptgGT          {0D} : V := 1;
      ptgNE          {0E} : V := 1;
      ptgIsect       {0F} : V := 1;
      ptgUnion       {10} : V := 1;
      ptgRange       {11} : V := 1;
      ptgUplus       {12} : V := 1;
      ptgUminus      {13} : V := 1;
      ptgPercent     {14} : V := 1;
      ptgParen       {15} : V := 1;
      ptgMissArg     {16} : V := 1;
      ptgStr         {17} : begin
        asm inc P end;
        if BIFF8 then begin
          if PByteArray(P)[1] = 0 then
            V := PByteArray(P)[0] + 2
          else
            V := (PByteArray(P)[0] * 2) + 2;
        end
        else
          V := PByteArray(P)[0] + 1;
      end;
      ptgAttr        {19} : begin
        asm inc P end;

        if P[0] = $04 then begin
          asm inc P end;
          V := (Word(Pointer(P)^) + 1) * SizeOf(word) + 2;
        end
        else
          V := 3;
      end;
      ptgSheet       {1A} : V := 1;
      ptgEndSheet    {1B} : V := 1;
      ptgErr         {1C} : V := 2;
      ptgBool        {1D} : V := 2;
      ptgInt         {1E} : V := 3;
      ptgNum         {1F} : V := 9;

      ptgArray       {20} ,
      ptgArrayV      {40} ,
      ptgArrayA      {60} : V := 8;

      ptgFunc        {21} ,
      ptgFuncV       {41} ,
      ptgFuncA       {61} : V := 3;

      ptgFuncVar     {22} ,
      ptgFuncVarV    {42} ,
      ptgFuncVarA    {62} : V := 4;

      ptgName        {23} ,
      ptgNameV       {43} ,
      ptgNameA       {63} : if BIFF8 then V := 7 else V := 15;

      ptgRef         {24} ,
      ptgRefV        {44} ,
      ptgRefA        {64} ,
      ptgRefN        {2C} ,
      ptgRefNV       {4C} ,
      ptgRefNA       {6C} : begin
                              P := Pointer(Integer(P) + 1);
                              if BIFF8 then begin
                                C1 := PPTGRef8(P).Col and $3FFF;
                                R1 := PPTGRef8(P).Row;
                                Add(ptgRef,P,MakeAbsR((PPTGRef8(P).Col and $8000) <> $8000,(PPTGRef8(P).Col and $4000) <> $4000),C1,R1,C1,R1,-1);
                                V := 4;
                              end
                              else begin
                                C1 := PPTGRef7(P).Col;
                                R1 := PPTGRef7(P).Row;
                                Add(ptgRef,P,MakeAbsR((PPTGRef8(P).Row and $8000) <> $8000,(PPTGRef8(P).Row and $4000) <> $4000),C1,R1,C1,R1,-1);
                                V := 3;
                              end;
                            end;

      ptgRefErr      {2A} ,
      ptgRefErrV     {4A} ,
      ptgRefErrA     {6A} : if BIFF8 then V := 5 else V := 4;

      ptgArea        {25} ,
      ptgAreaV       {45} ,
      ptgAreaA       {65} ,
      ptgAreaN       {2D} ,
      ptgAreaNV      {4D} ,
      ptgAreaNA      {6D} : begin
                              P := Pointer(Integer(P) + 1);
                              if BIFF8 then begin
                                C1 := PPTGArea8(P).Col1 and $3FFF;
                                R1 := PPTGArea8(P).Row1;
                                C2 := PPTGArea8(P).Col2 and $3FFF;
                                R2 := PPTGArea8(P).Row2;
                                Add(ptgArea,P,MakeAbsA((PPTGArea8(P).Col1 and $8000) <> $8000,(PPTGArea8(P).Col1 and $4000) <> $4000,(PPTGArea8(P).Col2 and $8000) <> $8000,(PPTGArea8(P).Col2 and $4000) <> $4000),C1,R1,C2,R2,-1);
                                V := 8;
                              end
                              else begin
                                C1 := PPTGArea7(P).Col1;
                                R1 := PPTGArea7(P).Row1;
                                C2 := PPTGArea7(P).Col2;
                                R2 := PPTGArea7(P).Row2;
                                Add(ptgArea,P,MakeAbsA((PPTGArea7(P).Row1 and $8000) <> $8000,(PPTGArea7(P).Row1 and $4000) <> $4000,(PPTGArea7(P).Row2 and $8000) <> $8000,(PPTGArea7(P).Row2 and $4000) <> $4000),C1,R1,C2,R2,-1);
                                V := 6;
                              end;
                            end;

      ptgAreaErr     {2B} ,
      ptgAreaErrV    {4B} ,
      ptgAreaErrA    {6B} : if BIFF8 then V := 9 else V := 7;

      ptgMemArea     {26} ,
      ptgMemAreaV    {46} ,
      ptgMemAreaA    {66} : V := Word(Pointer(Integer(P) + 1)^) + 7;

      ptgMemAreaN    {2E} ,
      ptgMemAreaNV   {4E} ,
      ptgMemAreaNA   {6E} : V := Word(Pointer(Integer(P) + 1)^) + 3;

      ptgMemErr      {27} ,
      ptgMemErrV     {47} ,
      ptgMemErrA     {67} : V := Word(Pointer(Integer(P) + 1)^) + 7;

      ptgMemNoMem    {28} ,
      ptgMemNoMemV   {48} ,
      ptgMemNoMemA   {68} : V := Word(Pointer(Integer(P) + 1)^) + 7;

      ptgMemNoMemN   {2F} ,
      ptgMemNoMemNV  {4F} ,
      ptgMemNoMemNA  {6F} : V := Word(Pointer(Integer(P) + 1)^) + 3;

      ptgMemFunc     {29} ,
      ptgMemFuncV    {49} ,
      ptgMemFuncA    {69} : V := Word(Pointer(Integer(P) + 1)^) + 3;

      ptgNameX       {39} ,
      ptgNameXV      {59} ,
      ptgNameXA      {79} : if BIFF8 then V := 7 else V := 25;

      ptgRef3d       {3A} ,
      ptgRef3dV      {5A} ,
      ptgRef3dA      {7A} : begin
                              P := Pointer(Integer(P) + 1);
                              if BIFF8 then begin
                                C1 := PPTGRef3d8(P).Col and $3FFF;
                                R1 := PPTGRef3d8(P).Row;
                                Add(ptgRef3d,P,MakeAbsR((PPTGRef3d8(P).Col and $8000) <> $8000,(PPTGRef3d8(P).Col and $4000) <> $4000),C1,R1,C1,R1,PPTGRef3d8(P).Index);
                                V := 6;
                              end
                              else begin
                                C1 := PPTGRef3d7(P).Col;
                                R1 := PPTGRef3d7(P).Row;
                                Add(ptgRef3d,P,MakeAbsR((PPTGRef3d7(P).Row and $8000) <> $8000,(PPTGRef3d7(P).Row and $4000) <> $4000),C1,R1,C1,R1,PPTGRef3d7(P).Index);
                                V := 16;
                              end;
                            end;

      ptgRefErr3d    {3C} ,
      ptgRefErr3dV   {5C} ,
      ptgRefErr3dA   {7C} : if BIFF8 then V := 7 else V := 17;

      ptgArea3d      {3B} ,
      ptgArea3dV     {5B} ,
      ptgArea3dA     {7B} : begin
                              P := Pointer(Integer(P) + 1);
                              if BIFF8 then begin
                                C1 := PPTGArea3d8(P).Col1 and $3FFF;
                                R1 := PPTGArea3d8(P).Row1;
                                C2 := PPTGArea3d8(P).Col2 and $3FFF;
                                R2 := PPTGArea3d8(P).Row2;
                                Add(ptgArea3d,P,MakeAbsA((PPTGArea3d8(P).Col1 and $8000) <> $8000,(PPTGArea3d8(P).Col1 and $4000) <> $4000,(PPTGArea3d8(P).Col2 and $8000) <> $8000,(PPTGArea3d8(P).Col2 and $4000) <> $4000),C1,R1,C2,R2,PPTGArea3d8(P).Index);
                                V := 10;
                              end
                              else begin
                                C1 := PPTGArea3d7(P).Col1;
                                R1 := PPTGArea3d7(P).Row1;
                                C2 := PPTGArea3d7(P).Col2;
                                R2 := PPTGArea3d7(P).Row2;
                                Add(ptgArea3d,P,MakeAbsA((PPTGArea3d7(P).Row1 and $8000) <> $8000,(PPTGArea3d7(P).Row1 and $4000) <> $4000,(PPTGArea3d7(P).Row2 and $8000) <> $8000,(PPTGArea3d7(P).Row2 and $4000) <> $4000),C1,R1,C2,R2,PPTGArea3d7(P).SheetIndex);
                                V := 20;
                              end;
                            end;

      ptgAreaErr3d   {3D} ,
      ptgAreaErr3dV  {5D} ,
      ptgAreaErr3dA  {7D} : if BIFF8 then V := 11 else V := 21;

      ptgFuncCEV     {58} : V := 3; // Not sure how to handle these.
      ptgFuncCEA     {78} : V := 3;
      else
        raise Exception.CreateFmt('Unknown ptg[%.2X] in FindRefs',[P[0]]);
    end;
    P := Pointer(Integer(P) + V);
  end;
end;

function TFormulaRefs.GetItems(Index: integer): TFormulaRef;
begin
  Result := TFormulaRef(inherited Items[Index]);
end;

function TFormulaRefs.MakeAbsR(C,R: boolean): TAbsoluteRefs;
begin
  Result := [];
  if C then
    Result := Result + [arCol1,arCol2];
  if R then
    Result := Result + [arRow1,arRow2];
end;

function TFormulaRefs.MakeAbsA(C1,R1,C2,R2: boolean): TAbsoluteRefs;
begin
  Result := [];
  if C1 then
    Result := Result + [arCol1];
  if R1 then
    Result := Result + [arRow1];
  if C2 then
    Result := Result + [arCol2];
  if R2 then
    Result := Result + [arRow2];
end;

function TFormulaRefs.Find(Formula: TFormulaCell): boolean;
begin
  FindRefs(FVersion = xvExcel97,Formula.PTGS,Formula.Size);
  Result := Count > 0;
end;

constructor TFormulaRefs.Create(Version: TExcelVersion);
begin
  FVersion := Version;
end;

procedure TFormulaRefs.AdjustRefR1InArea(C1, R1, C2, R2: word; Delta: integer);
var
  i: integer;
begin
  for i := 0 to Count - 1 do begin
    if Items[i].IsArea and (Items[i].FCol1 >= C1) and (Items[i].FRow1 >= R1) and (Items[i].FCol1 <= C2) and (Items[i].FRow1 <= R2) then begin
      if Items[i].FPTG = ptgArea then
        PPTGArea8(Items[i].FRef).Row1 := PPTGArea8(Items[i].FRef).Row1 + Delta;
    end;
  end;
end;

initialization
  StrTRUE := 'TRUE';
  StrFALSE := 'FALSE';
  FuncArgSeparator := ListSeparator;

end.