diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 9d6305d0f..589311952 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -493,6 +493,8 @@ type FLeftPaneWidth: Integer; FTopPaneHeight: Integer; FOptions: TsSheetOptions; + FFirstRowIndex: Cardinal; + FFirstColIndex: Cardinal; FLastRowIndex: Cardinal; FLastColIndex: Cardinal; FOnChangeCell: TsCellEvent; @@ -620,16 +622,24 @@ type procedure WriteBorderStyles(ARow, ACol: Cardinal; const AStyles: TsCellBorderStyles); overload; procedure WriteBorderStyles(ACell: PCell; const AStyles: TsCellBorderStyles); overload; + procedure WriteDateTimeFormat(ARow, ACol: Cardinal; ANumberFormat: TsNumberFormat; + const AFormatString: String = ''); overload; + procedure WriteDateTimeFormat(ACell: PCell; ANumberFormat: TsNumberFormat; + const AFormatString: String = ''); overload; + procedure WriteDecimals(ARow, ACol: Cardinal; ADecimals: byte); overload; procedure WriteDecimals(ACell: PCell; ADecimals: Byte); overload; function WriteFont(ARow, ACol: Cardinal; const AFontName: String; AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; overload; + function WriteFont(ACell: PCell; const AFontName: String; + AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; overload; procedure WriteFont(ARow, ACol: Cardinal; AFontIndex: Integer); overload; function WriteFontColor(ARow, ACol: Cardinal; AFontColor: TsColor): Integer; function WriteFontName(ARow, ACol: Cardinal; AFontName: String): Integer; function WriteFontSize(ARow, ACol: Cardinal; ASize: Single): Integer; - function WriteFontStyle(ARow, ACol: Cardinal; AStyle: TsFontStyles): Integer; + function WriteFontStyle(ARow, ACol: Cardinal; AStyle: TsFontStyles): Integer; overload; + function WriteFontStyle(ACell: PCell; AStyle: TsFontStyles): Integer; overload; procedure WriteHorAlignment(ARow, ACol: Cardinal; AValue: TsHorAlignment); @@ -666,8 +676,10 @@ type function GetNextCell(): PCell; function GetFirstCellOfRow(ARow: Cardinal): PCell; function GetLastCellOfRow(ARow: Cardinal): PCell; + function GetFirstColIndex(AForceCalculation: Boolean = false): Cardinal; function GetLastColIndex(AForceCalculation: Boolean = false): Cardinal; function GetLastColNumber: Cardinal; deprecated 'Use GetLastColIndex'; + function GetFirstRowIndex(AForceCalculation: Boolean = false): Cardinal; function GetLastRowIndex(AForceCalculation: Boolean = false): Cardinal; function GetLastRowNumber: Cardinal; deprecated 'Use GetLastRowIndex'; @@ -1573,6 +1585,8 @@ begin FRows := TIndexedAVLTree.Create(@CompareRows); FCols := TIndexedAVLTree.Create(@CompareCols); + FFirstRowIndex := $FFFFFFFF; + FFirstColIndex := $FFFFFFFF; FLastRowIndex := 0; FLastColIndex := 0; @@ -1923,6 +1937,10 @@ begin Result^.BorderStyles := DEFAULT_BORDERSTYLES; Cells.Add(Result); + if FFirstColIndex = $FFFFFFFF then FFirstColIndex := GetFirstColIndex(true) + else FFirstColIndex := Min(FFirstColIndex, ACol); + if FFirstRowIndex = $FFFFFFFF then FFirstRowIndex := GetFirstRowIndex(true) + else FFirstRowIndex := Min(FFirstRowIndex, ARow); if FLastColIndex = 0 then FLastColIndex := GetLastColIndex(true) else FLastColIndex := Max(FLastColIndex, ACol); if FLastRowIndex = 0 then FLastRowIndex := GetLastRowIndex(true) @@ -2055,6 +2073,46 @@ begin else Result := nil; end; +{@@ + Returns the 0-based index of the first column with a cell with contents. + + If no cells have contents, zero will be returned, which is also a valid value. + + Use GetCellCount to verify if there is at least one cell with contents in the + worksheet. + + @param AForceCalculation The index of the first column is continuously updated + whenever a new cell is created. If AForceCalculation + is true all cells are scanned to determine the index + of the first column. + @see GetCellCount +} +function TsWorksheet.GetFirstColIndex(AForceCalculation: Boolean = false): Cardinal; +var + AVLNode: TAVLTreeNode; + i: Integer; +begin + if AForceCalculation then begin + Result := $FFFFFFFF; + // Traverse the tree from lowest to highest. + // Since tree primary sort order is on row lowest col could exist anywhere. + AVLNode := FCells.FindLowest; + While Assigned(AVLNode) do begin + Result := Math.Min(Result, PCell(AVLNode.Data)^.Col); + AVLNode := FCells.FindSuccessor(AVLNode); + end; + // In addition, there may be column records defining the column width even + // without content + for i:=0 to FCols.Count-1 do + if FCols[i] <> nil then + Result := Math.Min(Result, PCol(FCols[i])^.Col); + // Store the result + FFirstColIndex := Result; + end + else + Result := FFirstColIndex; +end; + {@@ Returns the 0-based index of the last column with a cell with contents. @@ -2145,6 +2203,41 @@ begin end; end; +{@@ + Returns the 0-based index of the first row with a cell with contents. + + If no cells have contents, zero will be returned, which is also a valid value. + + Use GetCellCount to verify if there is at least one cell with contents in the + worksheet. + + @param AForceCalculation The index of the first row is continuously updated + whenever a new cell is created. If AForceCalculation + is true all cells are scanned to determine the index + of the first row. + @see GetCellCount +} +function TsWorksheet.GetFirstRowIndex(AForceCalculation: Boolean = false): Cardinal; +var + AVLNode: TAVLTreeNode; + i: Integer; +begin + if AForceCalculation then begin + Result := $FFFFFFFF; + AVLNode := FCells.FindLowest; + if Assigned(AVLNode) then + Result := PCell(AVLNode.Data).Row; + // In addition, there may be row records even for rows without cells. + for i:=0 to FRows.Count-1 do + if FRows[i] <> nil then + Result := Math.Min(Result, PRow(FRows[i])^.Row); + // Store result + FFirstRowIndex := Result; + end + else + Result := FFirstRowIndex +end; + {@@ Returns the 0-based index of the last row with a cell with contents. @@ -2620,6 +2713,8 @@ end; } procedure TsWorksheet.UpdateCaches; begin + FFirstColIndex := GetFirstColIndex(true); + FFirstRowIndex := GetFirstRowIndex(true); FLastColIndex := GetLastColIndex(true); FLastRowIndex := GetLastRowIndex(true); end; @@ -3164,6 +3259,62 @@ begin WriteDateTime(ACell, AValue, nfCustom, AFormatStr); end; + + +{@@ + Adds a date/time format to the formatting of a cell + + @param ARow The row of the cell + @param ACol The column of the cell + @param ANumberFormat Identifier of the format to be applied (nfXXXX constant) + @param AFormatString optional string of formatting codes. Is only considered + if ANumberFormat is nfCustom. + + @see TsNumberFormat +} +procedure TsWorksheet.WriteDateTimeFormat(ARow, ACol: Cardinal; + ANumberFormat: TsNumberFormat; const AFormatString: String = ''); +begin + WriteDateTimeFormat(GetCell(ARow, ACol), ANumberFormat, AFormatString); +end; + +{@@ + Adds a date/time format to the formatting of a cell + + @param ACell Pointer to the cell considered + @param ANumberFormat Identifier of the format to be applied (nxXXXX constant) + @param AFormatString optional string of formatting codes. Is only considered + if ANumberFormat is nfCustom. + + @see TsNumberFormat +} +procedure TsWorksheet.WriteDateTimeFormat(ACell: PCell; + ANumberFormat: TsNumberFormat; const AFormatString: String = ''); +begin + if ACell = nil then + exit; + + if not ((ANumberFormat in [nfGeneral, nfCustom]) or IsDateTimeFormat(ANumberFormat)) then + raise Exception.Create('WriteDateTimeFormat can only be called with date/time formats.'); + + ACell^.NumberFormat := ANumberFormat; + if (ANumberFormat <> nfGeneral) then begin + Include(ACell^.UsedFormattingFields, uffNumberFormat); + if (AFormatString = '') then + ACell^.NumberFormatStr := BuildDateTimeFormatString(ANumberFormat, Workbook.FormatSettings) + else + ACell^.NumberFormatStr := AFormatString; + end else begin + Exclude(ACell^.UsedFormattingFields, uffNumberFormat); + ACell^.NumberFormatStr := ''; + end; + ChangedCell(ACell^.Row, ACell^.Col); +end; + + + + + {@@ Formats the number in a cell to show a given count of decimal places. Is ignored for non-decimal formats (such as most date/time formats). @@ -3401,16 +3552,36 @@ end; } function TsWorksheet.WriteFont(ARow, ACol: Cardinal; const AFontName: String; AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; -var - lCell: PCell; begin - lCell := GetCell(ARow, ACol); - Include(lCell^.UsedFormattingFields, uffFont); + Result := WriteFont(GetCell(ARow, ACol), AFontName, AFontSize, AFontStyle, AFontColor); +end; + +{@@ + Adds font specification to the formatting of a cell. Looks in the workbook's + FontList and creates an new entry if the font is not used so far. Returns the + index of the font in the font list. + + @param ACell Pointer to the cell considered + @param AFontName Name of the font + @param AFontSize Size of the font, in points + @param AFontStyle Set with font style attributes + (don't use those of unit "graphics" !) + @return Index of the font in the workbook's font list. +} +function TsWorksheet.WriteFont(ACell: PCell; const AFontName: String; + AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; +begin + if ACell = nil then begin + Result := -1; + Exit; + end; + + Include(ACell^.UsedFormattingFields, uffFont); Result := FWorkbook.FindFont(AFontName, AFontSize, AFontStyle, AFontColor); if Result = -1 then result := FWorkbook.AddFont(AFontName, AFontSize, AFontStyle, AFontColor); - lCell^.FontIndex := Result; - ChangedFont(ARow, ACol); + ACell^.FontIndex := Result; + ChangedFont(ACell^.Row, ACell^.Col); end; {@@ @@ -3513,13 +3684,33 @@ end; } function TsWorksheet.WriteFontStyle(ARow, ACol: Cardinal; AStyle: TsFontStyles): Integer; +begin + Result := WriteFontStyle(GetCell(ARow, ACol), AStyle); +end; + +{@@ + Replaces the font style (bold, italic, etc) in formatting of a cell. + Looks in the workbook's font list if this modified font has already been used. + If not a new font entry is created. + Returns the index of this font in the font list. + + @param ACell Pointer to the cell considered + @param AStyle New font style to be used + @return Index of the font in the workbook's font list. + + @see TsFontStyle +} +function TsWorksheet.WriteFontStyle(ACell: PCell; AStyle: TsFontStyles): Integer; var - lCell: PCell; fnt: TsFont; begin - lCell := GetCell(ARow, ACol); - fnt := Workbook.GetFont(lCell^.FontIndex); - Result := WriteFont(ARow, ACol, fnt.FontName, fnt.Size, AStyle, fnt.Color); + if ACell = nil then begin + Result := -1; + exit; + end; + + fnt := Workbook.GetFont(ACell^.FontIndex); + Result := WriteFont(ACell, fnt.FontName, fnt.Size, AStyle, fnt.Color); end; {@@ @@ -3893,7 +4084,7 @@ var begin Result := 0; h0 := Workbook.GetDefaultFontSize; - for col := 0 to GetLastColIndex do begin + for col := GetFirstColIndex to GetLastColIndex do begin cell := FindCell(ARow, col); if cell <> nil then Result := Max(Result, Workbook.GetFont(cell^.FontIndex).Size / h0); @@ -3972,10 +4163,12 @@ begin FillChar(Result^, SizeOf(TCol), #0); Result^.Col := ACol; FCols.Add(Result); - if FLastColIndex = 0 then - FLastColIndex := GetLastColIndex(true) - else - FLastColIndex := Max(FLastColIndex, ACol); + if FFirstColIndex = 0 + then FFirstColIndex := GetFirstColIndex(true) + else FFirstColIndex := Min(FFirstColIndex, ACol); + if FLastColIndex = 0 + then FLastColIndex := GetLastColIndex(true) + else FLastColIndex := Max(FLastColIndex, ACol); end; end; diff --git a/components/fpspreadsheet/tests/optiontests.pas b/components/fpspreadsheet/tests/optiontests.pas index 524907405..0e2b8da8b 100644 --- a/components/fpspreadsheet/tests/optiontests.pas +++ b/components/fpspreadsheet/tests/optiontests.pas @@ -75,6 +75,11 @@ type procedure TestWriteRead_OOXML_ShowGridLines_HideHeaders; procedure TestWriteRead_OOXML_HideGridLines_ShowHeaders; procedure TestWriteRead_OOXML_HideGridLines_HideHeaders; + + procedure TestWriteRead_OOXML_Panes_HorVert; + procedure TestWriteRead_OOXML_Panes_Hor; + procedure TestWriteRead_OOXML_Panes_Vert; + procedure TestWriteRead_OOXML_Panes_None; end; implementation @@ -358,6 +363,27 @@ begin TestWriteReadPanes(sfOpenDocument, 0, 0); end; +{ Tests for OOXML frozen panes } +procedure TSpreadWriteReadOptionsTests.TestWriteRead_OOXML_Panes_HorVert; +begin + TestWriteReadPanes(sfOOXML, 1, 2); +end; + +procedure TSpreadWriteReadOptionsTests.TestWriteRead_OOXML_Panes_Hor; +begin + TestWriteReadPanes(sfOOXML, 1, 0); +end; + +procedure TSpreadWriteReadOptionsTests.TestWriteRead_OOXML_Panes_Vert; +begin + TestWriteReadPanes(sfOOXML, 0, 2); +end; + +procedure TSpreadWriteReadOptionsTests.TestWriteRead_OOXML_Panes_None; +begin + TestWriteReadPanes(sfOOXML, 0, 0); +end; + initialization RegisterTest(TSpreadWriteReadOptionsTests); diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index 838967da3..db7d4b595 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -2676,6 +2676,7 @@ var lCell: TCell; value: variant; styleCell: PCell; + begin for r := 0 to Workbook.VirtualRowCount-1 do begin for c := 0 to Workbook.VirtualColCount-1 do begin @@ -2693,12 +2694,10 @@ begin lCell.ContentType := cctNumber; lCell.NumberValue := value; end else - { - if VarIsDateTime(value) then begin - lCell.ContentType := cctNumber; - lCell.DateTimeValue := value; + if VarType(value) = varDate then begin + lCell.ContentType := cctDateTime; + lCell.DateTimeValue := StrToDate(VarToStr(value), Workbook.FormatSettings); end else - } if VarIsStr(value) then begin lCell.ContentType := cctUTF8String; lCell.UTF8StringValue := VarToStrDef(value, ''); diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 53b04d4b6..c3820c41b 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -112,11 +112,13 @@ type procedure ListAllFills; procedure ResetStreams; procedure WriteBorderList(AStream: TStream); - procedure WriteCols(AStream: TStream; ASheet: TsWorksheet); + procedure WriteCols(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteFillList(AStream: TStream); procedure WriteFontList(AStream: TStream); procedure WriteNumFormatList(AStream: TStream); procedure WritePalette(AStream: TStream); + procedure WriteSheetData(AStream: TStream; AWorksheet: TsWorksheet); + procedure WriteSheetViews(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteStyleList(AStream: TStream; ANodeName: String); protected { Streams with the contents of files } @@ -133,7 +135,7 @@ type { Routines to write the files } procedure WriteGlobalFiles; procedure WriteContent; - procedure WriteWorksheet(CurSheet: TsWorksheet); + procedure WriteWorksheet(AWorksheet: TsWorksheet); protected { Record writing methods } //todo: add WriteDate @@ -153,7 +155,7 @@ type implementation uses - variants, fileutil, fpsStreams, fpsNumFormatParser; + variants, fileutil, StrUtils, fpsStreams, fpsNumFormatParser; const { OOXML general XML constants } @@ -1018,12 +1020,25 @@ end; procedure TsSpreadOOXMLReader.ReadSheetViews(ANode: TDOMNode; AWorksheet: TsWorksheet); var sheetViewNode: TDOMNode; + childNode: TDOMNode; nodeName: String; s: String; begin if ANode = nil then exit; + +{ +'' + + ''+ + '' + + '' + + '' + + '' + + '' + +'', [ +} + sheetViewNode := ANode.FirstChild; while Assigned(sheetViewNode) do begin nodeName := sheetViewNode.NodeName; @@ -1034,6 +1049,22 @@ begin s := GetAttrValue(sheetViewNode, 'showRowColHeaders'); if s = '0' then AWorksheet.Options := AWorksheet.Options - [soShowHeaders]; + + childNode := sheetViewNode.FirstChild; + while Assigned(childNode) do begin + nodeName := childNode.NodeName; + if nodeName = 'pane' then begin + s := GetAttrValue(childNode, 'state'); + if s = 'frozen' then begin + AWorksheet.Options := AWorksheet.Options + [soHasFrozenPanes]; + s := GetAttrValue(childNode, 'xSplit'); + if s <> '' then AWorksheet.LeftPaneWidth := StrToInt(s); + s := GetAttrValue(childNode, 'ySplit'); + if s <> '' then AWorksheet.TopPaneHeight := StrToInt(s); + end; + end; + childNode := childNode.NextSibling; + end; end; sheetViewNode := sheetViewNode.NextSibling; end; @@ -1422,19 +1453,19 @@ begin ''); end; -procedure TsSpreadOOXMLWriter.WriteCols(AStream: TStream; ASheet: TsWorksheet); +procedure TsSpreadOOXMLWriter.WriteCols(AStream: TStream; AWorksheet: TsWorksheet); var col: PCol; c: Integer; begin - if ASheet.Cols.Count = 0 then + if AWorksheet.Cols.Count = 0 then exit; AppendToStream(AStream, ''); - for c:=0 to ASheet.GetLastColIndex do begin - col := ASheet.FindCol(c); + for c:=0 to AWorksheet.GetLastColIndex do begin + col := AWorksheet.FindCol(c); if col <> nil then AppendToStream(AStream, Format( '', @@ -1580,6 +1611,175 @@ begin ''); end; +procedure TsSpreadOOXMLWriter.WriteSheetData(AStream: TStream; + AWorksheet: TsWorksheet); +var + r, c, c1, c2: Cardinal; + row: PRow; + value: Variant; + lCell: TCell; + styleCell: PCell; + AVLNode: TAVLTreeNode; + rh: String; + h0: Single; +begin + h0 := Workbook.GetDefaultFontSize; // Point size of default font + + AppendToStream(AStream, + ''); + + if (boVirtualMode in Workbook.Options) and Assigned(Workbook.OnWriteCellData) + then begin + for r := 0 to Workbook.VirtualRowCount-1 do begin + row := AWorksheet.FindRow(r); + if row <> nil then + rh := Format(' ht="%g" customHeight="1"', [ + (row^.Height + ROW_HEIGHT_CORRECTION)*h0]) + else + rh := ''; + AppendToStream(AStream, Format( + '', [r+1, Workbook.VirtualColCount, rh])); + for c := 0 to Workbook.VirtualColCount-1 do begin + InitCell(lCell); + value := varNull; + styleCell := nil; + Workbook.OnWriteCellData(Workbook, r, c, value, styleCell); + if styleCell <> nil then + lCell := styleCell^; + lCell.Row := r; + lCell.Col := c; + if VarIsNull(value) then + lCell.ContentType := cctEmpty + else + if VarIsNumeric(value) then begin + lCell.ContentType := cctNumber; + lCell.NumberValue := value; + end else + if VarType(value) = varDate then begin + lCell.ContentType := cctDateTime; + lCell.DateTimeValue := StrToDate(VarToStr(value), Workbook.FormatSettings); + end else + if VarIsStr(value) then begin + lCell.ContentType := cctUTF8String; + lCell.UTF8StringValue := VarToStrDef(value, ''); + end else + if VarIsBool(value) then begin + lCell.ContentType := cctBool; + lCell.BoolValue := value <> 0; + end; + WriteCellCallback(@lCell, AStream); + varClear(value); + end; + AppendToStream(AStream, + ''); + end; + end else + begin + // The cells need to be written in order, row by row, cell by cell + for r := 0 to AWorksheet.GetLastRowIndex do begin + // If the row has a custom height add this value to the specification + row := AWorksheet.FindRow(r); + if row <> nil then + rh := Format(' ht="%g" customHeight="1"', [ + (row^.Height + ROW_HEIGHT_CORRECTION)*h0]) + else + rh := ''; + c1 := AWorksheet.GetFirstColIndex; + c2 := AWorksheet.GetLastColIndex; + AppendToStream(AStream, Format( + '', [r+1, c1+1, c2+1, rh])); + // Write cells belonging to this row. + for c := c1 to c2 do begin + lCell.Row := r; + lCell.Col := c; + AVLNode := AWorksheet.Cells.Find(@lCell); + if Assigned(AVLNode) then + WriteCellCallback(PCell(AVLNode.Data), AStream); + end; + AppendToStream(AStream, + ''); + end; + end; + AppendToStream(AStream, + ''); +end; + +procedure TsSpreadOOXMLWriter.WriteSheetViews(AStream: TStream; + AWorksheet: TsWorksheet); +var + showGridLines: String; + showHeaders: String; + topRightCell: String; + bottomLeftCell: String; + bottomRightCell: String; +begin + // Show gridlines ? + showGridLines := IfThen(soShowGridLines in AWorksheet.Options, ' ', 'showGridLines="0" '); + + // Show headers? + showHeaders := IfThen(soShowHeaders in AWorksheet.Options, ' ', 'showRowColHeaders="0" '); + + // No frozen panes + if not (soHasFrozenPanes in AWorksheet.Options) or + ((AWorksheet.LeftPaneWidth = 0) and (AWorksheet.TopPaneHeight = 0)) + then + AppendToStream(AStream, Format( + '' + + '' + +// + '', [ + showGridLines, showHeaders + ])) + else + begin // Frozen panes + topRightCell := GetCellString(0, AWorksheet.LeftPaneWidth, [rfRelRow, rfRelCol]); + bottomLeftCell := GetCellString(AWorksheet.TopPaneHeight, 0, [rfRelRow, rfRelCol]); + bottomRightCell := GetCellString(AWorksheet.TopPaneHeight, AWorksheet.LeftPaneWidth, [rfRelRow, rfRelCol]); + if (AWorksheet.LeftPaneWidth > 0) and (AWorksheet.TopPaneHeight > 0) then + AppendToStream(AStream, Format( + '' + + ''+ + '' + + '' + + '' + + '' + + '' + + '', [ + showGridLines, showHeaders, + AWorksheet.LeftPaneWidth, AWorksheet.TopPaneHeight, bottomRightCell, + topRightCell, topRightCell, + bottomLeftCell, bottomLeftCell, + bottomRightCell, bottomrightCell + ])) + else + if (AWorksheet.LeftPaneWidth > 0) then + AppendToStream(AStream, Format( + '' + + ''+ + '' + + '' + + '' + + '', [ + showGridLines, showHeaders, + AWorksheet.LeftPaneWidth, topRightCell, + topRightCell, topRightCell + ])) + else + if (AWorksheet.TopPaneHeight > 0) then + AppendToStream(AStream, Format( + ''+ + ''+ + ''+ + '' + + ''+ + '', [ + showGridLines, showHeaders, + AWorksheet.TopPaneHeight, bottomLeftCell, + bottomLeftCell, bottomLeftCell + ])); + end; +end; + { Writes the style list which the writer has collected in FFormattingStyles. } procedure TsSpreadOOXMLWriter.WriteStyleList(AStream: TStream; ANodeName: String); var @@ -1710,7 +1910,7 @@ begin AppendToStream(FSRelsRels, Format( '', [SCHEMAS_RELS])); AppendToStream(FSRelsRels, Format( - '', [SCHEMAS_DOCUMENT])); + '', [SCHEMAS_DOCUMENT])); AppendToStream(FSRelsRels, ''); @@ -1793,8 +1993,8 @@ begin AppendToStream(FSWorkbook, ''); AppendToStream(FSWorkbook, - '', - '', + '' + + '' + ''); AppendToStream(FSWorkbook, ''); @@ -1826,63 +2026,10 @@ begin ''); end; -{ -FSheets[CurStr] := - XML_HEADER + LineEnding + - '' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' 1' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' 2' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' 3' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' 4' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' 0' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' 1' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' 2' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' 3' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ' ' + LineEnding + - ''; -} -procedure TsSpreadOOXMLWriter.WriteWorksheet(CurSheet: TsWorksheet); -var - r, c: Cardinal; - LastColIndex: Cardinal; - lCell: TCell; - AVLNode: TAVLTreeNode; - CellPosText: string; - value: Variant; - styleCell: PCell; - row: PRow; - rh: String; - h0: Single; - showGridLines: String; - showHeaders: String; +procedure TsSpreadOOXMLWriter.WriteWorksheet(AWorksheet: TsWorksheet); begin FCurSheetNum := Length(FSSheets); SetLength(FSSheets, FCurSheetNum + 1); - h0 := Workbook.GetDefaultFontSize; // Point size of default font // Create the stream if (boBufStream in Workbook.Options) then @@ -1891,117 +2038,17 @@ begin FSSheets[FCurSheetNum] := TMemoryStream.Create; // Header - if not (soShowGridLines in CurSheet.Options) then - showGridLines := 'showGridLines="0"' - else - showGridLines := ''; - - if not (soShowHeaders in CurSheet.Options) then - showHeaders := 'showRowColHeaders="0"' - else - showHeaders := ''; - AppendToStream(FSSheets[FCurSheetNum], XML_HEADER); AppendToStream(FSSheets[FCurSheetNum], Format( '', [SCHEMAS_SPREADML, SCHEMAS_DOC_RELS])); - AppendToStream(FSSheets[FCurSheetNum], - ''); - AppendToStream(FSSheets[FCurSheetNum], Format( - '', [showGridLines, showHeaders])); - AppendToStream(FSSheets[FCurSheetNum], - ''); - WriteCols(FSSheets[FCurSheetNum], CurSheet); - - AppendToStream(FSSheets[FCurSheetNum], - ''); - - if (boVirtualMode in Workbook.Options) and Assigned(Workbook.OnWriteCellData) - then begin - for r := 0 to Workbook.VirtualRowCount-1 do begin - row := CurSheet.FindRow(r); - if row <> nil then - rh := Format(' ht="%g" customHeight="1"', [ - (row^.Height + ROW_HEIGHT_CORRECTION)*h0]) - else - rh := ''; - AppendToStream(FSSheets[FCurSheetNum], Format( - '', [r+1, Workbook.VirtualColCount, rh])); - for c := 0 to Workbook.VirtualColCount-1 do begin - InitCell(lCell); - CellPosText := CurSheet.CellPosToText(r, c); - value := varNull; - styleCell := nil; - Workbook.OnWriteCellData(Workbook, r, c, value, styleCell); - if styleCell <> nil then - lCell := styleCell^; - lCell.Row := r; - lCell.Col := c; - if VarIsNull(value) then - lCell.ContentType := cctEmpty - else - if VarIsNumeric(value) then begin - lCell.ContentType := cctNumber; - lCell.NumberValue := value; - end - { - else if VarIsDateTime(value) then begin - lCell.ContentType := cctNumber; - lCell.DateTimeValue := value; - end - } - else if VarIsStr(value) then begin - lCell.ContentType := cctUTF8String; - lCell.UTF8StringValue := VarToStrDef(value, ''); - end else - if VarIsBool(value) then begin - lCell.ContentType := cctBool; - lCell.BoolValue := value <> 0; - end; - WriteCellCallback(@lCell, FSSheets[FCurSheetNum]); - varClear(value); - end; - AppendToStream(FSSheets[FCurSheetNum], - ''); - end; - end else - begin - // The cells need to be written in order, row by row, cell by cell - LastColIndex := CurSheet.GetLastColIndex; - for r := 0 to CurSheet.GetLastRowIndex do begin - // If the row has a custom height add this value to the specification - row := CurSheet.FindRow(r); - if row <> nil then - rh := Format(' ht="%g" customHeight="1"', [ - (row^.Height + ROW_HEIGHT_CORRECTION)*h0]) - else - rh := ''; - AppendToStream(FSSheets[FCurSheetNum], Format( - '', [r+1, LastColIndex+1, rh])); - // Write cells belonging to this row. - for c := 0 to LastColIndex do begin - LCell.Row := r; - LCell.Col := c; - AVLNode := CurSheet.Cells.Find(@LCell); - if Assigned(AVLNode) then - WriteCellCallback(PCell(AVLNode.Data), FSSheets[FCurSheetNum]) - else begin - CellPosText := CurSheet.CellPosToText(r, c); - AppendToStream(FSSheets[FCurSheetNum], Format( - '', [CellPosText]), - '', - ''); - end; - end; - AppendToStream(FSSheets[FCurSheetNum], - ''); - end; - end; + WriteSheetViews(FSSheets[FCurSheetNum], AWorksheet); + WriteCols(FSSheets[FCurSheetNum], AWorksheet); + WriteSheetData(FSSheets[FCurSheetNum], AWorksheet); // Footer AppendToStream(FSSheets[FCurSheetNum], - '' + ''); end;