Chip 2003 January/Chip_2003-01_cd1.bin/zkuste/delphi/kolekce/d567/FLEXCEL.ZIP/XLSAdapter/UXlsSheet.pas

Pascal/Delphi Source File | 2002-10-10 | 19.2 KB | 595 lines

unit UXlsSheet;

interface
uses Classes, SysUtils, UXlsBaseRecords, UXlsBaseRecordLists, UXlsOtherRecords, UXlsChart,
     UXlsSST, XlsMessages, UXlsSections, UXlsCondFmt, UXlsRowColEntries, UXlsEscher,
     UXlsRangeRecords, UEscherRecords, UXlsWorkbookGlobals, UXlsNotes, UXlsBaseList,
     UFlxMessages, UXlsCellRecords, UXlsFormula, UXlsPageBreaks, UXlsColInfo;

type
  TSheet= class (TBaseSection)
  private
    function GetShowGridLines: boolean;
    procedure SetShowGridLines(const Value: boolean);
  protected
    FWorkbookGlobals: TWorkbookGlobals;
    FWindow2: TWindow2Record;
    function GetSelected: boolean;
    procedure SetSelected(const Value: boolean);
  public
    function CopyTo: TSheet; //This method can't be virtual
    function DoCopyTo: TSheet; virtual;
    procedure InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);virtual;abstract;
    procedure DeleteRows(const aRow, aCount: word;const SheetInfo: TSheetInfo);virtual; abstract;
    procedure ArrangeInsert(const InsPos, InsCount: integer ; const SheetInfo: TSheetInfo);virtual;abstract;
    procedure ArrangeCopySheet(const SheetInfo: TSheetInfo); virtual;

    procedure InsertPageBreak(const aRow: word);virtual;

    constructor Create(const aWorkbookGlobals: TWorkbookGlobals);virtual;

    property Selected: boolean read GetSelected write SetSelected;
    property ShowGridLines: boolean read GetShowGridLines write SetShowGridLines;
  end;

  ClassOfTSheet= Class of TSheet;

  TChart = class (TSheet)
  private
    FChartRecords: TChartRecordList;
  public

    constructor Create(const aWorkbookGlobals: TWorkbookGlobals);override;
    destructor Destroy;override;
    function DoCopyTo: TSheet; override;

    function TotalSize:int64; override;
    procedure LoadFromStream( const DataStream: TStream; const First: TBOFRecord; const SST: TSST);override;
    procedure SaveToStream(const DataStream: TStream);override;
    procedure Clear; override;
    procedure ArrangeCopySheet(const SheetInfo: TSheetInfo);override;
    procedure ArrangeInsert(const InsPos, InsCount: integer; const SheetInfo: TSheetInfo);override;
    procedure InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);override;
    procedure DeleteRows(const aRow, aCount: word; const SheetInfo: TSheetInfo);override;

  end;

  TChartList = class(TBaseList) //records are TChart
    {$INCLUDE TChartListHdr.inc}
    procedure SaveToStream(const DataStream: TStream);
    procedure ArrangeInsert(const InsPos, InsCount: integer; const SheetInfo: TSheetInfo);
  end;


  TWorkSheet = class (TSheet)
  private
    FMiscRecords1: TBaseRecordList;
    FMiscRecords2: TBaseRecordList;
    FPageBreaks: TPageBreakList;
    FDrawing: TDrawing;
    FCells: TCells;
    FRanges: TRangeList;
    FNotes: TNoteList;
    FColumns: TColInfoList;

    FDefRowHeight: Longint;
    FDefColWidth:  integer;

    function GetDrawingRow(index: integer): integer;
    function GetDrawingName(index: integer): widestring;
  public
    constructor Create(const aWorkbookGlobals: TWorkbookGlobals);override;
    destructor Destroy;override;
    function DoCopyTo: TSheet; override;

    function TotalSize:int64; override;
    procedure LoadFromStream( const DataStream: TStream; const First: TBOFRecord; const SST: TSST);override;
    procedure SaveToStream(const DataStream: TStream); override;
    procedure Clear; override;

    procedure InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);override;
    procedure DeleteRows(const aRow, aCount: word; const SheetInfo: TSheetInfo);override;

    procedure ArrangeInsert(const InsPos, InsCount: integer; const SheetInfo: TSheetInfo);override;
    procedure ArrangeCopySheet(const SheetInfo: TSheetInfo); override;

    property Notes: TNoteList read FNotes;
    property Cells: TCells read FCells;

    function DrawingCount: integer;
    procedure AssignDrawing(const Index: integer; const Data: string; const DataType: TXlsImgTypes);
    procedure GetDrawingFromStream(const Index: integer; const Data: TStream; var DataType: TXlsImgTypes);
    property DrawingRow[index: integer]: integer read GetDrawingRow;
    property DrawingName[index: integer]: widestring read GetDrawingName;
    function GetAnchor(const Index: integer): TClientAnchor;

    procedure InsertPageBreak(const aRow: word);override;

    function GetRowHeight(const aRow: integer): integer;
    function GetColWidth(const aCol: Word): integer;
    procedure SetRowHeight(const aRow: integer; const Value: integer);
    procedure SetColWidth(const aCol: Word; const Value: integer);

    property DefRowHeight: Longint read FDefRowHeight;
    property DefColWidth:  integer read FDefColWidth;

    function GetRowFormat(const aRow: integer): integer;
    function GetColFormat(const aCol: integer): integer;
    procedure SetRowFormat(const aRow: integer; const Value: integer);
    procedure SetColFormat(const aCol: integer; const Value: integer);

    function CellMergedBounds(const aRow, aCol: integer): TXlsCellRange;

  end;

