home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 October / Chip_2002-10_cd1.bin / zkuste / delphi / kolekce / d56 / FLEXCEL.ZIP / XLSAdapter / UXlsCondFmt.pas < prev    next >
Pascal/Delphi Source File  |  2002-07-02  |  6KB  |  228 lines
  1. unit UXlsCondFmt;
  2. interface
  3.  
  4. uses UXlsBaseRecords, UXlsBaseRecordLists, UXlsOtherRecords,
  5.      XlsMessages, classes, sysutils, UXlsRangeRecords, UXlsTokenArray ;
  6.  
  7. type
  8.  
  9.   TCondFmtRecord= class(TRangeRecord)
  10.   end;
  11.  
  12.   TCFRecord = class(TBaseRecord)
  13.   private
  14.     CfType, Op: byte;
  15.     Cce1, Cce2: word;
  16.  
  17.     procedure ArrangeTokensInsertRow(const  atPos, fPos, InsPos, InsOffset, CopyOffset: integer; const SheetInfo: TSheetInfo);
  18.  
  19.   public
  20.     constructor Create(const aId: word; const aData: PArrayOfByte; const aDataSize: integer);override;
  21.     procedure ArrangeInsert(const aPos, aCount:integer; const SheetInfo: TSheetInfo);
  22.     procedure ArrangeCopy(const NewRow: Word);
  23.   end;
  24.  
  25.   TCFRecordList = class (TBaseRecordList)
  26.     {$INCLUDE inc\TCFRecordListHdr.inc}
  27.     procedure ArrangeInsert(const aPos, aCount:integer; const SheetInfo: TSheetInfo);
  28.   end;
  29.  
  30.  
  31.   TCondFmt = class (TRangeEntry)
  32.   private
  33.     Flag: word;
  34.     AllRange: TExcelRange;
  35.     CFs: TCFRecordList;
  36.   protected
  37.     function DoCopyTo: TRangeEntry; override;
  38.   public
  39.     constructor Create; override;
  40.     destructor Destroy; override;
  41.  
  42.     procedure Clear;
  43.     procedure LoadFromStream( const DataStream: TStream; const First: TRangeRecord); override;
  44.     procedure SaveToStream(const DataStream: TStream); override;
  45.     function TotalSize: int64; override;
  46.  
  47.     procedure ArrangeInsert(const aPos, aCount:integer; const SheetInfo: TSheetInfo);override;
  48.     procedure InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo); override;
  49.     procedure DeleteRows(const aRow, aCount: word; const SheetInfo: TSheetInfo);override;
  50.   end;
  51.  
  52. implementation
  53.  
  54.  
  55. { TCondFmt }
  56.  
  57. procedure TCondFmt.Clear;
  58. begin
  59.   if CFs<>nil then CFs.Clear;
  60.   if RangeValuesList<>nil then RangeValuesList.Clear;
  61. end;
  62.  
  63. constructor TCondFmt.Create;
  64. begin
  65.   inherited;
  66.   RangeValuesList:= TRangeValuesList.Create(4+SizeOf(TExcelRange));
  67.   CFs:= TCFRecordList.Create;
  68. end;
  69.  
  70. destructor TCondFmt.Destroy;
  71. begin
  72.   FreeAndNil(CFs);
  73.   inherited;
  74. end;
  75.  
  76. function TCondFmt.DoCopyTo: TRangeEntry;
  77. begin
  78.   Result:=inherited DoCopyTo;
  79.   (Result as TCondFmt).Flag:=Flag;
  80.   (Result as TCondFmt).AllRange:=AllRange;
  81.   (Result as TCondFmt).CFs.CopyFrom(CFs);
  82. end;
  83.  
  84. procedure TCondFmt.DeleteRows(const aRow, aCount: word; const SheetInfo: TSheetInfo);
  85. begin
  86.   RangeValuesList.DeleteRows(aRow, aCount, true);
  87.   inherited;
  88.  
  89. end;
  90.  
  91. procedure TCondFmt.InsertAndCopyRows(const FirstRow, LastRow, DestRow,
  92.   aCount: integer; const SheetInfo: TSheetInfo);
  93. var
  94.   RangeIntersects: boolean;
  95. begin
  96.   RangeIntersects:=(AllRange.R1<= LastRow) and(AllRange.R2>= FirstRow);
  97.   inherited;
  98.   if RangeIntersects then
  99.     RangeValuesList.CopyRowsInclusive( FirstRow, LastRow, DestRow, aCount, AllRange.R1, AllRange.R2);
  100.  
  101. end;
  102.  
  103. procedure TCondFmt.ArrangeInsert(const aPos, aCount:integer; const SheetInfo: TSheetInfo);
  104. begin
  105.   if AllRange.R2>= aPos then
  106.   begin
  107.     inherited;
  108.     if AllRange.R1>= aPos then IncMaxMin(AllRange.R1, aCount, Max_Rows, aPos);
  109.     IncMaxMin(AllRange.R2, aCount, Max_Rows, AllRange.R1);
  110.   end;
  111.  
  112.   CFs.ArrangeInsert(aPos, aCount, SheetInfo );
  113. end;
  114.  
  115. procedure TCondFmt.LoadFromStream(const DataStream: TStream;
  116.   const First: TRangeRecord);
  117. var
  118.   MyRecord: TBaseRecord;
  119.   aPos, CFCount, i: integer;
  120.  
  121.   RecordHeader: TRecordHeader;
  122.   R: TBaseRecord;
  123. begin
  124.   Clear;
  125.   MyRecord:= First;
  126.  
  127.   CFCount:=GetWord(First.Data, 0);
  128.   Flag:=GetWord(First.Data,2);
  129.   aPos:=4;
  130.   ReadMem(MyRecord, aPos, SizeOf(TExcelRange), @AllRange);
  131.   RangeValuesList.Load(First, aPos);
  132.  
  133.   //Load corresponding CFs
  134.   for i:=0 to CFCount-1 do
  135.   begin
  136.     if (DataStream.Read(RecordHeader, sizeof(RecordHeader)) <> sizeof(RecordHeader)) then
  137.        raise Exception.Create(ErrExcelInvalid);
  138.     R:=LoadRecord(DataStream, RecordHeader);
  139.     try
  140.       if not (R is TCFRecord) then raise Exception.Create(ErrInvalidCF);
  141.       CFs.Add(R as TCFRecord);
  142.     except
  143.       FreeAndNil(R);
  144.       raise;
  145.     end; //Except
  146.   end;
  147.  
  148.   First.Free;  //to be consistent with the other LoadFromStream, we should take ownership of the record if there are no exceptions
  149.  
  150. end;
  151.  
  152. procedure TCondFmt.SaveToStream(const DataStream: TStream);
  153. var
  154.   RecordHeader: TRecordHeader;
  155.   CFCount: Word;
  156.   i: integer;
  157. begin
  158.   if RangeValuesList.Count=0 then exit; //Don't save empty CF's
  159.   RecordHeader.Id:= xlr_CONDFMT;
  160.   for i:=0 to RangeValuesList.RepeatCountR-1 do
  161.   begin
  162.     RecordHeader.Size:=RangeValuesList.RecordSizeR(i);
  163.     DataStream.Write(RecordHeader, SizeOf(RecordHeader));
  164.  
  165.     CFCount:= CFs.Count;
  166.     DataStream.Write(CFCount, SizeOf(CFCount));
  167.     DataStream.Write(Flag, SizeOf(Flag));
  168.     DataStream.Write(AllRange, SizeOf(AllRange));
  169.  
  170.     RangeValuesList.SaveToStreamR(DataStream, i);
  171.     CFs.SaveToStream(DataStream);
  172.   end;
  173.  
  174. end;
  175.  
  176. function TCondFmt.TotalSize: int64;
  177. begin
  178.   if RangeValuesList.Count=0 then TotalSize:=0 else
  179.     TotalSize:=RangeValuesList.TotalSizeR + CFs.TotalSize*RangeValuesList.RepeatCountR;
  180. end;
  181.  
  182. { TCFRecord }
  183.  
  184. procedure TCFRecord.ArrangeCopy(const NewRow: Word);
  185. begin
  186. //  No need to arrange nothing... ranges are relative to the cells
  187. end;
  188.  
  189. procedure TCFRecord.ArrangeTokensInsertRow(const atPos, fPos, InsPos, InsOffset, CopyOffset: integer; const SheetInfo: TSheetInfo);
  190. begin
  191.   try
  192.     UXlsTokenArray.ArrangeInsertRows(Data, atPos, fPos, InsPos, InsOffset, CopyOffset, SheetInfo);
  193.   except
  194.     on e: ETokenException do raise Exception.CreateFmt(ErrBadCF,[e.Token]);
  195.     else raise;
  196.   end; //Except
  197. end;
  198.  
  199. constructor TCFRecord.Create(const aId: word;
  200.   const aData: PArrayOfByte; const aDataSize: integer);
  201. begin
  202.   inherited;
  203.   CfType:= Data[0];
  204.   Op:=Data[1];
  205.   Cce1:=GetWord(Data, 2);
  206.   Cce2:=GetWord(Data, 4);
  207. end;
  208.  
  209. procedure TCFRecord.ArrangeInsert(const aPos, aCount:integer; const SheetInfo: TSheetInfo);
  210. begin
  211.   inherited;
  212.   if Cce1>0 then ArrangeTokensInsertRow(DataSize-Cce1-Cce2 , DataSize-Cce2, aPos, aCount, 0,  SheetInfo);
  213.   if Cce2>0 then ArrangeTokensInsertRow(DataSize-Cce2 , DataSize, aPos, aCount, 0,  SheetInfo);
  214. end;
  215.  
  216. { TCFRecordList }
  217.  
  218. {$INCLUDE inc\TCFRecordListImp.inc}
  219.  
  220. procedure TCFRecordList.ArrangeInsert(const aPos, aCount:integer; const SheetInfo: TSheetInfo);
  221. var
  222.   i: integer;
  223. begin
  224.   for i:=0 to Count-1 do Items[i].ArrangeInsert(aPos, aCount,SheetInfo);
  225. end;
  226.  
  227. end.
  228.