uxlssheet.pas

来自「delphi 第三方控件很出色,表格制作的」· PAS 代码 · 共 1,602 行 · 第 1/4 页

  HasStandardWidthRec: boolean;
  StdW: integer;
begin
  Clear;
  MiscRecords:=FMiscRecords1;
  FShrFmlas:= TShrFmlaRecordList.Create;
  LastFormula:=nil;
  HasStandardWidthRec:=false;
  StdW:=8;
  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;

        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, 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, R as TCondFmtRecord)
        else if (R is TCellMergingRecord) then FRanges[FRanges.Add(TMergedCells.Create)].LoadFromStream(DataStream, 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 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
  sBOF:= First;
end;

procedure TWorkSheet.SaveToStream(const DataStream: TStream);
begin
  if (sBOF=nil)or(sEOF=nil) then raise Exception.Create(ErrSectionNotLoaded);
  sBOF.SaveToStream(DataStream);

  if (FGuts<>nil) and FGuts.RecalcNeeded then
  begin
    FCells.RowList.CalcGuts(FGuts);
    FColumns.CalcGuts(FGuts);
    FGuts.RecalcNeeded:=false;
  end;

  FMiscRecords1.SaveToStream(DataStream);
  FHPageBreaks.SaveToStream(DataStream);
  FVPageBreaks.SaveToStream(DataStream);
  FColumns.SaveToStream(DataStream);
  FCells.SaveToStream(DataStream);
  FDrawing.SaveToStream(DataStream);
  FNotes.SaveToStream(DataStream);
  FMiscRecords2.SaveToStream(DataStream);
  FRanges.SaveToStream(DataStream);
  FHLinks.SaveToStream(DataStream);
  if (FCodeName<>nil) then FCodeName.SaveToStream(DataStream);
  sEOF.SaveToStream(DataStream);
end;

procedure TWorkSheet.SaveRangeToStream(const DataStream: TStream;
  const SheetIndex: integer; const CellRange: TXlsCellRange);
begin
  if (sBOF=nil)or(sEOF=nil) then raise Exception.Create(ErrSectionNotLoaded);
  sBOF.SaveToStream(DataStream);
  FMiscRecords1.SaveToStream(DataStream);
  FHPageBreaks.SaveRangeToStream(DataStream, CellRange);
  FVPageBreaks.SaveRangeToStream(DataStream, CellRange);
  FColumns.SaveRangeToStream(DataStream, CellRange);
  FCells.SaveRangeToStream(DataStream, CellRange);
  //Excel doesnt save drawings to the clipboard
  //FDrawing.SaveToStream(DataStream);
  FNotes.SaveRangeToStream(DataStream, CellRange);
  FMiscRecords2.SaveToStream(DataStream);
  FRanges.SaveRangeToStream(DataStream, CellRange);
  FHLinks.SaveRangeToStream(DataStream, CellRange);
  if (FCodeName<>nil) then FCodeName.SaveToStream(DataStream);
  sEOF.SaveToStream(DataStream);
end;

procedure TWorkSheet.InsertAndCopyRowsAndCols(const FirstRow, LastRow, DestRow, aRowCount,FirstCol, LastCol, DestCol, aColCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);
var
  r: TXlsCellRange;
begin
  if (aRowCount>0) then
  begin
    FCells.InsertAndCopyRows(FirstRow, LastRow, DestRow, aRowCount, SheetInfo, OnlyFormulas);
    FRanges.InsertAndCopyRowsOrCols(FirstRow, LastRow, DestRow, aRowCount, SheetInfo, false);
    FNotes.InsertAndCopyRows(FirstRow, LastRow, DestRow, aRowCount, SheetInfo, false);
    FHPageBreaks.InsertRows(DestRow, aRowCount);

    r.Left:=0;r.Right:=Max_Columns;r.Top:=FirstRow; r.Bottom:=LastRow;
    FHLinks.InsertAndCopyRange(r, DestRow, 0, aRowCount, 0, SheetInfo);
  end;
  if (aColCount>0) then
  begin
    FCells.InsertAndCopyCols(FirstCol, LastCol, DestCol, aColCount, SheetInfo, OnlyFormulas);
    FRanges.InsertAndCopyRowsOrCols(FirstCol, LastCol, DestCol, aColCount, SheetInfo, true);
    FNotes.InsertAndCopyCols(FirstCol, LastCol, DestCol, aColCount, SheetInfo, false);
    FVPageBreaks.InsertCols(DestCol, aColCount);
    r.Top:=0;r.Bottom:=Max_Rows;r.Left:=FirstCol; r.Right:=LastCol;
    FHLinks.InsertAndCopyRange(r, 0, DestCol, 0, aColCount, SheetInfo);
  end;
  FDrawing.InsertAndCopyRowsAndCols(FirstRow, LastRow, DestRow, aRowCount, FirstCol, LastCol, DestCol, aColCount, SheetInfo);
end;

procedure TWorkSheet.DeleteRowsAndCols(const aRow, aRowCount, aCol, aColCount: word; const SheetInfo: TSheetInfo);
var
  r: TXlsCellRange;
begin
  if (aRowCount>0) then
  begin
    FCells.DeleteRows(aRow, aRowCount, SheetInfo);
    FDrawing.DeleteRows(aRow, aRowCount, SheetInfo);
    FRanges.DeleteRowsOrCols(aRow, aRowCount, SheetInfo, false);
    FNotes.DeleteRows(aRow, aRowCount, SheetInfo);
    FHPageBreaks.DeleteRows(aRow, aRowCount);
    r.Left:=0;r.Right:=Max_Columns;r.Top:=aRow; r.Bottom:=aRow+aRowCount;
    FHLinks.DeleteRange(r, 1, 0, SheetInfo);
  end;
  if (aColCount>0) then
  begin
    FCells.DeleteCols(aCol, aColCount, SheetInfo);
    FDrawing.DeleteCols(aCol, aColCount, SheetInfo);
    FRanges.DeleteRowsOrCols(aCol, aColCount, SheetInfo, true);
    FNotes.DeleteCols(aCol, aColCount, SheetInfo);
    FVPageBreaks.DeleteCols(aCol, aColCount);
    r.Top:=0;r.Bottom:=Max_Rows;r.Left:=aCol; r.Right:=aCol+aColCount;
    FHLinks.DeleteRange(r, 0, 1, SheetInfo);
  end;

end;


procedure TWorkSheet.ArrangeInsertRowsAndCols(const InsRowPos, InsRowCount, InsColPos, InsColCount: integer; const SheetInfo: TSheetInfo);
begin
  //PENDING: Optimize this
  FCells.ArrangeInsertRowsAndCols(InsRowPos, InsRowCount, InsColPos, InsColCount, SheetInfo);
  FDrawing.ArrangeInsertRowsAndCols(InsRowPos, InsRowCount, InsColPos, InsColCount, 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.DeleteHPageBreak(const aRow: word);
begin
  inherited;
  FHPageBreaks.DeleteBreak(aRow);
end;

procedure TWorkSheet.DeleteVPageBreak(const aCol: word);
begin
  inherited;
  FVPageBreaks.DeleteBreak(aCol);
end;

procedure TWorkSheet.InsertHPageBreak(const aRow: word);
begin
  inherited;
  FHPageBreaks.AddBreak(aRow);
end;

procedure TWorkSheet.InsertVPageBreak(const aCol: word);
begin
  inherited;
  FVPageBreaks.AddBreak(aCol);
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, 15, 0));
end;

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