implementation

{ TSheet }

function TSheet.CopyTo: TSheet;
begin
  if Self= nil then Result:=nil else Result:= DoCopyTo;
end;

constructor TSheet.Create(const aWorkbookGlobals: TWorkbookGlobals);
begin
  FWorkbookGlobals:=aWorkbookGlobals;
end;

function TSheet.DoCopyTo: TSheet;
begin
  Result:= ClassOfTSheet(ClassType).Create(FWorkbookGlobals);
  Result.BOF:= BOF.CopyTo as TBOFRecord;
  Result.EOF:= EOF.CopyTo as TEOFRecord;
end;

function TSheet.GetSelected: boolean;
begin
  if (FWindow2<>nil) then Result:=FWindow2.Selected else Result:=false;
end;

procedure TSheet.SetSelected(const Value: boolean);
begin
  if (FWindow2<>nil) then FWindow2.Selected:=value;
end;

procedure TSheet.InsertPageBreak(const aRow: word);
begin
  //Nothing in TSheet
end;

procedure TSheet.ArrangeCopySheet(const SheetInfo: TSheetInfo);
begin
  //Nothing in TSheet
end;

function TSheet.GetShowGridLines: boolean;
begin
  if (FWindow2<>nil) then Result:=FWindow2.ShowGridLines else Result:=true;
end;

procedure TSheet.SetShowGridLines(const Value: boolean);
begin
  if (FWindow2<>nil) then FWindow2.ShowGridLines:=value;
end;

{ TChart }

procedure TChart.ArrangeCopySheet(const SheetInfo: TSheetInfo);
begin
  FChartRecords.ArrangeCopySheet(SheetInfo);
end;

procedure TChart.InsertAndCopyRows(const FirstRow, LastRow, DestRow,
  aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);
begin
  //Nothing, we never insert rows in a chart sheet
end;

procedure TChart.DeleteRows(const aRow, aCount: word; const SheetInfo: TSheetInfo);
begin
  //Nothing, we never delete rows in a chart sheet
end;

procedure TChart.Clear;
begin
  inherited;
  if FChartRecords<>nil then FChartRecords.Clear;
end;

function TChart.DoCopyTo: TSheet;
begin
  Result:= inherited DoCopyTo;
  (Result as TChart).FChartRecords.CopyFrom(FChartRecords);
end;

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

destructor TChart.Destroy;
begin
  FreeAndNil(FChartRecords);
  inherited;
end;

procedure TChart.LoadFromStream(const DataStream: TStream;
  const First: TBOFRecord; const SST: TSST);
var
  RecordHeader: TRecordHeader;
  R: TBaseRecord;
