TXLSWorksheet.InsertRows Bug

[markjforte]

Hi,

I discovered what I believe to be a bug inTXLSWorksheet.InsertRows. To reproduce:

1) Create an Excel spreadsheet, populate cells A1 through A3 (ex: put in "Row1", "Row2", "Row3"), save as Book1.xls.
2) Create new Delphi project with code:

Code: Select all

procedure TForm1.FormShow(Sender: TObject);
var
  FXLS: TXLSReadWriteII5;
begin
  FXLS := TXLSReadWriteII5.Create(Self);
  FXLS.Filename := 'C:\Temp\Book1.xls';
  FXLS.Read;
  FXLS.Sheets[0].InsertRows(2, 3000);
  FXLS.Write;
  FXLS.Free;
end;

3) Run


When I do so, I get a "List index out of bounds (3072)" exception. This exception occurs on the "FCells.AddRow(R,Row.Style);" line:

Code: Select all

procedure TXLSWorksheet.InsertRows(const ARow, ARowCount: integer);
var
  i: integer;
  R,C: integer;
  Row: PXLSMMURowHeader;
begin
  if ARowCount > 0 then begin
    FCells.InsertRows(ARow,ARowCount);

    MoveCellObjects(0,ARow,XLS_MAXCOL,XLS_MAXROW,0,ARowCount);

    AdjustRowsFormulas(ARow,ARowCount);

    if ARow > 0 then begin
      FCells.CalcDimensions;

      Row := FCells.FindRow(ARow - 1);
      if Row <> Nil then begin
        for R := ARow to ARow + ARowCount - 1 do
          FCells.AddRow(R,Row.Style);
      end;

      for C := FCells.Dimension.Col1 to FCells.Dimension.Col2 do begin
        i := FCells.GetStyle(C,ARow - 1);
        if i <> XLS_STYLE_DEFAULT_XF then begin
          for R := ARow to ARow + ARowCount - 1 do
            FCells.StoreBlank(C,R,i);
        end;
      end;
    end;
  end;
end;

I believe it can be fixed as follows:

Code: Select all

procedure TXLSWorksheet.InsertRows(const ARow, ARowCount: integer);
var
  i: integer;
  R,C: integer;
  Row: PXLSMMURowHeader;
  RowStyle: Integer;
begin
  if ARowCount > 0 then begin
    FCells.InsertRows(ARow,ARowCount);

    MoveCellObjects(0,ARow,XLS_MAXCOL,XLS_MAXROW,0,ARowCount);

    AdjustRowsFormulas(ARow,ARowCount);

    if ARow > 0 then begin
      FCells.CalcDimensions;

      Row := FCells.FindRow(ARow - 1);
      if Row <> Nil then begin
        RowStyle := Row.Style;
        for R := ARow to ARow + ARowCount - 1 do
          FCells.AddRow(R,RowStyle);
      end;

      for C := FCells.Dimension.Col1 to FCells.Dimension.Col2 do begin
        i := FCells.GetStyle(C,ARow - 1);
        if i <> XLS_STYLE_DEFAULT_XF then begin
          for R := ARow to ARow + ARowCount - 1 do
            FCells.StoreBlank(C,R,i);
        end;
      end;
    end;
  end;
end;

Will you be updating XLSReadWriteII v5 with bug fixes like this?

Thanks,

-Mark

[larsa]

Hello

The fix will be added to the latest version (ver. 6). Sorry, we don't update old versions.