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.

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

View File

@ -89,6 +89,28 @@ begin
MyWorksheet.WriteDateTime(5, 0, now);
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
for i := 2 to 20 do
begin

View File

@ -62,8 +62,43 @@ begin
// E6 empty cell, only background color
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.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
MyWorksheet.WriteUTF8Text(6, 3, 'This is a very, very, very, very long wrapped text.');

View File

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

View File

@ -121,29 +121,23 @@ type
{@@ RPN formula. Similar to the expanded formula, but in RPN notation.
Simplifies the task of format writers which need RPN }
TsRPNFormula = array of TsFormulaElement;
{@@ Describes the type of content of a cell on a TsWorksheet }
TCellContentType = (cctEmpty, cctFormula, cctRPNFormula, cctNumber,
cctUTF8String, cctDateTime);
{@@ List of possible formatting fields }
TsUsedFormattingField = (uffTextRotation, uffFont, uffBold, uffBorder,
uffBackgroundColor, uffNumberFormat, uffWordWrap,
uffHorAlign, uffVertAlign
);
{@@ Describes which formatting fields are active }
TsUsedFormattingFields = set of TsUsedFormattingField;
{@@ 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,
nfShortDateTime, nfFmtDateTime, nfShortDate, nfShortTime, nfLongTime,
nfShortTimeAM, nfLongTimeAM, nfTimeInterval);
@ -163,18 +157,9 @@ type
| B
| A
}
TsTextRotation = (trHorizontal, rt90DegreeClockwiseRotation,
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 }
TsHorAlignment = (haDefault, haLeft, haCenter, haRight);
TsVertAlignment = (vaDefault, vaTop, vaCenter, vaBottom);
@ -183,8 +168,7 @@ type
Colors in fpspreadsheet are given as indices into a palette.
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).
The data type for rgb values is TsColorValue.
}
The data type for rgb values is TsColorValue. }
TsColor = Word;
{@@
@ -241,6 +225,32 @@ type
Color: TsColor;
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
Never suppose that all *Value fields are valid,
@ -267,6 +277,7 @@ type
HorAlignment: TsHorAlignment;
VertAlignment: TsVertAlignment;
Border: TsCellBorders;
BorderStyles: TsCelLBorderStyles;
BackgroundColor: TsColor;
NumberFormat: TsNumberFormat;
NumberFormatStr: String;
@ -327,6 +338,7 @@ type
function ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields;
function ReadBackgroundColor(ARow, ACol: Cardinal): TsColor;
procedure RemoveAllCells;
{ Writing of values }
procedure WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring);
procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double;
AFormat: TsNumberFormat = nfGeneral; ADecimals: Word = 2);
@ -334,8 +346,9 @@ type
procedure WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime;
AFormat: TsNumberFormat = nfShortDateTime; AFormatStr: String = '');
procedure WriteFormula(ARow, ACol: Cardinal; AFormula: TsFormula);
procedure WriteNumberFormat(ARow, ACol: Cardinal; ANumberFormat: TsNumberFormat);
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;
AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; overload;
procedure WriteFont(ARow, ACol: Cardinal; AFontIndex: Integer); overload;
@ -344,7 +357,15 @@ type
procedure WriteTextRotation(ARow, ACol: Cardinal; ARotation: TsTextRotation);
procedure WriteUsedFormatting(ARow, ACol: Cardinal; AUsedFormatting: TsUsedFormattingFields);
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 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 WriteVertAlignment(ARow, ACol: Cardinal; AValue: TsVertAlignment);
procedure WriteWordwrap(ARow, ACol: Cardinal; AValue: boolean);
@ -886,6 +907,7 @@ begin
Result^.Row := ARow;
Result^.Col := ACol;
Result^.BorderStyles := DEFAULT_BORDERSTYLES;
Cells.Add(Result);
end;
@ -1451,6 +1473,30 @@ begin
ACell^.BackgroundColor := AColor;
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);
var
lCell: PCell;
@ -1460,6 +1506,41 @@ begin
lCell^.Border := ABorders;
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);
var
lCell: PCell;
@ -2280,12 +2361,14 @@ begin
end;
{@@
Checks if the style of a cell is in the list FFormattingStyles and returns the index
or -1 if it isn't
Checks if the style of a cell is in the list of manually added FFormattingStyles
and returns the index or -1 if it isn't
}
function TsCustomSpreadWriter.FindFormattingInList(AFormat: PCell): Integer;
var
i: Integer;
b: TsCellBorder;
equ: Boolean;
begin
Result := -1;
@ -2302,8 +2385,23 @@ begin
if uffTextRotation in AFormat^.UsedFormattingFields then
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;
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 (FFormattingStyles[i].BackgroundColor <> AFormat^.BackgroundColor) then Continue;

