fpspreadsheet: TsWorksheetGrid support overflowing cells now (i.e. text longer than a cell is wide is shown in the neighbor cell).

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3563 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/examples/spready/mainform.pas

@@ -1033,10 +1033,10 @@ begin
         then Strings.Add('NumberFormatStr=')
         else Strings.Add('NumberFormatStr=' + ACell^.NumberFormatStr);
       if (ACell=nil) or (ACell^.MergedNeighbors = []) then
-        Strings.Add('Not merged=')
+        Strings.Add('Merged neighbors=')
       else begin
         WorksheetGrid.Worksheet.FindMergedRange(ACell, r1, c1, r2, c2);
-        Strings.Add('Belongs to merged range=' + GetCellRangeString(r1, c1, r2, c2));
+        Strings.Add('Merged neighbors=' + GetCellRangeString(r1, c1, r2, c2));
       end;
 
     end;

components/fpspreadsheet/fpspreadsheetgrid.pas

@@ -117,6 +117,8 @@ type
 
   protected
     { Protected declarations }
+    function CellOverflow(ACol, ARow: Integer; AState: TGridDrawState;
+      out ACol1, ACol2: Integer; var ARect: TRect): Boolean;
     procedure CreateNewWorkbook;
     procedure DoPrepareCanvas(ACol, ARow: Integer; AState: TGridDrawState); override;
     procedure DrawAllRows; override;
@@ -794,6 +796,110 @@ begin
   Result := PtsToPX(h_pts, Screen.PixelsPerInch) + 4;
 end;
 
