tmsuxlssheet.pas

TMS Component Pack V5.0包含了超过 280 个为 Delphi 以及 C++Builder 设计的 TMS 生产控件

end;

function TFlxChart.DoCopyTo: TSheet;
begin
  Result:= inherited DoCopyTo;
  (Result as TFlxChart).FChartRecords.CopyFrom(FChartRecords);
  (Result as TFlxChart).FPrintRecords:=(Result as TFlxChart).FChartRecords;
  Result.FixCachePointers;
  (Result as TFlxChart).RemainingData := nil; //we will not copy this
end;

constructor TFlxChart.Create(const aWorkbookGlobals: TWorkbookGlobals);
begin
  inherited;
  FChartRecords:= TChartRecordList.Create;
  FPrintRecords:=FChartRecords;
end;

destructor TFlxChart.Destroy;
begin
  FreeAndNil(FChartRecords);
  FreeAndNil(FCodeName);
  FreeAndNil(RemainingData);
  inherited;
end;


procedure TFlxChart.LoadSubChart(const DataStream: TOle2File; var RecordHeader: TRecordHeader; const SST: TSST; const Level: integer);
var
  R: TBaseRecord;
  RecordId: integer;
begin
  repeat
    RecordId := RecordHeader.Id;
    R:=LoadRecords(DataStream, RecordHeader);
    try
      if (Level = 0) then LoadCachePointers(R); //CachePointers are only on level 0, as they refer to the sheet

      if (R is TBofRecord) then raise Exception.Create(ErrExcelInvalid);
      if (R is TLabelSSTRecord) then (R as TLabelSSTRecord).AttachToSST(SST)
      else if (R is TIgnoreRecord) then FreeAndNil(R)
      else if (R is TDimensionsRecord) then begin; OriginalDimensions:=(R as TDimensionsRecord).Dim^; FreeAndNil(R);end
      else if (R is TEOFRecord) then sEOF:=(R as TEOFRecord)
      else if (R is TCodeNameRecord) then begin; FreeAndNil(FCodeName); FCodeName:=(R as TCodeNameRecord); end
      else if (R is TBeginRecord)then begin; FChartRecords.Add(R); LoadSubChart(DataStream, RecordHeader, SST, Level + 1); end

      else FChartRecords.Add(R) ;



      if (R<>nil) and (R.Id = xlr_EOF) then
      begin
        RemainingData := R.Continue;
        R.Continue := nil;
      end;

    except
      FreeAndNil(R);
      Raise;
    end; //Finally

  until (RecordId = xlr_EOF) or (RecordId = xlr_END);

end;

procedure TFlxChart.LoadFromStream(const DataStream: TOle2File; var RecordHeader: TRecordHeader;
  const First: TBOFRecord; const SST: TSST);
begin
  Clear;
  LoadSubChart(DataStream, RecordHeader, SST, 0);
  sBOF:=First; //Last statement
end;

procedure TFlxChart.SaveToStream(const DataStream: TOle2File);
begin
  if (sBOF=nil)or(sEOF=nil) then raise Exception.Create(ErrSectionNotLoaded);
  sBOF.SaveToStream(DataStream);
  FChartRecords.SaveToStream(DataStream);
  if (FCodeName<>nil) then FCodeName.SaveToStream(DataStream);
  sEOF.SaveToStream(DataStream);
end;

function TFlxChart.TotalSize: int64;
begin
  Result:= inherited TotalSize+
    FChartRecords.TotalSize;
end;

procedure TFlxChart.SaveRangeToStream(const DataStream: TOle2File;
  const SheetIndex: integer; const CellRange: TXlsCellRange);
begin
  //Can't save a chart range
  SaveToStream(DataStream);
end;

function TFlxChart.TotalRangeSize(const SheetIndex: integer; const CellRange: TXlsCellRange): int64;
begin
  //Can't save a chart range
  Result:=TotalSize;
end;

procedure TFlxChart.ArrangeInsertRowsAndCols(const InsRowPos, InsRowCount, InsColPos, InsColCount: integer; const SheetInfo: TSheetInfo);
begin
  FChartRecords.ArrangeInsertRowsAndCols( InsRowPos, InsRowCount, InsColPos, InsColCount, SheetInfo);