View File

@ -380,6 +380,54 @@ var
cell: PCell;
c, r: Integer;
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
inherited;
if FWorksheet = nil then exit;
@ -390,16 +438,14 @@ begin
c := cell^.Col + FixedCols;
r := cell^.Row + FixedRows;
rect := CellRect(c, r);
Canvas.Pen.Style := psSolid;
Canvas.Pen.Color := clBlack;
if (cbNorth in cell^.Border) then
Canvas.Line(rect.Left, rect.Top-1, rect.Right, rect.Top-1);
if (cbWest in cell^.Border) then
Canvas.Line(rect.Left-1, rect.Top, rect.Left-1, rect.Bottom);
if (cbEast in cell^.Border) then
Canvas.Line(rect.Right-1, rect.Top, rect.Right-1, rect.Bottom);
if (cbSouth in cell^.Border) then
Canvas.Line(rect.Left, rect.Bottom-1, rect.Right, rect.Bottom-1);
DrawBorderLine(cell, rect, cbNorth, cell^.BorderStyles[cbNorth].LineStyle);
if cbEast in cell^.Border then
DrawBorderLine(cell, rect, cbEast, cell^.BorderStyles[cbEast].LineStyle);
if cbSouth in cell^.Border then
DrawBorderLine(cell, rect, cbSouth, cell^.BorderStyles[cbSouth].LineStyle);
if cbWest in cell^.Border then
DrawBorderLine(cell, rect, cbWest, cell^.BorderStyles[cbWest].LineStyle);
end;
cell := FWorksheet.GetNextCell;
end;

View File

@ -30,6 +30,8 @@ var
SollColWidths: array[0..1] of Single;
SollBorders: array[0..15] of TsCellBorders;
SollBorderLineStyles: array[0..6] of TsLineStyle;
SollBorderColors: array[0..5] of TsColor;
procedure InitSollFmtData;
@ -47,6 +49,8 @@ type
procedure TestWriteReadAlignment(AFormat: TsSpreadsheetFormat);
// Test border
procedure TestWriteReadBorder(AFormat: TsSpreadsheetFormat);
// Test border styles
procedure TestWriteReadBorderStyles(AFormat: TsSpreadsheetFormat);
// Test column widths
procedure TestWriteReadColWidths(AFormat: TsSpreadsheetFormat);
// Test text rotation
@ -63,12 +67,14 @@ type
procedure TestWriteReadBIFF2_Border;
procedure TestWriteReadBIFF2_ColWidths;
// These features are not supported by Excel2 --> no test cases required!
// - BorderStyle
// - TextRotation
// - Wordwrap
{ BIFF5 Tests }
procedure TestWriteReadBIFF5_Alignment;
procedure TestWriteReadBIFF5_Border;
procedure TestWriteReadBIFF5_BorderStyles;
procedure TestWriteReadBIFF5_ColWidths;
procedure TestWriteReadBIFF5_TextRotation;
procedure TestWriteReadBIFF5_WordWrap;
@ -76,6 +82,7 @@ type
{ BIFF8 Tests }
procedure TestWriteReadBIFF8_Alignment;
procedure TestWriteReadBIFF8_Border;
procedure TestWriteReadBIFF8_BorderStyles;
procedure TestWriteReadBIFF8_ColWidths;
procedure TestWriteReadBIFF8_TextRotation;
procedure TestWriteReadBIFF8_WordWrap;
@ -192,6 +199,21 @@ begin
SollBorders[13] := [cbSouth, cbWest, cbNorth];
SollBorders[14] := [cbWest, cbNorth, cbEast];
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;
{ TSpreadWriteReadFormatTests }
@ -459,6 +481,107 @@ begin
TestWriteReadBorder(sfExcel8);
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);
var
MyWorksheet: TsWorksheet;

