From 9e0db3722b2cb99d4085b21a812c57a0b7db0a01 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 25 Jan 2016 22:29:13 +0000 Subject: [PATCH] fpspreadsheet: Fix incoomplete saving of merged cell borders if borders are assigned only to merge base cell. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4470 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/fpspreadsheet/fpspreadsheet.pas | 3 + .../fpspreadsheet/fpspreadsheetgrid.pas | 47 ++++- .../fpspreadsheet/tests/spreadtestgui.lpi | 185 ++++++++++++++++++ 3 files changed, 231 insertions(+), 4 deletions(-) diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index bc26ef170..2808a2296 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -2938,8 +2938,11 @@ begin if ACell <> nil then begin fmt := Workbook.GetPointerToCellFormat(ACell^.FormatIndex); + Result := Fmt^.BorderStyles; + { for b in fmt^.Border do Result[b] := fmt^.BorderStyles[b]; + } end; end; diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index df619488e..143556987 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -5116,13 +5116,42 @@ procedure TsCustomWorksheetGrid.SetCellBorder(ACol, ARow: Integer; AValue: TsCellBorders); var cell: PCell; + sr1, sc1, sr2, sc2: Cardinal; + gr1, gc1, gr2, gc2: Integer; + styles, saved_styles: TsCellBorderStyles; begin if Assigned(Worksheet) then begin BeginUpdate; try cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); - Worksheet.WriteBorders(cell, AValue); - FixNeighborCellBorders(cell); + + 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); + FixNeighborCellBorders(cell); + end; + finally EndUpdate; end; @@ -5150,13 +5179,23 @@ procedure TsCustomWorksheetGrid.SetCellBorderStyle(ACol, ARow: Integer; ABorder: TsCellBorder; AValue: TsCellBorderStyle); var cell: PCell; + borders: TsCellBorders; begin if Assigned(Worksheet) then begin BeginUpdate; try cell := Worksheet.GetCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol)); - Worksheet.WriteBorderStyle(cell, ABorder, AValue); - FixNeighborCellBorders(cell); + 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); + FixNeighborCellBorders(cell); + end; finally EndUpdate; end; diff --git a/components/fpspreadsheet/tests/spreadtestgui.lpi b/components/fpspreadsheet/tests/spreadtestgui.lpi index e69de29bb..96a83295e 100644 --- a/components/fpspreadsheet/tests/spreadtestgui.lpi +++ b/components/fpspreadsheet/tests/spreadtestgui.lpi @@ -0,0 +1,185 @@ + + + + + + + + + + <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>