end;

procedure TFlxChart.SetPageHeaderFooter(const P: TPageHeaderFooterRecord;
  const s: UTF16String);
var
  OldSize: integer;
begin
  if P=nil then exit;
  OldSize:=P.DataSize;
  P.Text:=s;
  FChartRecords.AdaptSize(P.DataSize-OldSize);
end;

procedure TFlxChart.AddZoomRecord;
begin
  FZoom:=FChartRecords[FChartRecords.Add(TSCLRecord.CreateFromData(100))] as TSCLRecord;
end;

procedure TFlxChart.FixCachePointers;
var
  i: integer;
begin
  inherited;
  for i:=0 to FChartRecords.Count-1 do
    LoadCachePointers(FChartRecords[i] as TBaseRecord);
end;

{ TChartList }

procedure TChartList.ArrangeInsertRowsAndCols(const InsRowPos, InsRowCount, InsColPos, InsColCount: integer;
  const SheetInfo: TSheetInfo);
var
  i: integer;
begin
  for i:=0 to Count -1 do Items[i].ArrangeInsertRowsAndCols(InsRowPos, InsRowCount, InsColPos, InsColCount, SheetInfo);
end;

procedure TChartList.SaveToStream(const DataStream: TOle2File);
var
  i:integer;
begin
  for i:=0 to Count-1 do Items[i].SaveToStream(DataStream);
end;

{ TWorkSheet }

procedure TWorkSheet.Clear;
begin
  inherited;
  //Dont Clear CodeName
  if FRanges<>nil then FRanges.Clear;
  if FCells<>nil then FCells.Clear;
  if FNotes<>nil then FNotes.Clear;
  if FColumns<>nil then FColumns.Clear;
  if FHLinks<>nil then FHLinks.Clear;
  //FDrawing should be freed after notes
  if FDrawing<>nil then FDrawing.Clear;
  if FVPageBreaks<>nil then FVPageBreaks.Clear;
  if FHPageBreaks<>nil then FHPageBreaks.Clear;
  if FMiscRecords1<>nil then FMiscRecords1.Clear;
  if FMiscRecords2<>nil then FMiscRecords2.Clear;
end;

procedure TWorkSheet.AddOrRemovePane(const Add: Boolean);
var
  i: integer;
  PaneData: PArrayOfByte;
  DataSize: integer;
begin
  if Add then
  begin
    if FPane = nil then
      if FMiscRecords2.Count > 1 then
      begin
        DataSize := 10;
        GetMem(PaneData, DataSize);
        FillChar(PaneData[0], DataSize, 0);
        try
          FPane := TPaneRecord.Create(xlr_PANE, PaneData, DataSize);
          FMiscRecords2.Insert(1, FPane);
        except
          FreeMem(PaneData);
          FPane := nil;
          raise;
        end; //Except
      end
  end
  else
  begin
    if FPane = nil then exit;

    for i := FMiscRecords2.Count - 1 downto 0 do
    if FMiscRecords2[i] = FPane then
    begin
      FMiscRecords2.Delete(i);
      FPane := nil;
      exit;
    end;
  end;
end;


function TWorkSheet.DoCopyTo: TSheet;
begin
  Result:= inherited DoCopyTo;
  (Result as TWorkSheet).FMiscRecords1.CopyFrom(FMiscRecords1);
  (Result as TWorkSheet).FMiscRecords2.CopyFrom(FMiscRecords2);
  (Result as TWorkSheet).FHPageBreaks.CopyFrom(FHPageBreaks);
  (Result as TWorkSheet).FVPageBreaks.CopyFrom(FVPageBreaks);
  (Result as TWorkSheet).FDrawing.CopyFrom(FDrawing, self);
  (Result as TWorkSheet).FCells.CopyFrom(FCells);
  (Result as TWorkSheet).FRanges.CopyFrom(FRanges);
  (Result as TWorkSheet).FNotes.CopyFrom(FNotes);
  (Result as TWorkSheet).FColumns.CopyFrom(FColumns);
  (Result as TWorkSheet).FHLinks.CopyFrom(FHLinks);

  (Result as TWorkSheet).FNotes.FixDwgIds((Result as TWorkSheet).FDrawing);

  (Result as TWorkSheet).FDefColWidth:=FDefColWidth;
  (Result as TWorkSheet).FDefRowHeight:=FDefRowHeight;
  Result.FixCachePointers;
