From a3ed071349667b69dd07f2f30254b48cc3492dbf Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 14 Sep 2014 20:40:58 +0000 Subject: [PATCH] fpspreadsheet: Fix cell range selection issue in TsWorksheetGrid if grid is in edit mode. Fix ods reporting an error due to a worksheet with empty name. Fix some bugs added when introducing text overflow cells (frozen cells incorrectly painted, failure to determine row heights correctly) git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3564 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/spready/mainform.lfm | 15 ++++++- .../examples/spready/mainform.pas | 9 ++++ components/fpspreadsheet/fpsopendocument.pas | 10 +++-- .../fpspreadsheet/fpspreadsheetgrid.pas | 43 ++++++++++++------- 4 files changed, 56 insertions(+), 21 deletions(-) diff --git a/components/fpspreadsheet/examples/spready/mainform.lfm b/components/fpspreadsheet/examples/spready/mainform.lfm index f319d8837..d00d2a68a 100644 --- a/components/fpspreadsheet/examples/spready/mainform.lfm +++ b/components/fpspreadsheet/examples/spready/mainform.lfm @@ -84,12 +84,23 @@ object MainFrm: TMainFrm object CbAutoCalcFormulas: TCheckBox Left = 8 Height = 19 - Top = 39 + Top = 32 Width = 128 Caption = 'Calculate on change' OnChange = CbAutoCalcFormulasChange TabOrder = 1 end + object CbTextOverflow: TCheckBox + Left = 8 + Height = 19 + Top = 56 + Width = 91 + Caption = 'Text overflow' + Checked = True + OnChange = CbTextOverflowChange + State = cbChecked + TabOrder = 5 + end end object ToolBar1: TToolBar Left = 0 @@ -442,9 +453,9 @@ object MainFrm: TMainFrm FrozenRows = 0 ReadFormulas = False Align = alClient + AutoAdvance = aaDown BorderStyle = bsNone ColCount = 27 - ExtendedSelect = False MouseWheelOption = mwGrid Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing, goThumbTracking, goSmoothScroll, goFixedColSizing] RowCount = 101 diff --git a/components/fpspreadsheet/examples/spready/mainform.pas b/components/fpspreadsheet/examples/spready/mainform.pas index 3b32a995f..5adf7adfb 100644 --- a/components/fpspreadsheet/examples/spready/mainform.pas +++ b/components/fpspreadsheet/examples/spready/mainform.pas @@ -86,6 +86,7 @@ type CbReadFormulas: TCheckBox; CbHeaderStyle: TComboBox; CbAutoCalcFormulas: TCheckBox; + CbTextOverflow: TCheckBox; EdFormula: TEdit; EdCellAddress: TEdit; FontComboBox: TComboBox; @@ -277,6 +278,7 @@ type procedure CbHeaderStyleChange(Sender: TObject); procedure CbReadFormulasChange(Sender: TObject); procedure CbBackgroundColorGetColors(Sender: TCustomColorBox; Items: TStrings); + procedure CbTextOverflowChange(Sender: TObject); procedure EdCellAddressEditingDone(Sender: TObject); procedure EdFormulaEditingDone(Sender: TObject); procedure EdFrozenColsChange(Sender: TObject); @@ -725,6 +727,12 @@ begin end; end; +procedure TMainFrm.CbTextOverflowChange(Sender: TObject); +begin + WorksheetGrid.TextOverflow := CbTextOverflow.Checked; + WorksheetGrid.Invalidate; +end; + procedure TMainFrm.CbBackgroundColorSelect(Sender: TObject); begin if CbBackgroundColor.ItemIndex <= 0 then @@ -878,6 +886,7 @@ begin AcShowHeaders.Checked := WorksheetGrid.ShowHeaders; EdFrozenCols.Value := WorksheetGrid.FrozenCols; EdFrozenRows.Value := WorksheetGrid.FrozenRows; + WorksheetGrid.TextOverflow := CbTextOverflow.Checked; SetupBackgroundColorBox; // Load names of worksheets into tabcontrol and show first sheet diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 319e14e43..efc32b85e 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -1287,6 +1287,7 @@ var BodyNode, SpreadSheetNode, TableNode: TDOMNode; StylesNode: TDOMNode; OfficeSettingsNode: TDOMNode; + nodename: String; begin //unzip files into AFileName path FilePath := GetTempDir(false); @@ -1334,10 +1335,11 @@ begin //process each table (sheet) TableNode := SpreadSheetNode.FindNode('table:table'); while Assigned(TableNode) do begin + nodename := TableNode.Nodename; // These nodes occur due to leading spaces which are not skipped // automatically any more due to PreserveWhiteSpace option applied // to ReadXMLFile - if TableNode.NodeName = '#text' then begin + if nodeName <> 'table:table' then begin // '#text' then begin TableNode := TableNode.NextSibling; continue; end; @@ -1839,7 +1841,7 @@ begin // These nodes occur due to indentation spaces which are not skipped // automatically any more due to PreserveWhiteSpace option applied // to ReadXMLFile - if nodeName = '#text' then begin + if nodeName <> 'table:table-cell' then begin //= '#text' then begin cellNode := cellNode.NextSibling; Continue; end; @@ -1963,7 +1965,7 @@ begin cfgEntryItemNode := cfgItemMapEntryNode.FirstChild; while Assigned(cfgEntryItemNode) do begin nodeName := cfgEntryItemNode.NodeName; - if (nodeName <> '#text') and (nodeName = 'config:config-item') + if (nodeName = 'config:config-item') then begin cfgName := lowercase(GetAttrValue(cfgEntryItemNode, 'config:name')); if cfgName = 'showgrid' then begin @@ -1975,7 +1977,7 @@ begin if cfgValue = 'false' then showHeaders := false; end; end else - if (nodeName <> '#text') and (nodeName = 'config:config-item-map-named') and + if (nodeName = 'config:config-item-map-named') and (GetAttrValue(cfgEntryItemNode, 'config:name') = 'Tables') then begin cfgTableItemNode := cfgEntryItemNode.FirstChild; diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index 07ea5e074..d7c105aef 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -47,6 +47,7 @@ type FEditing: Boolean; FCellFont: TFont; FAutoCalc: Boolean; + FTextOverflow: Boolean; FReadFormulas: Boolean; FDrawingCell: PCell; function CalcAutoRowHeight(ARow: Integer): Integer; @@ -165,6 +166,8 @@ type property ShowGridLines: Boolean read GetShowGridLines write SetShowGridLines default true; {@@ Shows/hides column and row headers in the fixed col/row style of the grid. } property ShowHeaders: Boolean read GetShowHeaders write SetShowHeaders default true; + {@@ Activates text overflow (cells reaching into neighbors) } + property TextOverflow: Boolean read FTextOverflow write FTextOverflow default false; public { public methods } @@ -328,6 +331,8 @@ type property ShowGridLines; {@@ Shows/hides column and row headers in the fixed col/row style of the grid. } property ShowHeaders; + {@@ Activates text overflow (cells reaching into neighbors) } + property TextOverflow; {@@ inherited from ancestors} property Align; @@ -368,7 +373,7 @@ type {@@ inherited from ancestors} property Enabled; {@@ inherited from ancestors} - property ExtendedSelect; + property ExtendedSelect default true; {@@ inherited from ancestors} property FixedColor; {@@ inherited from ancestors} @@ -1083,8 +1088,8 @@ begin then begin r := ARow - FHeaderCount; c := ACol - FHeaderCount; - lCell := FDrawingCell; -// lCell := FWorksheet.FindCell(r, c); + //lCell := FDrawingCell; + lCell := FWorksheet.FindCell(r, c); if lCell <> nil then begin // Background color if (uffBackgroundColor in lCell^.UsedFormattingFields) then begin @@ -1400,8 +1405,8 @@ end; procedure TsCustomWorksheetGrid.DrawRow(ARow: Integer); var gds: TGridDrawState; - sr, sc, sr1,sc1,sr2,sc2: Cardinal; // sheet row/column - gr, gc, gcNext, gcLast, gc1, gc2: Integer; // grid row/column + sr, sc, sr1,sc1,sr2,sc2: Cardinal; // sheet row/column + gr, gc, gcNext, gcLast, gc1, gc2, gcLastUsed: Integer; // grid row/column Rs: Boolean; rct, saved_rct: TRect; clipArea: Trect; @@ -1464,6 +1469,7 @@ begin end; sr := GetWorksheetRow(ARow); + gcLastUsed := GetGridCol(FWorksheet.GetLastOccupiedColIndex); // Draw columns in this row with GCache.VisibleGrid do @@ -1473,7 +1479,7 @@ begin // Because of possible cell overflow from cells left of the visible range // we have to seek to the left for the first occupied text cell // and start painting from here. - if sr <> Cardinal(-1) then + if FTextOverflow and (sr <> Cardinal(-1)) then while (gc > FixedCols) do begin dec(gc); @@ -1497,8 +1503,8 @@ begin // Now find the last column. Again text can overflow into the visible area // from cells to the right. gcLast := Right; - if sr <> Cardinal(-1) then - while gcLast < ColCount-1 do begin + if FTextOverflow and (sr <> Cardinal(-1)) then + while (gcLast < ColCount-1) and (gcLast < gcLastUsed) do begin inc(gcLast); cell := FWorksheet.FindCell(sr, GetWorksheetCol(gcLast)); // Empty cell --> proceed with next cell to the right @@ -1514,9 +1520,10 @@ begin Break; // All other cases --> no overflow --> return to initial right column gcLast := Right; + Break; end; - while gc <= gcLast do begin + while (gc <= gcLast) do begin gr := ARow; rct := saved_rct; // FDrawingCell is the cell which is currently being painted. We store @@ -1529,12 +1536,15 @@ begin if (cell = nil) or (cell^.MergedNeighbors = []) then begin // single cell FDrawingCell := cell; - gds := GetGridDrawState(gc, gr); - ColRowToOffset(true, true, gc, rct.Left, rct.Right); - if CellOverflow(gc, gr, gds, gc1, gc2, rct) then + if FTextOverflow then begin - gc := gc1; - gcNext := gc + (gc2 - gc1) + 1; + gds := GetGridDrawState(gc, gr); + ColRowToOffset(true, true, gc, rct.Left, rct.Right); + if CellOverflow(gc, gr, gds, gc1, gc2, rct) then + begin + gc := gc1; + gcNext := gc + (gc2 - gc1) + 1; + end; end; end else @@ -1588,7 +1598,10 @@ begin ColRowToOffset(True, True, gc, rct.Left, rct.Right); // is this column within the ClipRect? if (rct.Left < rct.Right) and HorizontalIntersect(rct, clipArea) then + begin + FDrawingCell := FWorksheet.FindCell(GetWorksheetRow(gr), GetWorksheetCol(gc)); DoDrawCell(gc, gr); + end; end; end; @@ -3450,7 +3463,7 @@ begin begin lRow := FWorksheet.FindRow(i - FHeaderCount); if (lRow <> nil) then - RowHeights[i] := CalcRowHeight(lRow^.Height); + h := CalcRowHeight(lRow^.Height); end; RowHeights[i] := h; end;