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

fpspreadsheet: Add linestyle and linecolor as attributes to cell borders. Works in BIFF8 and BIFF5 (BIFF2 does not support this). Add corresponding unit test cases -> passed.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2999 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-05-03 17:00:00 +00:00
parent b3b2c2aa22
commit b93d9eae0c
9 changed files with 584 additions and 179 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
components/fpspreadsheet/examples/excel5demo/excel5write.lpr
View File

@ -89,6 +89,28 @@ begin
MyWorksheet.WriteDateTime(5, 0, now); MyWorksheet.WriteDateTime(5, 0, now);
MyWorksheet.WriteFont(5, 0, 'Courier New', 20, [fssBold, fssItalic, fssUnderline], scBlue); MyWorksheet.WriteFont(5, 0, 'Courier New', 20, [fssBold, fssItalic, fssUnderline], scBlue);
// F6 empty cell, only all thin borders
MyWorksheet.WriteBorders(5, 5, [cbNorth, cbEast, cbSouth, cbWest]);
MyWorksheet.WriteBorderLineStyle(5, 5, cbSouth, lsDotted);
MyWorksheet.WriteBorderColor(5, 5, cbSouth, scRed);
MyWorksheet.WriteBorderLineStyle(5, 5, cbNorth, lsThick);
// H6 empty cell, only all medium borders
MyWorksheet.WriteBorders(5, 7, [cbNorth, cbEast, cbSouth, cbWest]);
MyWorksheet.WriteBorderColor(5, 7, cbSouth, scBlack);
MyWorksheet.WriteBorderLineStyle(5, 7, cbSouth, lsMedium);
MyWorksheet.WriteBorderLineStyle(5, 7, cbEast, lsMedium);
MyWorksheet.WriteBorderLineStyle(5, 7, cbWest, lsMedium);
MyWorksheet.WriteBorderLineStyle(5, 7, cbNorth, lsMedium);
// J6 empty cell, only all thick borders
MyWorksheet.WriteBorders(5, 9, [cbNorth, cbEast, cbSouth, cbWest]);
MyWorksheet.WriteBorderLineStyle(5, 9, cbSouth, lsThick);
MyWorksheet.WriteBorderLineStyle(5, 9, cbEast, lsThick);
MyWorksheet.WriteBorderLineStyle(5, 9, cbWest, lsThick);
MyWorksheet.WriteBorderLineStyle(5, 9, cbNorth, lsThick);
{ Uncomment this to test large XLS files { Uncomment this to test large XLS files
for i := 2 to 20 do for i := 2 to 20 do
begin begin

37
components/fpspreadsheet/examples/excel8demo/excel8write.lpr
View File

@ -62,8 +62,43 @@ begin
// E6 empty cell, only background color // E6 empty cell, only background color
MyWorksheet.WriteBackgroundColor(5, 4, scYellow); MyWorksheet.WriteBackgroundColor(5, 4, scYellow);
// E7 empty cell, only all borders // F6 empty cell, all borders
MyWorksheet.WriteBorders(5, 5, [cbNorth, cbEast, cbSouth, cbWest]); MyWorksheet.WriteBorders(5, 5, [cbNorth, cbEast, cbSouth, cbWest]);
MyWorksheet.WriteBorderStyle(5, 5, cbSouth, lsDotted, scRed);
MyWorksheet.WriteBorderLineStyle(5, 5, cbNorth, lsThick);
// H6 empty cell, all medium borders
MyWorksheet.WriteBorders(5, 7, [cbNorth, cbEast, cbSouth, cbWest]);
MyWorksheet.WriteBorderColor(5, 7, cbSouth, scBlack);
MyWorksheet.WriteBorderLineStyle(5, 7, cbSouth, lsMedium);
MyWorksheet.WriteBorderLineStyle(5, 7, cbEast, lsMedium);
MyWorksheet.WriteBorderLineStyle(5, 7, cbWest, lsMedium);
MyWorksheet.WriteBorderLineStyle(5, 7, cbNorth, lsMedium);
// J6 empty cell, all thick borders
MyWorksheet.WriteBorders(5, 9, [cbNorth, cbEast, cbSouth, cbWest]);
MyWorksheet.WriteBorderLineStyle(5, 9, cbSouth, lsThick);
MyWorksheet.WriteBorderLineStyle(5, 9, cbEast, lsThick);
MyWorksheet.WriteBorderLineStyle(5, 9, cbWest, lsThick);
MyWorksheet.WriteBorderLineStyle(5, 9, cbNorth, lsThick);
// K6 empty cell, top border thick
MyWorksheet.WriteBorders(5, 11, [cbNorth]);
MyWorksheet.WriteBorderLineStyle(5, 11, cbNorth, lsThick);
// L6 empty cell, bottom border medium
MyWorksheet.WriteBorders(5, 12, [cbSouth]);
MyWorksheet.WriteBorderLineStyle(5, 12, cbSouth, lsMedium);
// M6 empty cell, top & bottom border dashed and dotted
MyWorksheet.WriteBorders(5, 13, [cbNorth, cbSouth]);
MyWorksheet.WriteBorderLineStyle(5, 13, cbNorth, lsDashed);
MyWorksheet.WriteBorderLineStyle(5, 13, cbSouth, lsDotted);
// N6 empty cell, left border: double
// MyWorksheet.WriteBlank(5, 14);
MyWorksheet.WriteBorders(5, 14, [cbWest]);
MyWorksheet.WriteBorderLineStyle(5, 14, cbWest, lsDouble);
// Word-wrapped long text in D7 // Word-wrapped long text in D7
MyWorksheet.WriteUTF8Text(6, 3, 'This is a very, very, very, very long wrapped text.'); MyWorksheet.WriteUTF8Text(6, 3, 'This is a very, very, very, very long wrapped text.');

147
components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi
View File

@ -108,7 +108,7 @@
<PackageName Value="LCL"/> <PackageName Value="LCL"/>
</Item2> </Item2>
</RequiredPackages> </RequiredPackages>
<Units Count="28"> <Units Count="29">
<Unit0> <Unit0>
<Filename Value="fpsgrid.lpr"/> <Filename Value="fpsgrid.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
@ -117,7 +117,7 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<CursorPos X="10" Y="7"/> <CursorPos X="10" Y="7"/>
<UsageCount Value="124"/> <UsageCount Value="125"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
@ -131,28 +131,28 @@
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="43"/> <TopLine Value="43"/>
<CursorPos X="38" Y="63"/> <CursorPos X="38" Y="63"/>
<UsageCount Value="124"/> <UsageCount Value="125"/>
<Loaded Value="True"/> <Loaded Value="True"/>
<LoadedDesigner Value="True"/> <LoadedDesigner Value="True"/>
</Unit1> </Unit1>
<Unit2> <Unit2>
<Filename Value="..\..\fpspreadsheet.pas"/> <Filename Value="..\..\fpspreadsheet.pas"/>
<UnitName Value="fpspreadsheet"/> <UnitName Value="fpspreadsheet"/>
<IsVisibleTab Value="True"/> <EditorIndex Value="7"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="1273"/> <TopLine Value="111"/>
<CursorPos X="28" Y="1285"/> <CursorPos X="18" Y="126"/>
<UsageCount Value="60"/> <UsageCount Value="60"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit2> </Unit2>
<Unit3> <Unit3>
<Filename Value="..\..\fpspreadsheetgrid.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<UnitName Value="fpspreadsheetgrid"/> <UnitName Value="fpspreadsheetgrid"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="3"/> <EditorIndex Value="3"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="257"/> <TopLine Value="400"/>
<CursorPos X="34" Y="260"/> <CursorPos X="63" Y="425"/>
<UsageCount Value="61"/> <UsageCount Value="61"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit3> </Unit3>
@ -247,10 +247,12 @@
<Unit15> <Unit15>
<Filename Value="d:\lazarus-svn\lcl\graphics.pp"/> <Filename Value="d:\lazarus-svn\lcl\graphics.pp"/>
<UnitName Value="Graphics"/> <UnitName Value="Graphics"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="34"/> <TopLine Value="649"/>
<CursorPos X="1" Y="64"/> <CursorPos X="28" Y="675"/>
<UsageCount Value="27"/> <UsageCount Value="27"/>
<Loaded Value="True"/>
</Unit15> </Unit15>
<Unit16> <Unit16>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\rtl\objpas\classes\classesh.inc"/> <Filename Value="d:\lazarus-svn\fpc\2.6.2\source\rtl\objpas\classes\classesh.inc"/>
@ -262,10 +264,10 @@
<Unit17> <Unit17>
<Filename Value="..\..\xlsbiff8.pas"/> <Filename Value="..\..\xlsbiff8.pas"/>
<UnitName Value="xlsbiff8"/> <UnitName Value="xlsbiff8"/>
<EditorIndex Value="6"/> <EditorIndex Value="9"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="1989"/> <TopLine Value="284"/>
<CursorPos X="32" Y="1993"/> <CursorPos X="1" Y="305"/>
<UsageCount Value="35"/> <UsageCount Value="35"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit17> </Unit17>
@ -287,7 +289,7 @@
<Unit20> <Unit20>
<Filename Value="..\..\xlscommon.pas"/> <Filename Value="..\..\xlscommon.pas"/>
<UnitName Value="xlscommon"/> <UnitName Value="xlscommon"/>
<EditorIndex Value="5"/> <EditorIndex Value="8"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="515"/> <TopLine Value="515"/>
<CursorPos X="35" Y="541"/> <CursorPos X="35" Y="541"/>
@ -297,17 +299,17 @@
<Unit21> <Unit21>
<Filename Value="..\..\xlsbiff5.pas"/> <Filename Value="..\..\xlsbiff5.pas"/>
<UnitName Value="xlsbiff5"/> <UnitName Value="xlsbiff5"/>
<EditorIndex Value="7"/> <EditorIndex Value="10"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="100"/> <TopLine Value="300"/>
<CursorPos X="15" Y="117"/> <CursorPos X="40" Y="310"/>
<UsageCount Value="18"/> <UsageCount Value="18"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit21> </Unit21>
<Unit22> <Unit22>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<UnitName Value="xlsbiff2"/> <UnitName Value="xlsbiff2"/>
<EditorIndex Value="8"/> <EditorIndex Value="11"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="219"/> <TopLine Value="219"/>
<CursorPos X="26" Y="233"/> <CursorPos X="26" Y="233"/>
@ -328,10 +330,12 @@
<Unit24> <Unit24>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\packages\fcl-image\src\fpcanvas.pp"/> <Filename Value="d:\lazarus-svn\fpc\2.6.2\source\packages\fcl-image\src\fpcanvas.pp"/>
<UnitName Value="FPCanvas"/> <UnitName Value="FPCanvas"/>
<EditorIndex Value="6"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="64"/> <TopLine Value="111"/>
<CursorPos X="3" Y="83"/> <CursorPos X="3" Y="112"/>
<UsageCount Value="14"/> <UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit24> </Unit24>
<Unit25> <Unit25>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\packages\fcl-image\src\fpimage.pp"/> <Filename Value="d:\lazarus-svn\fpc\2.6.2\source\packages\fcl-image\src\fpimage.pp"/>
@ -351,135 +355,140 @@
<Unit27> <Unit27>
<Filename Value="d:\Prog_Delphi\common\units\XLS.pas"/> <Filename Value="d:\Prog_Delphi\common\units\XLS.pas"/>
<UnitName Value="Xls"/> <UnitName Value="Xls"/>
<EditorIndex Value="9"/> <EditorIndex Value="12"/>
<WindowIndex Value="0"/> <WindowIndex Value="0"/>
<TopLine Value="114"/> <TopLine Value="114"/>
<CursorPos X="42" Y="152"/> <CursorPos X="42" Y="152"/>
<UsageCount Value="10"/> <UsageCount Value="10"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit27> </Unit27>
<Unit28>
<Filename Value="d:\lazarus-svn\lcl\include\pen.inc"/>
<EditorIndex Value="5"/>
<WindowIndex Value="0"/>
<TopLine Value="272"/>
<CursorPos X="3" Y="286"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit28>
</Units> </Units>
<JumpHistory Count="30" HistoryIndex="29"> <JumpHistory Count="29" HistoryIndex="28">
<Position1> <Position1>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="852" Column="1" TopLine="820"/> <Caret Line="962" Column="1" TopLine="938"/>
</Position1> </Position1>
<Position2> <Position2>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="854" Column="1" TopLine="822"/> <Caret Line="968" Column="1" TopLine="938"/>
</Position2> </Position2>
<Position3> <Position3>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="857" Column="1" TopLine="825"/> <Caret Line="1034" Column="1" TopLine="1014"/>
</Position3> </Position3>
<Position4> <Position4>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="861" Column="1" TopLine="830"/> <Caret Line="1037" Column="1" TopLine="1014"/>
</Position4> </Position4>
<Position5> <Position5>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="864" Column="1" TopLine="832"/> <Caret Line="1040" Column="1" TopLine="1014"/>
</Position5> </Position5>
<Position6> <Position6>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="867" Column="1" TopLine="835"/> <Caret Line="1043" Column="1" TopLine="1014"/>
</Position6> </Position6>
<Position7> <Position7>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="869" Column="1" TopLine="837"/> <Caret Line="1044" Column="1" TopLine="1014"/>
</Position7> </Position7>
<Position8> <Position8>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1044" Column="1" TopLine="1024"/> <Caret Line="1077" Column="19" TopLine="1064"/>
</Position8> </Position8>
<Position9> <Position9>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="982" Column="1" TopLine="963"/> <Caret Line="536" Column="32" TopLine="530"/>
</Position9> </Position9>
<Position10> <Position10>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="984" Column="1" TopLine="963"/> <Caret Line="124" Column="32" TopLine="97"/>
</Position10> </Position10>
<Position11> <Position11>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="957" Column="1" TopLine="938"/> <Caret Line="537" Column="24" TopLine="517"/>
</Position11> </Position11>
<Position12> <Position12>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="958" Column="1" TopLine="938"/> <Caret Line="283" Column="14" TopLine="272"/>
</Position12> </Position12>
<Position13> <Position13>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="960" Column="1" TopLine="938"/> <Caret Line="124" Column="30" TopLine="104"/>
</Position13> </Position13>
<Position14> <Position14>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="962" Column="1" TopLine="938"/> <Caret Line="283" Column="9" TopLine="251"/>
</Position14> </Position14>
<Position15> <Position15>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="d:\Prog_Delphi\common\units\XLS.pas"/>
<Caret Line="968" Column="1" TopLine="938"/> <Caret Line="130" Column="20" TopLine="113"/>
</Position15> </Position15>
<Position16> <Position16>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1034" Column="1" TopLine="1014"/> <Caret Line="290" Column="31" TopLine="238"/>
</Position16> </Position16>
<Position17> <Position17>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1037" Column="1" TopLine="1014"/> <Caret Line="233" Column="26" TopLine="219"/>
</Position17> </Position17>
<Position18> <Position18>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="1040" Column="1" TopLine="1014"/> <Caret Line="1993" Column="32" TopLine="1989"/>
</Position18> </Position18>
<Position19> <Position19>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1043" Column="1" TopLine="1014"/> <Caret Line="441" Column="5" TopLine="376"/>
</Position19> </Position19>
<Position20> <Position20>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1044" Column="1" TopLine="1014"/> <Caret Line="414" Column="1" TopLine="389"/>
</Position20> </Position20>
<Position21> <Position21>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="d:\lazarus-svn\lcl\graphics.pp"/>
<Caret Line="1077" Column="19" TopLine="1064"/> <Caret Line="1226" Column="14" TopLine="1212"/>
</Position21> </Position21>
<Position22> <Position22>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="d:\lazarus-svn\lcl\graphics.pp"/>
<Caret Line="536" Column="32" TopLine="530"/> <Caret Line="636" Column="3" TopLine="619"/>
</Position22> </Position22>
<Position23> <Position23>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff5.pas"/>
<Caret Line="124" Column="32" TopLine="97"/> <Caret Line="1667" Column="95" TopLine="1637"/>
</Position23> </Position23>
<Position24> <Position24>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="537" Column="24" TopLine="517"/> <Caret Line="2062" Column="79" TopLine="2048"/>
</Position24> </Position24>
<Position25> <Position25>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="283" Column="14" TopLine="272"/> <Caret Line="418" Column="31" TopLine="374"/>
</Position25> </Position25>
<Position26> <Position26>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="d:\lazarus-svn\lcl\graphics.pp"/>
<Caret Line="124" Column="30" TopLine="104"/> <Caret Line="586" Column="3" TopLine="570"/>
</Position26> </Position26>
<Position27> <Position27>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="283" Column="9" TopLine="251"/> <Caret Line="392" Column="6" TopLine="388"/>
</Position27> </Position27>
<Position28> <Position28>
<Filename Value="d:\Prog_Delphi\common\units\XLS.pas"/> <Filename Value="d:\lazarus-svn\lcl\graphics.pp"/>
<Caret Line="130" Column="20" TopLine="113"/> <Caret Line="1226" Column="14" TopLine="1212"/>
</Position28> </Position28>
<Position29> <Position29>
<Filename Value="..\..\xlsbiff2.pas"/> <Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="290" Column="31" TopLine="238"/> <Caret Line="250" Column="38" TopLine="235"/>
</Position29> </Position29>
<Position30>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="233" Column="26" TopLine="219"/>
</Position30>
</JumpHistory> </JumpHistory>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

142
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -121,29 +121,23 @@ type
{@@ RPN formula. Similar to the expanded formula, but in RPN notation. {@@ RPN formula. Similar to the expanded formula, but in RPN notation.
Simplifies the task of format writers which need RPN } Simplifies the task of format writers which need RPN }
TsRPNFormula = array of TsFormulaElement; TsRPNFormula = array of TsFormulaElement;
{@@ Describes the type of content of a cell on a TsWorksheet } {@@ Describes the type of content of a cell on a TsWorksheet }
TCellContentType = (cctEmpty, cctFormula, cctRPNFormula, cctNumber, TCellContentType = (cctEmpty, cctFormula, cctRPNFormula, cctNumber,
cctUTF8String, cctDateTime); cctUTF8String, cctDateTime);
{@@ List of possible formatting fields } {@@ List of possible formatting fields }
TsUsedFormattingField = (uffTextRotation, uffFont, uffBold, uffBorder, TsUsedFormattingField = (uffTextRotation, uffFont, uffBold, uffBorder,
uffBackgroundColor, uffNumberFormat, uffWordWrap, uffBackgroundColor, uffNumberFormat, uffWordWrap,
uffHorAlign, uffVertAlign uffHorAlign, uffVertAlign
); );
{@@ Describes which formatting fields are active } {@@ Describes which formatting fields are active }
TsUsedFormattingFields = set of TsUsedFormattingField; TsUsedFormattingFields = set of TsUsedFormattingField;
{@@ Number/cell formatting. Only uses a subset of the default formats, {@@ Number/cell formatting. Only uses a subset of the default formats,
enough to be able to read/write date values. enough to be able to read/write date values. }
}
TsNumberFormat = (nfGeneral, nfFixed, nfFixedTh, nfExp, nfSci, nfPercentage, TsNumberFormat = (nfGeneral, nfFixed, nfFixedTh, nfExp, nfSci, nfPercentage,
nfShortDateTime, nfFmtDateTime, nfShortDate, nfShortTime, nfLongTime, nfShortDateTime, nfFmtDateTime, nfShortDate, nfShortTime, nfLongTime,
nfShortTimeAM, nfLongTimeAM, nfTimeInterval); nfShortTimeAM, nfLongTimeAM, nfTimeInterval);
@ -163,18 +157,9 @@ type
| B | B
| A | A
} }
TsTextRotation = (trHorizontal, rt90DegreeClockwiseRotation, TsTextRotation = (trHorizontal, rt90DegreeClockwiseRotation,
rt90DegreeCounterClockwiseRotation, rtStacked); rt90DegreeCounterClockwiseRotation, rtStacked);
{@@ Indicates the border for a cell }
TsCellBorder = (cbNorth, cbWest, cbEast, cbSouth);
{@@ Indicates the border for a cell }
TsCellBorders = set of TsCellBorder;
{@@ Indicates horizontal and vertical text alignment in cells } {@@ Indicates horizontal and vertical text alignment in cells }
TsHorAlignment = (haDefault, haLeft, haCenter, haRight); TsHorAlignment = (haDefault, haLeft, haCenter, haRight);
TsVertAlignment = (vaDefault, vaTop, vaCenter, vaBottom); TsVertAlignment = (vaDefault, vaTop, vaCenter, vaBottom);
@ -183,8 +168,7 @@ type
Colors in fpspreadsheet are given as indices into a palette. Colors in fpspreadsheet are given as indices into a palette.
Use the workbook's GetPaletteColor to determine the color rgb value as Use the workbook's GetPaletteColor to determine the color rgb value as
little-endian (with "r" being the low-value byte, in agreement with TColor). little-endian (with "r" being the low-value byte, in agreement with TColor).
The data type for rgb values is TsColorValue. The data type for rgb values is TsColorValue. }
}
TsColor = Word; TsColor = Word;
{@@ {@@
@ -241,6 +225,32 @@ type
Color: TsColor; Color: TsColor;
end; end;
{@@ Indicates the border for a cell }
TsCellBorder = (cbNorth, cbWest, cbEast, cbSouth);
{@@ Indicates the border for a cell }
TsCellBorders = set of TsCellBorder;
{@@ Line style (for cell borders) }
TsLineStyle = (lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble);
{@@ Cell border style }
TsCellBorderStyle = record
LineStyle: TsLineStyle;
Color: TsColor;
end;
TsCellBorderStyles = array[TsCellBorder] of TsCellBorderStyle;
const
DEFAULT_BORDERSTYLES: TsCellBorderStyles = (
(LineStyle: lsThin; Color: scBlack),
(LineStyle: lsThin; Color: scBlack),
(LineStyle: lsThin; Color: scBlack),
(LineStyle: lsThin; Color: scBlack)
);
type
{@@ Cell structure for TsWorksheet {@@ Cell structure for TsWorksheet
Never suppose that all *Value fields are valid, Never suppose that all *Value fields are valid,
@ -267,6 +277,7 @@ type
HorAlignment: TsHorAlignment; HorAlignment: TsHorAlignment;
VertAlignment: TsVertAlignment; VertAlignment: TsVertAlignment;
Border: TsCellBorders; Border: TsCellBorders;
BorderStyles: TsCelLBorderStyles;
BackgroundColor: TsColor; BackgroundColor: TsColor;
NumberFormat: TsNumberFormat; NumberFormat: TsNumberFormat;
NumberFormatStr: String; NumberFormatStr: String;
@ -327,6 +338,7 @@ type
function ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields; function ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields;
function ReadBackgroundColor(ARow, ACol: Cardinal): TsColor; function ReadBackgroundColor(ARow, ACol: Cardinal): TsColor;
procedure RemoveAllCells; procedure RemoveAllCells;
{ Writing of values }
procedure WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring); procedure WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring);
procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double; procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double;
AFormat: TsNumberFormat = nfGeneral; ADecimals: Word = 2); AFormat: TsNumberFormat = nfGeneral; ADecimals: Word = 2);
@ -334,8 +346,9 @@ type
procedure WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime; procedure WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime;
AFormat: TsNumberFormat = nfShortDateTime; AFormatStr: String = ''); AFormat: TsNumberFormat = nfShortDateTime; AFormatStr: String = '');
procedure WriteFormula(ARow, ACol: Cardinal; AFormula: TsFormula); procedure WriteFormula(ARow, ACol: Cardinal; AFormula: TsFormula);
procedure WriteNumberFormat(ARow, ACol: Cardinal; ANumberFormat: TsNumberFormat);
procedure WriteRPNFormula(ARow, ACol: Cardinal; AFormula: TsRPNFormula); procedure WriteRPNFormula(ARow, ACol: Cardinal; AFormula: TsRPNFormula);
{ Writing of cell attributes }
procedure WriteNumberFormat(ARow, ACol: Cardinal; ANumberFormat: TsNumberFormat);
function WriteFont(ARow, ACol: Cardinal; const AFontName: String; function WriteFont(ARow, ACol: Cardinal; const AFontName: String;
AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; overload; AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; overload;
procedure WriteFont(ARow, ACol: Cardinal; AFontIndex: Integer); overload; procedure WriteFont(ARow, ACol: Cardinal; AFontIndex: Integer); overload;
@ -344,7 +357,15 @@ type
procedure WriteTextRotation(ARow, ACol: Cardinal; ARotation: TsTextRotation); procedure WriteTextRotation(ARow, ACol: Cardinal; ARotation: TsTextRotation);
procedure WriteUsedFormatting(ARow, ACol: Cardinal; AUsedFormatting: TsUsedFormattingFields); procedure WriteUsedFormatting(ARow, ACol: Cardinal; AUsedFormatting: TsUsedFormattingFields);
procedure WriteBackgroundColor(ARow, ACol: Cardinal; AColor: TsColor); procedure WriteBackgroundColor(ARow, ACol: Cardinal; AColor: TsColor);
procedure WriteBorderColor(ARow, ACol: Cardinal; ABorder: TsCellBorder; AColor: TsColor);
procedure WriteBorderLineStyle(ARow, ACol: Cardinal; ABorder: TsCellBorder;
ALineStyle: TsLineStyle);
procedure WriteBorders(ARow, ACol: Cardinal; ABorders: TsCellBorders); procedure WriteBorders(ARow, ACol: Cardinal; ABorders: TsCellBorders);
procedure WriteBorderStyle(ARow, ACol: Cardinal; ABorder: TsCellBorder;
AStyle: TsCellBorderStyle); overload;
procedure WriteBorderStyle(ARow, ACol: Cardinal; ABorder: TsCellBorder;
ALineStyle: TsLineStyle; AColor: TsColor); overload;
procedure WriteBorderStyles(ARow, ACol: Cardinal; const AStyles: TsCellBorderStyles);
procedure WriteHorAlignment(ARow, ACol: Cardinal; AValue: TsHorAlignment); procedure WriteHorAlignment(ARow, ACol: Cardinal; AValue: TsHorAlignment);
procedure WriteVertAlignment(ARow, ACol: Cardinal; AValue: TsVertAlignment); procedure WriteVertAlignment(ARow, ACol: Cardinal; AValue: TsVertAlignment);
procedure WriteWordwrap(ARow, ACol: Cardinal; AValue: boolean); procedure WriteWordwrap(ARow, ACol: Cardinal; AValue: boolean);
@ -886,6 +907,7 @@ begin
Result^.Row := ARow; Result^.Row := ARow;
Result^.Col := ACol; Result^.Col := ACol;
Result^.BorderStyles := DEFAULT_BORDERSTYLES;
Cells.Add(Result); Cells.Add(Result);
end; end;
@ -1451,6 +1473,30 @@ begin
ACell^.BackgroundColor := AColor; ACell^.BackgroundColor := AColor;
end; end;
{ Sets the color of a cell border line.
Note: the border must be included in Borders set in order to be shown! }
procedure TsWorksheet.WriteBorderColor(ARow, ACol: Cardinal;
ABorder: TsCellBorder; AColor: TsColor);
var
lCell: PCell;
begin
lCell := GetCell(ARow, ACol);
lCell^.BorderStyles[ABorder].Color := AColor;
end;
{ Sets the linestyle of a cell border.
Note: the border must be included in the "Borders" set in order to be shown! }
procedure TsWorksheet.WriteBorderLineStyle(ARow, ACol: Cardinal;
ABorder: TsCellBorder; ALineStyle: TsLineStyle);
var
lCell: PCell;
begin
lCell := GetCell(ARow, ACol);
lCell^.BorderStyles[ABorder].LineStyle := ALineStyle;
end;
{ Shows the cell borders included in the set ABorders. The borders are drawn
using the "BorderStyles" assigned to the cell. }
procedure TsWorksheet.WriteBorders(ARow, ACol: Cardinal; ABorders: TsCellBorders); procedure TsWorksheet.WriteBorders(ARow, ACol: Cardinal; ABorders: TsCellBorders);
var var
lCell: PCell; lCell: PCell;
@ -1460,6 +1506,41 @@ begin
lCell^.Border := ABorders; lCell^.Border := ABorders;
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! }
procedure TsWorksheet.WriteBorderStyle(ARow, ACol: Cardinal;
ABorder: TsCellBorder; AStyle: TsCellBorderStyle);
var
lCell: PCell;
begin
lCell := GetCell(ARow, ACol);
lCell^.BorderStyles[ABorder] := AStyle;
end;
{ Sets line style and line color of a cell border.
Note: the border must be included in the "Borders" set in order to be shown! }
procedure TsWorksheet.WriteBorderStyle(ARow, ACol: Cardinal;
ABorder: TsCellBorder; ALineStyle: TsLinestyle; AColor: TsColor);
var
lCell: PCell;
begin
lCell := GetCell(ARow, ACol);
lCell^.BorderStyles[ABorder].LineStyle := ALineStyle;
lCell^.BorderStyles[ABorder].Color := AColor;
end;
{ Sets the style of all cell border of a cell, i.e. line style and line color.
Note: Only those borders included in the "Borders" set are shown! }
procedure TsWorksheet.WriteBorderStyles(ARow, ACol: Cardinal;
const AStyles: TsCellBorderStyles);
var
b: TsCellBorder;
cell: PCell;
begin
cell := GetCell(ARow, ACol);
for b in TsCellBorder do cell^.BorderStyles[b] := AStyles[b];
end;
procedure TsWorksheet.WriteHorAlignment(ARow, ACol: Cardinal; AValue: TsHorAlignment); procedure TsWorksheet.WriteHorAlignment(ARow, ACol: Cardinal; AValue: TsHorAlignment);
var var
lCell: PCell; lCell: PCell;
@ -2280,12 +2361,14 @@ begin
end; end;
{@@ {@@
Checks if the style of a cell is in the list FFormattingStyles and returns the index Checks if the style of a cell is in the list of manually added FFormattingStyles
or -1 if it isn't and returns the index or -1 if it isn't
} }
function TsCustomSpreadWriter.FindFormattingInList(AFormat: PCell): Integer; function TsCustomSpreadWriter.FindFormattingInList(AFormat: PCell): Integer;
var var
i: Integer; i: Integer;
b: TsCellBorder;
equ: Boolean;
begin begin
Result := -1; Result := -1;
@ -2302,8 +2385,23 @@ begin
if uffTextRotation in AFormat^.UsedFormattingFields then if uffTextRotation in AFormat^.UsedFormattingFields then
if (FFormattingStyles[i].TextRotation <> AFormat^.TextRotation) then Continue; if (FFormattingStyles[i].TextRotation <> AFormat^.TextRotation) then Continue;
if uffBorder in AFormat^.UsedFormattingFields then if uffBorder in AFormat^.UsedFormattingFields then begin
if (FFormattingStyles[i].Border <> AFormat^.Border) then Continue; if (FFormattingStyles[i].Border <> AFormat^.Border) then Continue;
equ := true;
for b in TsCellBorder do begin
if FFormattingStyles[i].BorderStyles[b].LineStyle <> AFormat^.BorderStyles[b].LineStyle
then begin
equ := false;
Break;
end;
if FFormattingStyles[i].BorderStyles[b].Color <> AFormat^.BorderStyles[b].Color
then begin
equ := false;
Break;
end;
end;
if not equ then Continue;
end;
if uffBackgroundColor in AFormat^.UsedFormattingFields then if uffBackgroundColor in AFormat^.UsedFormattingFields then
if (FFormattingStyles[i].BackgroundColor <> AFormat^.BackgroundColor) then Continue; if (FFormattingStyles[i].BackgroundColor <> AFormat^.BackgroundColor) then Continue;

64
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -380,6 +380,54 @@ var
cell: PCell; cell: PCell;
c, r: Integer; c, r: Integer;
rect: TRect; rect: TRect;
procedure DrawBorderLine(ACell: PCell; ARect: TRect; ABorder: TsCellBorder;
ALineStyle: TsLineStyle);
const
// TsLineStyle = (lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble);
PEN_WIDTHS: array[TsLineStyle] of Byte =
(1, 2, 1, 1, 3, 1);
PEN_STYLES: array[TsLineStyle] of TPenStyle =
(psSolid, psSolid, psDash, psDot, psSolid, psSolid);
// (psSolid, psSolid, psPattern, psPattern, psSolid, psSolid);
PEN_PATTERNS: array[TsLineStyle] of TPenPattern =
($FFFFFFFF, $FFFFFFFF, $07070707, $AAAAAAAA, $FFFFFFFF, $FFFFFFFF);
var
w: Integer;
begin
if ALineStyle = lsDouble then
case ABorder of
cbEast, cbWest:
begin
InflateRect(ARect, -1, 0);
DrawBorderLine(ACell, ARect, ABorder, lsThin);
InflateRect(ARect, +2, 0);
DrawBorderLine(ACell, ARect, ABorder, lsThin);
end;
cbNorth, cbSouth:
begin
InflateRect(ARect, 0, -1);
DrawBorderLine(ACell, ARect, ABorder, lsThin);
InflateRect(ARect, 0, +2);
DrawBorderLine(ACell, ARect, ABorder, lsThin)
end;
end
else begin
w := PEN_WIDTHS[ACell^.BorderStyles[ABorder].LineStyle] div 2;
Canvas.Pen.Style := PEN_STYLES[ACell^.BorderStyles[ABorder].LineStyle];
Canvas.Pen.Width := PEN_WIDTHS[ACell^.BorderStyles[ABorder].LineStyle];
Canvas.Pen.Color := FWorkBook.GetPaletteColor(ACell^.BorderStyles[ABorder].Color);
//Canvas.Pen.Pattern := PEN_PATTERNS[ACell^.BorderStyles[ABorder].LineStyle];
//Canvas.Pen.EndCap := pecSquare;
case ABorder of
cbEast : Canvas.Line(ARect.Right-1, ARect.Top, ARect.Right-1, ARect.Bottom-w);
cbSouth: Canvas.Line(ARect.Left-1, ARect.Bottom-1, ARect.Right-w, ARect.Bottom-1);
cbWest : Canvas.Line(ARect.Left-1, ARect.Top, ARect.Left-1, ARect.Bottom-w);
cbNorth: Canvas.Line(ARect.Left-1, ARect.Top-1, ARect.Right-w, ARect.Top-1);
end;
end;
end;
begin begin
inherited; inherited;
if FWorksheet = nil then exit; if FWorksheet = nil then exit;
@ -390,16 +438,14 @@ begin
c := cell^.Col + FixedCols; c := cell^.Col + FixedCols;
r := cell^.Row + FixedRows; r := cell^.Row + FixedRows;
rect := CellRect(c, r); rect := CellRect(c, r);
Canvas.Pen.Style := psSolid;
Canvas.Pen.Color := clBlack;
if (cbNorth in cell^.Border) then if (cbNorth in cell^.Border) then
Canvas.Line(rect.Left, rect.Top-1, rect.Right, rect.Top-1); DrawBorderLine(cell, rect, cbNorth, cell^.BorderStyles[cbNorth].LineStyle);
if (cbWest in cell^.Border) then if cbEast in cell^.Border then
Canvas.Line(rect.Left-1, rect.Top, rect.Left-1, rect.Bottom); DrawBorderLine(cell, rect, cbEast, cell^.BorderStyles[cbEast].LineStyle);
if (cbEast in cell^.Border) then if cbSouth in cell^.Border then
Canvas.Line(rect.Right-1, rect.Top, rect.Right-1, rect.Bottom); DrawBorderLine(cell, rect, cbSouth, cell^.BorderStyles[cbSouth].LineStyle);
if (cbSouth in cell^.Border) then if cbWest in cell^.Border then
Canvas.Line(rect.Left, rect.Bottom-1, rect.Right, rect.Bottom-1); DrawBorderLine(cell, rect, cbWest, cell^.BorderStyles[cbWest].LineStyle);
end; end;
cell := FWorksheet.GetNextCell; cell := FWorksheet.GetNextCell;
end; end;

123
components/fpspreadsheet/tests/formattests.pas
View File

@ -30,6 +30,8 @@ var
SollColWidths: array[0..1] of Single; SollColWidths: array[0..1] of Single;
SollBorders: array[0..15] of TsCellBorders; SollBorders: array[0..15] of TsCellBorders;
SollBorderLineStyles: array[0..6] of TsLineStyle;
SollBorderColors: array[0..5] of TsColor;
procedure InitSollFmtData; procedure InitSollFmtData;
@ -47,6 +49,8 @@ type
procedure TestWriteReadAlignment(AFormat: TsSpreadsheetFormat); procedure TestWriteReadAlignment(AFormat: TsSpreadsheetFormat);
// Test border // Test border
procedure TestWriteReadBorder(AFormat: TsSpreadsheetFormat); procedure TestWriteReadBorder(AFormat: TsSpreadsheetFormat);
// Test border styles
procedure TestWriteReadBorderStyles(AFormat: TsSpreadsheetFormat);
// Test column widths // Test column widths
procedure TestWriteReadColWidths(AFormat: TsSpreadsheetFormat); procedure TestWriteReadColWidths(AFormat: TsSpreadsheetFormat);
// Test text rotation // Test text rotation
@ -63,12 +67,14 @@ type
procedure TestWriteReadBIFF2_Border; procedure TestWriteReadBIFF2_Border;
procedure TestWriteReadBIFF2_ColWidths; procedure TestWriteReadBIFF2_ColWidths;
// These features are not supported by Excel2 --> no test cases required! // These features are not supported by Excel2 --> no test cases required!
// - BorderStyle
// - TextRotation // - TextRotation
// - Wordwrap // - Wordwrap
{ BIFF5 Tests } { BIFF5 Tests }
procedure TestWriteReadBIFF5_Alignment; procedure TestWriteReadBIFF5_Alignment;
procedure TestWriteReadBIFF5_Border; procedure TestWriteReadBIFF5_Border;
procedure TestWriteReadBIFF5_BorderStyles;
procedure TestWriteReadBIFF5_ColWidths; procedure TestWriteReadBIFF5_ColWidths;
procedure TestWriteReadBIFF5_TextRotation; procedure TestWriteReadBIFF5_TextRotation;
procedure TestWriteReadBIFF5_WordWrap; procedure TestWriteReadBIFF5_WordWrap;
@ -76,6 +82,7 @@ type
{ BIFF8 Tests } { BIFF8 Tests }
procedure TestWriteReadBIFF8_Alignment; procedure TestWriteReadBIFF8_Alignment;
procedure TestWriteReadBIFF8_Border; procedure TestWriteReadBIFF8_Border;
procedure TestWriteReadBIFF8_BorderStyles;
procedure TestWriteReadBIFF8_ColWidths; procedure TestWriteReadBIFF8_ColWidths;
procedure TestWriteReadBIFF8_TextRotation; procedure TestWriteReadBIFF8_TextRotation;
procedure TestWriteReadBIFF8_WordWrap; procedure TestWriteReadBIFF8_WordWrap;
@ -192,6 +199,21 @@ begin
SollBorders[13] := [cbSouth, cbWest, cbNorth]; SollBorders[13] := [cbSouth, cbWest, cbNorth];
SollBorders[14] := [cbWest, cbNorth, cbEast]; SollBorders[14] := [cbWest, cbNorth, cbEast];
SollBorders[15] := [cbEast, cbSouth, cbWest, cbNorth]; SollBorders[15] := [cbEast, cbSouth, cbWest, cbNorth];
SollBorderLineStyles[0] := lsThin;
SollBorderLineStyles[1] := lsMedium;
SollBorderLineStyles[2] := lsThick;
SollBorderLineStyles[3] := lsThick;
SollBorderLineStyles[4] := lsDashed;
SollBorderLineStyles[5] := lsDotted;
SollBorderLineStyles[6] := lsDouble;
SollBorderColors[0] := scBlue;
SollBorderColors[1] := scRed;
SollBorderColors[2] := scBlue;
SollBorderColors[3] := scGray;
SollBorderColors[4] := scSilver;
SollBorderColors[5] := scMagenta;
end; end;
{ TSpreadWriteReadFormatTests } { TSpreadWriteReadFormatTests }
@ -459,6 +481,107 @@ begin
TestWriteReadBorder(sfExcel8); TestWriteReadBorder(sfExcel8);
end; end;
procedure TSpreadWriteReadFormatTests.TestWriteReadBorderStyles(AFormat: TsSpreadsheetFormat);
{ This test paints 10x10 cells with all borders, each separated by an empty
column and an empty row. The border style varies from border to border
according to the line styles defined in SollBorderStyles. At first, all border
lines use the first color in SollBorderColors. When all BorderStyles are used
the next color is taken, etc. }
var
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
MyCell: PCell;
ActualColWidth: Single;
row, col: Integer;
b: TsCellBorder;
expected: Integer;
current: Integer;
TempFile: string; //write xls/xml to this file and read back from it
c, ls: Integer;
begin
TempFile:=GetTempFileName;
{// Not needed: use workbook.writetofile with overwrite=true
if fileexists(TempFile) then
DeleteFile(TempFile);
}
// Write out all test values
MyWorkbook := TsWorkbook.Create;
MyWorkSheet:= MyWorkBook.AddWorksheet(BordersSheet);
c := 0;
ls := 0;
for row := 1 to 10 do begin
for col := 1 to 10 do begin
MyWorksheet.WriteBorders(row*2, col*2, [cbNorth, cbSouth, cbEast, cbWest]);
for b in TsCellBorders do begin
MyWorksheet.WriteBorderLineStyle(row*2, col*2, b, SollBorderLineStyles[ls]);
MyWorksheet.WriteBorderColor(row*2, col*2, b, SollBorderColors[c]);
inc(ls);
if ls > High(SollBorderLineStyles) then begin
ls := 0;
inc(c);
if c > High(SollBorderColors) then
c := 0;
end;
end;
end;
end;
MyWorkBook.WriteToFile(TempFile, AFormat, true);
MyWorkbook.Free;
// Open the spreadsheet
MyWorkbook := TsWorkbook.Create;
MyWorkbook.ReadFromFile(TempFile, AFormat);
if AFormat = sfExcel2 then
MyWorksheet := MyWorkbook.GetFirstWorksheet
else
MyWorksheet := GetWorksheetByName(MyWorkBook, BordersSheet);
if MyWorksheet=nil then
fail('Error in test code. Failed to get named worksheet');
c := 0;
ls := 0;
for row := 1 to 10 do begin
for col := 1 to 10 do begin
MyCell := MyWorksheet.FindCell(row*2, col*2);
if myCell = nil then
fail('Error in test code. Failed to get cell.');
for b in TsCellBorder do begin
current := ord(MyCell^.BorderStyles[b].LineStyle);
expected := ord(SollBorderLineStyles[ls]);
CheckEquals(current, expected,
'Test saved border line style mismatch, cell ' + CellNotation(MyWorksheet, row*2, col*2));
current := MyCell^.BorderStyles[b].Color;
expected := SollBorderColors[c];
CheckEquals(current, expected,
'Test saved border color mismatch, cell ' + CellNotation(MyWorksheet, row*2, col*2));
inc(ls);
if ls > High(SollBorderLineStyles) then begin
ls := 0;
inc(c);
if c > High(SollBorderColors) then
c := 0;
end;
end;
end;
end;
// Finalization
MyWorkbook.Free;
DeleteFile(TempFile);
end;
procedure TSpreadWriteReadFormatTests.TestWriteReadBIFF5_BorderStyles;
begin
TestWriteReadBorderStyles(sfExcel5);
end;
procedure TSpreadWriteReadFormatTests.TestWriteReadBIFF8_BorderStyles;
begin
TestWriteReadBorderStyles(sfExcel8);
end;
procedure TSpreadWriteReadFormatTests.TestWriteReadColWidths(AFormat: TsSpreadsheetFormat); procedure TSpreadWriteReadFormatTests.TestWriteReadColWidths(AFormat: TsSpreadsheetFormat);
var var
MyWorksheet: TsWorksheet; MyWorksheet: TsWorksheet;

111
components/fpspreadsheet/xlsbiff5.pas
View File

@ -129,9 +129,9 @@ type
procedure WriteWindow2(AStream: TStream; ASheetSelected: Boolean); procedure WriteWindow2(AStream: TStream; ASheetSelected: Boolean);
procedure WriteXF(AStream: TStream; AFontIndex: Word; procedure WriteXF(AStream: TStream; AFontIndex: Word;
AFormatIndex: Word; AXF_TYPE_PROT, ATextRotation: Byte; ABorders: TsCellBorders; AFormatIndex: Word; AXF_TYPE_PROT, ATextRotation: Byte; ABorders: TsCellBorders;
AHorAlignment: TsHorAlignment = haDefault; AVertAlignment: TsVertAlignment = vaDefault; const ABorderStyles: TsCellBorderStyles; AHorAlignment: TsHorAlignment = haDefault;
AWordWrap: Boolean = false; AddBackground: Boolean = false; AVertAlignment: TsVertAlignment = vaDefault; AWordWrap: Boolean = false;
ABackgroundColor: TsColor = scSilver); AddBackground: Boolean = false; ABackgroundColor: TsColor = scSilver);
procedure WriteXFFieldsForFormattingStyles(AStream: TStream); procedure WriteXFFieldsForFormattingStyles(AStream: TStream);
procedure WriteXFRecords(AStream: TStream); procedure WriteXFRecords(AStream: TStream);
public public
@ -318,10 +318,16 @@ const
MASK_XF_BORDER_TOP = $00000007; MASK_XF_BORDER_TOP = $00000007;
MASK_XF_BORDER_BOTTOM = $01C00000; MASK_XF_BORDER_BOTTOM = $01C00000;
{ XF CELL BORDER COLORS }
MASK_XF_BORDER_LEFT_COLOR = $007F0000;
MASK_XF_BORDER_RIGHT_COLOR = $3F800000;
MASK_XF_BORDER_TOP_COLOR = $0000FE00;
MASK_XF_BORDER_BOTTOM_COLOR = $FE000000;
{ XF CELL BACKGROUND } { XF CELL BACKGROUND }
MASK_XF_BKGR_PATTERN_COLOR = $0000007F; MASK_XF_BKGR_PATTERN_COLOR = $0000007F;
MASK_XF_BKGR_BACKGROUND_COLOR = $00003F80; MASK_XF_BKGR_BACKGROUND_COLOR = $00003F80;
MASK_XF_BKGR_FILLPATTERN = $003F0000; MASK_XF_BKGR_FILLPATTERN = $003F0000;
{ TsSpreadBIFF5Writer } { TsSpreadBIFF5Writer }
@ -1049,13 +1055,11 @@ end;
*******************************************************************} *******************************************************************}
procedure TsSpreadBIFF5Writer.WriteXF(AStream: TStream; AFontIndex: Word; procedure TsSpreadBIFF5Writer.WriteXF(AStream: TStream; AFontIndex: Word;
AFormatIndex: Word; AXF_TYPE_PROT, ATextRotation: Byte; ABorders: TsCellBorders; AFormatIndex: Word; AXF_TYPE_PROT, ATextRotation: Byte; ABorders: TsCellBorders;
AHorAlignment: TsHorAlignment = haDefault; AVertAlignment: TsVertAlignment = vaDefault; const ABorderStyles: TsCellBorderStyles; AHorAlignment: TsHorAlignment = haDefault;
AWordWrap: Boolean = false; AddBackground: Boolean = false; AVertAlignment: TsVertAlignment = vaDefault; AWordWrap: Boolean = false;
ABackgroundColor: TsColor = scSilver); AddBackground: Boolean = false; ABackgroundColor: TsColor = scSilver);
const const
FILL_PATTERN = 1; // solid fill FILL_PATTERN = 1; // solid fill
BORDER_LINE_STYLE = 1; // thin solid line
BORDER_COLOR = scBLACK;
var var
optns: Word; optns: Word;
b: Byte; b: Byte;
@ -1111,14 +1115,14 @@ begin
end; end;
// Border lines // Border lines
if cbSouth in ABorders then if cbSouth in ABorders then
dw1 := dw1 or (BORDER_LINE_STYLE shl 22); dw1 := dw1 or ((ord(ABorderStyles[cbSouth].LineStyle)+1) shl 22);
dw1 := dw1 or (BORDER_COLOR shl 25); // Bottom line color dw1 := dw1 or (ABorderStyles[cbSouth].Color shl 25); // Bottom line color
dw2 := (BORDER_COLOR shl 9) or // Top line color dw2 := (ABorderStyles[cbNorth].Color shl 9) or // Top line color
(BORDER_COLOR shl 16) or // Left line color (ABorderStyles[cbWest].Color shl 16) or // Left line color
(BORDER_COLOR shl 23); // Right line color (ABorderStyles[cbEast].Color shl 23); // Right line color
if cbNorth in ABorders then dw2 := dw2 or BORDER_LINE_STYLE; if cbNorth in ABorders then dw2 := dw2 or (ord(ABorderStyles[cbNorth].LineStyle)+1);
if cbWest in ABorders then dw2 := dw2 or (BORDER_LINE_STYLE shl 3); if cbWest in ABorders then dw2 := dw2 or ((ord(ABorderStyles[cbWest].LineStyle)+1) shl 3);
if cbEast in ABorders then dw2 := dw2 or (BORDER_LINE_STYLE shl 6); if cbEast in ABorders then dw2 := dw2 or ((ord(ABorderStyles[cbEast].LineStyle)+1) shl 6);
AStream.WriteDWord(DWordToLE(dw1)); AStream.WriteDWord(DWordToLE(dw1));
AStream.WriteDWord(DWordToLE(dw2)); AStream.WriteDWord(DWordToLE(dw2));
end; end;
@ -1130,6 +1134,7 @@ var
lFormatIndex: Word; //number format lFormatIndex: Word; //number format
lTextRotation: Byte; lTextRotation: Byte;
lBorders: TsCellBorders; lBorders: TsCellBorders;
lBorderStyles: TsCellBorderStyles;
lAddBackground: Boolean; lAddBackground: Boolean;
lBackgroundColor: TsColor; lBackgroundColor: TsColor;
lHorAlign: TsHorAlignment; lHorAlign: TsHorAlignment;
@ -1144,6 +1149,7 @@ begin
lFormatIndex := 0; //General format (one of the built-in number formats) lFormatIndex := 0; //General format (one of the built-in number formats)
lTextRotation := XF_ROTATION_HORIZONTAL; lTextRotation := XF_ROTATION_HORIZONTAL;
lBorders := []; lBorders := [];
lBorderStyles := FFormattingStyles[i].BorderStyles;
lHorAlign := FFormattingStyles[i].HorAlignment; lHorAlign := FFormattingStyles[i].HorAlignment;
lVertAlign := FFormattingStyles[i].VertAlignment; lVertAlign := FFormattingStyles[i].VertAlignment;
lBackgroundColor := FFormattingStyles[i].BackgroundColor; lBackgroundColor := FFormattingStyles[i].BackgroundColor;
@ -1233,44 +1239,45 @@ begin
// And finally write the style // And finally write the style
WriteXF(AStream, lFontIndex, lFormatIndex, 0, lTextRotation, lBorders, WriteXF(AStream, lFontIndex, lFormatIndex, 0, lTextRotation, lBorders,
lHorAlign, lVertAlign, lWordwrap, lAddBackground, lBackgroundColor); lBorderStyles, lHorAlign, lVertAlign, lWordwrap, lAddBackground,
lBackgroundColor);
end; end;
end; end;
procedure TsSpreadBIFF5Writer.WriteXFRecords(AStream: TStream); procedure TsSpreadBIFF5Writer.WriteXFRecords(AStream: TStream);
begin begin
// XF0 // XF0
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF1 // XF1
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF2 // XF2
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF3 // XF3
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF4 // XF4
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF5 // XF5
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF6 // XF6
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF7 // XF7
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF8 // XF8
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF9 // XF9
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF10 // XF10
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF11 // XF11
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF12 // XF12
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF13 // XF13
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF14 // XF14
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF15 - Default, no formatting // XF15 - Default, no formatting
WriteXF(AStream, 0, 0, 0, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, 0, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// Add all further non-standard/built-in formatting styles // Add all further non-standard/built-in formatting styles
ListAllFormattingStyles; ListAllFormattingStyles;
@ -1594,6 +1601,7 @@ var
lData: TXFListData; lData: TXFListData;
xf: TXFRecord; xf: TXFRecord;
b: Byte; b: Byte;
dw: DWord;
begin begin
AStream.ReadBuffer(xf, SizeOf(xf)); AStream.ReadBuffer(xf, SizeOf(xf));
@ -1634,16 +1642,35 @@ begin
xf.Border_Background_1 := DWordLEToN(xf.Border_Background_1); xf.Border_Background_1 := DWordLEToN(xf.Border_Background_1);
xf.Border_Background_2 := DWordLEToN(xf.Border_Background_2); xf.Border_Background_2 := DWordLEToN(xf.Border_Background_2);
lData.Borders := []; lData.Borders := [];
// the 4 masked bits encode the line style of the border line. 0 = no line // The 4 masked bits encode the line style of the border line. 0 = no line.
// We ignore the line style here. --> check against "no line" // The case of "no line" is not included in the TsLineStyle enumeration.
if xf.Border_Background_1 and MASK_XF_BORDER_BOTTOM <> 0 then // --> correct by subtracting 1!
dw := xf.Border_Background_1 and MASK_XF_BORDER_BOTTOM;
if dw <> 0 then begin
Include(lData.Borders, cbSouth); Include(lData.Borders, cbSouth);
if xf.Border_Background_2 and MASK_XF_BORDER_LEFT <> 0 then lData.BorderStyles[cbSouth].LineStyle := TsLineStyle(dw shr 22 - 1);
end;
dw := xf.Border_Background_2 and MASK_XF_BORDER_LEFT;
if dw <> 0 then begin
Include(lData.Borders, cbWest); Include(lData.Borders, cbWest);
if xf.Border_Background_2 and MASK_XF_BORDER_RIGHT <> 0 then lData.BorderStyles[cbWest].LineStyle := TsLineStyle(dw shr 3 - 1);
end;
dw := xf.Border_Background_2 and MASK_XF_BORDER_RIGHT;
if dw <> 0 then begin
Include(lData.Borders, cbEast); Include(lData.Borders, cbEast);
if xf.Border_Background_2 and MASK_XF_BORDER_TOP <> 0 then lData.BorderStyles[cbEast].LineStyle := TsLineStyle(dw shr 6 - 1);
end;
dw := xf.Border_Background_2 and MASK_XF_BORDER_TOP;
if dw <> 0 then begin
Include(lData.Borders, cbNorth); Include(lData.Borders, cbNorth);
lData.BorderStyles[cbNorth].LineStyle := TsLineStyle(dw - 1);
end;
// Border line colors
lData.BorderStyles[cbWest].Color := (xf.Border_Background_2 and MASK_XF_BORDER_LEFT_COLOR) shr 16;
lData.BorderStyles[cbEast].Color := (xf.Border_Background_2 and MASK_XF_BORDER_RIGHT_COLOR) shr 23;
lData.BorderStyles[cbNorth].Color := (xf.Border_Background_2 and MASK_XF_BORDER_TOP_COLOR) shr 9;
lData.BorderStyles[cbSouth].Color := (xf.Border_Background_1 and MASK_XF_BORDER_BOTTOM_COLOR) shr 25;
// Background color // Background color
lData.BackgroundColor := xf.Border_Background_1 AND MASK_XF_BKGR_PATTERN_COLOR; lData.BackgroundColor := xf.Border_Background_1 AND MASK_XF_BKGR_PATTERN_COLOR;

111
components/fpspreadsheet/xlsbiff8.pas
View File

@ -107,7 +107,6 @@ type
TsSpreadBIFF8Writer = class(TsSpreadBIFFWriter) TsSpreadBIFF8Writer = class(TsSpreadBIFFWriter)
private private
// Writes index to XF record according to cell's formatting // Writes index to XF record according to cell's formatting
//procedure WriteXFIndex(AStream: TStream; ACell: PCell);
procedure WriteXFFieldsForFormattingStyles(AStream: TStream); procedure WriteXFFieldsForFormattingStyles(AStream: TStream);
protected protected
{ Record writing methods } { Record writing methods }
@ -131,9 +130,9 @@ type
procedure WriteWindow2(AStream: TStream; ASheetSelected: Boolean); procedure WriteWindow2(AStream: TStream; ASheetSelected: Boolean);
procedure WriteXF(AStream: TStream; AFontIndex: Word; procedure WriteXF(AStream: TStream; AFontIndex: Word;
AFormatIndex: Word; AXF_TYPE_PROT, ATextRotation: Byte; ABorders: TsCellBorders; AFormatIndex: Word; AXF_TYPE_PROT, ATextRotation: Byte; ABorders: TsCellBorders;
AHorAlignment: TsHorAlignment = haDefault; AVertAlignment: TsVertAlignment = vaDefault; const ABorderStyles: TsCellBorderStyles; AHorAlignment: TsHorAlignment = haDefault;
AWordWrap: Boolean = false; AddBackground: Boolean = false; AVertAlignment: TsVertAlignment = vaDefault; AWordWrap: Boolean = false;
ABackgroundColor: TsColor = scSilver); AddBackground: Boolean = false; ABackgroundColor: TsColor = scSilver);
procedure WriteXFRecords(AStream: TStream); procedure WriteXFRecords(AStream: TStream);
public public
{ General writing methods } { General writing methods }
@ -292,12 +291,18 @@ const
XF_ROTATION_90DEG_CW = 180; XF_ROTATION_90DEG_CW = 180;
XF_ROTATION_STACKED = 255; // Letters stacked top to bottom, but not rotated XF_ROTATION_STACKED = 255; // Letters stacked top to bottom, but not rotated
{ XF CELL BORDER } { XF CELL BORDER LINE STYLES }
MASK_XF_BORDER_LEFT = $0000000F; MASK_XF_BORDER_LEFT = $0000000F;
MASK_XF_BORDER_RIGHT = $000000F0; MASK_XF_BORDER_RIGHT = $000000F0;
MASK_XF_BORDER_TOP = $00000F00; MASK_XF_BORDER_TOP = $00000F00;
MASK_XF_BORDER_BOTTOM = $0000F000; MASK_XF_BORDER_BOTTOM = $0000F000;
{ XF CELL BORDER COLORS }
MASK_XF_BORDER_LEFT_COLOR = $007F0000;
MASK_XF_BORDER_RIGHT_COLOR = $3F800000;
MASK_XF_BORDER_TOP_COLOR = $0000007F;
MASK_XF_BORDER_BOTTOM_COLOR = $00003F80;
{ TsSpreadBIFF8Writer } { TsSpreadBIFF8Writer }
@ -308,6 +313,7 @@ var
lFormatIndex: Word; //number format lFormatIndex: Word; //number format
lTextRotation: Byte; lTextRotation: Byte;
lBorders: TsCellBorders; lBorders: TsCellBorders;
lBorderStyles: TsCellBorderStyles;
lAddBackground: Boolean; lAddBackground: Boolean;
lBackgroundColor: TsColor; lBackgroundColor: TsColor;
lHorAlign: TsHorAlignment; lHorAlign: TsHorAlignment;
@ -322,6 +328,7 @@ begin
lFormatIndex := 0; //General format (one of the built-in number formats) lFormatIndex := 0; //General format (one of the built-in number formats)
lTextRotation := XF_ROTATION_HORIZONTAL; lTextRotation := XF_ROTATION_HORIZONTAL;
lBorders := []; lBorders := [];
lBorderStyles := FFormattingStyles[i].BorderStyles;
lHorAlign := FFormattingStyles[i].HorAlignment; lHorAlign := FFormattingStyles[i].HorAlignment;
lVertAlign := FFormattingStyles[i].VertAlignment; lVertAlign := FFormattingStyles[i].VertAlignment;
lBackgroundColor := FFormattingStyles[i].BackgroundColor; lBackgroundColor := FFormattingStyles[i].BackgroundColor;
@ -410,7 +417,8 @@ begin
// And finally write the style // And finally write the style
WriteXF(AStream, lFontIndex, lFormatIndex, 0, lTextRotation, lBorders, WriteXF(AStream, lFontIndex, lFormatIndex, 0, lTextRotation, lBorders,
lHorAlign, lVertAlign, lWordwrap, lAddBackground, lBackgroundColor); lBorderStyles, lHorAlign, lVertAlign, lWordwrap, lAddBackground,
lBackgroundColor);
end; end;
end; end;
@ -1229,9 +1237,9 @@ end;
*******************************************************************} *******************************************************************}
procedure TsSpreadBIFF8Writer.WriteXF(AStream: TStream; AFontIndex: Word; procedure TsSpreadBIFF8Writer.WriteXF(AStream: TStream; AFontIndex: Word;
AFormatIndex: Word; AXF_TYPE_PROT, ATextRotation: Byte; ABorders: TsCellBorders; AFormatIndex: Word; AXF_TYPE_PROT, ATextRotation: Byte; ABorders: TsCellBorders;
AHorAlignment: TsHorAlignment = haDefault; AVertAlignment: TsVertAlignment = vaDefault; const ABorderStyles: TsCellBorderStyles; AHorAlignment: TsHorAlignment = haDefault;
AWordWrap: Boolean = false; AddBackground: Boolean = false; AVertAlignment: TsVertAlignment = vaDefault; AWordWrap: Boolean = false;
ABackgroundColor: TsColor = scSilver); AddBackground: Boolean = false; ABackgroundColor: TsColor = scSilver);
var var
XFOptions: Word; XFOptions: Word;
XFAlignment, XFOrientationAttrib: Byte; XFAlignment, XFOrientationAttrib: Byte;
@ -1292,18 +1300,33 @@ begin
{ Cell border lines and background area } { Cell border lines and background area }
// Left and Right line colors, use black // Left and Right line colors
XFBorderDWord1 := ABorderStyles[cbWest].Color shl 16 +
ABorderStyles[cbEast].Color shl 23;
// Border line styles
if cbWest in ABorders then
XFBorderDWord1 := XFBorderDWord1 or (ord(ABorderStyles[cbWest].LineStyle)+1);
if cbEast in ABorders then
XFBorderDWord1 := XFBorderDWord1 or ((ord(ABorderStyles[cbEast].LineStyle)+1) shl 4);
if cbNorth in ABorders then
XFBorderDWord1 := XFBorderDWord1 or ((ord(ABorderStyles[cbNorth].LineStyle)+1) shl 8);
if cbSouth in ABorders then
XFBorderDWord1 := XFBorderDWord1 or ((ord(ABorderStyles[cbSouth].LineStyle)+1) shl 12);
(*
XFBorderDWord1 := 8 * $10000 {left line - black} + 8 * $800000 {right line - black}; XFBorderDWord1 := 8 * $10000 {left line - black} + 8 * $800000 {right line - black};
if cbNorth in ABorders then XFBorderDWord1 := XFBorderDWord1 or $100; if cbNorth in ABorders then XFBorderDWord1 := XFBorderDWord1 or $100;
if cbWest in ABorders then XFBorderDWord1 := XFBorderDWord1 or $1; if cbWest in ABorders then XFBorderDWord1 := XFBorderDWord1 or $1;
if cbEast in ABorders then XFBorderDWord1 := XFBorderDWord1 or $10; if cbEast in ABorders then XFBorderDWord1 := XFBorderDWord1 or $10;
if cbSouth in ABorders then XFBorderDWord1 := XFBorderDWord1 or $1000; if cbSouth in ABorders then XFBorderDWord1 := XFBorderDWord1 or $1000;
*)
AStream.WriteDWord(DWordToLE(XFBorderDWord1)); AStream.WriteDWord(DWordToLE(XFBorderDWord1));
// Top and Bottom line colors, use black // Top and Bottom line colors
XFBorderDWord2 := 8 {top line - black} + 8 * $80 {bottom line - black}; XFBorderDWord2 := ABorderStyles[cbNorth].Color + ABorderStyles[cbSouth].Color shl 7;
// XFBorderDWord2 := 8 {top line - black} + 8 * $80 {bottom line - black};
// Add a background, if desired // Add a background, if desired
if AddBackground then XFBorderDWord2 := XFBorderDWord2 or $4000000; if AddBackground then XFBorderDWord2 := XFBorderDWord2 or $4000000;
AStream.WriteDWord(DWordToLE(XFBorderDWord2)); AStream.WriteDWord(DWordToLE(XFBorderDWord2));
@ -1318,37 +1341,37 @@ end;
procedure TsSpreadBIFF8Writer.WriteXFRecords(AStream: TStream); procedure TsSpreadBIFF8Writer.WriteXFRecords(AStream: TStream);
begin begin
// XF0 // XF0
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF1 // XF1
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF2 // XF2
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF3 // XF3
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF4 // XF4
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF5 // XF5
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF6 // XF6
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF7 // XF7
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF8 // XF8
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF9 // XF9
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF10 // XF10
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF11 // XF11
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF12 // XF12
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF13 // XF13
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF14 // XF14
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// XF15 - Default, no formatting // XF15 - Default, no formatting
WriteXF(AStream, 0, 0, 0, XF_ROTATION_HORIZONTAL, []); WriteXF(AStream, 0, 0, 0, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES);
// Add all further non-standard/built-in formatting styles // Add all further non-standard/built-in formatting styles
ListAllFormattingStyles; ListAllFormattingStyles;
@ -1971,6 +1994,7 @@ var
lData: TXFListData; lData: TXFListData;
xf: TXFRecord; xf: TXFRecord;
b: Byte; b: Byte;
dw: DWord;
begin begin
AStream.ReadBuffer(xf, SizeOf(xf)); AStream.ReadBuffer(xf, SizeOf(xf));
@ -2010,16 +2034,35 @@ begin
// Cell borders // Cell borders
xf.Border_Background_1 := DWordLEToN(xf.Border_Background_1); xf.Border_Background_1 := DWordLEToN(xf.Border_Background_1);
lData.Borders := []; lData.Borders := [];
lData.BorderStyles := DEFAULT_BORDERSTYLES;
// the 4 masked bits encode the line style of the border line. 0 = no line // the 4 masked bits encode the line style of the border line. 0 = no line
// We ignore the line style here. --> check against "no line" dw := xf.Border_Background_1 and MASK_XF_BORDER_LEFT;
if xf.Border_Background_1 and MASK_XF_BORDER_LEFT <> 0 then if dw <> 0 then begin
Include(lData.Borders, cbWest); Include(lData.Borders, cbWest);
if xf.Border_Background_1 and MASK_XF_BORDER_RIGHT <> 0 then lData.BorderStyles[cbWest].LineStyle := TsLineStyle(dw - 1);
end;
dw := xf.Border_Background_1 and MASK_XF_BORDER_RIGHT;
if dw <> 0 then begin
Include(lData.Borders, cbEast); Include(lData.Borders, cbEast);
if xf.Border_Background_1 and MASK_XF_BORDER_TOP <> 0 then lData.BorderStyles[cbEast].LineStyle := TsLineStyle(dw shr 4 - 1);
end;
dw := xf.Border_Background_1 and MASK_XF_BORDER_TOP;
if dw <> 0 then begin
Include(lData.Borders, cbNorth); Include(lData.Borders, cbNorth);
if xf.Border_Background_1 and MASK_XF_BORDER_BOTTOM <> 0 then lData.BorderStyles[cbNorth].LineStyle := TsLineStyle(dw shr 8 - 1);
end;
dw := xf.Border_Background_1 and MASK_XF_BORDER_BOTTOM;
if dw <> 0 then begin
Include(lData.Borders, cbSouth); Include(lData.Borders, cbSouth);
lData.BorderStyles[cbSouth].LineStyle := TsLineStyle(dw shr 12 - 1);
end;
// Border line colors
lData.BorderStyles[cbWest].Color := (xf.Border_Background_1 and MASK_XF_BORDER_LEFT_COLOR) shr 16;
lData.BorderStyles[cbEast].Color := (xf.Border_Background_1 and MASK_XF_BORDER_RIGHT_COLOR) shr 23;
lData.BorderStyles[cbNorth].Color := (xf.Border_Background_2 and MASK_XF_BORDER_TOP_COLOR);
lData.BorderStyles[cbSouth].Color := (xf.Border_Background_2 and MASK_XF_BORDER_BOTTOM_COLOR) shr 7;
// Background color; // Background color;
xf.Border_Background_3 := DWordLEToN(xf.Border_Background_3); xf.Border_Background_3 := DWordLEToN(xf.Border_Background_3);