View File

@ -129,9 +129,9 @@ type
procedure WriteWindow2(AStream: TStream; ASheetSelected: Boolean);
procedure WriteXF(AStream: TStream; AFontIndex: Word;
AFormatIndex: Word; AXF_TYPE_PROT, ATextRotation: Byte; ABorders: TsCellBorders;
AHorAlignment: TsHorAlignment = haDefault; AVertAlignment: TsVertAlignment = vaDefault;
AWordWrap: Boolean = false; AddBackground: Boolean = false;
ABackgroundColor: TsColor = scSilver);
const ABorderStyles: TsCellBorderStyles; AHorAlignment: TsHorAlignment = haDefault;
AVertAlignment: TsVertAlignment = vaDefault; AWordWrap: Boolean = false;
AddBackground: Boolean = false; ABackgroundColor: TsColor = scSilver);
procedure WriteXFFieldsForFormattingStyles(AStream: TStream);
procedure WriteXFRecords(AStream: TStream);
public
@ -318,6 +318,12 @@ const
MASK_XF_BORDER_TOP = $00000007;
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 }
MASK_XF_BKGR_PATTERN_COLOR = $0000007F;
MASK_XF_BKGR_BACKGROUND_COLOR = $00003F80;
@ -1049,13 +1055,11 @@ end;
*******************************************************************}
procedure TsSpreadBIFF5Writer.WriteXF(AStream: TStream; AFontIndex: Word;
AFormatIndex: Word; AXF_TYPE_PROT, ATextRotation: Byte; ABorders: TsCellBorders;
AHorAlignment: TsHorAlignment = haDefault; AVertAlignment: TsVertAlignment = vaDefault;
AWordWrap: Boolean = false; AddBackground: Boolean = false;
ABackgroundColor: TsColor = scSilver);
const ABorderStyles: TsCellBorderStyles; AHorAlignment: TsHorAlignment = haDefault;
AVertAlignment: TsVertAlignment = vaDefault; AWordWrap: Boolean = false;
AddBackground: Boolean = false; ABackgroundColor: TsColor = scSilver);
const
FILL_PATTERN = 1; // solid fill
BORDER_LINE_STYLE = 1; // thin solid line
BORDER_COLOR = scBLACK;
var
optns: Word;
b: Byte;
@ -1111,14 +1115,14 @@ begin
end;
// Border lines
if cbSouth in ABorders then
dw1 := dw1 or (BORDER_LINE_STYLE shl 22);
dw1 := dw1 or (BORDER_COLOR shl 25); // Bottom line color
dw2 := (BORDER_COLOR shl 9) or // Top line color
(BORDER_COLOR shl 16) or // Left line color
(BORDER_COLOR shl 23); // Right line color
if cbNorth in ABorders then dw2 := dw2 or BORDER_LINE_STYLE;
if cbWest in ABorders then dw2 := dw2 or (BORDER_LINE_STYLE shl 3);
if cbEast in ABorders then dw2 := dw2 or (BORDER_LINE_STYLE shl 6);
dw1 := dw1 or ((ord(ABorderStyles[cbSouth].LineStyle)+1) shl 22);
dw1 := dw1 or (ABorderStyles[cbSouth].Color shl 25); // Bottom line color
dw2 := (ABorderStyles[cbNorth].Color shl 9) or // Top line color
(ABorderStyles[cbWest].Color shl 16) or // Left line color
(ABorderStyles[cbEast].Color shl 23); // Right line color
if cbNorth in ABorders then dw2 := dw2 or (ord(ABorderStyles[cbNorth].LineStyle)+1);
if cbWest in ABorders then dw2 := dw2 or ((ord(ABorderStyles[cbWest].LineStyle)+1) shl 3);
if cbEast in ABorders then dw2 := dw2 or ((ord(ABorderStyles[cbEast].LineStyle)+1) shl 6);
AStream.WriteDWord(DWordToLE(dw1));
AStream.WriteDWord(DWordToLE(dw2));
end;
@ -1130,6 +1134,7 @@ var
lFormatIndex: Word; //number format
lTextRotation: Byte;
lBorders: TsCellBorders;
lBorderStyles: TsCellBorderStyles;
lAddBackground: Boolean;
lBackgroundColor: TsColor;
lHorAlign: TsHorAlignment;
@ -1144,6 +1149,7 @@ begin
lFormatIndex := 0; //General format (one of the built-in number formats)
lTextRotation := XF_ROTATION_HORIZONTAL;
lBorders := [];
lBorderStyles := FFormattingStyles[i].BorderStyles;
lHorAlign := FFormattingStyles[i].HorAlignment;
lVertAlign := FFormattingStyles[i].VertAlignment;
lBackgroundColor := FFormattingStyles[i].BackgroundColor;
@ -1233,44 +1239,45 @@ begin
// And finally write the style
WriteXF(AStream, lFontIndex, lFormatIndex, 0, lTextRotation, lBorders,
lHorAlign, lVertAlign, lWordwrap, lAddBackground, lBackgroundColor);
lBorderStyles, lHorAlign, lVertAlign, lWordwrap, lAddBackground,
lBackgroundColor);
end;
end;
procedure TsSpreadBIFF5Writer.WriteXFRecords(AStream: TStream);
begin
// 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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
ListAllFormattingStyles;
@ -1594,6 +1601,7 @@ var
lData: TXFListData;
xf: TXFRecord;
b: Byte;
dw: DWord;
begin
AStream.ReadBuffer(xf, SizeOf(xf));
@ -1634,16 +1642,35 @@ begin
xf.Border_Background_1 := DWordLEToN(xf.Border_Background_1);
xf.Border_Background_2 := DWordLEToN(xf.Border_Background_2);
lData.Borders := [];
// 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"
if xf.Border_Background_1 and MASK_XF_BORDER_BOTTOM <> 0 then
// The 4 masked bits encode the line style of the border line. 0 = no line.
// The case of "no line" is not included in the TsLineStyle enumeration.
// --> correct by subtracting 1!
dw := xf.Border_Background_1 and MASK_XF_BORDER_BOTTOM;
if dw <> 0 then begin
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);
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);
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);
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
lData.BackgroundColor := xf.Border_Background_1 AND MASK_XF_BKGR_PATTERN_COLOR;

