pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Fix cell row and column enumerator sometimes failing

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4036 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-03-16 00:05:56 +00:00
parent 3a9150acf3
commit 95edadbd29
8 changed files with 109 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
components/fpspreadsheet/examples/visual/fpsctrls/main.lfm
View File

@ -1,7 +1,7 @@
object MainForm: TMainForm
Left = 503
Left = 338
Height = 621
Top = 157
Top = 118
Width = 940
Caption = 'demo_ctrls'
ClientHeight = 601
@ -80,7 +80,7 @@ object MainForm: TMainForm
'FileName='
'FileFormat=sfExcel8'
'ActiveWorksheet=Sheet1'
'Options=boAutoCalc, boCalcBeforeSaving, boReadFormulas'
'Options=boBufStream, boCalcBeforeSaving, boReadFormulas'
'FormatSettings='
' ThousandSeparator=.'
' DecimalSeparator=.'

6
components/fpspreadsheet/examples/visual/fpsctrls/main.pas
View File

@ -320,7 +320,6 @@ implementation
{$R *.lfm}
uses
LCLProc, // debugln
fpsUtils, fpsCSV,
sCSVParamsForm, sCurrencyForm, sFormatSettingsForm, sSortParamsForm;
@ -329,8 +328,6 @@ uses
{ Loads the spreadsheet file selected by the AcFileOpen action }
procedure TMainForm.AcFileOpenAccept(Sender: TObject);
var
t: TTime;
begin
WorkbookSource.AutodetectFormat := false;
case AcFileOpen.Dialog.FilterIndex of
@ -343,10 +340,7 @@ begin
7: WorkbookSource.FileFormat := sfOpenDocument; // Open/LibreOffice
8: WorkbookSource.FileFormat := sfCSV; // Text files
end;
t := now;
WorkbookSource.FileName := UTF8ToAnsi(AcFileOpen.Dialog.FileName); // this loads the file
t := (now - t)*24*3600;
DebugLn(Format('Loading time for %s: %.3f sec', [AcFileOpen.Dialog.FileName, t]));
UpdateCaption;
end;

2
components/fpspreadsheet/examples/visual/spready/mainform.pas
View File

@ -365,7 +365,7 @@ implementation
uses
TypInfo, LCLIntf, LCLType, LCLVersion, fpcanvas, Buttons,
fpsutils, fpscsv, fpsNumFormat,
sFormatSettingsForm, sCSVParamsForm, sSortParamsForm, sfCurrencyForm;
sFormatSettingsForm, sCSVParamsForm, sSortParamsForm, sCurrencyForm;
const
DROPDOWN_COUNT = 24;

76
components/fpspreadsheet/fpsclasses.pas
View File

