home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 October / Chip_2002-10_cd1.bin / zkuste / delphi / kolekce / d56 / FLEXCEL.ZIP / XLSAdapter / UXlsFormula.pas < prev    next >
Pascal/Delphi Source File  |  2002-06-24  |  7KB  |  262 lines
  1. unit UXlsFormula;
  2.  
  3. interface
  4. uses classes, sysutils, UXlsBaseRecords, XlsMessages, UXlsTokenArray;
  5.  
  6. type
  7.   TFormulaRecord = class(TCellRecord)
  8.   private
  9.     procedure ArrangeTokensInsertRows(const InsPos, InsOffset, CopyOffset: integer; const SheetInfo: TSheetInfo);
  10.     procedure ArrangeSharedTokens;
  11.   public
  12.     constructor Create(const aId: word; const aData: PArrayOfByte; const aDataSize: integer);override;
  13.     procedure ArrangeInsert(const aPos, aCount:integer;  const SheetInfo: TSheetInfo);override;
  14.     procedure ArrangeCopy(const NewRow: Word);override;
  15.  
  16.     function IsExp(var Key: Cardinal): boolean;
  17.     procedure MixShared(const PData: PArrayOfByte; const aDataSize: integer);
  18.   end;
  19.  
  20.   TNameRecord =  class (TBaseRecord)
  21.   private
  22.     procedure ArrangeTokensInsertRows(const InsPos, InsOffset, CopyOffset: integer; const SheetInfo: TSheetInfo);
  23.     function NameLength: byte;
  24.     function NameSize: integer;
  25.     function OptionFlags: byte;
  26.   public
  27.     constructor Create(const aId: word; const aData: PArrayOfByte; const aDataSize: integer);override;
  28.     procedure ArrangeInsert(aPos, aCount:integer; const SheetInfo: TSheetInfo);
  29.     procedure ArrangeInsertSheets(const FirstSheet, SheetCount: Word);
  30.  
  31.     function ArrangeCopySheet(const SheetInfo: TSheetInfo): TNameRecord;
  32.  
  33.     function RangeSheet: integer;
  34.     function RefersToSheet(const GetSheet:TGetSheet) : integer;
  35.     function Name:Widestring;
  36.     function R1: integer;
  37.     function R2: integer;
  38.     function C1: integer;
  39.     function C2: integer;
  40.   end;
  41.  
  42.   TShrFmlaRecord=class(TBaseRecord)
  43.   public
  44.     function FirstRow: integer;
  45.     function LastRow: integer;
  46.     function FirstCol: integer;
  47.     function LastCol: integer;
  48.     function Key: Cardinal;
  49.   end;
  50.  
  51. implementation
  52.  
  53.  
  54. { TFormulaRecord }
  55.  
  56. procedure TFormulaRecord.ArrangeInsert(const aPos, aCount:integer; const SheetInfo: TSheetInfo);
  57. begin
  58.   inherited;
  59.   ArrangeTokensInsertRows(aPos, aCount, 0, SheetInfo);
  60. end;
  61.  
  62. constructor TFormulaRecord.Create(const aId: word;
  63.   const aData: PArrayOfByte; const aDataSize: integer);
  64. begin
  65.   inherited;
  66.   FillChar(Data^[6],8,0); //clear result
  67.   Data^[6+6]:=2; //error value
  68.   FillChar(Data^[16],4,0); //clear chn
  69.  
  70.   // For automatic recalc...Data^[14]:=Data^[14] or 2;
  71. end;
  72.  
  73. procedure TFormulaRecord.ArrangeCopy(const NewRow: Word);
  74. const
  75.   SheetInfo: TSheetInfo=(InsSheet:-1;FormulaSheet:-1;GetSheet:nil;SetSheet:nil);
  76. begin
  77.   ArrangeTokensInsertRows( 0, 0, NewRow-Row, SheetInfo); //Sheet info doesn't have meaninig on copy
  78.   inherited;   //should be last, so we dont modify Row
  79. end;
  80.  
  81. procedure TFormulaRecord.ArrangeTokensInsertRows(const InsPos, InsOffset,
  82.   CopyOffset: integer; const SheetInfo: TSheetInfo);
  83. begin
  84.   try
  85.     UXlsTokenArray.ArrangeInsertRows(Data, 22, 22+GetWord(Data,20), InsPos, InsOffset, CopyOffset, SheetInfo);
  86.   except
  87.     on e: ETokenException do raise Exception.CreateFmt(ErrBadFormula,[ Row+1, Column+1, e.Token]);
  88.     else raise;
  89.   end; //Except
  90. end;
  91.  
  92. procedure TFormulaRecord.ArrangeSharedTokens;
  93. begin
  94.   try
  95.     UXlsTokenArray.ArrangeSharedFormulas(Data, 22, 22+GetWord(Data,20), Row, Column);
  96.   except
  97.     on e: ETokenException do raise Exception.CreateFmt(ErrBadFormula,[ Row+1, Column+1, e.Token]);
  98.     else raise;
  99.   end; //Except
  100. end;
  101.  
  102. function TFormulaRecord.IsExp(var Key: Cardinal): boolean;
  103. begin
  104.   Result:= (DataSize=27) and (GetWord(Data,20)=5) and (Data[22]=1);
  105.   if Result then Key:=GetWord(Data,23) or (GetWord(Data,25) shl 16);
  106. end;
  107.  
  108. procedure TFormulaRecord.MixShared(const PData: PArrayOfByte; const aDataSize: integer);
  109. var
  110.   NewDataSize: integer;
  111. begin
  112.   //Important: This method changes the size of the record without notifying it's parent list
  113.   //It's necessary to adapt the Totalsize in the parent list.
  114.   NewDataSize:=DataSize - 5+ aDataSize-8 ;
  115.   ReallocMem(Data, NewDataSize);
  116.   //Now is save to change DataSize
  117.   DataSize:=NewDataSize;
  118.   Move(PData[8], Data[20], aDataSize-8);
  119.   ArrangeSharedTokens;
  120. end;
  121.  
  122. { TNameRecord }
  123.  
  124. procedure TNameRecord.ArrangeInsertSheets(const FirstSheet, SheetCount: Word);
  125. begin
  126.   if (RangeSheet<>$FFFF) and (RangeSheet>=FirstSheet) then IncWord(Data, 8, SheetCount, MaxSheets+1); //NewSheet is 0 based, Data[8] is one-based;
  127. end;
  128.  
  129. procedure TNameRecord.ArrangeTokensInsertRows(const InsPos, InsOffset,
  130.   CopyOffset: integer; const SheetInfo: TSheetInfo);
  131. begin
  132.   try
  133.     UXlsTokenArray.ArrangeInsertRows(Data, 14+ NameSize,14+ NameSize+GetWord(Data,4), InsPos, InsOffset, CopyOffset, SheetInfo);
  134.   except
  135.     on e: ETokenException do raise Exception.CreateFmt(ErrBadName,[ Name, e.Token]);
  136.     else raise;
  137.   end; //Except
  138. end;
  139.  
  140. constructor TNameRecord.Create(const aId: word; const aData: PArrayOfByte;
  141.   const aDataSize: integer);
  142. begin
  143.   inherited;
  144.  
  145. end;
  146.  
  147. procedure TNameRecord.ArrangeInsert(aPos, aCount: integer; const SheetInfo: TSheetInfo);
  148. begin
  149.   ArrangeTokensInsertRows( aPos, aCount, 0, SheetInfo);
  150. end;
  151.  
  152. function TNameRecord.Name: Widestring;
  153. var
  154.   s: string;
  155. begin
  156.   if (OptionFlags and 1)=1 then
  157.   begin
  158.     SetLength(Result, NameLength);
  159.     Move(Data[15], Result[1], NameLength*2);
  160.   end else
  161.   begin
  162.     SetLength(s, NameLength);
  163.     Move(Data[15], s[1], NameLength);
  164.     Result:=s;
  165.   end;
  166. end;
  167.  
  168. function TNameRecord.NameLength: byte;
  169. begin
  170.   Result:= Data[3];
  171. end;
  172.  
  173. function TNameRecord.NameSize: integer;
  174. begin
  175.   Result:= GetStrLen(false , Data, 14, true, NameLength);
  176. end;
  177.  
  178. function TNameRecord.OptionFlags: byte;
  179. begin
  180.   OptionFlags:= Data[14];
  181. end;
  182.  
  183. function TNameRecord.RangeSheet: integer;
  184. begin
  185.   Result:=GetWord(Data,8)-1;
  186. end;
  187.  
  188. function TNameRecord.ArrangeCopySheet(const SheetInfo: TSheetInfo): TNameRecord;
  189. begin
  190.   try
  191.     UXlsTokenArray.ArrangeInsertSheets(Data, 14+ NameSize,14+ NameSize+GetWord(Data,4), SheetInfo);
  192.   except
  193.     on e: ETokenException do raise Exception.CreateFmt(ErrBadName,[ Name, e.Token]);
  194.     else raise;
  195.   end; //Except
  196.  
  197.   SetWord(Data, 8, SheetInfo.InsSheet+1); //InsSheet is 0 based, Data[8] is one-based;
  198.   Result:=Self;
  199. end;
  200.  
  201. function TNameRecord.R1: integer;
  202. begin
  203.   if Data[14+ NameSize] in tk_Area3d then Result:= GetWord(Data, 15+2+NameSize)
  204.   else Result:=-1;
  205. end;
  206.  
  207. function TNameRecord.R2: integer;
  208. begin
  209.   if Data[14+ NameSize] in tk_Area3d then Result:= GetWord(Data, 15+4+NameSize)
  210.   else Result:=-1;
  211. end;
  212.  
  213. function TNameRecord.RefersToSheet(const GetSheet:TGetSheet): integer;
  214. begin
  215.   if Data[14+ NameSize] in tk_Area3d then Result:= GetSheet(GetWord(Data, 15+NameSize))
  216.   else Result:=-1;
  217. end;
  218.  
  219.  
  220. function TNameRecord.C1: integer;
  221. begin
  222.   if Data[14+ NameSize] in tk_Area3d then Result:= GetWord(Data, 15+6+NameSize)
  223.   else Result:=-1;
  224. end;
  225.  
  226. function TNameRecord.C2: integer;
  227. begin
  228.   if Data[14+ NameSize] in tk_Area3d then Result:= GetWord(Data, 15+8+NameSize)
  229.   else Result:=-1;
  230. end;
  231.  
  232.  
  233. { TShrFmlaRecord }
  234. function TShrFmlaRecord.FirstRow: integer;
  235. begin
  236.   Result:=GetWord(Data,0);
  237. end;
  238.  
  239. function TShrFmlaRecord.LastRow: integer;
  240. begin
  241.   Result:=GetWord(Data,2);
  242. end;
  243.  
  244. function TShrFmlaRecord.FirstCol: integer;
  245. begin
  246.   Result:=Data[4];
  247. end;
  248.  
  249. function TShrFmlaRecord.LastCol: integer;
  250. begin
  251.   Result:=Data[5];
  252. end;
  253.  
  254. function TShrFmlaRecord.Key: cardinal;
  255. begin
  256.   Result:=GetWord(Data,0) or Data[4] shl 16;
  257. end;
  258.  
  259.  
  260. end.
  261.  
  262.