begin
  Clear;
  repeat
    if (DataStream.Read(RecordHeader, sizeof(RecordHeader)) <> sizeof(RecordHeader)) then
      raise Exception.Create(ErrExcelInvalid);

    R:=LoadRecord(DataStream, RecordHeader);
    try
      if RecordHeader.Id=xlr_WINDOW2 then FWindow2:=R as TWindow2Record;
      if (R is TLabelSSTRecord) then (R as TLabelSSTRecord).AttachToSST(SST);
      if (R is TBofRecord) then raise Exception.Create(ErrExcelInvalid)
      else if (R is TIgnoreRecord) then FreeAndNil(R)
      else if (R is TEOFRecord) then EOF:=(R as TEOFRecord)
      else FChartRecords.Add(R) ;
    except
      FreeAndNil(R);
      Raise;
    end; //Finally

  until RecordHeader.id = xlr_EOF;
  BOF:=First; //Last statement
end;

procedure TChart.SaveToStream(const DataStream: TStream);
begin
  if (BOF=nil)or(EOF=nil) then raise Exception.Create(ErrSectionNotLoaded);
  BOF.SaveToStream(DataStream);
  FChartRecords.SaveToStream(DataStream);
  EOF.SaveToStream(DataStream);
end;

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

procedure TChart.ArrangeInsert(const InsPos, InsCount: integer; const SheetInfo: TSheetInfo);
begin
  FChartRecords.ArrangeInsert( InsPos, InsCount, SheetInfo);
end;

{ TChartList }

{$INCLUDE TChartListImp.inc}

procedure TChartList.ArrangeInsert(const InsPos, InsCount: integer;
  const SheetInfo: TSheetInfo);
var
  i: integer;
begin
  for i:=0 to Count -1 do Items[i].ArrangeInsert(InsPos, InsCount, SheetInfo);
end;

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

{ TWorkSheet }

procedure TWorkSheet.Clear;
begin
  inherited;
  if FMiscRecords1<>nil then FMiscRecords1.Clear;
  if FMiscRecords2<>nil then FMiscRecords2.Clear;
  if FPageBreaks<>nil then FPageBreaks.Clear;
  if FDrawing<>nil then FDrawing.Clear;
  if FCells<>nil then FCells.Clear;
  if FRanges<>nil then FRanges.Clear;
  if FNotes<>nil then FNotes.Clear;
  if FColumns<>nil then FColumns.Clear;
end;

function TWorkSheet.DoCopyTo: TSheet;
begin
  Result:= inherited DoCopyTo;
  (Result as TWorkSheet).FMiscRecords1.CopyFrom(FMiscRecords1);
  (Result as TWorkSheet).FMiscRecords2.CopyFrom(FMiscRecords2);
  (Result as TWorkSheet).FPageBreaks.CopyFrom(FPageBreaks);
  (Result as TWorkSheet).FDrawing.CopyFrom(FDrawing);
  (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).FNotes.FixDwgIds((Result as TWorkSheet).FDrawing);

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

constructor TWorkSheet.Create(const aWorkbookGlobals: TWorkbookGlobals);
begin
  inherited;
  FMiscRecords1:= TBaseRecordList.Create;
  FMiscRecords2:= TBaseRecordList.Create;
  FPageBreaks:=TPageBreakList.Create;
  FDrawing:= TDrawing.Create(FWorkbookGlobals.DrawingGroup);
  FColumns:= TColInfoList.Create;
  FCells:= TCells.Create(aWorkbookGlobals.SST, FColumns);
  FRanges :=TRangeList.Create;
  FNotes:= TNoteList.Create;

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

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

procedure TWorkSheet.LoadFromStream(const DataStream: TStream;
  const First: TBOFRecord; const SST: TSST);
var
  RecordHeader: TRecordHeader;
  R: TBaseRecord;
  MiscRecords: TBaseRecordList;
  FShrFmlas: TShrFmlaRecordList;
  LastFormula: TFormulaRecord;