+{@@ Looks for overflowing cells: if the text of the given cell is longer than
+  the cell width the function calculates the column indexes and the rectangle
+  to show the complete text.
+  Ony for non-wordwrapped label cells and for horizontal orientation.
+  Function returns false if text overflow needs not to be considered.
+}
+function TsCustomWorksheetGrid.CellOverflow(ACol, ARow: Integer;
+  AState: TGridDrawState; out ACol1, ACol2: Integer; var ARect: TRect): Boolean;
+var
+  txt: String;
+  len: Integer;
+  cell: PCell;
+  txtalign: TsHorAlignment;
+  r: Cardinal;
+  w, w0: Integer;
+begin
+  Result := false;
+  cell := FDrawingCell;
+  if (cell = nil) or (cell^.ContentType <> cctUTF8String) then
+    exit;
+  if (uffWordWrap in cell^.UsedFormattingFields) then
+    exit;
+  if (uffTextRotation in cell^.UsedFormattingFields) and
+     (cell^.TextRotation <> trHorizontal)
+  then
+    exit;
+
+  txt := cell^.UTF8Stringvalue;
+  if (uffHorAlign in cell^.UsedFormattingFields) then
+    txtalign := cell^.HorAlignment
+  else
+    txtalign := haDefault;
+  PrepareCanvas(ACol, ARow, AState);
+  len := Canvas.TextWidth(txt);
+  ACol1 := ACol;
+  ACol2 := ACol;
+  r := GetWorksheetRow(ARow);
+  case txtalign of
+    haLeft, haDefault:
+      // overflow to the right
+      while (len > ARect.Right - ARect.Left) and (ACol2 < ColCount-1) do
+      begin
+        result := true;
+        inc(ACol2);
+        cell := FWorksheet.FindCell(r, GetWorksheetCol(ACol2));
+        if (cell <> nil) and (cell^.ContentType <> cctEmpty) then
+        begin
+          dec(ACol2);
+          break;
+        end;
+        ARect.Right := ARect.Right + ColWidths[ACol2];
+      end;
+    haRight:
+      // overflow to the left
+      while (len > ARect.Right - ARect.Left) and (ACol1 > FixedCols) do
+      begin
+        result := true;
+        dec(ACol1);
+        cell := FWorksheet.FindCell(r, GetWorksheetCol(ACol1));
+        if (cell <> nil) and (cell^.ContentType <> cctEmpty) then
+        begin
+          inc(ACol1);
+          break;
+        end;
+        ARect.Left := ARect.Left - ColWidths[ACol1];
+      end;
+    haCenter:
+      begin
+        len := len div 2;
+        w0 := (ARect.Right - ARect.Left) div 2;
+        w := w0;
+        // right part
+        while (len > w) and (ACol2 < ColCount-1) do
+        begin
+          Result := true;
+          inc(ACol2);
+          cell := FWorksheet.FindCell(r, GetWorksheetCol(ACol2));
+          if (cell <> nil) and (cell^.ContentType <> cctEmpty) then
+          begin
+            dec(ACol2);
+            break;
+          end;
+          ARect.Right := ARect.Right + ColWidths[ACol2];
+          inc(w, ColWidths[ACol2]);
+        end;
+        // left part
+        w := w0;
+        while (len > w) and (ACol1 > FixedCols) do
+        begin
+          Result := true;
+          dec(ACol1);
+          cell := FWorksheet.FindCell(r, GetWorksheetCol(ACol1));
+          if (cell <> nil) and (cell^.Contenttype <> cctEmpty) then
+          begin
+            inc(ACol1);
+            break;
+          end;
+          ARect.Left := ARect.left - ColWidths[ACol1];
+          inc(w, ColWidths[ACol1]);
+        end;
+      end;
+  end;
+end;
+
 {@@
   Handler for the event OnChangeCell fired by the worksheet when the contents
   or formatting of a cell have changed.
@@ -977,7 +1083,8 @@ begin
   then begin
     r := ARow - FHeaderCount;
     c := ACol - FHeaderCount;
-    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
@@ -1293,18 +1400,18 @@ end;
 procedure TsCustomWorksheetGrid.DrawRow(ARow: Integer);
 var
   gds: TGridDrawState;
-  r, c, cNext: Integer;
+  sr, sc, sr1,sc1,sr2,sc2: Cardinal;            // sheet row/column
+  gr, gc, gcNext, gcLast, gc1, gc2: Integer;    // grid row/column
   Rs: Boolean;
   rct, saved_rct: TRect;
   clipArea: Trect;
   cell: PCell;
-  r1,c1,r2,c2: Cardinal;
   tmp: Integer;
 
   function IsPushCellActive: boolean;
   begin
     with GCache do
-      result := (PushedCell.X<>-1) and (PushedCell.Y<>-1);
+      result := (PushedCell.X <> -1) and (PushedCell.Y <> -1);
   end;
 
   function VerticalIntersect(const aRect,bRect: TRect): boolean;
@@ -1343,7 +1450,7 @@ var
 
 begin
   // Upper and Lower bounds for this row
-  rct := Rect(0,0,0,0);
+  rct := Rect(0, 0, 0, 0);
   ColRowToOffSet(False, True, ARow, rct.Top, rct.Bottom);
   saved_rct := rct;
 
@@ -1356,53 +1463,111 @@ begin
     exit;
   end;
 
+  sr := GetWorksheetRow(ARow);
+
   // Draw columns in this row
-  with GCache.VisibleGrid do begin
+  with GCache.VisibleGrid do
-    c := Left;
+  begin
-    while c <= Right do begin
+    gc := Left;
-      r := ARow;
+
+    // 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
+      while (gc > FixedCols) do
+      begin
+        dec(gc);
+        cell := FWorksheet.FindCell(sr, GetWorksheetCol(gc));
+        // Empty cell --> proceed with next cell to the left
+        if (cell = nil) or (cell^.ContentType = cctEmpty) or
+           ((cell^.ContentType = cctUTF8String) and (cell^.UTF8StringValue = ''))
+        then
+          Continue;
+        // Overflow possible from non-merged, non-right-aligned, horizontal label cells
+        if (cell^.MergedNeighbors = []) and (cell^.ContentType = cctUTF8String) and
+           not (uffTextRotation in cell^.UsedFormattingFields) and
+           (uffHorAlign in cell^.UsedFormattingFields) and (cell^.HorAlignment <> haRight)
+        then
+          Break;
+        // All other cases --> no overflow --> return to initial left cell
+        gc := Left;
+        break;
+      end;
+
+    // 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
+        inc(gcLast);
+        cell := FWorksheet.FindCell(sr, GetWorksheetCol(gcLast));
+        // Empty cell --> proceed with next cell to the right
+        if (cell = nil) or (cell^.ContentType = cctEmpty) or
+           ((cell^.ContentType = cctUTF8String) and (cell^.UTF8StringValue = ''))
+        then
+          continue;
+        // Overflow possible from non-merged, horizontal, non-left-aligned label cells
+        if (cell^.MergedNeighbors = []) and (cell^.ContentType = cctUTF8String) and
+           not (uffTextRotation in cell^.UsedFormattingFields) and
+           (uffHorAlign in cell^.UsedFormattingFields) and (cell^.HorAlignment <> haLeft)
+        then
+          Break;
+        // All other cases --> no overflow --> return to initial right column
+        gcLast := Right;
+      end;
+
+    while gc <= gcLast do begin
+      gr := ARow;
       rct := saved_rct;
       // FDrawingCell is the cell which is currently being painted. We store
       // it to avoid excessive calls to "FindCell".
       FDrawingCell := nil;
-      cNext := c + 1;
+      gcNext := gc + 1;
-      if (FWorksheet <> nil) and (r >= FixedRows) and (c >= FixedCols) then
+      if (FWorksheet <> nil) and (gr >= FixedRows) and (gc >= FixedCols) then
       begin
-        cell := FWorksheet.FindCell(GetWorksheetRow(r), GetWorksheetCol(c));
+        cell := FWorksheet.FindCell(GetWorksheetRow(gr), GetWorksheetCol(gc));
-        if (cell = nil) or (cell^.MergedNeighbors = []) then
+        if (cell = nil) or (cell^.MergedNeighbors = []) then begin
           // single cell
-          FDrawingCell := cell
+          FDrawingCell := cell;
+          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
         else
         begin
           // merged cells
           FDrawingCell := FWorksheet.FindMergeBase(cell);
-          FWorksheet.FindMergedRange(FDrawingCell, r1, c1, r2, c2);
+          FWorksheet.FindMergedRange(FDrawingCell, sr1, sc1, sr2, sc2);
-          r := GetGridRow(r1);
+          gr := GetGridRow(sr1);
-          ColRowToOffSet(False, True, r, rct.Top, tmp);
+          ColRowToOffSet(False, True, gr, rct.Top, tmp);
-          ColRowToOffSet(False, True, r + r2 - r1, tmp, rct.Bottom);
+          ColRowToOffSet(False, True, gr + sr2 - sr1, tmp, rct.Bottom);
-          c := GetGridCol(c1);
+          gc := GetGridCol(sc1);
-          cNext := c + (c2-c1) + 1;
+          gcNext := gc + (sc2 - sc1) + 1;
         end;
       end;
 
-      ColRowToOffset(true, true, c, rct.Left, tmp);
+      ColRowToOffset(true, true, gc, rct.Left, tmp);
-      ColRowToOffset(true, true, cNext-1, tmp, rct.Right);
+      ColRowToOffset(true, true, gcNext-1, tmp, rct.Right);
 
       if (rct.Left < rct.Right) and HorizontalIntersect(rct, clipArea) then
       begin
  //       IntersectRect(rct, rct, clipArea);
 //        if rct.Left < clipArea.Left then rct.Left := clipArea.Left;
         Rs := (goRowSelect in Options);
-        gds := GetGridDrawState(c, r);
+        gds := GetGridDrawState(gc, gr);
-        DoDrawCell(c, r);
+        DoDrawCell(gc, gr);
       end;
 
-      c := cNext;
+      gc := gcNext;
     end;
 
     // Draw the focus Rect
     if FocusRectVisible and (ARow = Row) and
-       ((Rs and (ARow >= Top) and (ARow <= Bottom)) or IsCellVisible(Col, ARow))
+      (( Rs and (ARow >= Top) and (ARow <= Bottom)) or IsCellVisible(Col, ARow))
     then begin
       if EditorMode then begin
       //if EditorAlwaysShown and (FEditor<>nil) and FEditor.Visible then begin
@@ -1417,13 +1582,13 @@ begin
   end;
 
   // Draw Fixed Columns
-  r := ARow;
+  gr := ARow;
-  for c := 0 to FixedCols-1 do begin
+  for gc := 0 to FixedCols-1 do begin
     gds := [gdFixed];
-    ColRowToOffset(True, True, c, rct.Left, rct.Right);
+    ColRowToOffset(True, True, gc, rct.Left, rct.Right);
     // is this column within the ClipRect?
     if (rct.Left < rct.Right) and HorizontalIntersect(rct, clipArea) then
-      DoDrawCell(c, r);
+      DoDrawCell(gc, gr);
   end;
 end;
 
@@ -1481,19 +1646,19 @@ var
 begin
   if (FWorksheet = nil) then
     exit;
-                         {
+
   if (ACol < FHeaderCount) or (ARow < FHeaderCount) then
     lCell := nil
   else
     lCell := FDrawingCell;
-    }
+    {
   c := ACol - FHeaderCount;
   r := ARow - FHeaderCount;
   if (r >= 0) and (c >= 0) then
     lCell := FWorksheet.FindCell(r, c)
   else
     lCell := nil;
-
+     }
   // Header
   if lCell = nil then begin
     if ShowHeaders and ((ACol = 0) or (ARow = 0)) then begin
@@ -1522,7 +1687,8 @@ begin
 
   InflateRect(ARect, -constCellPadding, -constCellPadding);
 
-  txt := GetCellText(ACol, ARow);
+//  txt := GetCellText(ACol, ARow);
+  txt := GetCellText(GetGridRow(lCell^.Col), GetGridCol(lCell^.Row));
   if txt = '' then
     exit;
 
@@ -2442,6 +2608,9 @@ end;
 }
 function TsCustomWorksheetGrid.GetWorksheetCol(AGridCol: Integer): cardinal;
 begin
