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

fpspreadsheet: Add support for diagonal border lines. Implemented for BIFF8 and ods (BIFF2 and 5 do not support diagonal borders, OOXML reader currently does not have border support). Test cases adapted. "spready" adapted to show diagonal borders.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3400 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-07-30 22:51:59 +00:00
parent 07934e5c16
commit e96b16b993
10 changed files with 284 additions and 170 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
components/fpspreadsheet/examples/excel8demo/excel8write.lpi
View File

@ -44,9 +44,6 @@
<UseExternalDbgSyms Value="True"/> <UseExternalDbgSyms Value="True"/>
</Debugging> </Debugging>
</Linking> </Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions> </CompilerOptions>
</Item2> </Item2>
<Item3 Name="Release"> <Item3 Name="Release">
@ -74,9 +71,6 @@
</Debugging> </Debugging>
<LinkSmart Value="True"/> <LinkSmart Value="True"/>
</Linking> </Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions> </CompilerOptions>
</Item3> </Item3>
</BuildModes> </BuildModes>
@ -109,7 +103,6 @@
<PathDelim Value="\"/> <PathDelim Value="\"/>
<SearchPaths> <SearchPaths>
<OtherUnitFiles Value=".."/> <OtherUnitFiles Value=".."/>
<SrcPath Value=".."/>
</SearchPaths> </SearchPaths>
<Parsing> <Parsing>
<SyntaxOptions> <SyntaxOptions>
@ -121,8 +114,5 @@
<DebugInfoType Value="dsDwarf2Set"/> <DebugInfoType Value="dsDwarf2Set"/>
</Debugging> </Debugging>
</Linking> </Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions> </CompilerOptions>
</CONFIG> </CONFIG>

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

@ -95,12 +95,15 @@ begin
MyWorksheet.WriteBorderLineStyle(5, 7, cbWest, lsMedium); MyWorksheet.WriteBorderLineStyle(5, 7, cbWest, lsMedium);
MyWorksheet.WriteBorderLineStyle(5, 7, cbNorth, lsMedium); MyWorksheet.WriteBorderLineStyle(5, 7, cbNorth, lsMedium);
// J6 empty cell, all thick borders // J6 empty cell, all thick borders, diagonals thin&red
MyWorksheet.WriteBorders(5, 9, [cbNorth, cbEast, cbSouth, cbWest]); MyWorksheet.WriteBorders(5, 9, [cbNorth, cbEast, cbSouth, cbWest, cbDiagUp, cbDiagDown]);
MyWorksheet.WriteBorderLineStyle(5, 9, cbSouth, lsThick); MyWorksheet.WriteBorderLineStyle(5, 9, cbSouth, lsThick);
MyWorksheet.WriteBorderLineStyle(5, 9, cbEast, lsThick); MyWorksheet.WriteBorderLineStyle(5, 9, cbEast, lsThick);
MyWorksheet.WriteBorderLineStyle(5, 9, cbWest, lsThick); MyWorksheet.WriteBorderLineStyle(5, 9, cbWest, lsThick);
MyWorksheet.WriteBorderLineStyle(5, 9, cbNorth, lsThick); MyWorksheet.WriteBorderLineStyle(5, 9, cbNorth, lsThick);
MyWorksheet.WriteBorderLineStyle(5, 9, cbDiagUp, lsThin);
MyWorksheet.WriteBorderLineStyle(5, 9, cbDiagDown, lsThin);
MyWorksheet.WriteBorderColor(5, 9, cbDiagUp, scRed);
// K6 empty cell, top border thick // K6 empty cell, top border thick
MyWorksheet.WriteBorders(5, 11, [cbNorth]); MyWorksheet.WriteBorders(5, 11, [cbNorth]);

28
components/fpspreadsheet/fpsopendocument.pas
View File

