diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 406ce3424..17f6f6d69 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -165,6 +165,7 @@ type procedure WriteColumns(AStream: TStream; ASheet: TsWorksheet); procedure WriteFontNames(AStream: TStream); procedure WriteMasterStyles(AStream: TStream); + procedure WriteNamedExpressions(AStream: TStream; ASheet: TsWorksheet); procedure WriteNumFormats(AStream: TStream); procedure WriteRowStyles(AStream: TStream); procedure WriteRowsAndCells(AStream: TStream; ASheet: TsWorksheet); @@ -183,6 +184,7 @@ type function WriteHeaderFooterFontXMLAsString(AFont: TsHeaderFooterFont): String; function WriteHorAlignmentStyleXMLAsString(const AFormat: TsCellFormat): String; function WritePageLayoutAsXMLString(AStyleName: String; const APageLayout: TsPageLayout): String; + function WritePrintRangesAsXMLString(ASheet: TsWorksheet): String; function WriteTextRotationStyleXMLAsString(const AFormat: TsCellFormat): String; function WriteVertAlignmentStyleXMLAsString(const AFormat: TsCellFormat): String; function WriteWordwrapStyleXMLAsString(const AFormat: TsCellFormat): String; @@ -4286,8 +4288,8 @@ begin // Header AppendToStream(AStream, Format( - '', [ - FWorkSheet.Name, ASheetIndex+1 + '', [ + FWorkSheet.Name, ASheetIndex+1, WritePrintRangesAsXMLString(FWorksheet) ])); // columns @@ -4302,6 +4304,9 @@ begin end else WriteRowsAndCells(AStream, FWorksheet); + // named expressions, i.e. print range, repeated cols/rows + WriteNamedExpressions(AStream, FWorksheet); + // Footer AppendToStream(AStream, ''); @@ -4412,23 +4417,38 @@ procedure TsSpreadOpenDocWriter.WriteColumns(AStream: TStream; ASheet: TsWorksheet); var lastCol: Integer; - j, k: Integer; + c, k: Integer; w, w_mm: Double; widthMultiplier: Double; styleName: String; colsRepeated: Integer; colsRepeatedStr: String; + firstRepeatedPrintCol, lastRepeatedPrintCol: Cardinal; + headerCols: Boolean; begin widthMultiplier := Workbook.GetFont(0).Size / 2; lastCol := ASheet.GetLastColIndex; + firstRepeatedPrintCol := ASheet.PageLayout.RepeatedCols.FirstIndex; + lastRepeatedPrintCol := ASheet.PageLayout.RepeatedCols.LastIndex; + if (firstRepeatedPrintCol <> UNASSIGNED_ROW_COL_INDEX) and + (lastRepeatedPrintCol = UNASSIGNED_ROW_COL_INDEX) + then + lastRepeatedPrintCol := firstRepeatedPrintCol; - j := 0; - while (j <= lastCol) do + headerCols := false; + c := 0; + while (c <= lastCol) do begin - w := ASheet.GetColWidth(j); + w := ASheet.GetColWidth(c); // Convert to mm w_mm := PtsToMM(w * widthMultiplier); + if (c = firstRepeatedPrintCol) then + begin + headerCols := true; + AppendToStream(AStream, ''); + end; + // Find width in ColumnStyleList to retrieve corresponding style name styleName := ''; for k := 0 to FColumnStyleList.Count-1 do @@ -4441,22 +4461,38 @@ begin // Determine value for "number-columns-repeated" colsRepeated := 1; - k := j+1; - while (k <= lastCol) do - begin - if ASheet.GetColWidth(k) = w then - inc(colsRepeated) - else - break; - inc(k); - end; + k := c+1; + if headerCols then + while (k <= lastCol) and (k <= lastRepeatedPrintCol) do + begin + if ASheet.GetColWidth(k) = w then + inc(colsRepeated) + else + break; + inc(k); + end + else + while (k <= lastCol) do + begin + if ASheet.GetColWidth(k) = w then + inc(colsRepeated) + else + break; + inc(k); + end; colsRepeatedStr := IfThen(colsRepeated = 1, '', Format(' table:number-columns-repeated="%d"', [colsRepeated])); AppendToStream(AStream, Format( '', [styleName, colsRepeatedStr])); - j := j + colsRepeated; + if headerCols and (k-1 = lastRepeatedPrintCol) then + begin + AppendToStream(AStream, ''); + headerCols := false; + end; + + c := c + colsRepeated; end; end; @@ -4617,6 +4653,84 @@ begin defFnt.Free; end; +{ + + + } + +procedure TsSpreadOpenDocWriter.WriteNamedExpressions(AStream: TStream; + ASheet: TsWorksheet); +var + stotal, srng: String; + j: Integer; + prng: TsCellRange; +begin + stotal := ''; + + // Cell block of print range + srng := ''; + for j := 0 to ASheet.NumPrintRanges - 1 do + begin + prng := ASheet.GetPrintRange(j); + srng := srng + ';' + Format('[$%s.%s]', [ + ASheet.Name, GetCellRangeString(prng.Row1, prng.Col1, prng.Row2, prng.Col2, []) + ]); + end; + if srng <> '' then + begin + Delete(srng, 1, 1); + stotal := stotal + Format( + '', + [ASheet.Name, srng] + ); + end; + + // Next commented part appears only in files converted from Excel + + { + // repeated columns ... + srng := ''; + if ASheet.PageLayout.RepeatedCols.FirstIndex <> UNASSIGNED_ROW_COL_INDEX then + begin + if ASheet.PageLayout.RepeatedCols.LastIndex = UNASSIGNED_ROW_COL_INDEX then + srng := srng + ';' + Format('[$%s.$%s]', + [ASheet.Name, GetColString(ASheet.pageLayout.RepeatedCols.FirstIndex)] + ) + else + srng := srng + ';' + Format('[$%s.$%s1:.$%s1048576]', [ // [$Sheet1.$A$1:.$D$1048576] + ASheet.Name, + GetColString(ASheet.Pagelayout.RepeatedCols.FirstIndex), + GetColString(ASheet.PageLayout.RepeatedCols.LastIndex) + ]); + end; + // ... and repeated rows + if ASheet.PageLayout.RepeatedRows.FirstIndex <> UNASSIGNED_ROW_COL_INDEX then + begin + if ASheet.PageLayout.RepeatedRows.LastIndex = UNASSIGNED_ROW_COL_INDEX then + srng := srng + ';' + Format('[$%s.$%d]', + [ASheet.Name, ASheet.pageLayout.RepeatedRows.FirstIndex] + ) + else + srng := srng + ';' + Format('[$%s.$A$%d:.$AMJ$%d]', [ // [$Sheet1.$A$1:.$AMJ$2]" + ASheet.Name, + ASheet.Pagelayout.RepeatedRows.FirstIndex+1, + ASheet.PageLayout.RepeatedRows.LastIndex+1 + ]); + end; + if srng <> '' then begin + Delete(srng, 1,1); + stotal := stotal + Format( + '', + [ASheet.Name, srng] + ); + end; + } + // Write to stream if any defined names exist + if stotal <> '' then + AppendtoStream(AStream, + '' + stotal + ''); +end; + procedure TsSpreadOpenDocWriter.WriteNumFormats(AStream: TStream); var i, p: Integer; @@ -4657,20 +4771,38 @@ var colsRepeatedStr: String; rowsRepeatedStr: String; firstCol, firstRow, lastCol, lastRow: Cardinal; + firstRepeatedPrintRow, lastRepeatedPrintRow: Cardinal; rowStyleData: TRowStyleData; defFontSize: Single; emptyRowsAbove: Boolean; + headerRows: Boolean; begin // some abbreviations... defFontSize := Workbook.GetFont(0).Size; GetSheetDimensions(ASheet, firstRow, lastRow, firstCol, lastCol); emptyRowsAbove := firstRow > 0; + headerRows := false; + firstRepeatedPrintRow := ASheet.PageLayout.RepeatedRows.FirstIndex; + lastRepeatedPrintRow := ASheet.PageLayout.RepeatedRows.LastIndex; + if (firstRepeatedPrintRow <> UNASSIGNED_ROW_COL_INDEX) and + (lastRepeatedPrintRow = UNASSIGNED_ROW_COL_INDEX) + then + lastRepeatedPrintRow := firstRepeatedPrintRow; + // Now loop through all rows r := firstRow; while (r <= lastRow) do begin rowsRepeated := 1; + + // Header rows need a special tag + if (r = firstRepeatedPrintRow) then + begin + AppendToStream(AStream, ''); + headerRows := true; + end; + // Look for the row style of the current row (r) row := ASheet.FindRow(r); if row = nil then @@ -4738,6 +4870,14 @@ begin [styleName, rowsRepeatedStr, colsRepeatedStr])); r := rr; + + // Header rows need a special tag + if headerRows and (r-1 = lastRepeatedPrintRow) then + begin + AppendToStream(AStream, ''); + headerRows := false; + end; + continue; end; @@ -4788,6 +4928,13 @@ begin AppendToStream(AStream, ''); + // Header rows need a special tag + if headerRows and (r = lastRepeatedPrintRow) then + begin + AppendToStream(AStream, ''); + headerRows := false; + end; + // Next row inc(r, rowsRepeated); end; @@ -5453,6 +5600,32 @@ begin ''; end; +function TsSpreadOpenDocWriter.WritePrintRangesAsXMLString(ASheet: TsWorksheet): String; +var + i: Integer; + rng: TsCellRange; + srng: String; +begin + if ASheet.NumPrintRanges > 0 then + begin + srng := ''; + for i := 0 to ASheet.NumPrintRanges - 1 do + begin + rng := ASheet.GetPrintRange(i); + Result := Result + ' ' + Format('%s.%s:%s.%s', [ + ASheet.Name, GetCellString(rng.Row1,rng.Col1), + ASheet.Name, GetCellString(rng.Row2,rng.Col2) + ]); + end; + if Result <> '' then + begin + Delete(Result, 1, 1); + Result := 'table:print-ranges="' + Result + '"'; + end; + end else + Result := ''; +end; + procedure TsSpreadOpenDocWriter.WriteTableSettings(AStream: TStream); var i: Integer; diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index a41c844e7..62376c572 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -127,6 +127,7 @@ type FDefaultRowHeight: Single; // in "character heights", i.e. line count FSortParams: TsSortParams; // Parameters of the current sorting operation FBiDiMode: TsBiDiMode; + FPrintRanges: TsCellRangeArray; FOnChangeCell: TsCellEvent; FOnChangeFont: TsCellEvent; FOnCompareCells: TsCellCompareEvent; @@ -488,6 +489,16 @@ type procedure UnmergeCells(ARow, ACol: Cardinal); overload; procedure UnmergeCells(ARange: String); overload; + // Print ranges + function AddPrintRange(ARow1, ACol1, ARow2, ACol2: Cardinal): Integer; overload; + function AddPrintRange(const ARange: TsCellRange): Integer; overload; + function GetPrintRange(AIndex: Integer): TsCellRange; + function NumPrintRanges: Integer; + procedure RemovePrintRange(AIndex: Integer); + + procedure SetRepeatedPrintCols(AFirstCol: Cardinal; ALastCol: Cardinal = UNASSIGNED_ROW_COL_INDEX); + procedure SetRepeatedPrintRows(AFirstRow: Cardinal; ALastRow: Cardinal = UNASSIGNED_ROW_COL_INDEX); + // Notification of changed cells procedure ChangedCell(ARow, ACol: Cardinal); procedure ChangedFont(ARow, ACol: Cardinal); @@ -3278,6 +3289,91 @@ begin Result := (ACell <> nil) and (cfMerged in ACell^.Flags); end; +{@@ ---------------------------------------------------------------------------- + Adds a print range defined by the row/column indexes of its corner cells. +-------------------------------------------------------------------------------} +function TsWorksheet.AddPrintRange(ARow1, ACol1, ARow2, ACol2: Cardinal): Integer; +begin + Result := Length(FPrintRanges); + SetLength(FPrintRanges, Result + 1); + with FPrintRanges[Result] do + begin + Row1 := ARow1; + Col1 := ACol1; + Row2 := ARow2; + Col2 := ACol2; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Adds a print range defined by a TsCellRange record +-------------------------------------------------------------------------------} +function TsWorksheet.AddPrintRange(const ARange: TsCellRange): Integer; +begin + Result := AddPrintRange(ARange.Row1, ARange.Col1, ARange.Row2, ARange.Col2); +end; + +{@@ ---------------------------------------------------------------------------- + Returns the TsCellRange record of the print range with the specified index. +-------------------------------------------------------------------------------} +function TsWorksheet.GetPrintRange(AIndex: Integer): TsCellRange; +begin + Result := FPrintRanges[AIndex]; +end; + +{@@ ---------------------------------------------------------------------------- + Returns the count of print ranges defined for this worksheet +-------------------------------------------------------------------------------} +function TsWorksheet.NumPrintRanges: Integer; +begin + Result := Length(FPrintRanges); +end; + +{@@ ---------------------------------------------------------------------------- + Removes the print range specified by the index +-------------------------------------------------------------------------------} +procedure TsWorksheet.RemovePrintRange(AIndex: Integer); +var + i: Integer; +begin + if not InRange(AIndex, 0, High(FPrintRanges)) then exit; + for i := AIndex + 1 to High(FPrintRanges) do + FPrintRanges[i - 1] := FPrintRanges[i]; + SetLength(FPrintRanges, Length(FPrintRanges)-1); +end; + +{@@ ---------------------------------------------------------------------------- + Defines a range of header columns for printing repeated on every page +-------------------------------------------------------------------------------} +procedure TsWorksheet.SetRepeatedPrintCols(AFirstCol, ALastCol: Cardinal); +begin + if AFirstCol < ALastCol then + begin + PageLayout.RepeatedCols.FirstIndex := AFirstCol; + PageLayout.RepeatedCols.LastIndex := ALastCol; + end else + begin + PageLayout.RepeatedCols.FirstIndex := ALastCol; + PageLayout.RepeatedCols.LastIndex := AFirstCol; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Defines a range of header rows for printing repeated on every page +-------------------------------------------------------------------------------} +procedure TsWorksheet.SetRepeatedPrintRows(AFirstRow, ALastRow: Cardinal); +begin + if AFirstRow < ALastRow then + begin + PageLayout.RepeatedRows.FirstIndex := AFirstRow; + PageLayout.RepeatedRows.LastIndex := ALastRow; + end else + begin + PageLayout.RepeatedRows.FirstIndex := ALastRow; + PageLayout.RepeatedRows.LastIndex := AFirstRow; + end; +end; + {@@ ---------------------------------------------------------------------------- Removes the comment from a cell and releases the memory occupied by the node. -------------------------------------------------------------------------------} diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas index 0015cd559..397aae0c0 100644 --- a/components/fpspreadsheet/fpstypes.pas +++ b/components/fpspreadsheet/fpstypes.pas @@ -560,7 +560,7 @@ type Row, Col: Cardinal; end; - {@@ Record combining row and column cornder indexes of a range of cells } + {@@ Record combining row and column corner indexes of a range of cells } TsCellRange = record Row1, Col1, Row2, Col2: Cardinal; end; @@ -569,6 +569,11 @@ type {@@ Array with cell ranges } TsCellRangeArray = array of TsCellRange; + {@@ Record containing limiting indexes of column or row range } + TsRowColRange = record + FirstIndex, LastIndex: Cardinal; + end; + {@@ Options for sorting } TsSortOption = (ssoDescending, ssoCaseInsensitive); {@@ Set of options for sorting } @@ -705,6 +710,8 @@ type Array index 1 contains the strings if these options are not used. } Headers: array[0..2] of string; Footers: array[0..2] of string; + RepeatedCols: TsRowColRange; + RepeatedRows: TsRowColRange; end; {@@ Pointer to a page layout record } diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 9a0165255..57aac16db 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -172,6 +172,8 @@ function SameFont(AFont1, AFont2: TsFont): Boolean; overload; function SameFont(AFont: TsFont; AFontName: String; AFontSize: Single; AStyle: TsFontStyles; AColor: TsColor; APos: TsFontPosition): Boolean; overload; +function Range(ARow1, ACol1, ARow2, ACol2: Cardinal): TsCellRange; + //function GetUniqueTempDir(Global: Boolean): String; procedure AppendToStream(AStream: TStream; const AString: String); inline; overload; @@ -2127,6 +2129,10 @@ begin Options := []; for i:=0 to 2 do Headers[i] := ''; for i:=0 to 2 do Footers[i] := ''; + RepeatedRows.FirstIndex := UNASSIGNED_ROW_COL_INDEX; + RepeatedRows.LastIndex := UNASSIGNED_ROW_COL_INDEX; + RepeatedCols.FirstIndex := UNASSIGNED_ROW_COL_INDEX; + RepeatedCols.LastIndex := UNASSIGNED_ROW_COL_INDEX; end; end; @@ -2238,6 +2244,15 @@ begin (AFont.Color = AColor) and (AFont.Position = APos); end; + +function Range(ARow1, ACol1, ARow2, ACol2: Cardinal): TsCellRange; +begin + Result.Row1 := ARow1; + Result.Col1 := ACol1; + Result.Row2 := ARow2; + Result.Col2 := ACol2; +end; + (* {@@ ---------------------------------------------------------------------------- Constructs a string of length "Len" containing random uppercase characters diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index eaa297230..2376419f0 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -128,6 +128,7 @@ type procedure WriteBorderList(AStream: TStream); procedure WriteCols(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteComments(AWorksheet: TsWorksheet); + procedure WriteDefinedNames(AStream: TStream); procedure WriteDimension(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteFillList(AStream: TStream); procedure WriteFont(AStream: TStream; AFont: TsFont; UseInStyleNode: Boolean); @@ -251,6 +252,7 @@ const {%H-}MIME_XML = 'application/xml'; MIME_RELS = 'application/vnd.openxmlformats-package.relationships+xml'; MIME_OFFICEDOCUMENT = 'application/vnd.openxmlformats-officedocument'; + MIME_CORE = 'application/vnd.openxmlformats-package.core-properties+xml'; MIME_SPREADML = MIME_OFFICEDOCUMENT + '.spreadsheetml'; MIME_SHEET = MIME_SPREADML + '.sheet.main+xml'; MIME_WORKSHEET = MIME_SPREADML + '.worksheet+xml'; @@ -3349,6 +3351,7 @@ begin '' + '' + ''); + AppendToStream(FSWorkbook, ''); for counter:=1 to Workbook.GetWorksheetCount do @@ -3357,6 +3360,9 @@ begin [Workbook.GetWorksheetByIndex(counter-1).Name, counter, counter])); AppendToStream(FSWorkbook, ''); + + WriteDefinedNames(FSWorkbook); + AppendToStream(FSWorkbook, ''); AppendToStream(FSWorkbook, @@ -3421,10 +3427,81 @@ begin ''); AppendToStream(FSContentTypes, ''); + { + AppendToStream(FSContentTypes, + ''); + } AppendToStream(FSContentTypes, ''); end; +procedure TsSpreadOOXMLWriter.WriteDefinedNames(AStream: TStream); +var + sheet: TsWorksheet; + stotal, srng: String; + i, j: Integer; + prng: TsCellRange; + firstIndex, lastIndex: Integer; +begin + stotal := ''; + + // Write print ranges and repeatedly printed rows and columns + for i := 0 to Workbook.GetWorksheetCount-1 do + begin + sheet := Workbook.GetWorksheetByIndex(i); + + // Cell block of print range + srng := ''; + for j := 0 to sheet.numPrintRanges - 1 do + begin + prng := sheet.GetPrintRange(j); +// prng.Col2 := Min(prng.Col2, sheet.GetLastColIndex); +// prng.Row2 := Min(prng.Row2, sheet.GetLastColIndex); + srng := srng + ',' + Format('%s!%s', [ + sheet.Name, GetCellRangeString(prng.Row1, prng.Col1, prng.Row2, prng.Col2, []) + ]); + end; + if srng <> '' then + begin + Delete(srng, 1, 1); + stotal := stotal + Format( + '%s', + [i, srng] + ); + end; + + // repeated columns ... + srng := ''; + if sheet.PageLayout.RepeatedCols.FirstIndex <> UNASSIGNED_ROW_COL_INDEX then + begin + firstindex := sheet.PageLayout.RepeatedCols.FirstIndex; + lastindex := IfThen(sheet.PageLayout.RepeatedCols.LastIndex = UNASSIGNED_ROW_COL_INDEX, + firstindex, sheet.PageLayout.RepeatedCols.LastIndex); + srng := srng + ',' + Format('%s!$%s:$%s', [sheet.Name, GetColString(firstindex), GetColString(lastindex)]); + end; + // ... and repeated rows + if sheet.PageLayout.RepeatedRows.FirstIndex <> UNASSIGNED_ROW_COL_INDEX then + begin + firstindex := sheet.PageLayout.RepeatedRows.FirstIndex; + lastindex := IfThen(sheet.PageLayout.RepeatedRows.LastIndex = UNASSIGNED_ROW_COL_INDEX, + firstindex, sheet.PageLayout.RepeatedRows.LastIndex); + srng := srng + ',' + Format('%s!$%d:$%d', [sheet.Name, firstindex+1, lastindex+1]); + end; + if srng <> '' then begin + Delete(srng, 1,1); + stotal := stotal + Format( + '%s', + [i, srng] + ); + end; + end; + + // Write to stream if any defined names exist + if stotal <> '' then + AppendtoStream(FSWorkbook, + '' + stotal + ''); +end; + procedure TsSpreadOOXMLWriter.WriteWorksheet(AWorksheet: TsWorksheet); begin FCurSheetNum := Length(FSSheets);