uxlsrowcolentries.pas

DELPHI tms.component.pack.v4.6.0.7

    Value.XF:=XF;
    SetValue(Row,Col,Value);
  end;
end;

procedure TCellList.ArrangeInsertSheet(const SheetInfo: TSheetInfo);
var
  Data: PArrayOfByte;
  i, k: integer;
  it: TCellRecordList;
begin
  for i:=0 to Count-1 do
  begin
    it:=Items[i];
    for k:=0 to it.Count-1 do
      if it.Items[k] is TFormulaRecord then
      begin
        Data:= it.Items[k].Data;
        ArrangeInsertSheets(Data, 22, 22 + GetWord(Data, 20), SheetInfo);
      end;
  end;
end;

procedure TCellList.RecalcRowHeights(const Workbook: pointer; const Row1: integer; const Row2: integer; const Forced: Boolean; const KeepAutofit: Boolean; const Adjustment: Extended);
var
  RowCalc: TRowHeightCalc;
  RowMultDisplay: Extended;
  ColMultDisplay: Extended;
  i: integer;
  Row: TRowRecord;
  MaxCellHeight: integer;
  Columns: TCellRecordList;
  cCount: integer;
  c: integer;
  Cell: TXlsCellValue;
  rx: TRichString;
  CellHeight: integer;
  Color, index: integer;
  XF: integer;
begin
  //For autofitting all the workoobk:
  //Row2 should be = FRowRecordList.Count - 1;
  //Row1 should be 0.
  RowCalc := TRowHeightCalc.Create(FGlobals);
  try
    RowMultDisplay := RowMult;
    ColMultDisplay := ColMult;
    for i := Row1 to Row2 do
    begin
      if not FRowRecordList.HasRow(i) then
        continue;

      Row := FRowRecordList[i];
      if Row = nil then
        continue;

      if not Forced and not Row.IsAutoHeight then
        continue;

      rx.Value:='';
      SetLength(rx.RTFRuns, 0);
      MaxCellHeight := RowCalc.CalcCellHeight(i + 1, -1, rx, Row.XF, Workbook, RowMultDisplay, ColMultDisplay);
      if i < Count then
      begin
        Columns := Self[i];
        cCount := Columns.Count;
        for c := 0 to cCount - 1 do
        begin
          GetValueX2(i, Columns[c].Column, Cell, Rx.RTFRuns);
          XF:= Cell.XF;
          if XF<0 then
          begin
            XF:=FRowRecordList[i].XF;
            if (XF<=0) and (FColInfoList.Find(Columns[c].Column, index)) then XF:=  FColInfoList[index].XF;
          end;
          if (XF<0) then XF:=15;

          rx.Value:= XlsFormatValue1904(Cell.Value, TExcelFile(Workbook).FormatList[XF].Format, TExcelFile(Workbook).Options1904Dates, Color);

          CellHeight := RowCalc.CalcCellHeight(i + 1, Columns[c].Column + 1, rx, XF, Workbook, RowMultDisplay, ColMultDisplay);
          if CellHeight > MaxCellHeight then MaxCellHeight := CellHeight;
        end;

      end;

      if (Adjustment <> 1) and (Adjustment >= 0) then
        MaxCellHeight := Round(MaxCellHeight * Adjustment);

      if MaxCellHeight > $7FFF then
        MaxCellHeight := $7FFF;

      Row.Height := word(MaxCellHeight);
      if not KeepAutofit then
        Row.ManualHeight;

    end;
  finally
    FreeAndNil(RowCalc);
  end;
end;

procedure TCellList.AutofitColumn(const Workbook: pointer; const Column: integer; const ColCalc: TColWidthCalc; const RowMultDisplay: Extended; const ColMultDisplay: Extended; const IgnoreStrings: Boolean; const Adjustment: Extended);
var
  MaxWidth: integer;
  r: integer;
  CellWidth: integer;

  Cell: TXlsCellValue;
  rx: TRichString;
  Color, index: integer;
  XF: integer;