+  if (FHeaderCount > 0) and (AGridCol = 0) then
+    Result := Cardinal(-1)
+  else
     Result := AGridCol - FHeaderCount;
 end;
 
@@ -2455,6 +2624,9 @@ end;
 }
 function TsCustomWorksheetGrid.GetWorksheetRow(AGridRow: Integer): Cardinal;
 begin
+  if (FHeaderCount > 0) and (AGridRow = 0) then
+    Result := Cardinal(-1)
+  else
     Result := AGridRow - FHeaderCount;
 end;
 
@@ -2574,6 +2746,7 @@ var
   i: Integer;
   L: TStrings;
   wrapped: Boolean;
+  pLeft, pRight: Integer;
 begin
   wrapped := ATextWrap or (ATextRot = rtStacked);
   if AMeasureText = '' then txt := AText else txt := AMeasureText;
@@ -2625,6 +2798,37 @@ begin
         ts.Layout := tlTop
       else
         ts.Layout := VERT_ALIGNMENTS[ACellVertAlign];
+
+      // too long text
+      if w > ARect.Right - ARect.Left then
+        if ReplaceTooLong then
+        begin
+          txt := '';
+          repeat
+            txt := txt + '#';
+            LCLIntf.DrawText(Canvas.Handle, PChar(txt), Length(txt), txtRect, flags);
+          until txtRect.Right - txtRect.Left > ARect.Right - ARect.Left;
+          AText := Copy(txt, 1, Length(txt)-1);
+          w := Canvas.TextWidth(AText);
+        end;
+
+      P := ARect.TopLeft;
+      case AJustification of
+        0: ts.Alignment := taLeftJustify;
+        1: if FDrawingCell <> nil then
+           begin
+             // Special treatment for overflowing cells: they must be centered
+             // at their original column, not in the total enclosing rectangle.
+             ColRowToOffset(true, true, FDrawingCell^.Col + FHeaderCount, pLeft, pRight);
+             P.X := (pLeft + pRight - w) div 2;
+             P.y := ARect.Top;
+             ts.Alignment := taLeftJustify;
+           end
+           else
+             ts.Alignment := taCenter;
+        2: ts.Alignment := taRightJustify;
+      end;
+      (*
       if w > ARect.Right - ARect.Left then begin
         if ReplaceTooLong then begin
           txt := '';
@@ -2634,15 +2838,16 @@ begin
           until txtRect.Right - txtRect.Left > ARect.Right - ARect.Left;
           AText := Copy(txt, 1, Length(txt)-1);
         end;
-        ts.Alignment := taLeftJustify;
+        //ts.Alignment := taLeftJustify;
       end else
         case AJustification of
           0: ts.Alignment := taLeftJustify;
           1: ts.Alignment := taCenter;
           2: ts.Alignment := taRightJustify;
         end;
+        *)
       Canvas.TextStyle := ts;
-      Canvas.TextRect(ARect,ARect.Left, ARect.Top, AText);
+      Canvas.TextRect(ARect, P.X, P.Y, AText);
     end;
   end
   else

components/fpspreadsheet/xlscommon.pas

@@ -747,7 +747,16 @@ begin
     ACell^.FontIndex := XFData.FontIndex;
 
     // Alignment
+    if XFData.HorAlignment <> haDefault then
+      Include(ACell^.UsedFormattingFields, uffHorAlign)
+    else
+      Exclude(ACell^.UsedFormattingFields, uffHorAlign);
     ACell^.HorAlignment := XFData.HorAlignment;
+
+    if XFData.VertAlignment <> vaDefault then
+      Include(ACell^.UsedFormattingFields, uffVertAlign)
+    else
+      Exclude(ACell^.UsedFormattingFields, uffVertAlign);
     ACell^.VertAlignment := XFData.VertAlignment;
 
     // Word wrap