begin
  Clear;
  MiscRecords:=FMiscRecords1;
  FShrFmlas:= TShrFmlaRecordList.Create;
  LastFormula:=nil;
  try
    repeat
      if (DataStream.Read(RecordHeader, sizeof(RecordHeader)) <> sizeof(RecordHeader)) then
        raise Exception.Create(ErrExcelInvalid);

      R:=LoadRecord(DataStream, RecordHeader);
      try
        if RecordHeader.Id=xlr_WINDOW2 then
        begin
          MiscRecords:=FMiscRecords2;
          FWindow2:=R as TWindow2Record;
        end;
        if (R is TFormulaRecord) then LastFormula:=R as TFormulaRecord;

        if (R is TDefColWidthRecord) then FDefColWidth:= (R as TDefColWidthRecord).Width*DefColWidthAdapt;
        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, R as TDrawingRecord, SST)
        else if (R is TIgnoreRecord) then FreeAndNil(R)
        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, R as TCondFmtRecord)
        else if (R is TCellMergingRecord) then FRanges[FRanges.Add(TMergedCells.Create)].LoadFromStream(DataStream, R as TCellMergingRecord)
        else if (R is TShrFmlaRecord) then FShrFmlas.Add(R as TShrFmlaRecord)
        else if (R is THPageBreakRecord) then FPageBreaks.AddRecord(R as THPageBreakRecord)
        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 TEOFRecord) then EOF:=(R as TEOFRecord)
        else MiscRecords.Add(R) ;

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

    until RecordHeader.id = xlr_EOF;

    FNotes.FixDwgIds(FDrawing);
    FCells.CellList.FixFormulas(FShrFmlas);
  finally
    FreeAndNil(FShrFmlas);
  end; //finally

  //this must be the last statment, so if there is an exception, we dont take First
  BOF:= First;
end;

procedure TWorkSheet.SaveToStream(const DataStream: TStream);
begin
  if (BOF=nil)or(EOF=nil) then raise Exception.Create(ErrSectionNotLoaded);
  BOF.SaveToStream(DataStream);
  FMiscRecords1.SaveToStream(DataStream);
  FPageBreaks.SaveToStream(DataStream);
  FColumns.SaveToStream(DataStream);
  FCells.SaveToStream(DataStream);
  FDrawing.SaveToStream(DataStream);
  FNotes.SaveToStream(DataStream);
  FMiscRecords2.SaveToStream(DataStream);
  FRanges.SaveToStream(DataStream);
  EOF.SaveToStream(DataStream);
end;

function TWorkSheet.TotalSize: int64;
begin
  Result:= inherited TotalSize+
    FMiscRecords1.TotalSize +
    FPageBreaks.TotalSize +
    FCells.TotalSize +
    FRanges.TotalSize +
    FDrawing.TotalSize +
    FMiscRecords2.TotalSize+
    FNotes.TotalSize+
    FColumns.TotalSize;
end;

procedure TWorkSheet.InsertAndCopyRows(const FirstRow, LastRow, DestRow, aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);
begin
   FCells.InsertAndCopyRows(FirstRow, LastRow, DestRow, aCount, SheetInfo, OnlyFormulas);
   FDrawing.InsertAndCopyRows(FirstRow, LastRow, DestRow, aCount, SheetInfo);
   FRanges.InsertAndCopyRows(FirstRow, LastRow, DestRow, aCount, SheetInfo);
   FNotes.InsertAndCopyRows(FirstRow, LastRow, DestRow, aCount, SheetInfo, false);
   FPageBreaks.InsertRows(DestRow, aCount);
end;

procedure TWorkSheet.DeleteRows(const aRow, aCount: word; const SheetInfo: TSheetInfo);
begin
   FCells.DeleteRows(aRow, aCount, SheetInfo);
   FDrawing.DeleteRows(aRow, aCount, SheetInfo);
   FRanges.DeleteRows(aRow, aCount, SheetInfo);
   FNotes.DeleteRows(aRow, aCount, SheetInfo);
   FPageBreaks.DeleteRows(aRow, aCount);
end;


procedure TWorkSheet.ArrangeInsert(const InsPos, InsCount: integer; const SheetInfo: TSheetInfo);
begin
  //PENDING: Optimize this
  FCells.ArrangeInsert(InsPos, InsCount, SheetInfo);
  FDrawing.ArrangeInsert(InsPos, InsCount, SheetInfo);
end;



