home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / Chip_2003-01_cd1.bin / zkuste / delphi / kolekce / d567 / FLEXCEL.ZIP / XLSAdapter / UXlsWorkbookGlobals.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-10-05  |  11.1 KB  |  339 lines
  1. unit UXlsWorkbookGlobals;
  2.  
  3. interface
  4. uses Classes, SysUtils, UXlsBaseRecords, UXlsBaseRecordLists, UXlsOtherRecords, UXlsChart,
  5.      UXlsSST, XlsMessages, UXlsSections, UXlsReferences, USheetNameList, UXlsEscher,
  6.      UXlsFormula, UEscherRecords, UXlsPalette, UXlsXF;
  7. type
  8.   TBoundSheetList = class
  9.   private
  10.    FSheetNames: TSheetNameList;  //Cache with all the sheet names to speed up searching
  11.    FBoundSheets: TBoundSheetRecordList;
  12.   public
  13.     property BoundSheets: TBoundSheetRecordList read FBoundSheets;
  14.  
  15.     constructor Create;
  16.     destructor Destroy; override;
  17.     procedure Clear;
  18.  
  19.     procedure Add(const aRecord: TBoundSheetRecord);
  20.  
  21.     function TotalSize:int64;
  22.     procedure SaveToStream( const DataStream: TStream );
  23.  
  24.     procedure InsertSheet(const BeforeSheet: byte; const OptionFlags: word; const SheetName: WideString);
  25.   end;
  26.  
  27.   TWorkbookGlobals = class( TBaseSection)
  28.   private
  29.     FSST: TSST;
  30.     FReferences: TReferences;
  31.     FBoundSheets: TBoundSheetList;
  32.     FMiscRecords: TBaseRecordList;
  33.     FNames : TNameRecordList;
  34.     FDrawingGroup: TDrawingGroup;
  35.     FWindow1: TWindow1Record;
  36.     FXF: TXFRecordList;
  37.     FFonts: TFontRecordList;
  38.     FFormats: TFormatRecordList;
  39.  
  40.     FPaletteCache: TPaletteRecord;
  41.     FPaletteIndex: integer;
  42.  
  43.     function GetSheetCount: integer;
  44.     function GetSheetName(const index: integer): Widestring;
  45.     procedure SetSheetName(const index: integer; const Value: Widestring);
  46.     function GetSheetOptionFlags(const index: integer): word;
  47.     function GetActivesheet: integer;
  48.     procedure SetActiveSheet(const Value: integer);
  49.     function GetColorPalette(Index: integer): LongWord;
  50.     procedure SetColorPalette(Index: integer; const Value: LongWord);
  51.   public
  52.     property SST: TSST read FSST;
  53.  
  54.     property SheetName[const index: integer]: Widestring read GetSheetName write SetSheetName;
  55.     property SheetCount: integer read GetSheetCount;
  56.     property SheetOptionFlags[const index: integer]: word read GetSheetOptionFlags;
  57.     procedure SheetSetOffset(const index: integer; const Offset: cardinal);
  58.  
  59.     property ActiveSheet: integer read GetActivesheet write SetActiveSheet;
  60.  
  61.     property DrawingGroup: TDrawingGroup read FDrawingGroup;
  62.     property References: TReferences read FReferences;
  63.     property Names: TNameRecordList read FNames;
  64.  
  65.     constructor Create;
  66.     destructor Destroy; override;
  67.     function TotalSize:int64; override;
  68.     procedure Clear; override;
  69.     procedure LoadFromStream( const DataStream: TStream; const First: TBOFRecord; const SST: TSST); override;
  70.     procedure SaveToStream(const DataStream: TStream);override;
  71.  
  72.     procedure InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo);
  73.     procedure DeleteRows(const aRow, aCount: word;const SheetInfo: TSheetInfo);
  74.  
  75.     procedure InsertSheets(const CopyFrom, BeforeSheet: byte; const OptionFlags: word; const Name: WideString; const SheetCount: byte);
  76.  
  77.     property ColorPalette[Index: integer]: LongWord read GetColorPalette write SetColorPalette;
  78.  
  79.     property XF:TXFRecordList read FXF;
  80.     property Fonts:TFontRecordList read FFonts;
  81.     property Formats:TFormatRecordList read FFormats;
  82.   end;
  83.  
  84.  
  85. implementation
  86. { TBoundSheetList }
  87.  
  88. procedure TBoundSheetList.Add(const aRecord: TBoundSheetRecord);
  89. begin
  90.   FSheetNames.Add(aRecord.SheetName);
  91.   FBoundSheets.Add(aRecord); //Last
  92. end;
  93.  
  94. procedure TBoundSheetList.Clear;
  95. begin
  96.   if FSheetNames<>nil then FSheetNames.Clear;
  97.   if FBoundSheets<>nil then FBoundSheets.Clear;
  98. end;
  99.  
  100. constructor TBoundSheetList.Create;
  101. begin
  102.   inherited;
  103.   FSheetNames:= TSheetNameList.Create;
  104.   FBoundSheets:= TBoundSheetRecordList.Create;
  105. end;
  106.  
  107. destructor TBoundSheetList.Destroy;
  108. begin
  109.   FreeAndNil(FSheetNames);
  110.   FreeAndNil(FBoundSheets);
  111.   inherited;
  112. end;
  113.  
  114. procedure TBoundSheetList.InsertSheet(const BeforeSheet: byte;
  115.   const OptionFlags: word; const SheetName: WideString);
  116. var
  117.   NewName: WideString;
  118. begin
  119.   NewName:= FSheetNames.AddUniqueName(SheetName);
  120.   FBoundSheets.Insert(BeforeSheet, TBoundSheetRecord.CreateNew(OptionFlags, NewName));
  121. end;
  122.  
  123. procedure TBoundSheetList.SaveToStream(const DataStream: TStream);
  124. begin
  125.   FBoundSheets.SaveToStream(DataStream);
  126. end;
  127.  
  128. function TBoundSheetList.TotalSize: int64;
  129. begin
  130.   TotalSize:= FBoundSheets.TotalSize;
  131. end;
  132.  
  133. { TWorkbookGlobals }
  134.  
  135. procedure TWorkbookGlobals.Clear;
  136. begin
  137.   inherited;
  138.   if FSST<>nil then FSST.Clear;
  139.   if FReferences<>nil then FReferences.Clear;
  140.   if FBoundSheets<>nil then FBoundSheets.Clear;
  141.   if FMiscRecords<>nil then FMiscRecords.Clear;
  142.   if FNames<>nil then FNames.Clear;
  143.   if FDrawingGroup<>nil then FDrawingGroup.Clear;
  144.   if FXF<>nil then FXF.Clear;
  145.   if FFonts<>nil then FFonts.Clear;
  146.   if FFormats<>nil then FFormats.Clear;
  147.   FPaletteCache:=nil;
  148.   FWindow1:=nil;
  149. end;
  150.  
  151. constructor TWorkbookGlobals.Create;
  152. begin
  153.   inherited;
  154.   FSST:= TSST.Create;
  155.   FReferences:= TReferences.Create;
  156.   FBoundSheets:= TBoundSheetList.Create;
  157.   FMiscRecords:= TBaseRecordList.Create;
  158.   FNames:=TNameRecordList.Create;
  159.   FDrawingGroup:= TDrawingGroup.Create;
  160.   FXF:= TXFRecordList.Create;
  161.   FFonts:= TFontRecordList.Create;
  162.   FFormats:= TFormatRecordList.Create;
  163.   FPaletteCache:=nil;
  164.   FWindow1:=nil;
  165. end;
  166.  
  167. procedure TWorkbookGlobals.DeleteRows(const aRow, aCount: word; const SheetInfo: TSheetInfo);
  168. begin
  169.   FNames.ArrangeInsert(aRow, -aCount, SheetInfo);
  170. end;
  171.  
  172. destructor TWorkbookGlobals.Destroy;
  173. begin
  174.   FreeAndNil(FSST);
  175.   FreeAndNil(FReferences);
  176.   FreeAndNil(FBoundSheets);
  177.   FreeAndNil(FMiscRecords);
  178.   FreeAndNil(FNames);
  179.   FreeAndNil(FDrawingGroup);
  180.   FreeAndNil(FXF);
  181.   FreeAndNil(FFonts);
  182.   FreeAndNil(FFormats);
  183.   inherited;
  184. end;
  185.  
  186. function TWorkbookGlobals.GetActivesheet: integer;
  187. begin
  188.   if FWindow1<>nil then Result:= FWindow1.ActiveSheet else Result:=0;
  189. end;
  190.  
  191. function TWorkbookGlobals.GetColorPalette(Index: integer): LongWord;
  192. begin
  193.   if FPaletteCache=nil then Result:=StandardPalette(Index) else Result:=FPaletteCache.Color[Index];
  194. end;
  195.  
  196. function TWorkbookGlobals.GetSheetCount: integer;
  197. begin
  198.   Result:= FBoundSheets.BoundSheets.Count;
  199. end;
  200.  
  201. function TWorkbookGlobals.GetSheetName(const index: integer): Widestring;
  202. begin
  203.   Result:= FBoundSheets.BoundSheets.SheetName[index];
  204. end;
  205.  
  206. function TWorkbookGlobals.GetSheetOptionFlags(const index: integer): word;
  207. begin
  208.   Result:= FBoundSheets.BoundSheets[index].OptionFlags;
  209. end;
  210.  
  211. procedure TWorkbookGlobals.InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo);
  212. begin
  213.   FNames.ArrangeInsert(DestRow, (LastRow -FirstRow +1)* aCount, SheetInfo);
  214. end;
  215.  
  216. procedure TWorkbookGlobals.InsertSheets(const CopyFrom, BeforeSheet: byte;
  217.   const OptionFlags: word; const Name: WideString; const SheetCount: byte);
  218. var
  219.   i: integer;
  220.   SheetInfo: TSheetInfo;
  221. begin
  222.   for i:=0 to SheetCount-1 do
  223.     FBoundSheets.InsertSheet(BeforeSheet, OptionFlags, Name);
  224.   FReferences.InsertSheets(BeforeSheet, SheetCount);
  225.  
  226.   SheetInfo.InsSheet:=-1;
  227.   SheetInfo.FormulaSheet:=CopyFrom;
  228.   SheetInfo.GetSheet:= FReferences.GetSheet;
  229.   SheetInfo.SetSheet:= FReferences.SetSheet;
  230.   FNames.InsertSheets(CopyFrom, BeforeSheet, SheetCount, SheetInfo );
  231. end;
  232.  
  233. procedure TWorkbookGlobals.LoadFromStream(const DataStream: TStream;
  234.   const First: TBOFRecord; const SST: TSST);
  235. var
  236.   RecordHeader: TRecordHeader;
  237.   R: TBaseRecord;
  238. begin
  239.   Clear;
  240.   repeat
  241.     if (DataStream.Read(RecordHeader, sizeof(RecordHeader)) <> sizeof(RecordHeader)) then
  242.       raise Exception.Create(ErrExcelInvalid);
  243.  
  244.     R:=LoadRecord(DataStream, RecordHeader);
  245.     try
  246.       if (R is TXFRecord) and (FXF.Count=0) then FMiscRecords.Add(TSubListRecord.CreateAndAssign(FXF));
  247.       if (R is TFontRecord) and (FFonts.Count=0) then FMiscRecords.Add(TSubListRecord.CreateAndAssign(FFonts));
  248.       if (R is TFormatRecord) and (FFormats.Count=0) then FMiscRecords.Add(TSubListRecord.CreateAndAssign(FFormats));
  249.  
  250.       if (R is TPaletteRecord) then FPaletteCache:=(R as TPaletteRecord);
  251.       if (R is TXFRecord) or (R is TStyleRecord) then FPaletteIndex:=FMiscRecords.Count; //After the last Style record
  252.  
  253.       if (R is TBofRecord) then raise Exception.Create(ErrExcelInvalid)
  254.       else if (R is TIgnoreRecord) then FreeAndNil(R)
  255.       else if (R is TBoundSheetRecord) then FBoundSheets.Add(R as TBoundSheetRecord)
  256.       else if (R is TNameRecord) then FNames.Add(R as TNameRecord)
  257.       else if (R is TXFRecord) then FXF.Add(R as TXFRecord)
  258.       else if (R is TFontRecord) then FFonts.Add(R as TFontRecord)
  259.       else if (R is TFormatRecord) then FFormats.Add(R as TFormatRecord)
  260.       else if (R is TEOFRecord) then EOF:=(R as TEOFRecord)
  261.       else if (R is TSSTRecord) then begin FSST.Load(R as TSSTRecord); FreeAndNil(R);end
  262.       else if (R is TSupBookRecord) then FReferences.AddSupbook(R as TSupBookRecord)
  263.       else if (R is TExternSheetRecord) then begin; FReferences.AddExternRef(R as TExternSheetRecord); FreeAndNil(R);end
  264.       else if (R is TDrawingGroupRecord) then FDrawingGroup.LoadFromStream(DataStream, R as TDrawingGroupRecord)
  265.       else if (R is TWindow1Record) then begin; FWindow1:=R as TWindow1Record; FMiscRecords.Add(R); end
  266.  
  267.       else FMiscRecords.Add(R);
  268.  
  269.     except
  270.       FreeAndNil(R);
  271.       Raise;
  272.     end; //Finally
  273.  
  274.   until RecordHeader.id = xlr_EOF;
  275.  
  276.   BOF:=First; //Last statement
  277. end;
  278.  
  279. procedure TWorkbookGlobals.SaveToStream(const DataStream: TStream);
  280. begin
  281.   if (BOF=nil)or(EOF=nil) then raise Exception.Create(ErrSectionNotLoaded);
  282.  
  283.   BOF.SaveToStream(DataStream);
  284.   FMiscRecords.SaveToStream(DataStream);
  285.   //FXF, FFonts and FFormats are saved in FMiscRecords.SaveToStream;
  286.  
  287.   FBoundSheets.SaveToStream(DataStream);
  288.   FReferences.SaveToStream(DataStream);
  289.   FNames.SaveToStream(DataStream); //Should be after FBoundSheets.SaveToStream
  290.   FDrawingGroup.SaveToStream(DataStream);
  291.   FSST.SaveToStream(DataStream);
  292.   EOF.SaveToStream(DataStream);
  293. end;
  294.  
  295. procedure TWorkbookGlobals.SetActiveSheet(const Value: integer);
  296. begin
  297.   if FWindow1<>nil then FWindow1.ActiveSheet:=Value;
  298. end;
  299.  
  300. procedure TWorkbookGlobals.SetColorPalette(Index: integer;
  301.   const Value: LongWord);
  302. begin
  303.   if FPaletteCache=nil then
  304.   begin
  305.     //We have to create a standard palette first.
  306.     FMiscRecords.Insert(FPaletteIndex, TPaletteRecord.CreateStandard);
  307.     FPaletteCache:=FMiscRecords[FPaletteIndex] as TPaletteRecord;
  308.   end;
  309.   FPaletteCache.Color[Index]:= Value;
  310. end;
  311.  
  312. procedure TWorkbookGlobals.SetSheetName(const index: integer;
  313.   const Value: Widestring);
  314. begin
  315.    FBoundSheets.BoundSheets.SheetName[index]:=Value;
  316. end;
  317.  
  318. procedure TWorkbookGlobals.SheetSetOffset(const index: integer; const Offset: cardinal);
  319. begin
  320.   FBoundSheets.BoundSheets[index].SetOffset(Offset);
  321. end;
  322.  
  323. function TWorkbookGlobals.TotalSize: int64;
  324. begin
  325.   Result:= inherited TotalSize +
  326.       FSST.TotalSize +
  327.       FReferences.TotalSize +
  328.       FBoundSheets.TotalSize +
  329.       FMiscRecords.TotalSize +
  330.       FNames.TotalSize+
  331.       FDrawingGroup.TotalSize+
  332.       //FXF.TotalSize, FFonts.TotalSize and FFormats.TotalSize are not included in FMiscRecords.TotalSize;
  333.       FXF.TotalSize+
  334.       FFonts.TotalSize+
  335.       FFormats.TotalSize;
  336. end;
  337.  
  338. end.
  339.