View File

@ -107,7 +107,6 @@ type
TsSpreadBIFF8Writer = class(TsSpreadBIFFWriter)
private
// Writes index to XF record according to cell's formatting
//procedure WriteXFIndex(AStream: TStream; ACell: PCell);
procedure WriteXFFieldsForFormattingStyles(AStream: TStream);
protected
{ Record writing methods }
@ -131,9 +130,9 @@ type
procedure WriteWindow2(AStream: TStream; ASheetSelected: Boolean);
procedure WriteXF(AStream: TStream; AFontIndex: Word;
AFormatIndex: Word; AXF_TYPE_PROT, ATextRotation: Byte; ABorders: TsCellBorders;
AHorAlignment: TsHorAlignment = haDefault; AVertAlignment: TsVertAlignment = vaDefault;
AWordWrap: Boolean = false; AddBackground: Boolean = false;
ABackgroundColor: TsColor = scSilver);
const ABorderStyles: TsCellBorderStyles; AHorAlignment: TsHorAlignment = haDefault;
AVertAlignment: TsVertAlignment = vaDefault; AWordWrap: Boolean = false;
AddBackground: Boolean = false; ABackgroundColor: TsColor = scSilver);
procedure WriteXFRecords(AStream: TStream);
public
{ General writing methods }
@ -292,12 +291,18 @@ const
XF_ROTATION_90DEG_CW = 180;
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_RIGHT = $000000F0;
MASK_XF_BORDER_TOP = $00000F00;
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 }
@ -308,6 +313,7 @@ var
lFormatIndex: Word; //number format
lTextRotation: Byte;
lBorders: TsCellBorders;
lBorderStyles: TsCellBorderStyles;
lAddBackground: Boolean;
lBackgroundColor: TsColor;
lHorAlign: TsHorAlignment;
@ -322,6 +328,7 @@ begin
lFormatIndex := 0; //General format (one of the built-in number formats)
lTextRotation := XF_ROTATION_HORIZONTAL;
lBorders := [];
lBorderStyles := FFormattingStyles[i].BorderStyles;
lHorAlign := FFormattingStyles[i].HorAlignment;
lVertAlign := FFormattingStyles[i].VertAlignment;
lBackgroundColor := FFormattingStyles[i].BackgroundColor;
@ -410,7 +417,8 @@ begin
// And finally write the style
WriteXF(AStream, lFontIndex, lFormatIndex, 0, lTextRotation, lBorders,
lHorAlign, lVertAlign, lWordwrap, lAddBackground, lBackgroundColor);
lBorderStyles, lHorAlign, lVertAlign, lWordwrap, lAddBackground,
lBackgroundColor);
end;
end;
@ -1229,9 +1237,9 @@ end;
*******************************************************************}
procedure TsSpreadBIFF8Writer.WriteXF(AStream: TStream; AFontIndex: Word;
AFormatIndex: Word; AXF_TYPE_PROT, ATextRotation: Byte; ABorders: TsCellBorders;
AHorAlignment: TsHorAlignment = haDefault; AVertAlignment: TsVertAlignment = vaDefault;
AWordWrap: Boolean = false; AddBackground: Boolean = false;
ABackgroundColor: TsColor = scSilver);
const ABorderStyles: TsCellBorderStyles; AHorAlignment: TsHorAlignment = haDefault;
AVertAlignment: TsVertAlignment = vaDefault; AWordWrap: Boolean = false;
AddBackground: Boolean = false; ABackgroundColor: TsColor = scSilver);
var
XFOptions: Word;
XFAlignment, XFOrientationAttrib: Byte;
@ -1292,18 +1300,33 @@ begin
{ 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};
if cbNorth in ABorders then XFBorderDWord1 := XFBorderDWord1 or $100;
if cbWest in ABorders then XFBorderDWord1 := XFBorderDWord1 or $1;
if cbEast in ABorders then XFBorderDWord1 := XFBorderDWord1 or $10;
if cbSouth in ABorders then XFBorderDWord1 := XFBorderDWord1 or $1000;
*)
AStream.WriteDWord(DWordToLE(XFBorderDWord1));
// Top and Bottom line colors, use black
XFBorderDWord2 := 8 {top line - black} + 8 * $80 {bottom line - black};
// Top and Bottom line colors
XFBorderDWord2 := ABorderStyles[cbNorth].Color + ABorderStyles[cbSouth].Color shl 7;
// XFBorderDWord2 := 8 {top line - black} + 8 * $80 {bottom line - black};
// Add a background, if desired
if AddBackground then XFBorderDWord2 := XFBorderDWord2 or $4000000;
AStream.WriteDWord(DWordToLE(XFBorderDWord2));
@ -1318,37 +1341,37 @@ end;
procedure TsSpreadBIFF8Writer.WriteXFRecords(AStream: TStream);
begin
// 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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
ListAllFormattingStyles;
@ -1971,6 +1994,7 @@ var
lData: TXFListData;
xf: TXFRecord;
b: Byte;
dw: DWord;
begin
AStream.ReadBuffer(xf, SizeOf(xf));
@ -2010,16 +2034,35 @@ begin
// Cell borders
xf.Border_Background_1 := DWordLEToN(xf.Border_Background_1);
lData.Borders := [];
lData.BorderStyles := DEFAULT_BORDERSTYLES;
// 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"
if xf.Border_Background_1 and MASK_XF_BORDER_LEFT <> 0 then
dw := xf.Border_Background_1 and MASK_XF_BORDER_LEFT;
if dw <> 0 then begin
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);
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);
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);
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;
xf.Border_Background_3 := DWordLEToN(xf.Border_Background_3);

View File

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