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

fpspreadsheet: Restructure merged cells. Info on merged cells is no longer stored in cell, but in separate avltree, FMergedCells. Unit tests ok.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3954 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-02-22 00:12:16 +00:00
parent e59ea19149
commit eddf623803
10 changed files with 472 additions and 317 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
components/fpspreadsheet/examples/fpsctrls/main.lfm
View File

@ -529,12 +529,6 @@ object MainForm: TMainForm
Caption = 'ToolButton52'
Style = tbsDivider
end
object ToolButton4: TToolButton
Left = 427
Top = 0
Caption = 'ToolButton4'
OnClick = ToolButton4Click
end
end
object ToolBar3: TToolBar
Left = 0
@ -558,7 +552,7 @@ object MainForm: TMainForm
TabOrder = 0
object CellIndicator: TsCellIndicator
Left = 0
Height = 23
Height = 27
Top = 0
Width = 138
Align = alTop

7
components/fpspreadsheet/examples/fpsctrls/main.pas
View File

@ -262,7 +262,6 @@ type
ToolButton38: TToolButton;
ToolButton39: TToolButton;
TbCommentAdd: TToolButton;
ToolButton4: TToolButton;
ToolButton40: TToolButton;
ToolButton41: TToolButton;
ToolButton42: TToolButton;
@ -292,7 +291,6 @@ type
procedure AcRowDeleteExecute(Sender: TObject);
procedure AcViewInspectorExecute(Sender: TObject);
procedure InspectorTabControlChange(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
private
{ private declarations }
procedure UpdateCaption;
@ -397,11 +395,6 @@ begin
Inspector.Mode := TsInspectorMode(InspectorTabControl.TabIndex);
end;
procedure TMainForm.ToolButton4Click(Sender: TObject);
begin
WorksheetGrid.Worksheet.WriteBackgroundColor(0, 0, scRed);
end;
procedure TMainForm.UpdateCaption;
begin
if WorkbookSource = nil then

5
components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi
View File

@ -1,4 +1,4 @@
<?xml version="1.0"?>
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
@ -74,9 +74,6 @@
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="5">

3
components/fpspreadsheet/fpsactions.pas
View File

@ -1106,10 +1106,10 @@ procedure TsCellBorderAction.ApplyFormatToRange(ARange: TsCellRange);
fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
if AEnable then
begin
Include(fmt.UsedFormattingFields, uffBorder);
Include(fmt.Border, ABorder);
fmt.BorderStyles[ABorder] := ABorderStyle;
ACell^.FormatIndex := Workbook.AddCellFormat(fmt);
Include(fmt.UsedFormattingFields, uffBorder);
end else
Exclude(fmt.UsedFormattingFields, uffBorder);
Worksheet.ChangedCell(ACell^.Row, ACell^.Col);
@ -1170,7 +1170,6 @@ procedure TsCellBorderAction.ExtractFromCell(ACell: PCell);
var
EmptyCell: TCell;
begin
// if (ACell = nil) or not (uffBorder in ACell^.UsedFormattingFields) then
if (ACell = nil) or not (uffBorder in Worksheet.ReadUsedFormatting(ACell)) then
begin
EmptyCell.Row := 0; // silence the compiler...

2
components/fpspreadsheet/fpsopendocument.pas
View File

@ -3247,7 +3247,7 @@ begin
cell := ASheet.FindCell(r, c);
// Belongs to merged block?
if (cell <> nil) and not FWorksheet.IsMergeBase(cell) and (cell^.MergeBase <> nil) then
if (cell <> nil) and not FWorksheet.IsMergeBase(cell) and FWorksheet.IsMerged(cell) then
// this means: all cells of a merged block except for the merge base
begin
AppendToStream(AStream,

695
components/fpspreadsheet/fpspreadsheet.pas
View File

File diff suppressed because it is too large Load Diff

28
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -839,7 +839,7 @@ begin
FCellFont := TFont.Create;
FOwnsWorkbook := true;
{$IF (ENABLE_MULTI_SELECT=1)}
RangeSelectMode := rsmMulti;
//RangeSelectMode := rsmMulti;
{$ENDIF}
end;
@ -1816,7 +1816,7 @@ begin
Continue;
// Overflow possible from non-merged, non-right-aligned, horizontal label cells
fmt := Workbook.GetPointerToCellFormat(cell^.FormatIndex);
if (cell^.MergeBase = nil) and (cell^.ContentType = cctUTF8String) and
if (not Worksheet.IsMerged(cell)) and (cell^.ContentType = cctUTF8String) and
not (uffTextRotation in fmt^.UsedFormattingFields) and
(uffHorAlign in fmt^.UsedFormattingFields) and (fmt^.HorAlignment <> haRight)
then
@ -1842,7 +1842,7 @@ begin
continue;
// Overflow possible from non-merged, horizontal, non-left-aligned label cells
fmt := Workbook.GetPointerToCellFormat(cell^.FormatIndex);
if (cell^.MergeBase = nil) and (cell^.ContentType = cctUTF8String) and
if (not Worksheet.IsMerged(cell)) and (cell^.ContentType = cctUTF8String) and
not (uffTextRotation in fmt^.UsedFormattingFields) and
(uffHorAlign in fmt^.UsedFormattingFields) and (fmt^.HorAlignment <> haLeft)
then
@ -1864,7 +1864,7 @@ begin
if Assigned(Worksheet) and (gr >= FixedRows) and (gc >= FixedCols) then
begin
cell := Worksheet.FindCell(GetWorksheetRow(gr), GetWorksheetCol(gc));
if (cell = nil) or (cell^.Mergebase = nil) then
if (cell = nil) or (not Worksheet.IsMerged(cell)) then
begin
// single cell
FDrawingCell := cell;
@ -2513,7 +2513,7 @@ begin
lCell := Worksheet.FindCell(ARow-FHeaderCount, ACol-FHeaderCount);
if lCell <> nil then
begin
if (lCell^.Mergebase <> nil) then
if Worksheet.IsMerged(lCell) then
begin
Worksheet.FindMergedRange(lCell, r1, c1, r2, c2);
if r1 <> r2 then
@ -2727,9 +2727,7 @@ begin
// Only cell has border, but neighbor has not
if HasBorder(cell, border) and not HasBorder(neighborCell, neighborBorder) then
begin
if Worksheet.IsMerged(cell) and Worksheet.IsMerged(neighborcell) and
(cell^.MergeBase = neighborcell^.Mergebase)
then
if Worksheet.InSameMergedRange(cell, neighborcell) then
result := false
else
ABorderStyle := Worksheet.ReadCellBorderStyle(cell, border)
@ -2738,24 +2736,20 @@ begin
// Only neighbor has border, cell has not
if not HasBorder(cell, border) and HasBorder(neighborCell, neighborBorder) then
begin
if Worksheet.IsMerged(cell) and Worksheet.IsMerged(neighborcell) and
(cell^.MergeBase = neighborcell^.Mergebase)
then
if Worksheet.InSameMergedRange(cell, neighborcell) then
result := false
else
ABorderStyle := Worksheet.ReadCellBorderStyle(neighborcell, neighborborder); //neighborcell^.BorderStyles[neighborborder]
ABorderStyle := Worksheet.ReadCellBorderStyle(neighborcell, neighborborder);
end
else
// Both cells have shared border -> use top or left border
if HasBorder(cell, border) and HasBorder(neighborCell, neighborBorder) then
begin
if Worksheet.IsMerged(cell) and Worksheet.IsMerged(neighborcell) and
(cell^.MergeBase = neighborcell^.Mergebase)
then
if Worksheet.InSameMergedRange(cell, neighborcell) then
result := false
else
if (border in [cbNorth, cbWest]) then
ABorderStyle := Worksheet.ReadCellBorderStyle(neighborcell, neighborborder) //neighborcell^.BorderStyles[neighborborder]
ABorderStyle := Worksheet.ReadCellBorderStyle(neighborcell, neighborborder)
else
ABorderStyle := Worksheet.ReadCellBorderStyle(cell, border); //cell^.BorderStyles[border];
end else
@ -3027,7 +3021,7 @@ begin
P := ARect.TopLeft;
case AJustification of
0: ts.Alignment := taLeftJustify;
1: if (FDrawingCell <> nil) and (FDrawingCell^.MergeBase = nil) then
1: if (FDrawingCell <> nil) and not Worksheet.IsMerged(FDrawingCell) then
begin
// Special treatment for overflowing cells: they must be centered
// at their original column, not in the total enclosing rectangle.

3
components/fpspreadsheet/fpstypes.pas
View File

@ -412,7 +412,7 @@ type
TsCalcState = (csNotCalculated, csCalculating, csCalculated);
{@@ Cell flag }
TsCellFlag = (cfCalculating, cfCalculated, cfHasComment);
TsCellFlag = (cfCalculating, cfCalculated, cfHasComment, cfMerged);
{@@ Set of cell flags }
TsCellFlags = set of TsCellFlag;
@ -426,6 +426,7 @@ type
TsCellRange = record
Row1, Col1, Row2, Col2: Cardinal;
end;
PsCellRange = ^TsCellRange;
{@@ Array with cell ranges }
TsCellRangeArray = array of TsCellRange;

37
components/fpspreadsheet/tests/insertdeletetests.pas
View File

@ -124,9 +124,9 @@ type
procedure TestWriteRead_InsDelColRow_45_BIFF8; // row through merged block
procedure TestWriteRead_InsDelColRow_46_BIFF8; // row after merged block
// ... and deletes columns
procedure TestWriteRead_InsDelColRow_47_BIFF8; // column before merged block
procedure TestWriteRead_InsDelColRow_48_BIFF8; // column through merged block
procedure TestWriteRead_InsDelColRow_49_BIFF8; // column after merged block
procedure TestWriteRead_DelColBeforeMerge_BIFF8; // column before merged block
procedure TestWriteRead_DelColInMerge_BIFF8; // column through merged block
procedure TestWriteRead_DelColAfterMerge_BIFF8; // column after merged block
// ... and deletes rows
procedure TestWriteRead_InsDelColRow_50_BIFF8; // row before merged block
procedure TestWriteRead_InsDelColRow_51_BIFF8; // row through merged block
@ -201,9 +201,9 @@ type
procedure TestWriteRead_InsDelColRow_45_OOXML; // row through merged block
procedure TestWriteRead_InsDelColRow_46_OOXML; // row after merged block
// ... and deletes columns
procedure TestWriteRead_InsDelColRow_47_OOXML; // column before merged block
procedure TestWriteRead_InsDelColRow_48_OOXML; // column through merged block
procedure TestWriteRead_InsDelColRow_49_OOXML; // column after merged block
procedure TestWriteRead_DelColBeforeMerge_OOXML; // column before merged block
procedure TestWriteRead_DelColInMerge_OOXML; // column through merged block
procedure TestWriteRead_DelColAfterMerge_OOXML; // column after merged block
// ... and deletes rows
procedure TestWriteRead_InsDelColRow_50_OOXML; // row before merged block
procedure TestWriteRead_InsDelColRow_51_OOXML; // row through merged block
@ -278,9 +278,9 @@ type
procedure TestWriteRead_InsDelColRow_45_ODS; // row through merged block
procedure TestWriteRead_InsDelColRow_46_ODS; // row after merged block
// ... and deletes columns
procedure TestWriteRead_InsDelColRow_47_ODS; // column before merged block
procedure TestWriteRead_InsDelColRow_48_ODS; // column through merged block
procedure TestWriteRead_InsDelColRow_49_ODS; // column after merged block
procedure TestWriteRead_DelColBeforeMerge_ODS; // column before merged block
procedure TestWriteRead_DelColInMerge_ODS; // column through merged block
procedure TestWriteRead_DelColAfterMerge_ODS; // column after merged block
// ... and deletes rows
procedure TestWriteRead_InsDelColRow_50_ODS; // row before merged block
procedure TestWriteRead_InsDelColRow_51_ODS; // row through merged block
@ -1963,19 +1963,19 @@ begin
TestWriteRead_InsDelColRow(46, sfExcel8);
end;
procedure TSpreadWriteRead_InsDelColRow_Tests.TestWriteRead_InsDelColRow_47_BIFF8;
procedure TSpreadWriteRead_InsDelColRow_Tests.TestWriteRead_DelColBeforeMerge_BIFF8;
// delete column before merged block
begin
TestWriteRead_InsDelColRow(47, sfExcel8);
end;
procedure TSpreadWriteRead_InsDelColRow_Tests.TestWriteRead_InsDelColRow_48_BIFF8;
procedure TSpreadWriteRead_InsDelColRow_Tests.TestWriteRead_DelColInMerge_BIFF8;
// delete column through merged block
begin
TestWriteRead_InsDelColRow(48, sfExcel8);
end;
procedure TSpreadWriteRead_InsDelColRow_Tests.TestWriteRead_InsDelColRow_49_BIFF8;
procedure TSpreadWriteRead_InsDelColRow_Tests.TestWriteRead_DelColAfterMerge_BIFF8;
// delete column behind merged block
begin
TestWriteRead_InsDelColRow(49, sfExcel8);
@ -2286,19 +2286,19 @@ begin
TestWriteRead_InsDelColRow(46, sfOOXML);
end;
procedure TSpreadWriteRead_InsDelColRow_Tests.TestWriteRead_InsDelColRow_47_OOXML;
procedure TSpreadWriteRead_InsDelColRow_Tests.TestWriteRead_DelColBeforeMerge_OOXML;
// delete column before merged block
begin
TestWriteRead_InsDelColRow(47, sfOOXML);
end;
procedure TSpreadWriteRead_InsDelColRow_Tests.TestWriteRead_InsDelColRow_48_OOXML;
procedure TSpreadWriteRead_InsDelColRow_Tests.TestWriteRead_DelColInMerge_OOXML;
// delete column through merged block
begin
TestWriteRead_InsDelColRow(48, sfOOXML);
end;
procedure TSpreadWriteRead_InsDelColRow_Tests.TestWriteRead_InsDelColRow_49_OOXML;
procedure TSpreadWriteRead_InsDelColRow_Tests.TestWriteRead_DelColAfterMerge_OOXML;
// delete column behind merged block
begin
TestWriteRead_InsDelColRow(49, sfOOXML);
@ -2609,19 +2609,18 @@ begin
TestWriteRead_InsDelColRow(46, sfOpenDocument);
end;
procedure TSpreadWriteRead_InsDelColRow_Tests.TestWriteRead_InsDelColRow_47_ODS;
procedure TSpreadWriteRead_InsDelColRow_Tests.TestWriteRead_DelColBeforeMerge_ODS;
// delete column before merged block
begin
TestWriteRead_InsDelColRow(47, sfOpenDocument);
end;
procedure TSpreadWriteRead_InsDelColRow_Tests.TestWriteRead_InsDelColRow_48_ODS;
// delete column through merged block
procedure TSpreadWriteRead_InsDelColRow_Tests.TestWriteRead_DelColInMerge_ODS;
begin
TestWriteRead_InsDelColRow(48, sfOpenDocument);
end;
procedure TSpreadWriteRead_InsDelColRow_Tests.TestWriteRead_InsDelColRow_49_ODS;
procedure TSpreadWriteRead_InsDelColRow_Tests.TestWriteRead_DelColAfterMerge_ODS;
// delete column behind merged block
begin
TestWriteRead_InsDelColRow(49, sfOpenDocument);

1
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@ -119,6 +119,7 @@
<Unit17>
<Filename Value="insertdeletetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="insertdeletetests"/>
</Unit17>
<Unit18>
<Filename Value="celltypetests.pas"/>