begin
  MaxWidth := 0;
  for r :=  FRowRecordList.Count - 1 downto 0 do
  begin
    GetValueX2(r, Column, Cell, Rx.RTFRuns);
    XF:= Cell.XF;
    if XF<0 then
    begin
      if (FRowRecordList.HasRow(r)) then XF:=FRowRecordList[r].XF;
      if (XF<=0) and (FColInfoList.Find(Column, index)) then XF:=  FColInfoList[index].XF;
    end;
    if (XF<0) then XF:=15;

    rx.Value:= XlsFormatValue1904(Cell.Value, TExcelFile(Workbook).FormatList[XF].Format, TExcelFile(Workbook).Options1904Dates, Color);

    if IgnoreStrings then
    begin
      if (Items[r].Find(Column,Index)) and (Items[r][index] is TLabelSSTRecord) then continue;
    end;

    CellWidth := ColCalc.CalcCellWidth(r + 1, Column + 1, rx, XF, Workbook, RowMultDisplay, ColMultDisplay);
    if CellWidth > MaxWidth then
      MaxWidth := CellWidth;

  end;

  if (Adjustment <> 1) and (Adjustment >= 0) then
    MaxWidth := Round(MaxWidth * Adjustment) ;

  if MaxWidth > 32767 then
    MaxWidth := 32767;

  if MaxWidth > 0 then
    TExcelFile(Workbook).ColumnWidth[Column + 1]:= MaxWidth;

end;


procedure TCellList.RecalcColWidths(const Workbook: pointer; const Col1, Col2: integer; const IgnoreStrings: Boolean; const Adjustment: Extended);
var
  ColCalc: TColWidthCalc;
  RowMultDisplay: Extended;
  ColMultDisplay: Extended;
  c: integer;
begin
    ColCalc := TColWidthCalc.Create(FGlobals);
    try
      RowMultDisplay := RowMult;
      ColMultDisplay := ColMult;
      for c := Col1 to Col2 do
      begin
        AutofitColumn(Workbook, c,  ColCalc, RowMultDisplay, ColMultDisplay, IgnoreStrings, Adjustment);
      end;
    finally
      FreeAndNil(ColCalc);
    end;
end;


procedure TCellList.ArrangeInsertRowsAndCols(const InsRowPos, InsRowCount,
  InsColPos, InsColCount: integer; const SheetInfo: TSheetInfo);
begin
  inherited ArrangeInsertRowsAndCols(InsRowPos, InsRowCount, InsColPos, InsColCount, SheetInfo);
  if (InsColCount > 0) then
    FColInfoList.ArrangeInsertCols(InsColPos, InsColCount, SheetInfo);
end;

procedure TCellList.InsertAndCopyCols(const FirstCol, LastCol, DestCol,
  aCount: integer; const SheetInfo: TSheetInfo;
  const OnlyFormulas: boolean);
var
  NewFirstCol: integer;
  NewLastCol: integer;
begin
  inherited InsertAndCopyCols(FirstCol, LastCol, DestCol, aCount, SheetInfo, OnlyFormulas);
  if (aCount > 0) then
  begin
    NewFirstCol := FirstCol;
    NewLastCol := LastCol;
    if (DestCol <= FirstCol) then
    begin
      NewFirstCol := FirstCol + (LastCol - FirstCol + 1) * aCount;
      NewLastCol := LastCol + (LastCol - FirstCol + 1) * aCount;
    end;

    FColInfoList.CopyCols(NewFirstCol, NewLastCol, DestCol, aCount, SheetInfo);
  end;

end;

{ TCells }

procedure TCells.AddCell(const aRecord: TCellRecord; const aRow: integer);
begin
  FCellList.AddRecord(aRecord, aRow);
end;

procedure TCells.AddMultipleCells(const aRecord: TMultipleValueRecord);
var
  OneRec: TCellRecord;
begin
  while not aRecord.Eof do
  begin
    OneRec:=aRecord.ExtractOneRecord;
    FCellList.AddRecord( OneRec, OneRec.Row);
  end;
end;

procedure TCells.AddRow(const aRecord: TRowRecord);
begin
  FRowList.AddRecord(aRecord);
end;

procedure TCells.ArrangeInsertRowsAndCols(const InsRowPos, InsRowCount, InsColPos, InsColCount: integer;
  const SheetInfo: TSheetInfo);
begin
  FRowList.ArrangeInsertRowsAndCols(InsRowPos, InsRowCount, InsColPos, InsColCount, SheetInfo);
  FCellList.ArrangeInsertRowsAndCols(InsRowPos, InsRowCount, InsColPos, InsColCount, SheetInfo);
end;

procedure TCells.Clear;
begin
  if FRowList<>nil then FRowList.Clear;
  if FCellList<>nil then FCellList.Clear;
end;

procedure TCells.CopyFrom(const aList: TCells);
begin
  FRowList.CopyFrom(aList.FRowList);
  FCellList.CopyFrom(aList.FCellList);
end;

constructor TCells.Create(const aGlobals: TWorkbookGlobals; const aColInfoList: TColInfoList);
begin
  inherited Create;
  FRowList:=TRowRecordList.Create;
  FCellList:=TCellList.Create(aGlobals, FRowList, aColInfoList);
end;

