diff --git a/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr b/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr index 1915f2bce..91602a785 100644 --- a/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr +++ b/components/fpspreadsheet/examples/ooxmldemo/ooxmlwrite.lpr @@ -55,6 +55,21 @@ begin MyCell := MyWorksheet.GetCell(2, 3); MyCell^.UsedFormattingFields := [uffBold]; + // Background and text color + MyWorksheet.WriteUTF8Text(4, 0, 'white on red'); + Myworksheet.WriteBackgroundColor(4, 0, scRed); + MyWorksheet.WriteFontColor(4, 0, scWhite); + + // Border + MyWorksheet.WriteUTF8Text(4, 2, 'left/right'); + Myworksheet.WriteBorders(4, 2, [cbWest, cbEast]); + MyWorksheet.WriteHorAlignment(4, 2, haCenter); + + Myworksheet.WriteUTF8Text(4, 4, 'top/bottom'); + Myworksheet.WriteBorders(4, 4, [cbNorth, cbSouth]); + MyWorksheet.WriteBorderStyle(4, 4, cbSouth, lsThick, scBlue); + Myworksheet.WriteHorAlignment(4, 4, haRight); + // Creates a new worksheet MyWorksheet := MyWorkbook.AddWorksheet('My Worksheet 2'); diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index b1ed4928d..e33d8db59 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -1071,6 +1071,7 @@ procedure RegisterSpreadFormat( AReaderClass: TsSpreadReaderClass; procedure CopyCellFormat(AFromCell, AToCell: PCell); function GetFileFormatName(AFormat: TsSpreadsheetFormat): String; procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer); +function SameCellBorders(ACell1, ACell2: PCell): Boolean; implementation @@ -1424,6 +1425,41 @@ begin AToCell^.NumberFormatStr := AFromCell^.NumberFormatStr; end; +{@@ + Checks whether two cells have same border attributes } +function SameCellBorders(ACell1, ACell2: PCell): Boolean; + + function NoBorder(ACell: PCell): Boolean; + begin + Result := (ACell = nil) or + not (uffBorder in ACell^.UsedFormattingFields) or + (ACell^.Border = []); + end; + +var + nobrdr1, nobrdr2: Boolean; + cb: TsCellBorder; +begin + nobrdr1 := NoBorder(ACell1); + nobrdr2 := NoBorder(ACell2); + if (nobrdr1 and nobrdr2) then + Result := true + else + if (nobrdr1 and (not nobrdr2) ) or ( (not nobrdr1) and nobrdr2) then + Result := false + else begin + Result := false; + if ACell1^.Border <> ACell2^.Border then + exit; + for cb in TsCellBorder do begin + if ACell1^.BorderStyles[cb].LineStyle <> ACell2^.BorderStyles[cb].LineStyle then + exit; + if ACell1^.BorderStyles[cb].Color <> ACell2^.BorderStyles[cb].Color then + exit; + end; + Result := true; + end; +end; { TsWorksheet } diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index b2824b317..4fca94547 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -62,14 +62,22 @@ type protected FPointSeparatorSettings: TFormatSettings; FSharedStringsCount: Integer; + FFillList: array of PCell; + FBorderList: array of PCell; protected { Helper routines } procedure AddDefaultFormats; override; procedure CreateNumFormatList; override; procedure CreateStreams; procedure DestroyStreams; + function FindBorderInList(ACell: PCell): Integer; + function FindFillInList(ACell: PCell): Integer; function GetStyleIndex(ACell: PCell): Cardinal; + procedure ListAllBorders; + procedure ListAllFills; procedure ResetStreams; + procedure WriteBorderList(AStream: TStream); + procedure WriteFillList(AStream: TStream); procedure WriteFontList(AStream: TStream); procedure WriteStyleList(AStream: TStream; ANodeName: String); protected @@ -179,6 +187,58 @@ begin NextXFIndex := 2; end; +{ Looks for the combination of border attributes of the given cell in the + FBorderList and returns its index. } +function TsSpreadOOXMLWriter.FindBorderInList(ACell: PCell): Integer; +var + i: Integer; + styleCell: PCell; +begin + // No cell, or border-less --> index 0 + if (ACell = nil) or not (uffBorder in ACell^.UsedFormattingFields) then begin + Result := 0; + exit; + end; + + for i:=0 to High(FBorderList) do begin + styleCell := FBorderList[i]; + if SameCellBorders(styleCell, ACell) then begin + Result := i; + exit; + end; + end; + + // Not found --> return -1 + Result := -1; +end; + +{ Looks for the combination of fill attributes of the given cell in the + FFillList and returns its index. } +function TsSpreadOOXMLWriter.FindFillInList(ACell: PCell): Integer; +var + i: Integer; + styleCell: PCell; +begin + if (ACell = nil) or not (uffBackgroundColor in ACell^.UsedFormattingFields) + then begin + Result := 0; + exit; + end; + + // Index 0 is "no fill" which already has been handled. + for i:=2 to High(FFillList) do begin + styleCell := FFillList[i]; + if (uffBackgroundColor in styleCell^.UsedFormattingFields) then + if (styleCell^.BackgroundColor = ACell^.BackgroundColor) then begin + Result := i; + exit; + end; + end; + + // Not found --> return -1 + Result := -1; +end; + { Determines the formatting index which a given cell has in list of "FormattingStyles" which correspond to the section cellXfs of the styles.xml file. } @@ -189,6 +249,169 @@ begin Result := 0; end; +{ Creates a list of all border styles found in the workbook. + The list contains indexes into the array FFormattingStyles for each unique + combination of border attributes. + To be used for the styles.xml. } +procedure TsSpreadOOXMLWriter.ListAllBorders; +var + styleCell: PCell; + i, n : Integer; +begin + // first list entry is a no-border cell + SetLength(FBorderList, 1); + FBorderList[0] := nil; + + n := 1; + for i := 0 to High(FFormattingStyles) do begin + styleCell := @FFormattingStyles[i]; + if FindBorderInList(styleCell) = -1 then begin + SetLength(FBorderList, n+1); + FBorderList[n] := styleCell; + inc(n); + end; + end; +end; + +{ Creates a list of all fill styles found in the workbook. + The list contains indexes into the array FFormattingStyles for each unique + combination of fill attributes. + Currently considers only backgroundcolor, fill style is always "solid". + To be used for styles.xml. } +procedure TsSpreadOOXMLWriter.ListAllFills; +var + styleCell: PCell; + i, n: Integer; +begin + // Add built-in fills first. + SetLength(FFillList, 2); + FFillList[0] := nil; // built-in "no fill" + FFillList[1] := nil; // built-in "gray125" + + n := 2; + for i := 0 to High(FFormattingStyles) do begin + styleCell := @FFormattingStyles[i]; + if FindFillInList(styleCell) = -1 then begin + SetLength(FFillList, n+1); + FFillList[n] := styleCell; + inc(n); + end; + end; +end; + +procedure TsSpreadOOXMLWriter.WriteBorderList(AStream: TStream); + + procedure WriteBorderStyle(AStream: TStream; ACell: PCell; ABorder: TsCellBorder); + { border names found in xlsx files for Excel selections: + "thin", "hair", "dotted", "dashed", "dashDotDot", "dashDot", "mediumDashDotDot", + "slantDashDot", "mediumDashDot", "mediumDashed", "medium", "thick", "double" } + var + borderName: String; + styleName: String; + colorName: String; + rgb: TsColorValue; + begin + // Border line location + case ABorder of + cbWest : borderName := 'left'; + cbEast : borderName := 'right'; + cbNorth : borderName := 'top'; + cbSouth : borderName := 'bottom'; + end; + if (ABorder in ACell^.Border) then begin + // Line style + case ACell.BorderStyles[ABorder].LineStyle of + lsThin : styleName := 'thin'; + lsMedium : styleName := 'medium'; + lsDashed : styleName := 'dashed'; + lsDotted : styleName := 'dotted'; + lsThick : styleName := 'thick'; + lsDouble : styleName := 'double'; + lsHair : styleName := 'hair'; + else raise Exception.Create('TsOOXMLWriter.WriteBorderList: LineStyle not supported.'); + end; + // Border color + rgb := Workbook.GetPaletteColor(ACell^.BorderStyles[ABorder].Color); + colorName := Copy(ColorToHTMLColorStr(rgb), 2, 255); + AppendToStream(AStream, Format( + '<%s style="%s">', + [borderName, styleName, colorName, borderName] + )); + end else + AppendToStream(AStream, Format( + '<%s />', [borderName])); + end; + +var + i: Integer; + styleCell: PCell; +begin + AppendToStream(AStream, Format( + '', [Length(FBorderList)])); + + // index 0 -- build-in "no borders" + AppendToStream(AStream, + '', + '', + ''); + + for i:=1 to High(FBorderList) do begin + styleCell := FBorderList[i]; + AppendToStream(AStream, + ''); + WriteBorderStyle(AStream, styleCell, cbWest); + WriteBorderStyle(AStream, styleCell, cbEast); + WriteBorderStyle(AStream, styleCell, cbNorth); + WriteBorderStyle(AStream, styleCell, cbSouth); + AppendToStream(AStream, + '', + ''); + end; + + AppendToStream(AStream, + ''); +end; + +procedure TsSpreadOOXMLWriter.WriteFillList(AStream: TStream); +var + i: Integer; + styleCell: PCell; + rgb: TsColorValue; +begin + AppendToStream(AStream, Format( + '', [Length(FFillList)])); + + // index 0 -- built-in empty fill + AppendToStream(AStream, + '', + '', + ''); + + // index 1 -- built-in gray125 pattern + AppendToStream(AStream, + '', + '', + ''); + + // user-defined fills + for i:=2 to High(FFillList) do begin + styleCell := FFillList[i]; + rgb := Workbook.GetPaletteColor(styleCell^.BackgroundColor); + AppendToStream(AStream, + '', + ''); + AppendToStream(AStream, Format( + '', [Copy(ColorToHTMLColorStr(rgb), 2, 255)]), + ''); + AppendToStream(AStream, + '', + ''); + end; + + AppendToStream(FSStyles, + ''); +end; + { Writes the fontlist of the workbook to the stream. The font id used in xf records is given by the index of a font in the list. Therefore, we have to write an empty record for font #4 which is nil due to compatibility with BIFF } @@ -288,11 +511,13 @@ begin end; { Fill } - fillID := 0; + fillID := FindFillInList(@styleCell); + if fillID = -1 then fillID := 0; s := s + Format('fillId="%d" ', [fillID]); { Border } - borderID := 0; + borderID := FindBorderInList(@styleCell); + if borderID = -1 then borderID := 0; s := s + Format('borderId="%d" ', [borderID]); { Write everything to stream } @@ -358,20 +583,11 @@ begin WriteFontList(FSStyles); // Fill patterns - AppendToStream(FSStyles, - ''); - AppendToStream(FSStyles, - '', - '', - ''); - AppendToStream(FSStyles, - '', - '', - ''); - AppendToStream(FSStyles, - ''); + WriteFillList(FSStyles); // Borders + WriteBorderList(FSStyles); + { AppendToStream(FSStyles, ''); AppendToStream(FSStyles, @@ -380,7 +596,7 @@ begin ''); AppendToStream(FSStyles, ''); - +} // Style records AppendToStream(FSStyles, '', @@ -747,6 +963,8 @@ begin { Analyze the workbook and collect all information needed } ListAllNumFormats; ListAllFormattingStyles; + ListAllFills; + ListAllBorders; { Create the streams that will hold the file contents } CreateStreams;