function TWorkSheet.GetColHidden(const aCol: Word): boolean;
var
  index: integer;
begin
  if not FColumns.Find(aCol, Index) then Result:=false else Result:=FColumns[Index].Options and $1 = $1;
end;

function TWorkSheet.GetRowHidden(const aRow: integer): boolean;
begin
  if not FCells.RowList.HasRow(aRow) then Result:=false else
  Result:= FCells.RowList[aRow].IsHidden;
end;

procedure TWorkSheet.SetColHidden(const aCol: Word; const Value: boolean);
var
  Index: integer;
begin
  if FColumns.Find(aCol, Index) then
  begin
    if Value then
    begin
      FColumns[Index].Options:=FColumns[Index].Options or $1;
    end else
    begin
      if FColumns[Index].Width=0 then FColumns[Index].Width:=$A;
      FColumns[Index].Options:=FColumns[Index].Options and not $1;
    end;
  end
  else
    if Value then
      FColumns.Insert(Index, TColInfo.Create(aCol, $A, 15, $1));
end;

procedure TWorkSheet.SetRowHidden(const aRow: integer;const Value: boolean);
begin
  FCells.RowList.AddRow(aRow);
  FCells.RowList[aRow].Hide(Value);
end;


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

function TWorkSheet.GetRowFormat(const aRow: integer): integer;
begin
  if not FCells.RowList.HasRow(aRow) or not FCells.RowList[aRow].IsFormatted then Result:=-1 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 row 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;

procedure TWorkSheet.SetAnchor(const Index: integer; const aAnchor: TClientAnchor);
begin
  FDrawing.SetAnchor(Index, aAnchor);
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;

function TWorkSheet.CellMergedList(const index: integer): TXlsCellRange;
var
  i, p, k: integer;
begin
  //Find the cell into the MergedCells array
  Result.Left:=0;
  Result.Right:=0;
  Result.Top:=0;
  Result.Bottom:=0;
  if index<0 then exit;
  p:=0;
  for i:=0 to FRanges.Count-1 do
    if FRanges[i] is TMergedCells then
    begin
      k:=(FRanges[i] as TMergedCells).MergedCount;
      if index<p+k then
      begin
        Result:=(FRanges[i] as TMergedCells).MergedCell(index-p);
        exit;
      end;
      inc (p, k);
    end;
end;

function TWorkSheet.CellMergedListCount: integer;
var
  i: integer;
begin
  Result:=0;
  for i:=0 to FRanges.Count-1 do
    if FRanges[i] is TMergedCells then