procedure TCells.DeleteRows(const aRow, aCount: word; const SheetInfo: TSheetInfo);
begin
  FRowList.DeleteRows(aRow, aCount, SheetInfo);
  FCellList.DeleteRows(aRow, aCount, SheetInfo);
end;

procedure TCells.DeleteCols(const aCol, aCount: word; const SheetInfo: TSheetInfo);
begin
  FCellList.DeleteCols(aCol, aCount, SheetInfo);
  ArrangeCols;
end;

destructor TCells.Destroy;
begin
  FreeAndNil(FRowList);
  FreeAndNil(FCellList);
  inherited;
end;

procedure TCells.InsertAndCopyRows(const FirstRow, LastRow, DestRow,
  aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);
begin
  FRowList.InsertAndCopyRows(FirstRow, LastRow, DestRow, aCount, SheetInfo);
  FCellList.InsertAndCopyRows(FirstRow, LastRow, DestRow, aCount, SheetInfo, OnlyFormulas);
end;

procedure TCells.InsertAndCopyCols(const FirstCol, LastCol, DestCol,
  aCount: integer; const SheetInfo: TSheetInfo; const OnlyFormulas: boolean);
begin
  FCellList.InsertAndCopyCols(FirstCol, LastCol, DestCol, aCount, SheetInfo, OnlyFormulas);
  ArrangeCols;
end;

procedure TCells.ArrangeCols;
var
  i: integer;
begin
  for i:= 0 to FRowList.Count-1 do
    if (FRowList.HasRow(i)) then
    begin
      if ((i<FCellList.Count) and (FCellList[i]<>nil) and (FCellList[i].Count>0)) then
      begin
        FRowList[i].MinCol:= FCellList[i][0].Column;
        FRowList[i].MaxCol:= FCellList[i][FCellList[i].Count-1].Column+1;
      end
      else
      begin
        FRowList[i].MinCol:= 0;
        FRowList[i].MaxCol:= 0;
      end;
    end;
end;

function TCells.DimensionsSize: integer;
begin
  Result:= SizeOf(TDimensionsRec)+SizeOf(TRecordHeader);
end;

procedure TCells.CalcUsedRange(var CellRange: TXlsCellRange);
var
  i: integer;
begin
  CellRange.Top:=0;
  while (int64(CellRange.Top)<RowList.Count) and not RowList.HasRow(CellRange.Top) do inc(CellRange.Top);
  CellRange.Bottom:=RowList.Count-1;
  CellRange.Left:=0;
  CellRange.Right:=0;
  for i:=CellRange.Top to RowList.Count-1 do
    if RowList.HasRow(i) then
    begin
      if RowList[i].MaxCol>CellRange.Right then CellRange.Right:=RowList[i].MaxCol;
      if RowList[i].MinCol<CellRange.Left then CellRange.Left:=RowList[i].MinCol;
    end;
  if CellRange.Right>0 then Dec(CellRange.Right); //MaxCol is the max col+1
end;

procedure TCells.WriteDimensions(const DataStream: TStream; const CellRange: TXlsCellRange);
var
  DimRec: TDimensionsRecord;
  DimRecDat: PDimensionsRec;
begin
  GetMem(DimRecDat, SizeOf(TDimensionsRec));
  try
    DimRecDat.FirstRow:=CellRange.Top;
    DimRecDat.LastRow:=CellRange.Bottom+1; //This adds an extra row. Dimensions do from firstrow to lastrow+1
    DimRecDat.FirstCol:=CellRange.Left;
    DimRecDat.LastCol:=CellRange.Right+1;
    DimRecDat.Extra:=0;
    DimRec:=TDimensionsRecord.Create(xlr_DIMENSIONS, PArrayOfByte(DimRecDat), SizeOf(TDimensionsRec));
  except
    FreeMem(DimRecDat);
    raise;
  end;
  try
    DimRec.SaveToStream(DataStream, false);
  finally
    FreeAndNil(DimRec);
  end; //Finally
end;

procedure TCells.SaveToStream(const DataStream: TStream; const NeedsRecalc: boolean);
var
  CellRange: TXlsCellRange;
begin
  FixRows;
  CalcUsedRange(CellRange);
  SaveRangetoStream(DataStream, CellRange, NeedsRecalc);
end;

function TCells.TotalSize: int64;
begin
  TotalSize:= DimensionsSize + FRowList.TotalSize + FCellList.TotalSize;
end;

procedure TCells.FixRows;
var
  i: integer;
begin
  if FRowList.Count>= FCellList.Count then exit;
  for i:=0 to FCellList.Count - 1 do
    if (not FRowList.HasRow(i) and (FCellList[i].Count>0)) then FRowList.AddRow(i);