end;

constructor TWorkSheet.Create(const aWorkbookGlobals: TWorkbookGlobals);
begin
  inherited;
  FMiscRecords1:= TBaseRecordList.Create;
  FMiscRecords2:= TBaseRecordList.Create;
  FHPageBreaks:=THPageBreakList.Create;
  FVPageBreaks:=TVPageBreakList.Create;
  FDrawing:= TDrawing.Create(FWorkbookGlobals.DrawingGroup);
  FColumns:= TColInfoList.Create;
  FCells:= TCells.Create(aWorkbookGlobals, FColumns);
  FRanges :=TRangeList.Create;
  FNotes:= TNoteList.Create;
  FHLinks:= THLinkList.Create;

  FPrintRecords:=FMiscRecords1;

  FDefRowHeight:=$FF;
  FDefColWidth:=$0A*DefColWidthAdapt;
end;

constructor TWorkSheet.DoCreateFromData(const SST: TSST);
var
  P: Pointer;
  H: THandle;
  MemStream: TMemoryStream;
  DataStream : TOle2File;
  R: TBaseRecord;
  BOF: TBOFRecord;
  RId: integer;
  RecordHeader: TRecordHeader;
begin
  H:=FindResource(HINSTANCE, RESOURCE_EMPTYSHEET, RT_RCDATA);
  try
    P:=LockResource(LoadResource(HINSTANCE, H));
    try
      MemStream:=TMemoryStream.Create;
      try
        MemStream.Write(P^, SizeofResource(HINSTANCE, H));
        MemStream.Position:=0;
        DataStream := TOle2File.Create(MemStream);
        try
          DataStream.SelectStream(WorkbookStrS);
          //skip workbook
          DataStream.ReadMem(RecordHeader, sizeof(RecordHeader)); //initialize the first time.
          repeat
            R := LoadRecords(DataStream, RecordHeader);
            try
              RId := R.Id;
            finally
              FreeAndNil(R);
            end;
          until RId = xlr_EOF;

          R := LoadRecords(DataStream, RecordHeader);
          try
            if (R is TBOFRecord) then
            begin
              BOF := TBOFRecord(R);
              LoadFromStream(DataStream, RecordHeader, BOF, SST);
            end
            else raise Exception.Create(ErrExcelInvalid);
          except
             FreeAndNil(R);
             raise;
          end;
        finally
          FreeAndNil(DataStream);
        end; //finally
      finally
        FreeAndNil(MemStream);
      end; //finally
finally
      //UnlockResource(P); obsolete in win32
    end;
  finally
    //FreeResource(H); obsolete in win32
  end;
end;

constructor TWorkSheet.CreateFromData(const aWorkbookGlobals: TWorkbookGlobals; const SST: TSST);
begin
  Create(aWorkbookGlobals);
  DoCreateFromData(SST);
end;

destructor TWorkSheet.Destroy;
begin
  FreeAndNil(FRanges);
  FreeAndNil(FCells);
  FreeAndNil(FNotes);
  FreeAndNil(FColumns);
  FreeAndNil(FHLinks);
  //FDrawing should be freed after notes
  FreeAndNil(FDrawing);
  FreeAndNil(FVPageBreaks);
  FreeAndNil(FHPageBreaks);
  FreeAndNil(FMiscRecords1);
  FreeAndNil(FMiscRecords2);
  FreeAndNil(FCodeName);
  inherited;
end;

procedure TWorkSheet.LoadFromStream(const DataStream: TOle2File; var RecordHeader: TRecordHeader;
  const First: TBOFRecord; const SST: TSST);
var
  R: TBaseRecord;
  MiscRecords: TBaseRecordList;
  FShrFmlas: TShrFmlaRecordList;
  LastFormula: TFormulaRecord;
  HasStandardWidthRec: boolean;
  StdW: integer;
  RecordId: integer;
