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

fpspreadsheet: Fix incoomplete saving of merged cell borders if borders are assigned only to merge base cell.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4470 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-01-25 22:29:13 +00:00
parent 8184c4b609
commit 9e0db3722b
3 changed files with 231 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -2938,8 +2938,11 @@ begin
if ACell <> nil then if ACell <> nil then
begin begin
fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex);
Result := Fmt^.BorderStyles;
{
for b in fmt^.Border do for b in fmt^.Border do
Result[b] := fmt^.BorderStyles[b]; Result[b] := fmt^.BorderStyles[b];
}
end; end;
end; end;

39
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -5116,13 +5116,42 @@ procedure TsCustomWorksheetGrid.SetCellBorder(ACol, ARow: Integer;
AValue: TsCellBorders); AValue: TsCellBorders);
var var
cell: PCell; cell: PCell;
sr1, sc1, sr2, sc2: Cardinal;
gr1, gc1, gr2, gc2: Integer;
styles, saved_styles: TsCellBorderStyles;
begin begin
if Assigned(Worksheet) then begin if Assigned(Worksheet) then begin
BeginUpdate; BeginUpdate;
try try
cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
if Worksheet.IsMergeBase(cell) then
begin
styles := Worksheet.ReadCellBorderStyles(cell);
saved_styles := styles;
if not (cbEast in AValue) then
styles[cbEast] := NO_CELL_BORDER;
if not (cbWest in AValue) then styles[cbWest] := NO_CELL_BORDER;
if not (cbNorth in AValue) then styles[cbNorth] := NO_CELL_BORDER;
if not (cbSouth in AValue) then styles[cbSouth] := NO_CELL_BORDER;
Worksheet.FindMergedRange(cell, sr1, sc1, sr2, sc2);
gr1 := GetGridRow(sr1);
gr2 := GetGridRow(sr2);
gc1 := GetGridCol(sc1);
gc2 := GetGridCol(sc2);
// Set border flags and styles for all outer cells of the merged block
// Note: This overwrites the styles of the base ...
ShowCellBorders(gc1,gr1, gc2,gr2, styles[cbWest], styles[cbNorth],
styles[cbEast], styles[cbSouth], NO_CELL_BORDER, NO_CELL_BORDER);
// ... Restores base border style overwritten in prev instruction
Worksheet.WriteBorderStyles(cell, saved_styles);
Worksheet.WriteBorders(cell, AValue);
end else
begin
Worksheet.WriteBorders(cell, AValue); Worksheet.WriteBorders(cell, AValue);
FixNeighborCellBorders(cell); FixNeighborCellBorders(cell);
end;
finally finally
EndUpdate; EndUpdate;
end; end;
@ -5150,13 +5179,23 @@ procedure TsCustomWorksheetGrid.SetCellBorderStyle(ACol, ARow: Integer;
ABorder: TsCellBorder; AValue: TsCellBorderStyle); ABorder: TsCellBorder; AValue: TsCellBorderStyle);
var var
cell: PCell; cell: PCell;
borders: TsCellBorders;
begin begin
if Assigned(Worksheet) then begin if Assigned(Worksheet) then begin
BeginUpdate; BeginUpdate;
try try
cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
if Worksheet.IsMergeBase(cell) then
begin
borders := Worksheet.ReadCellBorders(cell);
Worksheet.WriteBorderStyle(cell, ABorder, AValue);
// This will apply the new border style to the outer cells of the range.
SetCellBorder(ACol, ARow, borders);
end else
begin
Worksheet.WriteBorderStyle(cell, ABorder, AValue); Worksheet.WriteBorderStyle(cell, ABorder, AValue);
FixNeighborCellBorders(cell); FixNeighborCellBorders(cell);
end;
finally finally
EndUpdate; EndUpdate;
end; end;

185
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@ -0,0 +1,185 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="spreadtestgui"/>
<ResourceType Value="res"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="4">
<Item1>
<PackageName Value="LCLBase"/>
</Item1>
<Item2>
<PackageName Value="FPCUnitTestRunner"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
<Item4>
<PackageName Value="FCL"/>
</Item4>
</RequiredPackages>
<Units Count="25">
<Unit0>
<Filename Value="spreadtestgui.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="datetests.pas"/>
<IsPartOfProject Value="True"/>
</Unit1>
<Unit2>
<Filename Value="stringtests.pas"/>
<IsPartOfProject Value="True"/>
</Unit2>
<Unit3>
<Filename Value="numberstests.pas"/>
<IsPartOfProject Value="True"/>
</Unit3>
<Unit4>
<Filename Value="manualtests.pas"/>
<IsPartOfProject Value="True"/>
</Unit4>
<Unit5>
<Filename Value="testsutility.pas"/>
<IsPartOfProject Value="True"/>
</Unit5>
<Unit6>
<Filename Value="internaltests.pas"/>
<IsPartOfProject Value="True"/>
</Unit6>
<Unit7>
<Filename Value="formattests.pas"/>
<IsPartOfProject Value="True"/>
</Unit7>
<Unit8>
<Filename Value="colortests.pas"/>
<IsPartOfProject Value="True"/>
</Unit8>
<Unit9>
<Filename Value="fonttests.pas"/>
<IsPartOfProject Value="True"/>
</Unit9>
<Unit10>
<Filename Value="optiontests.pas"/>
<IsPartOfProject Value="True"/>
</Unit10>
<Unit11>
<Filename Value="numformatparsertests.pas"/>
<IsPartOfProject Value="True"/>
</Unit11>
<Unit12>
<Filename Value="rpnformulaunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rpnFormulaUnit"/>
</Unit12>
<Unit13>
<Filename Value="formulatests.pas"/>
<IsPartOfProject Value="True"/>
</Unit13>
<Unit14>
<Filename Value="emptycelltests.pas"/>
<IsPartOfProject Value="True"/>
</Unit14>
<Unit15>
<Filename Value="errortests.pas"/>
<IsPartOfProject Value="True"/>
</Unit15>
<Unit16>
<Filename Value="virtualmodetests.pas"/>
<IsPartOfProject Value="True"/>
</Unit16>
<Unit17>
<Filename Value="insertdeletetests.pas"/>
<IsPartOfProject Value="True"/>
</Unit17>
<Unit18>
<Filename Value="celltypetests.pas"/>
<IsPartOfProject Value="True"/>
</Unit18>
<Unit19>
<Filename Value="sortingtests.pas"/>
<IsPartOfProject Value="True"/>
</Unit19>
<Unit20>
<Filename Value="copytests.pas"/>
<IsPartOfProject Value="True"/>
</Unit20>
<Unit21>
<Filename Value="commenttests.pas"/>
<IsPartOfProject Value="True"/>
</Unit21>
<Unit22>
<Filename Value="enumeratortests.pas"/>
<IsPartOfProject Value="True"/>
</Unit22>
<Unit23>
<Filename Value="hyperlinktests.pas"/>
<IsPartOfProject Value="True"/>
</Unit23>
<Unit24>
<Filename Value="pagelayouttests.pas"/>
<IsPartOfProject Value="True"/>
</Unit24>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="spreadtestgui"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value=".."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Debugging>
<Exceptions Count="6">
<Item1>
<Name Value="EAbort"/>
<Enabled Value="False"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
<Enabled Value="False"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
<Enabled Value="False"/>
</Item3>
<Item4>
<Name Value="EAssertionFailedError"/>
</Item4>
<Item5>
<Name Value="EIgnoredTest"/>
</Item5>
<Item6>
<Name Value="EConvertError"/>
<Enabled Value="False"/>
</Item6>
</Exceptions>
</Debugging>
</CONFIG>