@ -24,6 +24,7 @@ type
FCurrentNode: TAVLTreeNode;
FTree: TsRowColAVLTree;
FStartRow, FEndRow, FStartCol, FEndCol: Cardinal;
FDone: Boolean;
FReverse: Boolean;
function GetCurrent: PsRowCol;
public
@ -175,7 +176,7 @@ type
implementation
uses
{%H-}Math,
Math,
fpsUtils;
@ -199,24 +200,23 @@ constructor TsRowColEnumerator.Create(ATree: TsRowColAVLTree;
begin
FTree := ATree;
FReverse := AReverse;
// Rearrange col/row indexes such that iteration always begins with "StartXXX"
if AStartRow <= AEndRow then
begin
FStartRow := IfThen(AReverse, AEndRow, AStartRow);
FEndRow := IfThen(AReverse, AStartRow, AEndRow);
FStartRow := AStartRow;
FEndRow := AEndRow;
end else
begin
FStartRow := IfThen(AReverse, AStartRow, AEndRow);
FEndRow := IfThen(AReverse, AEndRow, AStartRow);
FStartRow := AEndRow;
FEndRow := AStartRow;
end;
if AStartCol <= AEndCol then
begin
FStartCol := IfThen(AReverse, AEndCol, AStartCol);
FEndCol := IfThen(AReverse, AStartCol, AEndCol);
FStartCol := AStartCol;
FEndCol := AEndCol;
end else
begin
FStartCol := IfThen(AReverse, AStartCol, AEndCol);
FEndCol := IfThen(AReverse, AEndCol, AStartCol);
FStartCol := AEndCol;
FEndCol := AStartCol;
end;
end;
@ -234,46 +234,68 @@ begin
end;
function TsRowColEnumerator.MoveNext: Boolean;
var
curr: PsRowCol;
begin
Result := false;
if FCurrentNode <> nil then begin
if FReverse then
begin
FCurrentNode := FTree.FindPrecessor(FCurrentNode);
while (FCurrentNode <> nil) and
( (Current^.Col < FEndCol) or (Current^.Col > FStartCol) or
(Current^.Row < FEndRow) or (Current^.Row > FStartRow) )
do
FCurrentNode := FTree.FindPrecessor(FCurrentNode);
if FCurrentNode <> nil then
begin
curr := PsRowCol(FCurrentNode.Data);
if not InRange(curr^.Col, FStartCol, FEndCol) then
while (FCurrentNode <> nil) and
not InRange(curr^.Col, FStartCol, FEndCol) and (curr^.Row >= FStartRow)
do begin
FCurrentNode := FTree.FindPrecessor(FCurrentNode);
if FCurrentNode <> nil then curr := PsRowCol(FCurrentNode.Data);
end;
end;
end else
begin
FCurrentNode := FTree.FindSuccessor(FCurrentNode);
while (FCurrentNode <> nil) and
( (Current^.Col < FStartCol) or (Current^.Col > FEndCol) or
(Current^.Row < FStartRow) or (Current^.Row > FEndRow) )
do
FCurrentNode := FTree.FindSuccessor(FCurrentNode);
if FCurrentNode <> nil then
begin
curr := PsRowCol(FCurrentNode.Data);
if not InRange(curr^.Col, FStartCol, FEndCol) then
while (FCurrentNode <> nil) and
not InRange(curr^.Col, FStartCol, FEndCol) and (curr^.Row <= FEndRow)
do begin
FCurrentNode := FTree.FindSuccessor(FCurrentNode);
if FCurrentNode <> nil then curr := PsRowCol(FCurrentNode.Data);
end;
end;
end;
Result := (FCurrentNode <> nil) and
InRange(curr^.Col, FStartCol, FEndCol) and
InRange(curr^.Row, FStartRow, FEndRow);
end else
begin
if FReverse then
begin
FCurrentNode := FTree.FindHighest;
curr := PsRowCol(FCurrentNode.Data);
while (FCurrentNode <> nil) and
( (Current^.Row < FEndRow) or (Current^.Row > FStartRow) or
(Current^.Col < FEndCol) or (Current^.Col > FStartCol) )
do
not (InRange(curr^.Row, FStartRow, FEndRow) and InRange(curr^.Col, FStartCol, FEndCol))
do begin
FCurrentNode := FTree.FindPrecessor(FCurrentNode);
if FCurrentNode <> nil then curr := PsRowCol(FCurrentNode.Data);
end;
end else
begin
FCurrentNode := FTree.FindLowest;
curr := Current;
while (FCurrentNode <> nil) and
( (Current^.Row < FStartRow) or (Current^.Row > FEndRow) or
(Current^.Col < FStartCol) or (Current^.Col > FEndCol) )
do
not (InRange(curr^.Row, FStartRow, FEndRow) and InRange(curr^.Col, FStartCol, FEndCol))
do begin
FCurrentNode := FTree.FindSuccessor(FCurrentNode);
if FCurrentNode <> nil then curr := PsRowCol(FCurrentNode.Data);
end;
end;
Result := (FCurrentNode <> nil);
end;
Result := FCurrentNode <> nil;
end;

16
components/fpspreadsheet/fpspreadsheetctrls.pas
View File

@ -442,8 +442,8 @@ procedure Register;
implementation
uses
Types, Math, TypInfo, LCLType, Dialogs, Forms,
fpsStrings, fpsUtils; //, fpSpreadsheetGrid, fpSpreadsheetChart;
Types, Math, TypInfo, LCLType, LCLProc, Dialogs, Forms,
fpsStrings, fpsUtils;
{@@ ----------------------------------------------------------------------------
@ -453,7 +453,7 @@ uses
procedure Register;
begin
RegisterComponents('FPSpreadsheet', [
TsWorkbookSource, TsWorkbookTabControl, //TsWorksheetGrid,
TsWorkbookSource, TsWorkbookTabControl,
TsCellEdit, TsCellIndicator, TsCellCombobox,
TsSpreadsheetInspector
]);
@ -816,22 +816,30 @@ end;
-------------------------------------------------------------------------------}
procedure TsWorkbookSource.InternalLoadFromFile(AFileName: string;
AAutoDetect: Boolean; AFormat: TsSpreadsheetFormat; AWorksheetIndex: Integer = 0);
var
t: TTime;
begin
// Create a new empty workbook
t := now;
InternalCreateNewWorkbook;
DebugLn(Format('[Timer] Create workbook: %.3f sec', [(now-t)*24*3600]));
DisableControls;
try
t := Now;
// Read workbook from file and get worksheet
if AAutoDetect then
FWorkbook.ReadFromFile(AFileName)
else
FWorkbook.ReadFromFile(AFileName, AFormat);
DebugLn(Format('[Timer] Read file: %.3f sec', [(now-t)*24*3600]))
finally
EnableControls;
end;
SelectWorksheet(FWorkbook.GetWorkSheetByIndex(AWorksheetIndex));
t := now;
SelectWorksheet(FWorkbook.GetWorkSheetByIndex(AWorksheetIndex));
DebugLn(Format('[Timer] Select worksheet: %.3f sec', [(now-t)*24*3600]));
// If required, display loading error message
if FWorkbook.ErrorMsg <> '' then

33
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -26,7 +26,6 @@ interface
uses
Classes, SysUtils, LResources,
Forms, Controls, Graphics, Dialogs, Grids, ExtCtrls,
LCLVersion,
fpstypes, fpspreadsheet, fpspreadsheetctrls;
type
@ -53,6 +52,7 @@ type
FEditText: String;
FOldEditText: String;
FLockCount: Integer;
FLockSetup: Integer;
FEditing: Boolean;
FCellFont: TFont;
FAutoCalc: Boolean;
@ -584,7 +584,7 @@ procedure Register;
implementation
uses
Types, LCLType, LCLIntf, Math,
Types, LCLType, LCLIntf, LCLProc, Math,
fpCanvas, fpsStrings, fpsUtils, fpsVisualUtils;
const
@ -3289,6 +3289,7 @@ begin
FOwnedWorksheet := AWorksheet;
if FOwnedWorksheet <> nil then begin
inc(FLockSetup);
FOwnedWorksheet.OnChangeCell := @ChangedCellHandler;
FOwnedWorksheet.OnChangeFont := @ChangedFontHandler;
ShowHeaders := (soShowHeaders in Worksheet.Options);
@ -3302,6 +3303,7 @@ begin
end;
Row := FrozenRows;
Col := FrozenCols;
dec(FLockSetup);
end;
Setup;
end;
@ -3316,6 +3318,8 @@ end;
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.LoadFromSpreadsheetFile(AFileName: string;
AFormat: TsSpreadsheetFormat; AWorksheetIndex: Integer);
var
t: TTime;
begin
if FOwnsWorkbook then
FreeAndNil(FOwnedWorkbook);
@ -3326,9 +3330,17 @@ begin
begin
BeginUpdate;
try
t := now;
CreateNewWorkbook;
DebugLn(Format('[Timer] Create workbook: %.3f sec', [(now - t)*24*3600]));
t := now;
Workbook.ReadFromFile(AFileName, AFormat);
DebugLn(Format('[Timer] Read file: %.3f sec', [(now - t)*24*3600]));
t := now;
LoadFromWorksheet(Workbook.GetWorksheetByIndex(AWorksheetIndex));
DebugLn(Format('[Timer] Load into grid: %.3f sec', [(now - t)*24*3600]));
finally
EndUpdate;
end;
@ -3344,6 +3356,8 @@ end;
-------------------------------------------------------------------------------}
procedure TsCustomWorksheetGrid.LoadFromSpreadsheetFile(AFileName: string;
AWorksheetIndex: Integer);
var
t: TTime;
begin
if FOwnsWorkbook then
FreeAndNil(FOwnedWorkbook);
@ -3354,9 +3368,17 @@ begin
begin
BeginUpdate;
try
t := now;
CreateNewWorkbook;
DebugLn(Format('[Timer] Create workbook: %.3f sec', [(now - t)*24*3600]));
t := now;
Workbook.ReadFromFile(AFilename);
DebugLn(Format('[Timer] Read file: %.3f sec', [(now - t)*24*3600]));
t := now;
LoadFromWorksheet(Workbook.GetWorksheetByIndex(AWorksheetIndex));
DebugLn(Format('[Timer] Load into grid: %.3f sec', [(now - t)*24*3600]));
finally
EndUpdate;
end;
@ -3382,6 +3404,7 @@ begin
begin
if (Worksheet <> nil) then
begin
inc(FLockSetup);
ShowHeaders := (soShowHeaders in Worksheet.Options);
ShowGridLines := (soShowGridLines in Worksheet.Options);
if (soHasFrozenPanes in Worksheet.Options) then begin
@ -3391,6 +3414,7 @@ begin
FrozenCols := 0;
FrozenRows := 0;
end;
dec(FLockSetup);
end;
Setup;
end;
@ -3696,6 +3720,9 @@ begin
if csLoading in ComponentState then
exit;
if FLockSetup > 0 then
exit;
if (Worksheet = nil) or (Worksheet.GetCellCount = 0) then begin
if ShowHeaders then begin
ColCount := FInitColCount + 1; //2;
@ -3928,6 +3955,7 @@ var
lRow: PRow;
h: Integer;
begin
BeginUpdate;
if AStartIndex <= 0 then AStartIndex := FHeaderCount;
for i := AStartIndex to RowCount-1 do begin
h := CalcAutoRowHeight(i);
@ -3939,6 +3967,7 @@ begin
end;
RowHeights[i] := h;
end;
EndUpdate;
end;

