fpspreadsheet: Avoid selecting a non-base cell of a merged block (patch by wofs, https://forum.lazarus.freepascal.org/index.php/topic,40726.msg281408.html#msg281408).

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

components/fpspreadsheet/source/common/fpspreadsheet.pas

@@ -309,6 +309,9 @@ type
     function WriteBorders(ARow, ACol: Cardinal;
       ABorders: TsCellBorders): PCell; overload;
     procedure WriteBorders(ACell: PCell; ABorders: TsCellBorders); overload;
+    procedure WriteBorders(ALeft, ATop, ARight, ABottom: Integer;
+      ABorders: TsCellBorders; ALeftStyle, ATopStyle, ARightStyle, ABottomStyle,
+      AInnerHorStyle, AInnerVertStyle: TsCellBorderStyle);
     function WriteBorderStyle(ARow, ACol: Cardinal; ABorder: TsCellBorder;
       AStyle: TsCellBorderStyle): PCell; overload;
     procedure WriteBorderStyle(ACell: PCell; ABorder: TsCellBorder;
@@ -4432,12 +4435,22 @@ begin
   ChangedCell(ARowFrom, AColFrom);
 end;
 
-
 {@@ ----------------------------------------------------------------------------
   Marks a specified cell as "selected". Only needed by the visual controls.
 -------------------------------------------------------------------------------}
 procedure TsWorksheet.SelectCell(ARow, ACol: Cardinal);
+var
+  cell: PCell;
 begin
+  // Avoid selecting a non-base cell of a merged block.
+  cell := FindCell(ARow, ACol);
+  if Assigned(cell) then
+  begin
+    if IsMerged(cell) then
+      cell := FindMergeBase(cell);
+    ACol := cell^.Col;
+  end;
+
   FActiveCellRow := ARow;
   FActiveCellCol := ACol;
   if FWorkbook.NotificationsEnabled and Assigned(FOnSelectCell) then
@@ -6527,6 +6540,160 @@ begin
   end;
 end;
 
+procedure TsWorksheet.WriteBorders(ALeft, ATop, ARight, ABottom: Integer;
+  ABorders: TsCellBorders; ALeftStyle, ATopStyle, ARightStyle, ABottomStyle,
+  AInnerHorStyle, AInnerVertStyle: TsCellBorderStyle);
+
+  function BorderVisible(const AStyle: TsCellBorderStyle): Boolean;
+  begin
+    Result := (AStyle.Color <> scNotDefined) and (AStyle.Color <> scTransparent);
+  end;
+
+  procedure SetNeighborBorder(NewRow, NewCol: Cardinal;
+    ANewBorder: TsCellBorder; const ANewBorderStyle: TsCellBorderStyle;
+    AInclude: Boolean);
+  var
+    neighbor: PCell;
+    border: TsCellBorders;
+  begin
+    neighbor := FindCell(NewRow, NewCol);
+    if neighbor <> nil then
+    begin
+      border := ReadCelLBorders(neighbor);
+      if AInclude then
+      begin
+        Include(border, ANewBorder);
+        WriteBorderStyle(NewRow, NewCol, ANewBorder, ANewBorderStyle);
+      end else
+        Exclude(border, ANewBorder);
+      WriteBorders(NewRow, NewCol, border);
+    end;
+  end;
+
+  procedure FixNeighborCellBorders(ACell: PCell);
+  var
+    fmt: PsCellFormat;
+  begin
+    if (ACell = nil) then
+      exit;
+
+    fmt := GetPointerToEffectiveCellFormat(ACell);
+    with ACell^ do
+    begin
+      if Col > 0 then
+        SetNeighborBorder(Row, Col-1, cbEast, fmt^.BorderStyles[cbWest], cbWest in fmt^.Border);
+      SetNeighborBorder(Row, Col+1, cbWest, fmt^.BorderStyles[cbEast], cbEast in fmt^.Border);
+      if Row > 0 then
+        SetNeighborBorder(Row-1, Col, cbSouth, fmt^.BorderStyles[cbNorth], cbNorth in fmt^.Border);
+      SetNeighborBorder(Row+1, Col, cbNorth, fmt^.BorderStyles[cbSouth], cbSouth in fmt^.Border);
+    end;
+  end;
+
+  procedure ProcessBorder(ARow, ACol: Cardinal; ABorder: TsCellBorder;
+    const AStyle: TsCellBorderStyle);
+  var
+    cb: TsCellBorders = [];
+    cell: PCell;
+  begin
+    cell := FindCell(ARow, ACol);
+    if cell <> nil then
+      cb := ReadCellBorders(cell);
+    if BorderVisible(AStyle) then
+    begin
+      Include(cb, ABorder);
+      cell := WriteBorders(ARow, ACol, cb);
+      WriteBorderStyle(cell, ABorder, AStyle);
+    end else
+    if cb <> [] then
+    begin
+      Exclude(cb, ABorder);
+      cell := WriteBorders(ARow, ACol, cb);
+    end;
+    FixNeighborCellBorders(cell);
+  end;
+
+  procedure ShowCellBorders(ALeft, ATop, ARight, ABottom: Integer;
+    ALeftOuterStyle, ATopOuterStyle, ARightOuterStyle, ABottomOuterStyle,
+    AHorInnerStyle, AVertInnerStyle: TsCellBorderStyle);
+  var
+    r, c, r1, c1, r2, c2: Cardinal;
+  begin
+    // Preparations
+    EnsureOrder(ALeft, ARight);
+    EnsureOrder(ATop, ABottom);
+
+    // Top outer border
+    for c := ALeft to ARight do
+      ProcessBorder(r1, c, cbNorth, ATopOuterStyle);
+    // Bottom outer border
+    for c := ALeft to ARight do
+      ProcessBorder(r2, c, cbSouth, ABottomOuterStyle);
+    // Left outer border
+    for r := ATop to ABottom do
+      ProcessBorder(r, c1, cbWest, ALeftOuterStyle);
+    // Right outer border
+    for r := ATop to ABottom do
+      ProcessBorder(r, c2, cbEast, ARightOuterStyle);
+    // Horizontal inner border
+    if ATop <> ABottom then
+      for r := ATop to ABottom-1 do
+        for c := ALeft to ARight do
+          ProcessBorder(r, c, cbSouth, AHorInnerStyle);
+    // Vertical inner border
+    if ALeft <> ARight then
+      for r := ATop to ABottom do
+        for c := ALeft to ARight-1 do
+          ProcessBorder(r, c, cbEast, AVertInnerStyle);
+  end;
+
+  procedure SetCellBorders(ACol, ARow: Integer);
+  var
+    cell: PCell;
+    r1, c1, r2, c2: Cardinal;
+    styles, saved_styles: TsCellBorderStyles;
+  begin
+    cell := GetCell(ARow, ACol);
+
+    if IsMergeBase(cell) then
+    begin
+      styles := ReadCellBorderStyles(cell);
+      saved_styles := styles;
+      if not (cbEast in ABorders) then styles[cbEast] := NO_CELL_BORDER;
+      if not (cbWest in ABorders) then styles[cbWest] := NO_CELL_BORDER;
+      if not (cbNorth in ABorders) then styles[cbNorth] := NO_CELL_BORDER;
+      if not (cbSouth in ABorders) then styles[cbSouth] := NO_CELL_BORDER;
+      FindMergedRange(cell, r1, c1, r2, c2);
+      // Set border flags and styles for all outer cells of the merged block
+      // Note: This overwrites the styles of the base ...
+      ShowCellBorders(r1,c1, r2,c2, styles[cbWest], styles[cbNorth],
+        styles[cbEast], styles[cbSouth], NO_CELL_BORDER, NO_CELL_BORDER);
+        // ... Restores base border style overwritten in prev instruction
+      WriteBorderStyles(cell, saved_styles);
+      WriteBorders(cell, ABorders);
+    end else
+    begin
+      WriteBorders(cell, ABorders);
+      FixNeighborCellBorders(cell);
+    end;
+  end;
+
+var
+  r, c: Cardinal;
+begin
+  EnsureOrder(ALeft, ARight);
+  EnsureOrder(ATop, ABottom);
+  Workbook.DisableNotifications;
+  try
+    for c := ALeft to ARight do
+      for r := ATop to ABottom do
+        SetCellBorders(c, r);
+  finally
+    Workbook.EnableNotifications;
+    ChangedCell(ALeft, ATop);
+  end;
+end;
+
+
 {@@ ----------------------------------------------------------------------------
   Sets the style of a cell border, i.e. line style and line color.
   Note: the border must be included in the "Borders" set in order to be shown!