begin
  Clear;
  MiscRecords:=FMiscRecords1;
  FShrFmlas:= TShrFmlaRecordList.Create;
  LastFormula:=nil;
  HasStandardWidthRec:=false;
  StdW:=8;
  try
    repeat
      RecordId := RecordHeader.Id;
      R:=LoadRecords(DataStream, RecordHeader);
      try
        if RecordId=xlr_WINDOW2 then
        begin
          MiscRecords:=FMiscRecords2;
          FWindow2:=R as TWindow2Record;
        end;

        LoadCachePointers(R);

        if (R is TFormulaRecord) then LastFormula:=R as TFormulaRecord;

        //It looks like standardwidth is used <-> DefColwidth=8
        if (R is TDefColWidthRecord) and (not HasStandardWidthRec or ((R as TDefColWidthRecord).Width<>8)) then begin; StdW:=(R as TDefColWidthRecord).Width;FDefColWidth:= StdW*DefColWidthAdapt;end;
        if (R is TStandardWidthRecord) and (StdW=8) then begin HasStandardWidthRec:=true; FDefColWidth:= (R as TStandardWidthRecord).Width;end;
        if (R is TDefRowHeightRecord) then FDefRowHeight:= (R as TDefRowHeightRecord).Height;

        if (R is TLabelSSTRecord) then (R as TLabelSSTRecord).AttachToSST(SST);
        if (R is TBofRecord) then raise Exception.Create(ErrExcelInvalid)
        else if (R is TDrawingRecord) then FDrawing.LoadFromStream(DataStream, RecordHeader, R as TDrawingRecord, SST)
        else if (R is TIgnoreRecord) then FreeAndNil(R)
        else if (R is TDimensionsRecord) then begin; OriginalDimensions:=(R as TDimensionsRecord).Dim^; FreeAndNil(R);end
        else if (R is TNoteRecord) then FNotes.AddRecord(R as TNoteRecord, (R as TNoteRecord).Row)
        else if (R is TColInfoRecord) then FColumns.AddRecord(R as TColInfoRecord)
        else if (R is TCellRecord) then FCells.AddCell(R as TCellRecord, (R as TCellRecord).Row)
        else if (R is TMultipleValueRecord) then begin FCells.AddMultipleCells(R as TMultipleValueRecord);FreeAndNil(R);end
        else if (R is TRowRecord) then FCells.AddRow(R as TRowRecord)
        else if (R is TCondFmtRecord) then FRanges[FRanges.Add(TCondFmt.Create)].LoadFromStream(DataStream, RecordHeader, R as TCondFmtRecord)
        else if (R is TCellMergingRecord) then FRanges[FRanges.Add(TMergedCells.Create)].LoadFromStream(DataStream, RecordHeader, R as TCellMergingRecord)
        else if (R is THLinkRecord) then FHLinks.Add(R as THLinkRecord)
        else if (R is TShrFmlaRecord) then begin if LastFormula=nil then raise Exception.Create(ErrExcelInvalid) else begin; (R as TShrFmlaRecord).Key:=LastFormula.Row+LastFormula.Column shl 16; FShrFmlas.Add(R as TShrFmlaRecord);end end
        else if (R is THPageBreakRecord) then FHPageBreaks.AddRecord(R as THPageBreakRecord)
        else if (R is TVPageBreakRecord) then FVPageBreaks.AddRecord(R as TVPageBreakRecord)
        else if (R is TStringRecord) then begin if LastFormula=nil then raise Exception.Create(ErrExcelInvalid) else LastFormula.SetFormulaValue((R as TStringRecord).Value);FreeAndNil(R);end
        else if (R is TArrayRecord) then begin if LastFormula=nil then raise Exception.Create(ErrExcelInvalid) else LastFormula.ArrayRecord:=R as TArrayRecord;end
        else if (R is TEOFRecord) then sEOF:=(R as TEOFRecord)
        else if (R is TCodeNameRecord) then begin; FreeAndNil(FCodeName); FCodeName:=(R as TCodeNameRecord); end
        else MiscRecords.Add(R) ;

      except
        FreeAndNil(R);
        Raise;
      end; //Finally

    until RecordId = xlr_EOF;