You've already forked lazarus-ccr
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
This commit is contained in:
wp_xxyyzz
@ -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!
|
||||
|
||||
Reference in New Issue
Block a user