procedure TWorkSheet.AssignDrawing(const Index: integer; const Data: string;
  const DataType: TXlsImgTypes);
begin
  FDrawing.AssignDrawing( Index, Data, DataType);
end;

procedure TWorkSheet.GetDrawingFromStream(const Index: integer; const Data: TStream;
  var DataType: TXlsImgTypes);
begin
  FDrawing.GetDrawingFromStream( Index, Data, DataType);
end;

function TWorkSheet.DrawingCount: integer;
begin
  Result:= FDrawing.DrawingCount;
end;

function TWorkSheet.GetDrawingRow(index: integer): integer;
begin
  Result:= FDrawing.DrawingRow[index];
end;

function TWorkSheet.GetDrawingName(index: integer): widestring;
begin
  Result:= FDrawing.DrawingName[index];
end;

procedure TWorkSheet.InsertPageBreak(const aRow: word);
begin
  inherited;
  FPageBreaks.AddBreak(aRow);
end;

procedure TWorkSheet.ArrangeCopySheet(const SheetInfo: TSheetInfo);
begin
  inherited;
  FDrawing.ArrangeCopySheet(SheetInfo);
end;

function TWorkSheet.GetColWidth(const aCol: Word): integer;
var
  index: integer;
begin
  if not FColumns.Find(aCol, Index) then Result:=DefColWidth else Result:=FColumns[Index].Width;
end;

function TWorkSheet.GetRowHeight(const aRow: integer): integer;
begin
  if not FCells.RowList.HasRow(aRow) then Result:=DefRowHeight else
  Result:= FCells.RowList.RowHeight(aRow);
end;

procedure TWorkSheet.SetColWidth(const aCol: Word; const Value: integer);
var
  Index: integer;
begin
  if FColumns.Find(aCol, Index) then
    FColumns[Index].Width:=Value
  else
    FColumns.Insert(Index, TColInfo.Create(aCol, Value, 0, 0));
end;

procedure TWorkSheet.SetRowHeight(const aRow, Value: integer);
begin
  FCells.RowList.SetRowHeight(aRow, Value);
end;

function TWorkSheet.GetColFormat(const aCol: integer): integer;
var
  index: integer;
begin
  if not FColumns.Find(aCol, Index) then Result:=0 else Result:=FColumns[Index].XF;
end;

function TWorkSheet.GetRowFormat(const aRow: integer): integer;
begin
  if not FCells.RowList.HasRow(aRow) then Result:=0 else
  Result:= FCells.RowList[aRow].XF;
end;

procedure TWorkSheet.SetColFormat(const aCol: integer; const Value: integer);
var
  Index: integer;
  i: integer;
begin
  if FColumns.Find(aCol, Index) then
    FColumns[Index].XF:=Value
  else
    FColumns.Insert(Index, TColInfo.Create(aCol, DefColWidth, Value, 0));

  //Reset all cells in column to format XF
  for i:=0 to FCells.CellList.Count-1 do
    if FCells.CellList[i].Find(aCol, Index) then FCells.CellList[i][Index].XF:=Value;
end;

procedure TWorkSheet.SetRowFormat(const aRow, Value: integer);
var
  i: integer;
begin
  FCells.RowList.AddRow(aRow);
  FCells.RowList[aRow].XF:= Value;

  //Reset all cells in column to format XF
  if(aRow>=0) and (aRow<FCells.CellList.Count) then
    for i:=0 to FCells.CellList[aRow].Count-1 do FCells.CellList[aRow][i].XF:=Value;

end;

function TWorkSheet.GetAnchor(const Index: integer): TClientAnchor;
begin
  Result:= FDrawing.GetAnchor(Index);
end;

function TWorkSheet.CellMergedBounds(const aRow, aCol: integer): TXlsCellRange;
var
  i: integer;
begin
  //Find the cell into the MergedCells array
  Result.Left:=aCol;
  Result.Right:=aCol;
  Result.Top:=aRow;
  Result.Bottom:=aRow;
  for i:=0 to FRanges.Count-1 do
    if FRanges[i] is TMergedCells then
      if (FRanges[i] as TMergedCells).CheckCell(aRow, aCol, Result) then exit;
end;

end.