6
components/fpspreadsheet/xlscommon.pas
View File

@ -312,6 +312,7 @@ type
WordWrap: Boolean; WordWrap: Boolean;
TextRotation: TsTextRotation; TextRotation: TsTextRotation;
Borders: TsCellBorders; Borders: TsCellBorders;
BorderStyles: TsCellBorderStyles;
BackgroundColor: TsColor; BackgroundColor: TsColor;
end; end;
@ -523,6 +524,7 @@ begin
lCell^.TextRotation := XFData.TextRotation; lCell^.TextRotation := XFData.TextRotation;
// Borders // Borders
lCell^.BorderStyles := XFData.BorderStyles;
if XFData.Borders <> [] then begin if XFData.Borders <> [] then begin
Include(lCell^.UsedFormattingFields, uffBorder); Include(lCell^.UsedFormattingFields, uffBorder);
lCell^.Border := XFData.Borders; lCell^.Border := XFData.Borders;
@ -887,13 +889,13 @@ end;
} }
procedure TsSpreadBIFFWriter.AddDefaultFormats(); procedure TsSpreadBIFFWriter.AddDefaultFormats();
begin begin
SetLength(FFormattingStyles, 1);
// XF0..XF14: Normal style, Row Outline level 1..7, // XF0..XF14: Normal style, Row Outline level 1..7,
// Column Outline level 1..7. // Column Outline level 1..7.
// XF15 - Default cell format, no formatting (4.6.2) // XF15 - Default cell format, no formatting (4.6.2)
SetLength(FFormattingStyles, 1);
FFormattingStyles[0].UsedFormattingFields := []; FFormattingStyles[0].UsedFormattingFields := [];
FFormattingStyles[0].BorderStyles := DEFAULT_BORDERSTYLES;
FFormattingStyles[0].Row := 15; FFormattingStyles[0].Row := 15;
NextXFIndex := 15 + Length(FFormattingStyles); NextXFIndex := 15 + Length(FFormattingStyles);