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

fpspreadsheet: Redo internal structure of merged cells (use MergeBase cell instead of neighbor links).

Browse Source 
Suppress TsWorksheetGrid painting of inner grid lines of merged cells.
Fix inserting columns and rows running through merged cells. 
Silence some warnings. 
Fix ods reading merged cells incorrectly.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3569 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-09-15 20:54:39 +00:00
parent b7abdabd0b
commit e07e322170
5 changed files with 289 additions and 208 deletions
Download Patch File Download Diff File Expand all files Collapse all files

55
components/fpspreadsheet/examples/spready/mainform.lfm
View File

@ -4,7 +4,7 @@ object MainFrm: TMainFrm
Top = 258 Top = 258
Width = 884 Width = 884
Caption = 'spready' Caption = 'spready'
ClientHeight = 619 ClientHeight = 614
ClientWidth = 884 ClientWidth = 884
Menu = MainMenu Menu = MainMenu
OnActivate = FormActivate OnActivate = FormActivate
@ -14,7 +14,7 @@ object MainFrm: TMainFrm
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Height = 78 Height = 78
Top = 541 Top = 536
Width = 884 Width = 884
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
@ -23,7 +23,7 @@ object MainFrm: TMainFrm
TabOrder = 6 TabOrder = 6
object EdFrozenCols: TSpinEdit object EdFrozenCols: TSpinEdit
Left = 429 Left = 429
Height = 23 Height = 28
Top = 8 Top = 8
Width = 52 Width = 52
OnChange = EdFrozenColsChange OnChange = EdFrozenColsChange
@ -31,7 +31,7 @@ object MainFrm: TMainFrm
end end
object EdFrozenRows: TSpinEdit object EdFrozenRows: TSpinEdit
Left = 429 Left = 429
Height = 23 Height = 28
Top = 39 Top = 39
Width = 52 Width = 52
OnChange = EdFrozenRowsChange OnChange = EdFrozenRowsChange
@ -39,37 +39,37 @@ object MainFrm: TMainFrm
end end
object Label1: TLabel object Label1: TLabel
Left = 344 Left = 344
Height = 15 Height = 20
Top = 13 Top = 13
Width = 62 Width = 77
Caption = 'Frozen cols:' Caption = 'Frozen cols:'
FocusControl = EdFrozenCols FocusControl = EdFrozenCols
ParentColor = False ParentColor = False
end end
object Label2: TLabel object Label2: TLabel
Left = 344 Left = 344
Height = 15 Height = 20
Top = 40 Top = 40
Width = 66 Width = 82
Caption = 'Frozen rows:' Caption = 'Frozen rows:'
FocusControl = EdFrozenRows FocusControl = EdFrozenRows
ParentColor = False ParentColor = False
end end
object CbReadFormulas: TCheckBox object CbReadFormulas: TCheckBox
Left = 8 Left = 8
Height = 19 Height = 24
Top = 8 Top = 8
Width = 96 Width = 120
Caption = 'Read formulas' Caption = 'Read formulas'
OnChange = CbReadFormulasChange OnChange = CbReadFormulasChange
TabOrder = 0 TabOrder = 0
end end
object CbHeaderStyle: TComboBox object CbHeaderStyle: TComboBox
Left = 200 Left = 200
Height = 23 Height = 28
Top = 8 Top = 8
Width = 116 Width = 116
ItemHeight = 15 ItemHeight = 20
ItemIndex = 2 ItemIndex = 2
Items.Strings = ( Items.Strings = (
'Lazarus' 'Lazarus'
@ -83,18 +83,18 @@ object MainFrm: TMainFrm
end end
object CbAutoCalcFormulas: TCheckBox object CbAutoCalcFormulas: TCheckBox
Left = 8 Left = 8
Height = 19 Height = 24
Top = 32 Top = 32
Width = 128 Width = 158
Caption = 'Calculate on change' Caption = 'Calculate on change'
OnChange = CbAutoCalcFormulasChange OnChange = CbAutoCalcFormulasChange
TabOrder = 1 TabOrder = 1
end end
object CbTextOverflow: TCheckBox object CbTextOverflow: TCheckBox
Left = 8 Left = 8
Height = 19 Height = 24
Top = 56 Top = 56
Width = 91 Width = 114
Caption = 'Text overflow' Caption = 'Text overflow'
Checked = True Checked = True
OnChange = CbTextOverflowChange OnChange = CbTextOverflowChange
@ -189,19 +189,19 @@ object MainFrm: TMainFrm
end end
object FontComboBox: TComboBox object FontComboBox: TComboBox
Left = 52 Left = 52
Height = 23 Height = 28
Top = 2 Top = 2
Width = 127 Width = 127
ItemHeight = 15 ItemHeight = 20
OnSelect = FontComboBoxSelect OnSelect = FontComboBoxSelect
TabOrder = 0 TabOrder = 0
end end
object FontSizeComboBox: TComboBox object FontSizeComboBox: TComboBox
Left = 179 Left = 179
Height = 23 Height = 28
Top = 2 Top = 2
Width = 48 Width = 48
ItemHeight = 15 ItemHeight = 20
Items.Strings = ( Items.Strings = (
'8' '8'
'9' '9'
@ -375,7 +375,7 @@ object MainFrm: TMainFrm
end end
object InspectorSplitter: TSplitter object InspectorSplitter: TSplitter
Left = 648 Left = 648
Height = 462 Height = 457
Top = 79 Top = 79
Width = 5 Width = 5
Align = alRight Align = alRight
@ -383,7 +383,7 @@ object MainFrm: TMainFrm
end end
object InspectorPageControl: TPageControl object InspectorPageControl: TPageControl
Left = 653 Left = 653
Height = 462 Height = 457
Top = 79 Top = 79
Width = 231 Width = 231
ActivePage = PgCellValue ActivePage = PgCellValue
@ -393,11 +393,11 @@ object MainFrm: TMainFrm
OnChange = InspectorPageControlChange OnChange = InspectorPageControlChange
object PgCellValue: TTabSheet object PgCellValue: TTabSheet
Caption = 'Cell value' Caption = 'Cell value'
ClientHeight = 434 ClientHeight = 424
ClientWidth = 223 ClientWidth = 223
object CellInspector: TValueListEditor object CellInspector: TValueListEditor
Left = 0 Left = 0
Height = 434 Height = 424
Top = 0 Top = 0
Width = 223 Width = 223
Align = alClient Align = alClient
@ -438,7 +438,7 @@ object MainFrm: TMainFrm
end end
object TabControl: TTabControl object TabControl: TTabControl
Left = 0 Left = 0
Height = 462 Height = 457
Top = 79 Top = 79
Width = 648 Width = 648
OnChange = TabControlChange OnChange = TabControlChange
@ -446,7 +446,7 @@ object MainFrm: TMainFrm
TabOrder = 3 TabOrder = 3
object WorksheetGrid: TsWorksheetGrid object WorksheetGrid: TsWorksheetGrid
Left = 2 Left = 2
Height = 457 Height = 452
Top = 3 Top = 3
Width = 644 Width = 644
FrozenCols = 0 FrozenCols = 0
@ -456,6 +456,7 @@ object MainFrm: TMainFrm
AutoAdvance = aaDown AutoAdvance = aaDown
BorderStyle = bsNone BorderStyle = bsNone
ColCount = 27 ColCount = 27
ExtendedSelect = False
MouseWheelOption = mwGrid MouseWheelOption = mwGrid
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing, goThumbTracking, goSmoothScroll, goFixedColSizing] Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing, goThumbTracking, goSmoothScroll, goFixedColSizing]
RowCount = 101 RowCount = 101
@ -463,7 +464,7 @@ object MainFrm: TMainFrm
TitleStyle = tsNative TitleStyle = tsNative
OnSelection = WorksheetGridSelection OnSelection = WorksheetGridSelection
ColWidths = ( ColWidths = (
42 56
64 64
64 64
64 64

11
components/fpspreadsheet/examples/spready/mainform.pas
View File

@ -546,6 +546,7 @@ begin
WorksheetGrid.MergeCells WorksheetGrid.MergeCells
else else
WorksheetGrid.UnmergeCells; WorksheetGrid.UnmergeCells;
WorksheetGridSelection(nil, WorksheetGrid.Col, WorksheetGrid.Row);
end; end;
procedure TMainFrm.AcNewExecute(Sender: TObject); procedure TMainFrm.AcNewExecute(Sender: TObject);
@ -1041,11 +1042,11 @@ begin
if (ACell=nil) or not (uffNumberFormat in ACell^.UsedFormattingFields) if (ACell=nil) or not (uffNumberFormat in ACell^.UsedFormattingFields)
then Strings.Add('NumberFormatStr=') then Strings.Add('NumberFormatStr=')
else Strings.Add('NumberFormatStr=' + ACell^.NumberFormatStr); else Strings.Add('NumberFormatStr=' + ACell^.NumberFormatStr);
if (ACell=nil) or (ACell^.MergedNeighbors = []) then if not WorksheetGrid.Worksheet.IsMerged(ACell) then
Strings.Add('Merged neighbors=') Strings.Add('Merged range=')
else begin else begin
WorksheetGrid.Worksheet.FindMergedRange(ACell, r1, c1, r2, c2); WorksheetGrid.Worksheet.FindMergedRange(ACell, r1, c1, r2, c2);
Strings.Add('Merged neighbors=' + GetCellRangeString(r1, c1, r2, c2)); Strings.Add('Merged range=' + GetCellRangeString(r1, c1, r2, c2));
end; end;
end; end;
@ -1167,7 +1168,7 @@ begin
AcWordwrap.Checked := wrapped; AcWordwrap.Checked := wrapped;
end; end;
procedure TMainFrm.WorksheetGridSelection(Sender: TObject; aCol, aRow: Integer); procedure TMainFrm.WorksheetGridSelection(Sender: TObject; ACol, ARow: Integer);
var var
r, c: Cardinal; r, c: Cardinal;
cell: PCell; cell: PCell;
@ -1209,7 +1210,7 @@ begin
EdFormula.Text := ''; EdFormula.Text := '';
EdCellAddress.Text := GetCellString(r, c, [rfRelRow, rfRelCol]); EdCellAddress.Text := GetCellString(r, c, [rfRelRow, rfRelCol]);
AcMergeCells.Checked := (cell <> nil) and (cell^.MergedNeighbors <> []); AcMergeCells.Checked := WorksheetGrid.Worksheet.IsMerged(cell);
UpdateHorAlignmentActions; UpdateHorAlignmentActions;
UpdateVertAlignmentActions; UpdateVertAlignmentActions;

83
components/fpspreadsheet/fpsopendocument.pas
View File

@ -1841,50 +1841,60 @@ begin
// These nodes occur due to indentation spaces which are not skipped // These nodes occur due to indentation spaces which are not skipped
// automatically any more due to PreserveWhiteSpace option applied // automatically any more due to PreserveWhiteSpace option applied
// to ReadXMLFile // to ReadXMLFile
{
if nodeName <> 'table:table-cell' then begin //= '#text' then begin if nodeName <> 'table:table-cell' then begin //= '#text' then begin
cellNode := cellNode.NextSibling; cellNode := cellNode.NextSibling;
Continue; Continue;
end; end;
}
if nodeName = 'table:table-cell' then begin
// select this cell value's type
paramValueType := GetAttrValue(CellNode, 'office:value-type');
paramFormula := GetAttrValue(CellNode, 'table:formula');
tableStyleName := GetAttrValue(CellNode, 'table:style-name');
// select this cell value's type if paramValueType = 'string' then
paramValueType := GetAttrValue(CellNode, 'office:value-type'); ReadLabel(row, col, cellNode)
paramFormula := GetAttrValue(CellNode, 'table:formula'); else
tableStyleName := GetAttrValue(CellNode, 'table:style-name'); if (paramValueType = 'float') or (paramValueType = 'percentage') or
(paramValueType = 'currency')
then
ReadNumber(row, col, cellNode)
else if (paramValueType = 'date') or (paramValueType = 'time') then
ReadDateTime(row, col, cellNode)
else if (paramValueType = '') and (tableStyleName <> '') then
ReadBlank(row, col, cellNode);
if paramValueType = 'string' then if ParamFormula <> '' then
ReadLabel(row, col, cellNode) ReadFormula(row, col, cellNode);
paramColsSpanned := GetAttrValue(cellNode, 'table:number-columns-spanned');
if paramColsSpanned <> '' then
colsSpanned := StrToInt(paramColsSpanned) - 1
else
colsSpanned := 0;
paramRowsSpanned := GetAttrValue(cellNode, 'table:number-rows-spanned');
if paramRowsSpanned <> '' then
rowsSpanned := StrToInt(paramRowsSpanned) - 1
else
rowsSpanned := 0;
if (colsSpanned <> 0) or (rowsSpanned <> 0) then
FWorksheet.MergeCells(row, col, row+rowsSpanned, col+colsSpanned);
paramColsRepeated := GetAttrValue(cellNode, 'table:number-columns-repeated');
if paramColsRepeated = '' then paramColsRepeated := '1';
end
else else
if (paramValueType = 'float') or (paramValueType = 'percentage') or if nodeName = 'table:covered-table-cell' then
(paramValueType = 'currency') begin
then paramColsRepeated := GetAttrValue(cellNode, 'table:number-columns-repeated');
ReadNumber(row, col, cellNode) if paramColsRepeated = '' then paramColsRepeated := '1';
else if (paramValueType = 'date') or (paramValueType = 'time') then end else
ReadDateTime(row, col, cellNode) paramColsRepeated := '0';
else if (paramValueType = '') and (tableStyleName <> '') then
ReadBlank(row, col, cellNode);
if ParamFormula <> '' then
ReadFormula(row, col, cellNode);
paramColsSpanned := GetAttrValue(cellNode, 'table:number-columns-spanned');
if paramColsSpanned <> '' then
colsSpanned := StrToInt(paramColsSpanned) - 1
else
colsSpanned := 0;
paramRowsSpanned := GetAttrValue(cellNode, 'table:number-rows-spanned');
if paramRowsSpanned <> '' then
rowsSpanned := StrToInt(paramRowsSpanned) - 1
else
rowsSpanned := 0;
if (colsSpanned <> 0) or (rowsSpanned <> 0) then
FWorksheet.MergeCells(row, col, row+rowsSpanned, col+colsSpanned);
paramColsRepeated := GetAttrValue(cellNode, 'table:number-columns-repeated');
if paramColsRepeated = '' then paramColsRepeated := '1';
col := col + StrToInt(paramColsRepeated); col := col + StrToInt(paramColsRepeated);
cellNode := cellNode.NextSibling; cellNode := cellNode.NextSibling;
end; //while Assigned(cellNode) end; //while Assigned(cellNode)
@ -3056,7 +3066,8 @@ begin
cell := ASheet.FindCell(r, c); cell := ASheet.FindCell(r, c);
// Belongs to merged block? // Belongs to merged block?
if (cell <> nil) and not FWorksheet.IsMergeBase(cell) and (cell^.MergedNeighbors <> []) then // if (cell <> nil) and not FWorksheet.IsMergeBase(cell) and (cell^.MergedNeighbors <> []) then
if (cell <> nil) and not FWorksheet.IsMergeBase(cell) and (cell^.MergeBase <> nil) then
begin begin
AppendToStream(AStream, AppendToStream(AStream,
'<table:covered-table-cell />'); '<table:covered-table-cell />');

270
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -435,7 +435,8 @@ type
BoolValue: Boolean; BoolValue: Boolean;
ErrorValue: TsErrorValue; ErrorValue: TsErrorValue;
SharedFormulaBase: PCell; // Cell containing the shared formula SharedFormulaBase: PCell; // Cell containing the shared formula
MergedNeighbors: TsCellBorders; MergeBase: PCell; // Upper left cell if a merged range
//MergedNeighbors: TsCellBorders;
{ Formatting fields } { Formatting fields }
{ When adding/deleting formatting fields don't forget to update CopyFormat! } { When adding/deleting formatting fields don't forget to update CopyFormat! }
UsedFormattingFields: TsUsedFormattingFields; UsedFormattingFields: TsUsedFormattingFields;
@ -583,6 +584,7 @@ type
function FindMergedRange(ACell: PCell; out ARow1, ACol1, ARow2, ACol2: Cardinal): Boolean; function FindMergedRange(ACell: PCell; out ARow1, ACol1, ARow2, ACol2: Cardinal): Boolean;
procedure GetMergedCellRanges(out AList: TsCellRangeArray); procedure GetMergedCellRanges(out AList: TsCellRangeArray);
function IsMergeBase(ACell: PCell): Boolean; function IsMergeBase(ACell: PCell): Boolean;
function IsMerged(ACell: PCell): Boolean;
{ Writing of values } { Writing of values }
function WriteBlank(ARow, ACol: Cardinal): PCell; overload; function WriteBlank(ARow, ACol: Cardinal): PCell; overload;
@ -2918,69 +2920,13 @@ begin
if (ARow1 = ARow2) and (ACol1 = ACol2) then if (ARow1 = ARow2) and (ACol1 = ACol2) then
exit; exit;
// Case 2: single row base := GetCell(ARow1, ACol1);
if (ARow1 = ARow2) and (ACol1 <> ACol2) then begin for r := ARow1 to ARow2 do
cell := GetCell(ARow1, ACol1); for c := ACol1 to ACol2 do
cell^.MergedNeighbors := [cbEast]; begin
cell := GetCell(ARow2, ACol2); cell := GetCell(r, c);
cell^.MergedNeighbors := [cbWest]; cell^.MergeBase := base;
for c := ACol1+1 to ACol2-1 do begin
cell := GetCell(ARow1, c);
cell^.MergedNeighbors := [cbEast, cbWest];
end; end;
end else
// Case 3: single column
if (ARow1 <> ARow2) and (ACol1 = ACol2) then begin
cell := GetCell(ARow1, ACol1);
cell^.MergedNeighbors := [cbSouth];
cell := GetCell(ARow2, ACol2);
cell^.MergedNeighbors := [cbNorth];
for r := ARow1+1 to ARow2-1 do begin
cell := GetCell(r, ACol1);
cell^.MergedNeighbors := [cbNorth, cbSouth];
end;
end else
// case 4: general case
begin
// left/top corner
cell := GetCell(ARow1, ACol1);
cell^.MergedNeighbors := [cbEast, cbSouth];
// right/top corner
cell := GetCell(ARow1, ACol2);
cell^.MergedNeighbors := [cbWest, cbSouth];
// left/bottom corner
cell := GetCell(ARow2, ACol1);
cell^.MergedNeighbors := [cbEast, cbNorth];
// right/bottom corner
cell := GetCell(ARow2, ACol2);
cell^.MergedNeighbors := [cbWest, cbNorth];
// top row
for c := ACol1+1 to ACol2-1 do begin
cell := GetCell(ARow1, c);
cell^.MergedNeighbors := [cbSouth, cbEast, cbWest];
end;
// bottom row
for c := ACol1+1 to ACol2-1 do begin
cell := GetCell(ARow2, c);
cell^.MergedNeighbors := [cbNorth, cbEast, cbWest];
end;
// left column
for r := ARow1+1 to ARow2-1 do begin
cell := GetCell(r, ACol1);
cell^.MergedNeighbors := [cbEast, cbNorth, cbSouth];
end;
// right column
for r := ARow1+1 to ARow2-1 do begin
cell := GetCell(r, ACol2);
cell^.MergedNeighbors := [cbWest, cbNorth, cbSouth];
end;
// inner
for r := ARow1+1 to ARow2-1 do
for c := ACol1+1 to ACol2-1 do begin
cell := GetCell(r, c);
cell^.MergedNeighbors := [cbEast, cbWest, cbNorth, cbSouth];
end;
end;
ChangedCell(ARow1, ACol1); ChangedCell(ARow1, ACol1);
end; end;
@ -3008,9 +2954,9 @@ end;
} }
procedure TsWorksheet.UnmergeCells(ARow, ACol: Cardinal); procedure TsWorksheet.UnmergeCells(ARow, ACol: Cardinal);
var var
cell: PCell;
r, c: Cardinal; r, c: Cardinal;
r1, c1, r2, c2: Cardinal; r1, c1, r2, c2: Cardinal;
cell: PCell;
begin begin
cell := FindCell(ARow, ACol); cell := FindCell(ARow, ACol);
if not FindMergedRange(cell, r1, c1, r2, c2) then if not FindMergedRange(cell, r1, c1, r2, c2) then
@ -3020,7 +2966,8 @@ begin
begin begin
cell := FindCell(r, c); cell := FindCell(r, c);
if cell <> nil then if cell <> nil then
cell^.MergedNeighbors := []; cell^.MergeBase := nil;
// cell^.MergedNeighbors := [];
end; end;
ChangedCell(ARow, ACol); ChangedCell(ARow, ACol);
end; end;
@ -3054,6 +3001,13 @@ end;
nil. nil.
} }
function TsWorksheet.FindMergeBase(ACell: PCell): PCell; function TsWorksheet.FindMergeBase(ACell: PCell): PCell;
begin
if ACell = nil then
Result := nil
else
Result := ACell^.MergeBase;
end;
(*
var var
r, c: Cardinal; r, c: Cardinal;
begin begin
@ -3072,7 +3026,7 @@ begin
Result := FindCell(r, c); Result := FindCell(r, c);
end; end;
end; end;
*)
{@@ {@@
Determines the merged cell block to which a given cell belongs Determines the merged cell block to which a given cell belongs
@ -3090,15 +3044,38 @@ function TsWorksheet.FindMergedRange(ACell: PCell;
var var
r, c: Cardinal; r, c: Cardinal;
cell: PCell; cell: PCell;
base: PCell;
begin begin
cell := FindMergeBase(ACell); base := FindMergeBase(ACell);
if cell = nil then begin if base = nil then begin
Result := false; Result := false;
exit; exit;
end; end;
ARow1 := cell^.Row; // Assuming that the merged block is rectangular, we start at merge base...
ACol1 := cell^.Col; ARow1 := base^.Row;
ARow2 := ARow1; ARow2 := ARow1;
ACol1 := base^.Col;
ACol2 := ACol1;
// ... and go along first COLUMN to find the end of the merged block, ...
for c := ACol1+1 to GetLastColIndex do
begin
cell := FindCell(ARow1, c);
if (cell = nil) or (cell^.MergeBase <> base) then
break
else
ACol2 := c;
end;
// ... and go along first ROW to find the end of the merged block
for r := ARow1 + 1 to GetLastRowIndex do
begin
cell := FindCell(r, ACol1);
if (cell = nil) or (cell^.MergeBase <> base) then
break
else
ARow2 := r;
end;
{
while (cell <> nil) and (cbSouth in cell^.MergedNeighbors) do begin while (cell <> nil) and (cbSouth in cell^.MergedNeighbors) do begin
inc(ARow2); inc(ARow2);
cell := FindCell(ARow2, ACol1); cell := FindCell(ARow2, ACol1);
@ -3116,6 +3093,7 @@ begin
Result := false; Result := false;
exit; exit;
end; end;
}
Result := true; Result := true;
end; end;
@ -3145,9 +3123,9 @@ begin
SetLength(AList, n+1); SetLength(AList, n+1);
AList[n] := rng; AList[n] := rng;
inc(n); inc(n);
c := rng.Col2; // jump to next cell not belonging to this block c := rng.Col2; // jump to last cell of block
end; end;
inc(c); inc(c); // go to next cell
end; end;
end; end;
end; end;
@ -3161,11 +3139,24 @@ end;
} }
function TsWorksheet.IsMergeBase(ACell: PCell): Boolean; function TsWorksheet.IsMergeBase(ACell: PCell): Boolean;
begin begin
Result := (ACell <> nil) and (ACell = ACell^.MergeBase);
{
Result := (ACell <> nil) and ( Result := (ACell <> nil) and (
(ACell^.MergedNeighbors = [cbEast]) or // single row (ACell^.MergedNeighbors = [cbEast]) or // single row
(ACell^.MergedNeighbors = [cbSouth]) or // single column (ACell^.MergedNeighbors = [cbSouth]) or // single column
(ACell^.MergedNeighbors = [cbEast, cbSouth]) // 2d (ACell^.MergedNeighbors = [cbEast, cbSouth]) // 2d
); );
}
end;
{@@ Returns TRUE if the specified cell belongs to a merged block
@param ACell Pointer to the cell of interest
@return TRUE if the cell belongs to a merged block, FALSE if not.
}
function TsWorksheet.IsMerged(ACell: PCell): Boolean;
begin
Result := (ACell <> nil) and (ACell^.MergeBase <> nil);
end; end;
{@@ {@@
@ -5033,36 +5024,50 @@ var
begin begin
col := PtrInt(arg); col := PtrInt(arg);
cell := PCell(data); cell := PCell(data);
if cell = nil then // This should not happen. Just to make sure...
exit;
// Update column index of moved cells if (cell^.Col >= col) then
if cell^.Col >= col then // Update column index of moved cell
inc(cell^.Col); inc(cell^.Col);
// Update formulas // Update formulas
// (1) create an rpn formula if HasFormula(cell) then
formula := BuildRPNFormula(cell); begin
// (2) update cell addresses affected by the insertion of a column {
for i:=0 to Length(formula)-1 do begin if cell^.SharedFormulaBase <> cell then
fe := Formula[i]; // "fe" means "formula element" begin
case fe.ElementKind of newCell := GetCell(cell^.Row, col);
fekCell, fekCellRef: newCell^.SharedFormulaBase := cell^.SharedFormulaBasse;
if fe.Col >= col then inc(fe.Col); end else
fekCellRange: }
begin begin
if fe.Col >= col then inc(fe.Col); // (1) create an rpn formula
if fe.Col2 >= col then inc(fe.Col2); formula := BuildRPNFormula(cell);
// (2) update cell addresses affected by the insertion of a column
for i:=0 to Length(formula)-1 do
begin
fe := Formula[i]; // "fe" means "formula element"
case fe.ElementKind of
fekCell, fekCellRef:
if fe.Col >= col then inc(fe.Col);
fekCellRange:
begin
if fe.Col >= col then inc(fe.Col);
if fe.Col2 >= col then inc(fe.Col2);
end;
end; end;
end;
// (3) convert rpn formula back to string formula
cell^.FormulaValue := ConvertRPNFormulaToStringFormula(formula);
end; end;
end; end;
// (3) convert rpn formula back to string formula
cell^.FormulaValue := ConvertRPNFormulaToStringFormula(formula);
end; end;
{@@ {@@
Inserts a column BEFORE the index specified. Cells with greater column indexes are Inserts a column BEFORE the index specified. Cells with greater column indexes are
moved one column up. Cell references in rpn formulas are considered as well. moved one column to the right. Merged cell blocks and cell references in formulas
However, lacking a parser for string formulas, references in string formulas are considered as well.
are not changed which may lead to incorrect operation!
@param ACol Index of the column before which a new column is inserted. @param ACol Index of the column before which a new column is inserted.
} }
@ -5071,6 +5076,9 @@ var
cellnode: TAVLTreeNode; cellnode: TAVLTreeNode;
col: PCol; col: PCol;
i: Integer; i: Integer;
r, c: Cardinal;
r1, c1, r2, c2: Cardinal;
cell, nextcell, gapcell: PCell;
begin begin
// Update column index of cell records // Update column index of cell records
cellnode := FCells.FindLowest; cellnode := FCells.FindLowest;
@ -5079,6 +5087,26 @@ begin
cellnode := FCells.FindSuccessor(cellnode); cellnode := FCells.FindSuccessor(cellnode);
end; end;
// Fix merged cells: If the inserted column runs through a block of merged
// cells the block is cut into two pieces. Here we fill the gap with dummy
// cells and set their MergeBase correctly.
for r := 0 to GetLastRowIndex do
for c := 0 to GetLastColIndex do
begin
cell := FindCell(r, c);
if IsMergeBase(cell) then begin
FindMergedRange(cell, r1, c1, r2, c2);
if ACol = c2 + 1 then begin
nextcell := FindCell(r, ACol + 1);
if Assigned(nextcell) and (nextcell^.MergeBase = cell) then
begin
gapcell := GetCell(r, ACol);
gapcell^.MergeBase := cell;
end;
end;
end;
end;
// Update column index of column records // Update column index of column records
for i:=0 to FCols.Count-1 do begin for i:=0 to FCols.Count-1 do begin
col := PCol(FCols.Items[i]); col := PCol(FCols.Items[i]);
@ -5106,31 +5134,33 @@ begin
if cell^.Row >= row then if cell^.Row >= row then
inc(cell^.Row); inc(cell^.Row);
// Update rpn formulas // Update formulas
// (1) create an rpn formula if HasFormula(cell) then
formula := BuildRPNFormula(cell); begin
// (2) update cell addresses affected by the insertion of a column // (1) create an rpn formula
for i:=0 to Length(formula)-1 do begin formula := BuildRPNFormula(cell);
fe := formula[i]; // "fe" means "formula element" // (2) update cell addresses affected by the insertion of a column
case fe.ElementKind of for i:=0 to Length(formula)-1 do begin
fekCell, fekCellRef: fe := formula[i]; // "fe" means "formula element"
if fe.Row >= row then inc(fe.Row); case fe.ElementKind of
fekCellRange: fekCell, fekCellRef:
begin
if fe.Row >= row then inc(fe.Row); if fe.Row >= row then inc(fe.Row);
if fe.Row2 >= row then inc(fe.Row2); fekCellRange:
end; begin
if fe.Row >= row then inc(fe.Row);
if fe.Row2 >= row then inc(fe.Row2);
end;
end;
end; end;
// (3) convert rpn formula back to string formula
cell^.FormulaValue := ConvertRPNFormulaToStringFormula(formula);
end; end;
// (3) convert rpn formula back to string formula
cell^.FormulaValue := ConvertRPNFormulaToStringFormula(formula);
end; end;
{@@ {@@
Inserts a row BEFORE the row specified. Cells with greater row indexes are Inserts a row BEFORE the row specified. Cells with greater row indexes are
moved one row up. Cell references in rpn formulas are considered as well. moved one row down. Merged cell blocks and cell references in formulas are
However, lacking a parser for string formulas, references in string formulas considered as well.
are not changed which may lead to incorrect operation!
@param ARow Index of the row before which a new row is inserted. @param ARow Index of the row before which a new row is inserted.
} }
@ -5139,6 +5169,8 @@ var
row: PRow; row: PRow;
cellnode: TAVLTreeNode; cellnode: TAVLTreeNode;
i: Integer; i: Integer;
r, c, r1, c1, r2, c2: Cardinal;
cell, nextcell, gapcell: PCell;
begin begin
// Update row index of cell records // Update row index of cell records
cellnode := FCells.FindLowest; cellnode := FCells.FindLowest;
@ -5147,6 +5179,26 @@ begin
cellnode := FCells.FindSuccessor(cellnode); cellnode := FCells.FindSuccessor(cellnode);
end; end;
// Fix merged cells: If the inserted row runs through a block of merged
// cells the block is cut into two pieces. Here we fill the gap with dummy
// cells and set their MergeBase correctly.
for r := 0 to GetLastRowIndex do
for c := 0 to GetLastColIndex do
begin
cell := FindCell(r, c);
if IsMergeBase(cell) then begin
FindMergedRange(cell, r1, c1, r2, c2);
if ARow = r2 + 1 then begin
nextcell := FindCell(ARow + 1, c);
if Assigned(nextcell) and (nextcell^.MergeBase = cell) then
begin
gapcell := GetCell(ARow, c);
gapcell^.MergeBase := cell;
end;
end;
end;
end;
// Update row index of row records // Update row index of row records
for i:=0 to FRows.Count-1 do begin for i:=0 to FRows.Count-1 do begin
row := PRow(FRows.Items[i]); row := PRow(FRows.Items[i]);

78
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -1489,7 +1489,8 @@ begin
then then
Continue; Continue;
// Overflow possible from non-merged, non-right-aligned, horizontal label cells // Overflow possible from non-merged, non-right-aligned, horizontal label cells
if (cell^.MergedNeighbors = []) and (cell^.ContentType = cctUTF8String) and // if (cell^.MergedNeighbors = []) and (cell^.ContentType = cctUTF8String) and
if (cell^.MergeBase = nil) and (cell^.ContentType = cctUTF8String) and
not (uffTextRotation in cell^.UsedFormattingFields) and not (uffTextRotation in cell^.UsedFormattingFields) and
(uffHorAlign in cell^.UsedFormattingFields) and (cell^.HorAlignment <> haRight) (uffHorAlign in cell^.UsedFormattingFields) and (cell^.HorAlignment <> haRight)
then then
@ -1514,7 +1515,8 @@ begin
then then
continue; continue;
// Overflow possible from non-merged, horizontal, non-left-aligned label cells // Overflow possible from non-merged, horizontal, non-left-aligned label cells
if (cell^.MergedNeighbors = []) and (cell^.ContentType = cctUTF8String) and // if (cell^.MergedNeighbors = []) and (cell^.ContentType = cctUTF8String) and
if (cell^.MergeBase = nil) and (cell^.ContentType = cctUTF8String) and
not (uffTextRotation in cell^.UsedFormattingFields) and not (uffTextRotation in cell^.UsedFormattingFields) and
(uffHorAlign in cell^.UsedFormattingFields) and (cell^.HorAlignment <> haLeft) (uffHorAlign in cell^.UsedFormattingFields) and (cell^.HorAlignment <> haLeft)
then then
@ -1535,7 +1537,9 @@ begin
if Assigned(FWorksheet) and (gr >= FixedRows) and (gc >= FixedCols) then if Assigned(FWorksheet) and (gr >= FixedRows) and (gc >= FixedCols) then
begin begin
cell := FWorksheet.FindCell(GetWorksheetRow(gr), GetWorksheetCol(gc)); cell := FWorksheet.FindCell(GetWorksheetRow(gr), GetWorksheetCol(gc));
if (cell = nil) or (cell^.MergedNeighbors = []) then begin //if (cell = nil) or (cell^.MergedNeighbors = []) then begin
if (cell = nil) or (cell^.Mergebase = nil) then
begin
// single cell // single cell
FDrawingCell := cell; FDrawingCell := cell;
if FTextOverflow then if FTextOverflow then
@ -2265,7 +2269,9 @@ begin
lCell := FWorksheet.FindCell(ARow-FHeaderCount, ACol-FHeaderCount); lCell := FWorksheet.FindCell(ARow-FHeaderCount, ACol-FHeaderCount);
if lCell <> nil then begin if lCell <> nil then begin
if lCell^.MergedNeighbors <> [] then begin //if lCell^.MergedNeighbors <> [] then begin
if (lCell^.Mergebase <> nil) then
begin
FWorksheet.FindMergedRange(lCell, r1, c1, r2, c2); FWorksheet.FindMergedRange(lCell, r1, c1, r2, c2);
if r1 <> r2 then if r1 <> r2 then
// If the merged range encloses several rows we skip automatic row height // If the merged range encloses several rows we skip automatic row height
@ -2323,7 +2329,7 @@ end;
@param ACol Grid column index of the cell @param ACol Grid column index of the cell
@param ARow Grid row index of the cell @param ARow Grid row index of the cell
@return Text to be displayed in the cell. @return Text to be displayed in the cell.
} }
function TsCustomWorksheetGrid.GetCellText(ACol, ARow: Integer): String; function TsCustomWorksheetGrid.GetCellText(ACol, ARow: Integer): String;
var var
lCell: PCell; lCell: PCell;
@ -2362,7 +2368,6 @@ begin
end; end;
end; end;
end; end;
// else Result := 'NIL';
end; end;
end; end;
@ -2374,7 +2379,7 @@ end;
@param ACol Grid column index of the cell being edited @param ACol Grid column index of the cell being edited
@param ARow Grid row index of the grid cell being edited @param ARow Grid row index of the grid cell being edited
@return Text to be passed to the cell editor. @return Text to be passed to the cell editor.
} }
function TsCustomWorksheetGrid.GetEditText(aCol, aRow: Integer): string; function TsCustomWorksheetGrid.GetEditText(aCol, aRow: Integer): string;
begin begin
Result := GetCellText(aCol, aRow); Result := GetCellText(aCol, aRow);
@ -2383,7 +2388,9 @@ end;
{ Determines the style of the border between a cell and its neighbor given by { Determines the style of the border between a cell and its neighbor given by
ADeltaCol and ADeltaRow (one of them must be 0, the other one can only be +/-1). ADeltaCol and ADeltaRow (one of them must be 0, the other one can only be +/-1).
ACol and ARow are in grid units. } ACol and ARow are in grid units.
Result is FALSE if there is no border line.
}
function TsCustomWorksheetGrid.GetBorderStyle(ACol, ARow, ADeltaCol, ADeltaRow: Integer; function TsCustomWorksheetGrid.GetBorderStyle(ACol, ARow, ADeltaCol, ADeltaRow: Integer;
out ABorderStyle: TsCellBorderStyle): Boolean; out ABorderStyle: TsCellBorderStyle): Boolean;
var var
@ -2408,37 +2415,46 @@ begin
border := cbSouth; border := cbSouth;
neighborBorder := cbNorth; neighborBorder := cbNorth;
end else end else
raise Exception.Create('TsCustomWorksheetGrid: incorrect col/row for GetBorderStyle.'); raise Exception.Create('[TsCustomWorksheetGrid] Incorrect col/row for GetBorderStyle.');
r := GetWorksheetRow(ARow); r := GetWorksheetRow(ARow);
c := GetWorksheetCol(ACol); c := GetWorksheetCol(ACol);
cell := FWorksheet.FindCell(r, c); cell := FWorksheet.FindCell(r, c);
if (r+ADeltaRow < 0) or (c + ADeltaCol < 0) then if (ARow - FHeaderCount + ADeltaRow < 0) or (ACol - FHeaderCount + ADeltaCol < 0) then
neighborcell := nil neighborcell := nil
else else
neighborcell := FWorksheet.FindCell(r+ADeltaRow, c+ADeltaCol); neighborcell := FWorksheet.FindCell(ARow - FHeaderCount + ADeltaRow, ACol - FHeaderCount + ADeltaCol);
// Only cell has border, but neighbor has not // Only cell has border, but neighbor has not
if HasBorder(cell, border) and not HasBorder(neighborCell, neighborBorder) then if HasBorder(cell, border) and not HasBorder(neighborCell, neighborBorder) then
{ if ((cell <> nil) and (border in cell^.Border)) and begin
((neighborcell = nil) or (neighborborder in neighborcell^.Border)) if FWorksheet.IsMerged(cell) and FWorksheet.IsMerged(neighborcell) and
then } (cell^.MergeBase = neighborcell^.Mergebase)
ABorderStyle := cell^.BorderStyles[border] then
result := false
else
ABorderStyle := cell^.BorderStyles[border]
end
else else
// Only neighbor has border, cell has not // Only neighbor has border, cell has not
if not HasBorder(cell, border) and HasBorder(neighborCell, neighborBorder) then if not HasBorder(cell, border) and HasBorder(neighborCell, neighborBorder) then
{ begin
if ((cell = nil) or not (border in cell^.Border)) and if FWorksheet.IsMerged(cell) and FWorksheet.IsMerged(neighborcell) and
(neighborcell <> nil) and (neighborborder in neighborcell^.Border) (cell^.MergeBase = neighborcell^.Mergebase)
then then
} result := false
ABorderStyle := neighborcell^.BorderStyles[neighborborder] else
ABorderStyle := neighborcell^.BorderStyles[neighborborder]
end
else else
// Both cells have shared border -> use top or left border // Both cells have shared border -> use top or left border
if HasBorder(cell, border) and HasBorder(neighborCell, neighborBorder) then begin if HasBorder(cell, border) and HasBorder(neighborCell, neighborBorder) then
{ begin
if (cell <> nil) and (border in cell^.Border) and if FWorksheet.IsMerged(cell) and FWorksheet.IsMerged(neighborcell) and
(neighborcell <> nil) and (neighborborder in neighborcell^.Border) (cell^.MergeBase = neighborcell^.Mergebase)
then begin then
} result := false
else
if (border in [cbNorth, cbWest]) then if (border in [cbNorth, cbWest]) then
ABorderStyle := neighborcell^.BorderStyles[neighborborder] ABorderStyle := neighborcell^.BorderStyles[neighborborder]
else else
@ -2457,7 +2473,7 @@ end;
} }
function TsCustomWorksheetGrid.GetGridCol(ASheetCol: Cardinal): Integer; function TsCustomWorksheetGrid.GetGridCol(ASheetCol: Cardinal): Integer;
begin begin
Result := ASheetCol + FHeaderCount Result := Integer(ASheetCol) + FHeaderCount
end; end;
{@@ {@@
@ -2470,7 +2486,7 @@ end;
} }
function TsCustomWorksheetGrid.GetGridRow(ASheetRow: Cardinal): Integer; function TsCustomWorksheetGrid.GetGridRow(ASheetRow: Cardinal): Integer;
begin begin
Result := ASheetRow + FHeaderCount; Result := Integer(ASheetRow) + FHeaderCount;
end; end;
function TsCustomWorksheetGrid.GetHorAlignment(ACol, ARow: Integer): TsHorAlignment; function TsCustomWorksheetGrid.GetHorAlignment(ACol, ARow: Integer): TsHorAlignment;
@ -2700,7 +2716,7 @@ begin
if AGridCol < FHeaderCount then if AGridCol < FHeaderCount then
exit; exit;
if FWorksheet.GetLastColIndex+1 + FHeaderCount >= FInitColCount then if FWorksheet.GetLastColIndex + 1 + FHeaderCount >= FInitColCount then
ColCount := ColCount + 1; ColCount := ColCount + 1;
c := AGridCol - FHeaderCount; c := AGridCol - FHeaderCount;
FWorksheet.InsertCol(c); FWorksheet.InsertCol(c);
@ -2833,7 +2849,7 @@ begin
P := ARect.TopLeft; P := ARect.TopLeft;
case AJustification of case AJustification of
0: ts.Alignment := taLeftJustify; 0: ts.Alignment := taLeftJustify;
1: if (FDrawingCell <> nil) and (FDrawingCell^.MergedNeighbors = []) then 1: if (FDrawingCell <> nil) and (FDrawingCell^.MergeBase = nil) then //(FDrawingCell^.MergedNeighbors = []) then
begin begin
// Special treatment for overflowing cells: they must be centered // Special treatment for overflowing cells: they must be centered
// at their original column, not in the total enclosing rectangle. // at their original column, not in the total enclosing rectangle.