@ -2172,6 +2172,16 @@ begin
Include(borders, cbWest); Include(borders, cbWest);
SetBorderStyle(cbWest, s); SetBorderStyle(cbWest, s);
end; end;
s := GetAttrValue(styleChildNode, 'style:diagonal-bl-tr');
if (s <> '') and (s <> 'none') then begin
Include(borders, cbDiagUp);
SetBorderStyle(cbDiagUp, s);
end;
s := GetAttrValue(styleChildNode, 'style:diagonal-tl-br');
if (s <> '') and (s <>'none') then begin
Include(borders, cbDiagDown);
SetBorderStyle(cbDiagDown, s);
end;
// Text wrap // Text wrap
s := GetAttrValue(styleChildNode, 'fo:wrap-option'); s := GetAttrValue(styleChildNode, 'fo:wrap-option');
@ -3292,6 +3302,24 @@ begin
Result := Result + 'style:border-linewidth-top="0.002cm 0.035cm 0.002cm" '; Result := Result + 'style:border-linewidth-top="0.002cm 0.035cm 0.002cm" ';
end else end else
Result := Result + 'fo:border-top="none" '; Result := Result + 'fo:border-top="none" ';
if cbDiagUp in AFormat.Border then begin
Result := Result + Format('style:diagonal-bl-tr="%s %s %s" ', [
BORDER_LINEWIDTHS[AFormat.BorderStyles[cbDiagUp].LineStyle],
BORDER_LINESTYLES[AFormat.BorderStyles[cbDiagUp].LineStyle],
Workbook.GetPaletteColorAsHTMLStr(AFormat.BorderStyles[cbDiagUp].Color)
]);
end;
if cbDiagDown in AFormat.Border then begin
Result := Result + Format('style:diagonal-tl-br="%s %s %s" ', [
BORDER_LINEWIDTHS[AFormat.BorderStyles[cbDiagDown].LineStyle],
BORDER_LINESTYLES[AFormat.BorderStyles[cbDiagDown].LineStyle],
Workbook.GetPaletteColorAsHTMLStr(AFormat.BorderStyles[cbDiagDown].Color)
]);
end;
end; end;
function TsSpreadOpenDocWriter.WriteDefaultFontXMLAsString: String; function TsSpreadOpenDocWriter.WriteDefaultFontXMLAsString: String;