12
components/fpspreadsheet/tests/hyperlinktests.pas
View File

@ -212,15 +212,15 @@ begin
actual := MyWorksheet.ReadAsUTF8Text(cell);
if row = 0 then begin
// an originally blank cell shows the hyperlink.Target. But Worksheet.WriteHyperlink
// removes the "file:///" protocol
// An originally blank cell shows the hyperlink.Target.
// But Worksheet.WriteHyperlink removes the "file:///" protocol
expected := hyperlink.Target;
if pos('file:', SollLinks[ATestMode])=1 then begin
Delete(expected, 1, Length('file:///'));
ForcePathDelims(expected);
end;
if pos('file:', SollLinks[ATestMode])=1 then
Delete(expected, 1, Length('file:///'))
end else
expected := SollCellContent[row];
FixHyperlinkPathDelims(expected);
FixHyperlinkPathDelims(actual);
CheckEquals(expected, actual,
'Test saved hyperlink cell text, cell '+ CellNotation(MyWorksheet, row, col));

13
components/fpspreadsheet/xlsxooxml.pas
View File

@ -2417,7 +2417,6 @@ begin
lCell.BoolValue := value <> 0;
end;
WriteCellToStream(AStream, @lCell);
// WriteCellCallback(@lCell, AStream);
varClear(value);
end;
AppendToStream(AStream,
@ -2437,16 +2436,18 @@ begin
AppendToStream(AStream, Format(
'<row r="%d" spans="%d:%d"%s>', [r+1, c1+1, c2+1, rh]));
// Write cells belonging to this row.
{ // Strange: the RowEnumerator is very slow here... ?!
for cell in AWorksheet.Cells.GetRowEnumerator(r) do
WriteCellToStream(AStream, cell);
{
}
for c := c1 to c2 do begin
cell := AWorksheet.FindCell(r, c);
if Assigned(cell) then begin
WriteCellCallback(cell, AStream);
end;
if Assigned(cell) then
WriteCellToStream(AStream, cell);
end;
}
AppendToStream(AStream,
'</row>');
end;