home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / Chip_2003-01_cd1.bin / zkuste / delphi / kolekce / d567 / FLEXCEL.ZIP / XLSAdapter / UXlsTokenArray.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-09-26  |  7.9 KB  |  233 lines
  1. unit UXlsTokenArray;
  2.  
  3. interface
  4. uses XlsMessages, sysUtils;
  5. type
  6.   ETokenException= class (EExcelException)
  7.   public
  8.     Token: integer;
  9.     constructor Create(const aToken: integer);
  10.   end;
  11.  
  12.  
  13. //*************************************************************
  14. {**} procedure ArrangeInsertRows(const Data: PArrayOfByte; const atPos, afPos: integer;
  15.                                  const InsPos, InsOffset, CopyOffset: integer;
  16.                                  const SheetInfo: TSheetInfo);
  17. {**} procedure ArrangeInsertSheets(const Data: PArrayOfByte; const atPos, afPos: integer;
  18.                                    const SheetInfo: TSheetInfo);
  19. {**} procedure ArrangeSharedFormulas(const Data: PArrayOfByte; const atPos, afPos: integer;
  20.                               const SharedRow, SharedCol: integer);
  21. //*************************************************************
  22.  
  23. implementation
  24. procedure CreateInvalidRef(var Token: byte);
  25. begin
  26.   if Token in tk_Ref then Inc(Token, tk_RefToRefErr) else
  27.   if Token in tk_Area then Inc(Token, tk_AreaToAreaErr) else
  28.   if Token in tk_Ref3D then Inc(Token, tk_Ref3DToRef3DErr) else
  29.   if Token in tk_Area3D then Inc(Token, tk_Area3DToArea3DErr) else
  30.   if not (Token in tk_RefErr + tk_Ref3DErr + tk_AreaErr + tk_Area3DErr)
  31.     then raise ETokenException.Create(Token);
  32. end;
  33.  
  34. procedure IncWordRef( const Pdata: PArrayOfByte; const tPos: integer; const InsPos, Offset: integer; const Max: integer; const tkPos: integer);
  35. var
  36.   w: int64;
  37. begin
  38.   w:=Pdata^[tPos] or (PData^[tPos+1] shl 8);
  39.  
  40.   //Handle deletes...
  41.   if (Offset<0) and (InsPos >=0) and (w> InsPos) and (w<Inspos - Offset) then
  42.   begin
  43.     CreateInvalidRef( PData[tkPos]);
  44.     exit;
  45.   end;
  46.  
  47.   inc(w, Offset);
  48.  
  49.   if (w>Max) then
  50.   begin
  51.     w:=Max;
  52.     Pdata^[tPos]:= lo(w);
  53.     Pdata^[tPos+1]:= hi(w);
  54.     exit; //References are trimmed
  55.   end;
  56.   if (w<0) then
  57.   begin
  58.     CreateInvalidRef( PData[tkPos]);
  59.     exit;
  60.   end;
  61.   Pdata^[tPos]:= lo(w);
  62.   Pdata^[tPos+1]:= hi(w);
  63. end;
  64.  
  65. procedure IncW(const pData: PArrayOfByte; const tPos: integer; const Offset: integer);
  66. var
  67.   w: ^Word;
  68. begin
  69.   w:=@(PData[tPos]);
  70.   inc(w^, Offset);
  71. end;
  72.  
  73. procedure ArrangeTokenOperand(Token: integer;const Data: ParrayOfByte;
  74.                               var tPos: integer; const InsPos, InsOffset, CopyOffset: integer;
  75.                               const SheetInfo: TSheetInfo; const InsertingSheet: boolean; const SharedRow, SharedCol: integer);
  76. var
  77.   AbsoluteRef: boolean;
  78.   LocalSheet: integer;
  79.   tkPos: integer;
  80. begin
  81.   // Shared formulas
  82.   if (SharedRow>=0) and (Token in tk_RefN+ tk_AreaN) then
  83.   begin
  84.     Inc(Data[tPos],$24-$2C);
  85.     Token:=Data[tPos];
  86.   end;
  87.  
  88.   tkPos:=tPos;
  89.   inc (tPos);
  90.   LocalSheet:= SheetInfo.FormulaSheet;
  91.  
  92.   if Token in tk_Ref3D+ tk_Area3D+ tk_Ref3DErr + tk_Area3DErr then
  93.   begin
  94.     if Assigned(SheetInfo.GetSheet) then
  95.     begin
  96.       LocalSheet:=SheetInfo.GetSheet(GetWord(Data, tPos));
  97.       if InsertingSheet and (LocalSheet=SheetInfo.FormulaSheet) and Assigned(SheetInfo.SetSheet) then
  98.         SetWord(Data, tPos, SheetInfo.SetSheet(SheetInfo.InsSheet));        //this copies external refs to the old sheet to the new sheet
  99.     end;
  100.     inc(tPos, 2);
  101.   end;
  102.  
  103.  
  104.   if Token in tk_Array then
  105.   begin
  106.     inc(tPos,7);
  107.     //Values are stored outside the formula
  108.   end
  109.   else if Token in tk_Name then inc(tPos, 4)
  110.   else if Token in tk_NameX then inc(tPos, 6)
  111.   else if Token in tk_Ref + tk_RefErr + tk_Ref3D + tk_Ref3DErr then
  112.   begin
  113.     if (LocalSheet= SheetInfo.InsSheet) then
  114.     begin
  115.       if GetWord(Data, tPos)>= InsPos then IncWordRef(Data, tPos, InsPos, InsOffset, Max_Rows, tkpos);
  116.     end;
  117.     AbsoluteRef:= (GetWord(Data, tPos+2) and $8000) <> $8000;
  118.     if not AbsoluteRef then IncWordRef(Data, tPos, -1, CopyOffset, Max_Rows, tkpos);
  119.  
  120.     if SharedRow>=0 then
  121.     begin
  122.       AbsoluteRef:= (GetWord(Data, tPos+2) and $8000) <> $8000;
  123.       if not AbsoluteRef then IncW(Data, tPos,   SharedRow);
  124.       AbsoluteRef:= (GetWord(Data, tPos+2) and $4000) <> $4000;
  125.       if not AbsoluteRef then IncW(Data, tPos+2, SharedCol);
  126.     end;
  127.  
  128.     inc(tPos,4);
  129.   end
  130.   else if Token in tk_RefN then inc(tPos,4)//This is used in conditional formats, besides shared formulas
  131.  
  132.   else if Token in tk_Area + tk_AreaErr + tk_Area3D + tk_Area3DErr then
  133.   begin
  134.     if (LocalSheet= SheetInfo.InsSheet) then
  135.     begin
  136.       if GetWord(Data, tPos)>= InsPos then IncWordRef(Data, tPos, InsPos, InsOffset, Max_Rows, tkpos);
  137.       if GetWord(Data, tPos+2)>= InsPos then IncWordRef(Data, tPos+2, InsPos, InsOffset, Max_Rows, tkpos);
  138.     end;
  139.     AbsoluteRef:= (GetWord(Data, tPos+4) and $8000) <> $8000;
  140.     if not AbsoluteRef then IncWordRef(Data, tPos, -1, CopyOffset, Max_Rows, tkpos);
  141.     AbsoluteRef:= (GetWord(Data, tPos+6) and $8000) <> $8000;
  142.     if not AbsoluteRef then IncWordRef(Data, tPos+2, -1, CopyOffset, Max_Rows, tkpos);
  143.  
  144.     if SharedRow>=0 then
  145.     begin
  146.       AbsoluteRef:= (GetWord(Data, tPos+4) and $8000) <> $8000;
  147.       if not AbsoluteRef then IncW(Data, tPos, SharedRow);
  148.       AbsoluteRef:= (GetWord(Data, tPos+4) and $4000) <> $4000;
  149.       if not AbsoluteRef then IncW(Data, tPos+4, SharedCol);
  150.  
  151.       AbsoluteRef:= (GetWord(Data, tPos+6) and $8000) <> $8000;
  152.       if not AbsoluteRef then IncW(Data, tPos+2, SharedRow);
  153.       AbsoluteRef:= (GetWord(Data, tPos+6) and $4000) <> $4000;
  154.       if not AbsoluteRef then IncW(Data, tPos+6, SharedCol);
  155.     end;
  156.  
  157.     inc(tPos,8);
  158.   end
  159.   else if Token in tk_AreaN then inc(tPos,8)  //PENDING: Arreglar inserts en CFs
  160.  
  161.   else raise ETokenException.Create(Token);
  162. end;
  163.  
  164. procedure ArrangeTokenArray(const Data: PArrayOfByte; const atPos, afPos: integer;
  165.                             const InsPos, InsOffset, CopyOffset: integer;
  166.                             const SheetInfo: TSheetInfo; const InsertingSheet: boolean;
  167.                             const SharedRow, SharedCol: integer);
  168. var
  169.   tPos, fPos: integer;
  170.   Token: byte;
  171. begin;
  172.   tPos:=atPos;
  173.   fPos:=afPos;
  174.  
  175.   while tPos<fPos do
  176.   begin
  177.     Token:= Data[tPos];
  178.     if Token in tk_UnaryOps + tk_BinaryOps + [tk_MissArg] then inc(tPos)
  179.     else if Token = tk_Str then inc(tPos,1 + GetStrLen(false, Data,tPos+1, False, 0))
  180.     else if Token in [tk_Err, tk_Bool] then inc(tPos,1+1)
  181.     else if Token in [tk_Int]+ tk_Func then inc(tPos,1+2)
  182.     else if Token in tk_FuncVar then inc(tPos,1+3)
  183.     else if Token in [tk_Num] then inc (tPos,1+8)
  184.     else if Token=tk_Attr then
  185.     begin
  186.       if (Data[tPos+1] and $04)=$04 then inc(tPos, (GetWord(Data, tPos+2)+1)*2);
  187.       inc(tPos, 1+3);
  188.     end
  189.  
  190.     else if Token in tk_Operand then ArrangeTokenOperand(Token, Data, tPos, InsPos, InsOffset, CopyOffset, SheetInfo, InsertingSheet, SharedRow, SharedCol)
  191.  
  192.     else raise ETokenException.Create(Token);
  193.  
  194.   end;
  195.  
  196. end;
  197.  
  198. procedure ArrangeInsertRows(const Data: PArrayOfByte; const atPos, afPos: integer;
  199.                             const InsPos, InsOffset, CopyOffset: integer;
  200.                             const SheetInfo: TSheetInfo);
  201. begin
  202.   ArrangeTokenArray(Data, atPos, afPos, InsPos, InsOffset, CopyOffset, SheetInfo, false, -1, -1);
  203. end;
  204.  
  205. procedure ArrangeInsertSheets(const Data: PArrayOfByte; const atPos, afPos: integer;
  206.                               const SheetInfo: TSheetInfo);
  207. begin
  208.   ArrangeTokenArray(Data, atPos, afPos, 0, 0, 0, SheetInfo, true, -1, -1);
  209. end;
  210.  
  211. procedure ArrangeSharedFormulas(const Data: PArrayOfByte; const atPos, afPos: integer;
  212.                               const SharedRow, SharedCol: integer);
  213. var
  214.   SheetInfo: TSheetInfo;
  215. begin
  216.   SheetInfo.InsSheet:=0;
  217.   SheetInfo.FormulaSheet:=0;
  218.   SheetInfo.GetSheet:=nil;
  219.   sheetInfo.SetSheet:=nil;
  220.   ArrangeTokenArray(Data, atPos, afPos, 0, 0, 0, SheetInfo, false, SharedRow, SharedCol);
  221. end;
  222.  
  223.  
  224. { ETokenException }
  225.  
  226. constructor ETokenException.Create(const aToken: integer);
  227. begin
  228.   Token:= aToken;
  229.   inherited CreateFmt(ErrBadToken, [Token]);
  230. end;
  231.  
  232. end.
  233.