4
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -342,7 +342,7 @@ type
{@@ Indicates the border for a cell. If included in the CellBorders set the {@@ Indicates the border for a cell. If included in the CellBorders set the
corresponding border is drawn in the style defined by the CellBorderStyle. } corresponding border is drawn in the style defined by the CellBorderStyle. }
TsCellBorder = (cbNorth, cbWest, cbEast, cbSouth); TsCellBorder = (cbNorth, cbWest, cbEast, cbSouth, cbDiagUp, cbDiagDown);
{@@ Indicates the border for a cell } {@@ Indicates the border for a cell }
TsCellBorders = set of TsCellBorder; TsCellBorders = set of TsCellBorder;
@ -363,6 +363,8 @@ type
{@@ Border styles for each cell border used by default: a thin, black, solid line } {@@ Border styles for each cell border used by default: a thin, black, solid line }
const const
DEFAULT_BORDERSTYLES: TsCellBorderStyles = ( DEFAULT_BORDERSTYLES: TsCellBorderStyles = (
(LineStyle: lsThin; Color: scBlack),
(LineStyle: lsThin; Color: scBlack),
(LineStyle: lsThin; Color: scBlack), (LineStyle: lsThin; Color: scBlack),
(LineStyle: lsThin; Color: scBlack), (LineStyle: lsThin; Color: scBlack),
(LineStyle: lsThin; Color: scBlack), (LineStyle: lsThin; Color: scBlack),

104
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -1071,8 +1071,13 @@ end;
@param ARect Rectangle in pixels occupied by the cell. @param ARect Rectangle in pixels occupied by the cell.
} }
procedure TsCustomWorksheetGrid.DrawCellBorders(ACol, ARow: Integer; ARect: TRect); procedure TsCustomWorksheetGrid.DrawCellBorders(ACol, ARow: Integer; ARect: TRect);
const
drawHor = 0;
drawVert = 1;
drawDiagUp = 2;
drawDiagDown = 3;
procedure DrawBorderLine(ACoord: Integer; ARect: TRect; IsHor: Boolean; procedure DrawBorderLine(ACoord: Integer; ARect: TRect; ADrawDirection: Byte;
ABorderStyle: TsCellBorderStyle); ABorderStyle: TsCellBorderStyle);
const const
// TsLineStyle = (lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble, lsHair); // TsLineStyle = (lsThin, lsMedium, lsDashed, lsDotted, lsThick, lsDouble, lsHair);
@ -1082,6 +1087,8 @@ procedure TsCustomWorksheetGrid.DrawCellBorders(ACol, ARow: Integer; ARect: TRec
(1, 2, 1, 1, 3, 1, 1); (1, 2, 1, 1, 3, 1, 1);
var var
width3: Boolean; // line is 3 pixels wide width3: Boolean; // line is 3 pixels wide
deltax, deltay: Integer;
angle: Double;
begin begin
Canvas.Pen.Style := PEN_STYLES[ABorderStyle.LineStyle]; Canvas.Pen.Style := PEN_STYLES[ABorderStyle.LineStyle];
Canvas.Pen.Width := PEN_WIDTHS[ABorderStyle.LineStyle]; Canvas.Pen.Width := PEN_WIDTHS[ABorderStyle.LineStyle];
@ -1089,66 +1096,124 @@ procedure TsCustomWorksheetGrid.DrawCellBorders(ACol, ARow: Integer; ARect: TRec
Canvas.Pen.EndCap := pecSquare; Canvas.Pen.EndCap := pecSquare;
width3 := (ABorderStyle.LineStyle in [lsThick, lsDouble]); width3 := (ABorderStyle.LineStyle in [lsThick, lsDouble]);
// Workaround until efficient drawing procedures for diagonal "hair" lines
// is available
if (ADrawDirection in [drawDiagUp, drawDiagDown]) and
(ABorderStyle.LineStyle = lsHair)
then
ABorderStyle.LineStyle := lsDotted;
// Tuning the rectangle to avoid issues at the grid borders and to get nice corners // Tuning the rectangle to avoid issues at the grid borders and to get nice corners
if (ABorderStyle.LineStyle in [lsMedium, lsThick, lsDouble]) then begin if (ABorderStyle.LineStyle in [lsMedium, lsThick, lsDouble]) then begin
if ACol = ColCount-1 then begin if ACol = ColCount-1 then begin
if not IsHor and (ACoord = ARect.Right-1) and width3 then dec(ACoord); if (ADrawDirection = drawVert) and (ACoord = ARect.Right-1) and width3
then dec(ACoord);
dec(ARect.Right); dec(ARect.Right);
end; end;
if ARow = RowCount-1 then begin if ARow = RowCount-1 then begin
if IsHor and (ACoord = ARect.Bottom-1) and width3 then dec(ACoord); if (ADrawDirection = drawHor) and (ACoord = ARect.Bottom-1) and width3
then dec(ACoord);
dec(ARect.Bottom); dec(ARect.Bottom);
end; end;
end; end;
if ABorderStyle.LineStyle in [lsMedium, lsThick] then begin if ABorderStyle.LineStyle in [lsMedium, lsThick] then begin
if IsHor then dec(ARect.Right, 1) else dec(ARect.Bottom, 1); if (ADrawDirection = drawHor) then
dec(ARect.Right, 1)
else if (ADrawDirection = drawVert) then
dec(ARect.Bottom, 1);
end; end;
// Painting // Painting
case ABorderStyle.LineStyle of case ABorderStyle.LineStyle of
lsThin, lsMedium, lsThick, lsDotted, lsDashed: lsThin, lsMedium, lsThick, lsDotted, lsDashed:
if IsHor then case ADrawDirection of
Canvas.Line(ARect.Left, ACoord, ARect.Right, ACoord) drawHor : Canvas.Line(ARect.Left, ACoord, ARect.Right, ACoord);
else drawVert : Canvas.Line(ACoord, ARect.Top, ACoord, ARect.Bottom);
Canvas.Line(ACoord, ARect.Top, ACoord, ARect.Bottom); drawDiagUp : Canvas.Line(ARect.Left, ARect.Bottom, ARect.Right, ARect.Top);
drawDiagDown: Canvas.Line(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
end;
lsHair: lsHair:
if IsHor then case ADrawDirection of
DrawHairLineHor(Canvas, ARect.Left, ARect.Right, ACoord) drawHor : DrawHairLineHor(Canvas, ARect.Left, ARect.Right, ACoord);
else drawVert : DrawHairLineVert(Canvas, ACoord, ARect.Top, ARect.Bottom);
DrawHairLineVert(Canvas, ACoord, ARect.Top, ARect.Bottom); drawDiagUp : ;
drawDiagDown: ;
end;
lsDouble: lsDouble:
if IsHor then begin case ADrawDirection of
drawHor:
begin
Canvas.Line(ARect.Left, ACoord-1, ARect.Right, ACoord-1); Canvas.Line(ARect.Left, ACoord-1, ARect.Right, ACoord-1);
Canvas.Line(ARect.Left, ACoord+1, ARect.Right, ACoord+1); Canvas.Line(ARect.Left, ACoord+1, ARect.Right, ACoord+1);
Canvas.Pen.Color := Color; Canvas.Pen.Color := Color;
Canvas.Line(ARect.Left, ACoord, ARect.Right, ACoord); Canvas.Line(ARect.Left, ACoord, ARect.Right, ACoord);
end else begin end;
drawVert:
begin
Canvas.Line(ACoord-1, ARect.Top, ACoord-1, ARect.Bottom); Canvas.Line(ACoord-1, ARect.Top, ACoord-1, ARect.Bottom);
Canvas.Line(ACoord+1, ARect.Top, ACoord+1, ARect.Bottom); Canvas.Line(ACoord+1, ARect.Top, ACoord+1, ARect.Bottom);
Canvas.Pen.Color := Color; Canvas.Pen.Color := Color;
Canvas.Line(ACoord, ARect.Top, ACoord, ARect.Bottom); Canvas.Line(ACoord, ARect.Top, ACoord, ARect.Bottom);
end; end;
drawDiagUp:
begin
if ARect.Right = ARect.Left then
angle := pi/2
else
angle := arctan((ARect.Bottom-ARect.Top) / (ARect.Right-ARect.Left));
deltax := Max(1, round(1.0 / sin(angle)));
deltay := Max(1, round(1.0 / cos(angle)));
Canvas.Line(ARect.Left, ARect.Bottom-deltay-1, ARect.Right-deltax, ARect.Top-1);
Canvas.Line(ARect.Left+deltax, ARect.Bottom-1, ARect.Right, ARect.Top+deltay-1);
end;
drawDiagDown:
begin
if ARect.Right = ARect.Left then
angle := pi/2
else
angle := arctan((ARect.Bottom-ARect.Top) / (ARect.Right-ARect.Left));
deltax := Max(1, round(1.0 / sin(angle)));
deltay := Max(1, round(1.0 / cos(angle)));
Canvas.Line(ARect.Left, ARect.Top+deltay-1, ARect.Right-deltax, ARect.Bottom-1);
Canvas.Line(ARect.Left+deltax, ARect.Top-1, ARect.Right, ARect.Bottom-deltay-1);
end;
end;
end; end;
end; end;
var var
bs: TsCellBorderStyle; bs: TsCellBorderStyle;
cell: PCell;
begin begin
if Assigned(FWorksheet) then begin if Assigned(FWorksheet) then begin
// Left border // Left border
if GetBorderStyle(ACol, ARow, -1, 0, bs) then if GetBorderStyle(ACol, ARow, -1, 0, bs) then
DrawBorderLine(ARect.Left-1, ARect, false, bs); DrawBorderLine(ARect.Left-1, ARect, drawVert, bs);
// Right border // Right border
if GetBorderStyle(ACol, ARow, +1, 0, bs) then if GetBorderStyle(ACol, ARow, +1, 0, bs) then
DrawBorderLine(ARect.Right-1, ARect, false, bs); DrawBorderLine(ARect.Right-1, ARect, drawVert, bs);
// Top border // Top border
if GetBorderstyle(ACol, ARow, 0, -1, bs) then if GetBorderstyle(ACol, ARow, 0, -1, bs) then
DrawBorderLine(ARect.Top-1, ARect, true, bs); DrawBorderLine(ARect.Top-1, ARect, drawHor, bs);
// Bottom border // Bottom border
if GetBorderStyle(ACol, ARow, 0, +1, bs) then if GetBorderStyle(ACol, ARow, 0, +1, bs) then
DrawBorderLine(ARect.Bottom-1, ARect, true, bs); DrawBorderLine(ARect.Bottom-1, ARect, drawHor, bs);
cell := FWorksheet.FindCell(ARow-FHeaderCount, ACol-FHeaderCount);
if cell <> nil then begin
// Diagonal up
if cbDiagUp in cell^.Border then begin
bs := cell^.Borderstyles[cbDiagUp];
DrawBorderLine(0, ARect, drawDiagUp, bs);
end;
// Diagonal down
if cbDiagDown in cell^.Border then begin
bs := cell^.BorderStyles[cbDiagDown];
DrawborderLine(0, ARect, drawDiagDown, bs);
end;
end;
end; end;
end; end;
@ -1977,6 +2042,9 @@ begin
r := GetWorksheetRow(ARow); r := GetWorksheetRow(ARow);
c := GetWorksheetCol(ACol); c := GetWorksheetCol(ACol);
cell := FWorksheet.FindCell(r, c); cell := FWorksheet.FindCell(r, c);
if (r+ADeltaRow < 0) or (c + ADeltaCol < 0) then
neighborcell := nil
else
neighborcell := FWorksheet.FindCell(r+ADeltaRow, c+ADeltaCol); neighborcell := FWorksheet.FindCell(r+ADeltaRow, c+ADeltaCol);
// Only cell has border, but neighbor has not // Only cell has border, but neighbor has not
if ((cell <> nil) and (border in cell^.Border)) and if ((cell <> nil) and (border in cell^.Border)) and

156
components/fpspreadsheet/laz_fpspreadsheet.lpk
View File

@ -35,88 +35,88 @@ This package is all you need if you don't want graphical components (like grids
<UnitName Value="fpsallformats"/> <UnitName Value="fpsallformats"/>
</Item2> </Item2>
<Item3> <Item3>
<Filename Value="fpsopendocument.pas"/>
<UnitName Value="fpsopendocument"/>
</Item3>
<Item4>
<Filename Value="fpspreadsheet.pas"/>
<UnitName Value="fpspreadsheet"/>
</Item4>
<Item5>
<Filename Value="xlsbiff2.pas"/>
<UnitName Value="xlsbiff2"/>
</Item5>
<Item6>
<Filename Value="xlsbiff5.pas"/>
<UnitName Value="xlsbiff5"/>
</Item6>
<Item7>
<Filename Value="xlsbiff8.pas"/>
<UnitName Value="xlsbiff8"/>
</Item7>
<Item8>
<Filename Value="xlsxooxml.pas"/>
<UnitName Value="xlsxooxml"/>
</Item8>
<Item9>
<Filename Value="fpsutils.pas"/>
<UnitName Value="fpsutils"/>
</Item9>
<Item10>
<Filename Value="fpsstreams.pas"/>
<UnitName Value="fpsStreams"/>
</Item10>
<Item11>
<Filename Value="fpszipper.pp"/>
<UnitName Value="fpszipper"/>
</Item11>
<Item12>
<Filename Value="uvirtuallayer_types.pas"/>
<UnitName Value="uvirtuallayer_types"/>
</Item12>
<Item13>
<Filename Value="uvirtuallayer.pas"/>
<UnitName Value="uvirtuallayer"/>
</Item13>
<Item14>
<Filename Value="uvirtuallayer_ole.pas"/>
<UnitName Value="uvirtuallayer_ole"/>
</Item14>
<Item15>
<Filename Value="uvirtuallayer_ole_helpers.pas"/>
<UnitName Value="uvirtuallayer_ole_helpers"/>
</Item15>
<Item16>
<Filename Value="uvirtuallayer_ole_types.pas"/>
<UnitName Value="uvirtuallayer_ole_types"/>
</Item16>
<Item17>
<Filename Value="uvirtuallayer_stream.pas"/>
<UnitName Value="uvirtuallayer_stream"/>
</Item17>
<Item18>
<Filename Value="fpolebasic.pas"/>
<UnitName Value="fpolebasic"/>
</Item18>
<Item19>
<Filename Value="xlscommon.pas"/> <Filename Value="xlscommon.pas"/>
<UnitName Value="xlscommon"/> <UnitName Value="xlscommon"/>
</Item19> </Item3>
<Item20> <Item4>
<Filename Value="wikitable.pas"/> <Filename Value="fpsstreams.pas"/>
<UnitName Value="wikitable"/> <UnitName Value="fpsStreams"/>
</Item20> </Item4>
<Item21> <Item5>
<Filename Value="fpsnumformatparser.pas"/> <Filename Value="fpspreadsheet.pas"/>
<UnitName Value="fpsNumFormatParser"/> <UnitName Value="fpspreadsheet"/>
</Item21> </Item5>
<Item22> <Item6>
<Filename Value="fpsfunc.pas"/>
<UnitName Value="fpsfunc"/>
</Item22>
<Item23>
<Filename Value="fpsxmlcommon.pas"/> <Filename Value="fpsxmlcommon.pas"/>
<UnitName Value="fpsxmlcommon"/> <UnitName Value="fpsxmlcommon"/>
</Item6>
<Item7>
<Filename Value="xlsbiff2.pas"/>
<UnitName Value="xlsbiff2"/>
</Item7>
<Item8>
<Filename Value="xlsbiff5.pas"/>
<UnitName Value="xlsbiff5"/>
</Item8>
<Item9>
<Filename Value="xlsbiff8.pas"/>
<UnitName Value="xlsbiff8"/>
</Item9>
<Item10>
<Filename Value="xlsxooxml.pas"/>
<UnitName Value="xlsxooxml"/>
</Item10>
<Item11>
<Filename Value="fpsopendocument.pas"/>
<UnitName Value="fpsopendocument"/>
</Item11>
<Item12>
<Filename Value="fpsutils.pas"/>
<UnitName Value="fpsutils"/>
</Item12>
<Item13>
<Filename Value="fpszipper.pp"/>
<UnitName Value="fpszipper"/>
</Item13>
<Item14>
<Filename Value="uvirtuallayer_types.pas"/>
<UnitName Value="uvirtuallayer_types"/>
</Item14>
<Item15>
<Filename Value="uvirtuallayer.pas"/>
<UnitName Value="uvirtuallayer"/>
</Item15>
<Item16>
<Filename Value="uvirtuallayer_ole.pas"/>
<UnitName Value="uvirtuallayer_ole"/>
</Item16>
<Item17>
<Filename Value="uvirtuallayer_ole_helpers.pas"/>
<UnitName Value="uvirtuallayer_ole_helpers"/>
</Item17>
<Item18>
<Filename Value="uvirtuallayer_ole_types.pas"/>
<UnitName Value="uvirtuallayer_ole_types"/>
</Item18>
<Item19>
<Filename Value="uvirtuallayer_stream.pas"/>
<UnitName Value="uvirtuallayer_stream"/>
</Item19>
<Item20>
<Filename Value="fpolebasic.pas"/>
<UnitName Value="fpolebasic"/>
</Item20>
<Item21>
<Filename Value="wikitable.pas"/>
<UnitName Value="wikitable"/>
</Item21>
<Item22>
<Filename Value="fpsnumformatparser.pas"/>
<UnitName Value="fpsNumFormatParser"/>
</Item22>
<Item23>
<Filename Value="fpsfunc.pas"/>
<UnitName Value="fpsfunc"/>
</Item23> </Item23>
</Files> </Files>
<RequiredPkgs Count="2"> <RequiredPkgs Count="2">

8
components/fpspreadsheet/laz_fpspreadsheet.pas
View File

@ -7,11 +7,11 @@ unit laz_fpspreadsheet;
interface interface
uses uses
fpolestorage, fpsallformats, fpsopendocument, fpspreadsheet, xlsbiff2, fpolestorage, fpsallformats, xlscommon, fpsStreams, fpspreadsheet,
xlsbiff5, xlsbiff8, xlsxooxml, fpsutils, fpsStreams, fpszipper, fpsxmlcommon, xlsbiff2, xlsbiff5, xlsbiff8, xlsxooxml, fpsopendocument,
uvirtuallayer_types, uvirtuallayer, uvirtuallayer_ole, fpsutils, fpszipper, uvirtuallayer_types, uvirtuallayer, uvirtuallayer_ole,
uvirtuallayer_ole_helpers, uvirtuallayer_ole_types, uvirtuallayer_stream, uvirtuallayer_ole_helpers, uvirtuallayer_ole_types, uvirtuallayer_stream,
fpolebasic, xlscommon, wikitable, fpsNumFormatParser, fpsfunc, fpsxmlcommon; fpolebasic, wikitable, fpsNumFormatParser, fpsfunc;
implementation implementation

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

@ -34,7 +34,7 @@ var
SollColWidths: array[0..1] of Single; SollColWidths: array[0..1] of Single;
SollRowHeights: Array[0..2] of Single; SollRowHeights: Array[0..2] of Single;
SollBorders: array[0..15] of TsCellBorders; SollBorders: array[0..19] of TsCellBorders;
SollBorderLineStyles: array[0..6] of TsLineStyle; SollBorderLineStyles: array[0..6] of TsLineStyle;
SollBorderColors: array[0..5] of TsColor; SollBorderColors: array[0..5] of TsColor;
@ -245,15 +245,19 @@ begin
SollBorders[12] := [cbEast, cbSouth, cbNorth]; SollBorders[12] := [cbEast, cbSouth, cbNorth];
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]; // BIFF2/5 end here
SollBorders[16] := [cbDiagUp];
SollBorders[17] := [cbDiagDown];
SollBorders[18] := [cbDiagUp, cbDiagDown];
SollBorders[19] := [cbEast, cbSouth, cbWest, cbNorth, cbDiagUp, cbDiagDown];
SollBorderLineStyles[0] := lsThin; SollBorderLineStyles[0] := lsThin;
SollBorderLineStyles[1] := lsMedium; SollBorderLineStyles[1] := lsMedium;
SollBorderLineStyles[2] := lsThick; SollBorderLineStyles[2] := lsThick;
SollBorderLineStyles[3] := lsThick; SollBorderLineStyles[3] := lsDashed;
SollBorderLineStyles[4] := lsDashed; SollBorderLineStyles[4] := lsDotted;
SollBorderLineStyles[5] := lsDotted; SollBorderLineStyles[5] := lsDouble;
SollBorderLineStyles[6] := lsDouble; SollBorderLineStyles[6] := lsHair;
SollBorderColors[0] := scBlue; SollBorderColors[0] := scBlue;
SollBorderColors[1] := scRed; SollBorderColors[1] := scRed;
@ -569,7 +573,7 @@ var
MyWorksheet: TsWorksheet; MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook; MyWorkbook: TsWorkbook;
MyCell: PCell; MyCell: PCell;
col: Integer; col, maxCol: Integer;
expected: String; expected: String;
current: String; current: String;
TempFile: string; //write xls/xml to this file and read back from it TempFile: string; //write xls/xml to this file and read back from it
@ -581,7 +585,11 @@ begin
// Write out all test values // Write out all test values
MyWorkbook := TsWorkbook.Create; MyWorkbook := TsWorkbook.Create;
MyWorkSheet:= MyWorkBook.AddWorksheet(BordersSheet); MyWorkSheet:= MyWorkBook.AddWorksheet(BordersSheet);
for col := Low(SollBorders) to High(SollBorders) do if AFormat in [sfExcel2, sfExcel5] then
maxCol := 15 // no diagonal border support in BIFF2 and BIFF5
else
maxCol := High(SollBorders);
for col := Low(SollBorders) to maxCol do
begin begin
MyWorksheet.WriteUsedFormatting(row, col, [uffBorder]); MyWorksheet.WriteUsedFormatting(row, col, [uffBorder]);
MyCell := MyWorksheet.GetCell(row, col); MyCell := MyWorksheet.GetCell(row, col);
@ -656,6 +664,9 @@ var
current: Integer; current: Integer;
TempFile: string; //write xls/xml to this file and read back from it TempFile: string; //write xls/xml to this file and read back from it
c, ls: Integer; c, ls: Integer;
borders: TsCellBorders;
diagUp_ls: Integer;
diagUp_clr: integer;
begin begin
{// Not needed: use workbook.writetofile with overwrite=true {// Not needed: use workbook.writetofile with overwrite=true
if fileexists(TempFile) then if fileexists(TempFile) then
@ -665,14 +676,18 @@ begin
MyWorkbook := TsWorkbook.Create; MyWorkbook := TsWorkbook.Create;
MyWorkSheet:= MyWorkBook.AddWorksheet(BordersSheet); MyWorkSheet:= MyWorkBook.AddWorksheet(BordersSheet);
borders := [cbNorth, cbSouth, cbEast, cbWest];
if AFormat in [sfExcel8, sfOpenDocument, sfOOXML] then
borders := borders + [cbDiagUp, cbDiagDown];
c := 0; c := 0;
ls := 0; ls := 0;
for row := 1 to 10 do for row := 1 to 10 do
begin begin
for col := 1 to 10 do for col := 1 to 10 do
begin begin
MyWorksheet.WriteBorders(row*2, col*2, [cbNorth, cbSouth, cbEast, cbWest]); MyWorksheet.WriteBorders(row*2, col*2, borders);
for b in TsCellBorders do for b in borders do
begin begin
MyWorksheet.WriteBorderLineStyle(row*2, col*2, b, SollBorderLineStyles[ls]); MyWorksheet.WriteBorderLineStyle(row*2, col*2, b, SollBorderLineStyles[ls]);
MyWorksheet.WriteBorderColor(row*2, col*2, b, SollBorderColors[c]); MyWorksheet.WriteBorderColor(row*2, col*2, b, SollBorderColors[c]);
@ -709,14 +724,30 @@ begin
MyCell := MyWorksheet.FindCell(row*2, col*2); MyCell := MyWorksheet.FindCell(row*2, col*2);
if myCell = nil then if myCell = nil then
fail('Error in test code. Failed to get cell.'); fail('Error in test code. Failed to get cell.');
for b in TsCellBorder do for b in borders do
begin begin
current := ord(MyCell^.BorderStyles[b].LineStyle); current := ord(MyCell^.BorderStyles[b].LineStyle);
// In Excel both diagonals have the same line style. The reader picks
// the line style of the "diagonal-up" border. We use this as expected
// value in the "diagonal-down" case.
expected := ord(SollBorderLineStyles[ls]); expected := ord(SollBorderLineStyles[ls]);
if AFormat in [sfExcel8, sfOOXML] then
case b of
cbDiagUp : diagUp_ls := expected;
cbDiagDown: expected := diagUp_ls;
end;
CheckEquals(expected, current, CheckEquals(expected, current,
'Test saved border line style mismatch, cell ' + CellNotation(MyWorksheet, row*2, col*2)); 'Test saved border line style mismatch, cell ' + CellNotation(MyWorksheet, row*2, col*2));
current := MyCell^.BorderStyles[b].Color; current := MyCell^.BorderStyles[b].Color;
expected := SollBorderColors[c]; expected := SollBorderColors[c];
// In Excel both diagonals have the same line color. The reader picks
// the color of the "diagonal-up" border. We use this as expected value
// in the "diagonal-down" case.
if AFormat in [sfExcel8, sfOOXML] then
case b of
cbDiagUp : diagUp_clr := expected;
cbDiagDown: expected := diagUp_clr;
end;
CheckEquals(expected, current, CheckEquals(expected, current,
'Test saved border color mismatch, cell ' + CellNotation(MyWorksheet, row*2, col*2)); 'Test saved border color mismatch, cell ' + CellNotation(MyWorksheet, row*2, col*2));
inc(ls); inc(ls);

32
components/fpspreadsheet/xlsbiff8.pas
View File

@ -257,12 +257,17 @@ const
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;
MASK_XF_BORDER_DIAGONAL = $01E00000;
MASK_XF_BORDER_SHOW_DIAGONAL_DOWN = $40000000;
MASK_XF_BORDER_SHOW_DIAGONAL_UP = $80000000;
{ XF CELL BORDER COLORS } { XF CELL BORDER COLORS }
MASK_XF_BORDER_LEFT_COLOR = $007F0000; MASK_XF_BORDER_LEFT_COLOR = $007F0000;
MASK_XF_BORDER_RIGHT_COLOR = $3F800000; MASK_XF_BORDER_RIGHT_COLOR = $3F800000;
MASK_XF_BORDER_TOP_COLOR = $0000007F; MASK_XF_BORDER_TOP_COLOR = $0000007F;
MASK_XF_BORDER_BOTTOM_COLOR = $00003F80; MASK_XF_BORDER_BOTTOM_COLOR = $00003F80;
MASK_XF_BORDER_DIAGONAL_COLOR = $001FC000;
{ XF CELL BACKGROUND PATTERN } { XF CELL BACKGROUND PATTERN }
MASK_XF_BACKGROUND_PATTERN = $FC000000; MASK_XF_BACKGROUND_PATTERN = $FC000000;
@ -1214,11 +1219,21 @@ begin
XFBorderDWord1 := XFBorderDWord1 or ((ord(ABorderStyles[cbNorth].LineStyle)+1) shl 8); XFBorderDWord1 := XFBorderDWord1 or ((ord(ABorderStyles[cbNorth].LineStyle)+1) shl 8);
if cbSouth in ABorders then if cbSouth in ABorders then
XFBorderDWord1 := XFBorderDWord1 or ((ord(ABorderStyles[cbSouth].LineStyle)+1) shl 12); XFBorderDWord1 := XFBorderDWord1 or ((ord(ABorderStyles[cbSouth].LineStyle)+1) shl 12);
if cbDiagDown in ABorders then
XFBorderDWord1 := XFBorderDWord1 or $40000000;
if cbDiagUp in ABorders then
XFBorderDWord1 := XFBorderDWord1 or $80000000;
AStream.WriteDWord(DWordToLE(XFBorderDWord1)); AStream.WriteDWord(DWordToLE(XFBorderDWord1));
// Top and Bottom line colors // Top, bottom and diagonal line colors
XFBorderDWord2 := ABorderStyles[cbNorth].Color + ABorderStyles[cbSouth].Color shl 7; XFBorderDWord2 := ABorderStyles[cbNorth].Color + ABorderStyles[cbSouth].Color shl 7 +
// XFBorderDWord2 := 8 {top line - black} + 8 * $80 {bottom line - black}; ABorderStyles[cbDiagUp].Color shl 14;
// In BIFF8 both diagonals have the same color - we use the color of the up-diagonal.
// Diagonal line style
if (ABorders + [cbDiagUp, cbDiagDown] <> []) then
XFBorderDWord2 := XFBorderDWord2 or ((ord(ABorderStyles[cbDiagUp].LineStyle)+1) shl 21);
// In BIFF8 both diagonals have the same color - we use the color of the up-diagonal.
// Add a background, if desired // Add a background, if desired
if AddBackground then XFBorderDWord2 := XFBorderDWord2 or $4000000; if AddBackground then XFBorderDWord2 := XFBorderDWord2 or $4000000;
@ -1922,12 +1937,23 @@ begin
Include(lData.Borders, cbSouth); Include(lData.Borders, cbSouth);
lData.BorderStyles[cbSouth].LineStyle := FixLineStyle(dw shr 12); lData.BorderStyles[cbSouth].LineStyle := FixLineStyle(dw shr 12);
end; end;
dw := xf.Border_Background_2 and MASK_XF_BORDER_DIAGONAL;
if dw <> 0 then begin
lData.BorderStyles[cbDiagUp].LineStyle := FixLineStyle(dw shr 21);
lData.BorderStyles[cbDiagDown].LineStyle := lData.BorderStyles[cbDiagUp].LineStyle;
if xf.Border_Background_1 and MASK_XF_BORDER_SHOW_DIAGONAL_UP <> 0 then
Include(lData.Borders, cbDiagUp);
if xf.Border_Background_1 and MASK_XF_BORDER_SHOW_DIAGONAL_DOWN <> 0 then
Include(lData.Borders, cbDiagDown);
end;
// Border line colors // Border line colors
lData.BorderStyles[cbWest].Color := (xf.Border_Background_1 and MASK_XF_BORDER_LEFT_COLOR) shr 16; 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[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[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; lData.BorderStyles[cbSouth].Color := (xf.Border_Background_2 and MASK_XF_BORDER_BOTTOM_COLOR) shr 7;
lData.BorderStyles[cbDiagUp].Color := (xf.Border_Background_2 and MASK_XF_BORDER_DIAGONAL_COLOR) shr 14;
lData.BorderStyles[cbDiagDown].Color := lData.BorderStyles[cbDiagUp].Color;
// Background fill pattern // Background fill pattern
fill := (xf.Border_Background_2 and MASK_XF_BACKGROUND_PATTERN) shr 26; fill := (xf.Border_Background_2 and MASK_XF_BACKGROUND_PATTERN) shr 26;

34
components/fpspreadsheet/xlsxooxml.pas
View File

@ -599,40 +599,6 @@ begin
end; end;
end; end;
(*
AppendToStream(AStream, Format(
'<fills count="%d">', [Length(FFillList)]));
// index 0 -- built-in empty fill
AppendToStream(AStream,
'<fill>',
'<patternFill patternType="none" />',
'</fill>');
// index 1 -- built-in gray125 pattern
AppendToStream(AStream,
'<fill>',
'<patternFill patternType="gray125" />',
'</fill>');
// user-defined fills
for i:=2 to High(FFillList) do begin
styleCell := FFillList[i];
rgb := Workbook.GetPaletteColor(styleCell^.BackgroundColor);
AppendToStream(AStream,
'<fill>',
'<patternFill patternType="solid">');
AppendToStream(AStream, Format(
'<fgColor rgb="%s" />', [Copy(ColorToHTMLColorStr(rgb), 2, 255)]),
'<bgColor indexed="64" />');
AppendToStream(AStream,
'</patternFill>',
'</fill>');
end;
AppendToStream(FSStyles,
'</fills>');
*)
procedure TsSpreadOOXMLReader.ReadFont(ANode: TDOMNode); procedure TsSpreadOOXMLReader.ReadFont(ANode: TDOMNode);
var var
node: TDOMNode; node: TDOMNode;