diff --git a/components/fpspreadsheet/fpscsv.pas b/components/fpspreadsheet/fpscsv.pas index 0abd38a9f..ebcf3fa40 100644 --- a/components/fpspreadsheet/fpscsv.pas +++ b/components/fpspreadsheet/fpscsv.pas @@ -159,7 +159,7 @@ begin // Do not try to interpret the strings. --> everything is a LABEL cell. if not CSVParams.DetectContentType then begin - FWorksheet.WriteUTF8Text(cell, AText); + FWorksheet.WriteText(cell, AText); exit; end; @@ -192,7 +192,7 @@ begin end; // What is left is handled as a TEXT cell - FWorksheet.WriteUTF8Text(cell, AText); + FWorksheet.WriteText(cell, AText); end; procedure TsCSVReader.ReadFormula(AStream: TStream); diff --git a/components/fpspreadsheet/fpsheaderfooterparser.pas b/components/fpspreadsheet/fpsheaderfooterparser.pas index 8a967a208..a968b7b97 100644 --- a/components/fpspreadsheet/fpsheaderfooterparser.pas +++ b/components/fpspreadsheet/fpsheaderfooterparser.pas @@ -9,7 +9,8 @@ uses type TsHeaderFooterToken = (hftText, hftNewLine, - hftSheetName, hftPath, hftFileName, hftDate, hftTime, hftPage, hftPageCount); + hftSheetName, hftPath, hftFileName, hftDate, hftTime, hftPage, hftPageCount, + hftImage); TsHeaderFooterFontStyle = (hfsBold, hfsItalic, hfsUnderline, hfsDblUnderline, hfsStrikeout, hfsShadow, hfsOutline, hfsSubscript, hfsSuperScript); @@ -36,8 +37,6 @@ type FontIndex: Integer; end; - TsHeaderFooterSectionIndex = (hfsLeft, hfsCenter, hfsRight); - TsHeaderFooterSection = array of TsHeaderFooterElement; TsHeaderFooterSections = array[TsHeaderFooterSectionIndex] of TsHeaderFooterSection; @@ -50,6 +49,7 @@ type FStart: PChar; FEnd: PChar; FCurrFont: TsHeaderFooterFont; + FIgnoreFonts: Boolean; function NextToken: Char; function PrevToken: Char; procedure ScanFont; @@ -77,10 +77,12 @@ type procedure UseSection(AIndex: TsHeaderFooterSectionIndex); virtual; public constructor Create; overload; + constructor Create(AText: String); overload; constructor Create(AText: String; AFontList: TList; ADefaultFont: TsHeaderFooterFont); overload; destructor Destroy; override; function BuildHeaderFooter: String; + function IsImageInSection(ASection: TsHeaderFooterSectionIndex): Boolean; property Sections:TsHeaderFooterSections read FSections; end; @@ -150,6 +152,14 @@ begin FCurrText := ''; end; +constructor TsHeaderFooterParser.Create(AText: String); +begin + Create; + FParseText := AText; + FIgnoreFonts := true; + Parse; +end; + constructor TsHeaderFooterParser.Create(AText: String; AFontList: TList; ADefaultFont: TsHeaderFooterFont); begin @@ -160,6 +170,7 @@ begin Create; + FIgnoreFonts := false; FFontList := AFontList; FDefaultFont := ADefaultFont; FCurrFont := TsHeaderFooterFont.Create; @@ -195,7 +206,7 @@ begin FCurrText := ''; end else TextValue := ''; - FontIndex := GetCurrFontIndex; + if FIgnoreFonts then FontIndex := -1 else FontIndex := GetCurrFontIndex; end; end; @@ -274,6 +285,7 @@ begin hftTime : Result := Result + '&T'; hftPage : Result := Result + '&P'; hftPageCount : Result := Result + '&N'; + hftImage : Result := Result + '&G'; hftNewLine : Result := Result + LineEnding; end; end; // for element @@ -310,6 +322,17 @@ begin end; end; +function TsHeaderFooterParser.IsImageInSection( + ASection: TsHeaderFooterSectionIndex): Boolean; +var + element: TsHeaderFooterElement; +begin + Result := true; + for element in FSections[ASection] do + if element.Token = hftImage then exit; + Result := false; +end; + function TsHeaderFooterParser.NextToken: Char; begin if FCurrent < FEnd then begin @@ -438,6 +461,7 @@ begin 'T': AddElement(hftTime); 'P': AddElement(hftPage); 'N': AddElement(hftPageCount); + 'G': AddElement(hftImage); '"': ScanFont; '0'..'9', '.': ScanFontSize; 'K': ScanFontColor; @@ -458,10 +482,13 @@ procedure TsHeaderFooterParser.UseSection(AIndex: TsHeaderFooterSectionIndex); begin if FCurrText <> '' then AddCurrTextElement; - FCurrFont.FontName := FDefaultFont.FontName; - FCurrFont.Size := FDefaultFont.Size; - FCurrFont.Style := FDefaultFont.Style; - FCurrFont.Color := FDefaultFont.Color; + if not FIgnoreFonts then + begin + FCurrFont.FontName := FDefaultFont.FontName; + FCurrFont.Size := FDefaultFont.Size; + FCurrFont.Style := FDefaultFont.Style; + FCurrFont.Color := FDefaultFont.Color; + end; FCurrSection := AIndex; end; diff --git a/components/fpspreadsheet/fpshtml.pas b/components/fpspreadsheet/fpshtml.pas index b737f1bd6..63147aba5 100644 --- a/components/fpspreadsheet/fpshtml.pas +++ b/components/fpspreadsheet/fpshtml.pas @@ -251,7 +251,7 @@ begin // Case: Do not try to interpret the strings. --> everything is a LABEL cell. if not HTMLParams.DetectContentType then begin - FWorksheet.WriteUTF8Text(cell, AText, FCurrRichTextParams); + FWorksheet.WriteText(cell, AText, FCurrRichTextParams); exit; end; @@ -284,7 +284,7 @@ begin end; // What is left is handled as a TEXT cell - FWorksheet.WriteUTF8Text(cell, AText, FCurrRichTextParams); + FWorksheet.WriteText(cell, AText, FCurrRichTextParams); end; { Stores a font in the internal font list. Does not allow duplicates. } diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 6ac3ef059..7cd788d28 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -1818,7 +1818,7 @@ begin if ExtractErrorFromNode(ACellNode, errValue) then FWorkSheet.WriteErrorValue(cell, errValue) else - FWorksheet.WriteUTF8Text(cell, 'ERROR'); + FWorksheet.WriteText(cell, 'ERROR'); styleName := GetAttrValue(ACellNode, 'table:style-name'); ApplyStyleToCell(cell, stylename); @@ -2129,7 +2129,7 @@ begin if (node <> nil) and (node.FirstChild <> nil) then begin valueStr := node.FirstChild.Nodevalue; - FWorksheet.WriteUTF8Text(cell, valueStr); + FWorksheet.WriteText(cell, valueStr); end; end else // (d) boolean @@ -2142,11 +2142,11 @@ begin begin if ExtractErrorFromNode(ACellNode, errorValue) then FWorksheet.WriteErrorValue(cell, errorValue) else - FWorksheet.WriteUTF8Text(cell, 'ERROR'); + FWorksheet.WriteText(cell, 'ERROR'); end else // (e) Text if (valueStr <> '') then - FWorksheet.WriteUTF8Text(cell, valueStr); + FWorksheet.WriteText(cell, valueStr); if FIsVirtualMode then Workbook.OnReadCellData(Workbook, ARow, ACol, cell); @@ -2449,7 +2449,7 @@ begin childnode := childnode.NextSibling; end; - FWorkSheet.WriteUTF8Text(cell, cellText, rtParams); + FWorkSheet.WriteText(cell, cellText, rtParams); if hyperlink <> '' then begin // ODS sees relative paths relative to the internal own file structure @@ -3003,7 +3003,6 @@ var i, p: Integer; r1,c1,r2,c2: Cardinal; inName: Boolean; - ch:Char; begin s := GetAttrValue(ATableNode, 'table:print-ranges'); if s = '' then @@ -3026,10 +3025,8 @@ begin inc(i); p := i; if p <= Length(s) then - begin - ch := s[p]; - Continue; - end else + Continue + else break; end; end; diff --git a/components/fpspreadsheet/fpspagelayout.pas b/components/fpspreadsheet/fpspagelayout.pas index 9cb1f3c56..7890f30d0 100644 --- a/components/fpspreadsheet/fpspagelayout.pas +++ b/components/fpspreadsheet/fpspagelayout.pas @@ -1,5 +1,7 @@ unit fpsPageLayout; +{$mode objfpc}{$H+} + interface uses @@ -27,15 +29,15 @@ type FOptions: TsPrintOptions; FHeaders: array[0..2] of String; FFooters: array[0..2] of String; - FHeaderImages: array[TsHeaderFooterSection] of TsHeaderFooterImage; - FFooterImages: array[TsHeaderFooterSection] of TsHeaderFooterImage; + FHeaderImages: TsHeaderFooterImages; + FFooterImages: TsHeaderFooterImages; FRepeatedCols: TsRowColRange; FRepeatedRows: TsRowColRange; FPrintRanges: TsCellRangeArray; - function GetFooterImages(ASection: TsHeaderFooterSection): TsHeaderFooterImage; + function GetFooterImages(ASection: TsHeaderFooterSectionIndex): TsHeaderFooterImage; function GetFooters(AIndex: Integer): String; - function GetHeaderImages(ASection: TsHeaderFooterSection): TsHeaderFooterImage; + function GetHeaderImages(ASection: TsHeaderFooterSectionIndex): TsHeaderFooterImage; function GetHeaders(AIndex: Integer): String; procedure SetFitHeightToPages(AValue: Integer); procedure SetFitWidthToPages(AValue: Integer); @@ -44,15 +46,21 @@ type procedure SetScalingFactor(AValue: Integer); procedure SetStartPageNumber(AValue: Integer); + protected + function JoinHeaderFooterText(const ALeft, ACenter, ARight: String): String; + procedure SplitHeaderFooterText(const AText: String; out ALeft, ACenter, ARight: String); + public constructor Create(AWorksheet: pointer); procedure Assign(ASource: TsPageLayout); { Images embedded in header and/or footer } procedure AddHeaderImage(AHeaderIndex: Integer; - ASection: TsHeaderFooterSection; const AFilename: String); + ASection: TsHeaderFooterSectionIndex; const AFilename: String); procedure AddFooterImage(AFooterIndex: Integer; - ASection: TsHeaderFooterSection; const AFilename: String); + ASection: TsHeaderFooterSectionIndex; const AFilename: String); + procedure GetImageSections(out AHeaderTags, AFooterTags: String); + function HasHeaderFooterImages: Boolean; { Repeated rows and columns } function HasRepeatedCols: Boolean; @@ -130,7 +138,7 @@ type - sheet name: &A - file name without path: &F - file path without file name: &Z - - image: &G (must be provided by "AddHeaderImage" or "AddFooterImage") + - image: &G (filename must be provided by "AddHeaderImage" or "AddFooterImage") - bold/italic/underlining/double underlining/strike out/shadowed/ outlined/superscript/subscript on/off: &B / &I / &U / &E / &S / &H @@ -156,10 +164,10 @@ type read GetPrintRange; {@@ Images inserted into footer } - property FooterImages[ASection: TsHeaderFooterSection]: TsHeaderFooterImage + property FooterImages[ASection: TsHeaderFooterSectionIndex]: TsHeaderFooterImage read GetFooterImages; {@@ Images inserted into header } - property HeaderImages[ASection: TsHeaderFooterSection]: TsHeaderFooterImage + property HeaderImages[ASection: TsHeaderFooterSectionIndex]: TsHeaderFooterImage read GetHeaderImages; end; @@ -168,11 +176,11 @@ implementation uses Math, - fpsUtils, fpSpreadsheet; + fpsUtils, fpsHeaderFooterParser, fpSpreadsheet; constructor TsPageLayout.Create(AWorksheet: Pointer); var - hfs: TsHeaderFooterSection; + sec: TsHeaderFooterSectionIndex; i: Integer; begin inherited Create; @@ -198,10 +206,10 @@ begin for i:=0 to 2 do FHeaders[i] := ''; for i:=0 to 2 do FFooters[i] := ''; - for hfs in TsHeaderFooterSection do + for sec in TsHeaderFooterSectionIndex do begin - InitHeaderFooterImageRecord(FHeaderImages[hfs]); - InitHeaderFooterImageRecord(FFooterImages[hfs]); + InitHeaderFooterImageRecord(FHeaderImages[sec]); + InitHeaderFooterImageRecord(FFooterImages[sec]); end; FRepeatedRows.FirstIndex := UNASSIGNED_ROW_COL_INDEX; @@ -214,7 +222,7 @@ end; procedure TsPageLayout.Assign(ASource: TsPageLayout); var i: Integer; - hfs: TsHeaderFooterSection; + sec: TsHeaderFooterSectionIndex; begin FOrientation := ASource.Orientation; FPageWidth := ASource.PageWidth; @@ -236,10 +244,10 @@ begin FHeaders[i] := ASource.Headers[i]; FFooters[i] := ASource.Footers[i]; end; - for hfs in TsHeaderFooterSection do + for sec in TsHeaderFooterSectionIndex do begin - FHeaderImages[hfs] := ASource.HeaderImages[hfs]; - FFooterImages[hfs] := ASource.FooterImages[hfs]; + FHeaderImages[sec] := ASource.HeaderImages[sec]; + FFooterImages[sec] := ASource.FooterImages[sec]; end; FRepeatedCols := ASource.RepeatedCols; FRepeatedRows := ASource.RepeatedRows; @@ -249,10 +257,11 @@ begin end; procedure TsPageLayout.AddHeaderImage(AHeaderIndex: Integer; - ASection: TsHeaderFooterSection; const AFilename: String); + ASection: TsHeaderFooterSectionIndex; const AFilename: String); var book: TsWorkbook; idx: Integer; + s: Array[TsHeaderFooterSectionIndex] of String; begin if FWorksheet = nil then raise Exception.Create('[TsPageLayout.AddHeaderImage] Worksheet is nil.'); @@ -264,14 +273,17 @@ begin book.GetEmbeddedStream(idx).LoadFromFile(AFileName); end; FHeaderImages[ASection].Index := idx; - FHeaders[AHeaderIndex] := FHeaders[AHeaderIndex] + '&G'; + SplitHeaderFooterText(FHeaders[AHeaderIndex], s[hfsLeft], s[hfsCenter], s[hfsRight]); + s[ASection] := s[ASection] + '&G'; + FHeaders[AHeaderIndex] := JoinHeaderFooterText(s[hfsLeft], s[hfsCenter], s[hfsRight]); end; procedure TsPageLayout.AddFooterImage(AFooterIndex: Integer; - ASection: TsHeaderFooterSection; const AFileName: String); + ASection: TsHeaderFooterSectionIndex; const AFileName: String); var book: TsWorkbook; idx: Integer; + s: Array[TsHeaderFooterSectionIndex] of String; begin if FWorksheet = nil then raise Exception.Create('[TsPageLayout.AddFooterImage] Worksheet is nil.'); @@ -283,7 +295,9 @@ begin book.GetEmbeddedStream(idx).LoadFromFile(AFileName); end; FFooterImages[ASection].Index := idx; - FFooters[AFooterIndex] := FFooters[AFooterIndex] + '&G'; + SplitHeaderFooterText(FHeaders[AFooterIndex], s[hfsLeft], s[hfsCenter], s[hfsRight]); + s[ASection] := s[ASection] + '&G'; + FHeaders[AFooterIndex] := JoinHeaderFooterText(s[hfsLeft], s[hfsCenter], s[hfsRight]); end; {@@ ---------------------------------------------------------------------------- @@ -325,7 +339,7 @@ begin end; function TsPageLayout.GetFooterImages( - ASection: TsHeaderFooterSection): TsHeaderFooterImage; + ASection: TsHeaderFooterSectionIndex): TsHeaderFooterImage; begin Result := FFooterImages[ASection]; end; @@ -338,8 +352,47 @@ begin raise Exception.Create('[TsPageLayout.GetFooters] Illegal index.'); end; +{@@ ---------------------------------------------------------------------------- + Checks all sections of the headers and footers for images. + Creates a 3-character-string for the header and the footer containing an "L" + at the first position if any of the three header texts contains a "%G" in + the left section. + Dto. for the other sections. + Only one image per section is allowed! Sections violating this are marked by "x" +-------------------------------------------------------------------------------} +procedure TsPageLayout.GetImageSections(out AHeaderTags, AFooterTags: String); + + procedure Process(AText: String; var ATags: String); + var + hfp: TsHeaderFooterParser; + begin + hfp := TsHeaderFooterParser.Create(AText); //, booknil, nil); + try + if hfp.IsImageInSection(hfsLeft) then + ATags[1] := IfThen(ATags[1] = ' ', 'L', 'x'); + if hfp.IsImageInSection(hfsCenter) then + ATags[2] := IfThen(ATags[2] = ' ', 'C', 'x'); + if hfp.IsImageInSection(hfsRight) then + ATags[3] := IfThen(ATags[3] = ' ', 'R', 'x'); + finally + hfp.Free; + end; + end; + +var + i: Integer; +begin + AHeaderTags := ' '; + for i:=0 to 2 do + Process(FHeaders[i], AHeaderTags); + + AFooterTags := ' '; + for i:=0 to 2 do + Process(FFooters[i], AFooterTags); +end; + function TsPageLayout.GetHeaderImages( - ASection: TsHeaderFooterSection): TsHeaderFooterImage; + ASection: TsHeaderFooterSectionIndex): TsHeaderFooterImage; begin Result := FHeaderImages[ASection]; end; @@ -363,6 +416,22 @@ begin raise Exception.Create('[TsPageLayout.GetPrintRange] Illegal index.'); end; +{@@ ---------------------------------------------------------------------------- + Checks whether the header or footer of the worksheet contains embedded images +-------------------------------------------------------------------------------} +function TsPageLayout.HasHeaderFooterImages: Boolean; +var + sec: TsHeaderFooterSectionIndex; +begin + Result := true; + for sec in TsHeaderFooterSectionIndex do + begin + if FHeaderImages[sec].Index >= 0 then Exit; + if FFooterImages[sec].Index >= 0 then Exit; + end; + Result := false; +end; + {@@ ---------------------------------------------------------------------------- Checks whether the worksheet defines columns to be printed repeatedly at the left of each printed page @@ -381,6 +450,24 @@ begin Result := Cardinal(FRepeatedRows.FirstIndex) <> Cardinal(UNASSIGNED_ROW_COL_INDEX); end; +{@@ ---------------------------------------------------------------------------- + Combines the three strings for the left, center and right header/footer + sections to a valid header/footer string. Inserts "&L", "&C" and "&R" codes. +-------------------------------------------------------------------------------} +function TsPageLayout.JoinHeaderFooterText( + const ALeft, ACenter, ARight: String): String; +begin + Result := ''; + if (ALeft = '') and (ARight = '') then + begin + Result := ACenter; + exit; + end; + if (ALeft <> '') then Result := '&L' + ALeft; + if (ACenter <> '') then Result := Result + '&C' + ACenter; + if (ARight <> '') then Result := Result + '&R' + ARight; +end; + {@@ ---------------------------------------------------------------------------- Returns the count of print ranges defined for this worksheet -------------------------------------------------------------------------------} @@ -462,4 +549,59 @@ begin Include(FOptions, poUseStartPageNumber); end; +procedure TsPageLayout.SplitHeaderFooterText(const AText: String; + out ALeft, ACenter, ARight: String); +var + pL, pC, pR: Integer; + P, PStart: PChar; +begin + ALeft := ''; + ACenter := ''; + ARight := ''; + if AText = '' then + exit; + + P := PChar(AText); + PStart := P; + pL := 0; + pC := 0; + pR := 0; + while (P^ <> #0) do begin + if P^ = '&' then + begin + inc(P); + if (P^ = 'L') or (P^ = 'l') then + pL := PtrUInt(P) - PtrUInt(PStart) + else + if (P^ = 'C') or (P^ = 'c') then + pC := PtrUInt(P) - PtrUInt(PStart) + else + if (P^ = 'R') or (P^ = 'r') then + pR := PtrUInt(P) - PtrUInt(PStart); + end; + inc(P); + end; + if (pL > 0) then + begin + if pC > 0 then + ALeft := Copy(AText, pL+2, pC - pL - 1) + else + if pR > 0 then + ARight := Copy(AText, pL, pR - pL - 1) + else + ALeft := Copy(AText, pL+2, MaxInt); + exit; + end; + if (pC > 0) then + begin + if pR > 0 then + ACenter := Copy(AText, pC+2, pR - pC - 1) + else + ACenter := Copy(AText, pC+2, MaxInt); + exit; + end; + if (pR > 0) then + ARight := Copy(AText, pR+2, MaxInt); +end; + end. diff --git a/components/fpspreadsheet/fpsstrings.pas b/components/fpspreadsheet/fpsstrings.pas index d2a446109..e2b2d2252 100644 --- a/components/fpspreadsheet/fpsstrings.pas +++ b/components/fpspreadsheet/fpsstrings.pas @@ -92,7 +92,12 @@ resourcestring rsCannotSortMerged = 'The cell range cannot be sorted because it contains merged cells.'; + // PageLayout rsDifferentSheetPrintRange = 'Print range "%s" requires a different worksheet.'; + rsFooter = 'Footer'; + rsHeader = 'Header'; + rsIncorrectPositionOfImageInHeaderFooter = 'Incorrect position of %%G code in %s'; + rsOnlyOneHeaderFooterImageAllowed = 'Only one image per %s section allowed.'; // Colors rsAqua = 'aqua'; diff --git a/components/fpspreadsheet/fpstypes.pas b/components/fpspreadsheet/fpstypes.pas index 66afd616b..b5ba850eb 100644 --- a/components/fpspreadsheet/fpstypes.pas +++ b/components/fpspreadsheet/fpstypes.pas @@ -701,7 +701,10 @@ type TsPrintOptions = set of TsPrintOption; {@@ Headers and footers are divided into three parts: left, center and right } - TsHeaderFooterSection = (hfsLeft, hfsCenter, hfsRight); + TsHeaderFooterSectionIndex = (hfsLeft, hfsCenter, hfsRight); + + {@@ Array with all possible images in a header or a footer } + TsHeaderFooterImages = array[TsHeaderFooterSectionIndex] of TsHeaderFooterImage; const {@@ Indexes to be used for the various headers and footers } diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index e94686457..7aa0144d0 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -111,6 +111,7 @@ function GetFormatFromFileName(const AFileName: TFileName; procedure EnsureOrder(var a,b: Integer); overload; procedure EnsureOrder(var a,b: Cardinal); overload; function IfThen(ACondition: Boolean; AValue1,AValue2: TsNumberFormat): TsNumberFormat; overload; +function IfThen(ACondition: Boolean; AValue1,AValue2: Char): Char; overload; procedure FloatToFraction(AValue: Double; AMaxDenominator: Int64; out ANumerator, ADenominator: Int64); @@ -1209,6 +1210,11 @@ begin if ACondition then Result := AValue1 else Result := AValue2; end; +function IfThen(ACondition: Boolean; AValue1, AValue2: char): char; +begin + if ACondition then Result := AValue1 else Result := AValue2; +end; + {@@ ---------------------------------------------------------------------------- Approximates a floating point value as a fraction and returns the values of numerator and denominator. diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas index 09197e181..052ada39b 100755 --- a/components/fpspreadsheet/xlsbiff2.pas +++ b/components/fpspreadsheet/xlsbiff2.pas @@ -652,7 +652,7 @@ begin cell := @FVirtualCell; end else cell := FWorksheet.AddCell(ARow, ACol); - FWorksheet.WriteUTF8Text(cell, valueStr); + FWorksheet.WriteText(cell, valueStr); { Apply formatting to cell } ApplyCellFormatting(cell, XF); diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index a4149c5a0..604a52b46 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -399,7 +399,7 @@ var ansistr: ansiString; defName: String; rpnformula: TsRPNFormula; - extsheetIndex: Integer; + {%H-}extsheetIndex: Integer; sheetIndex: Integer; begin // Options @@ -652,7 +652,7 @@ begin { Save the data string to cell } valueStr := ConvertEncoding(ansistr, FCodePage, encodingUTF8); - FWorksheet.WriteUTF8Text(cell, valuestr); + FWorksheet.WriteText(cell, valuestr); { Read rich-text formatting runs } B := AStream.ReadByte; @@ -1065,7 +1065,7 @@ begin { Save the data } valueStr := ConvertEncoding(ansistr, FCodePage, encodingUTF8); - FWorksheet.WriteUTF8Text(cell, valueStr); //ISO_8859_1ToUTF8(ansistr)); + FWorksheet.WriteText(cell, valueStr); //ISO_8859_1ToUTF8(ansistr)); { Add attributes } ApplyCellFormatting(cell, XF); diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index 6beeb3255..536934899 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -1029,7 +1029,7 @@ begin end else cell := FWorksheet.AddCell(ARow, ACol); // "real" cell - FWorksheet.WriteUTF8Text(cell, UTF16ToUTF8(wideStrValue)); + FWorksheet.WriteText(cell, UTF16ToUTF8(wideStrValue)); { Add attributes } ApplyCellFormatting(cell, XF); @@ -1272,7 +1272,7 @@ begin cell := FWorksheet.AddCell(ARow, ACol); // "real" cell { Save the data string} - FWorksheet.WriteUTF8Text(cell, UTF16ToUTF8(wideStrValue)); + FWorksheet.WriteText(cell, UTF16ToUTF8(wideStrValue)); { Read rich-text formatting runs } L := WordLEToN(AStream.ReadWord); @@ -1421,7 +1421,7 @@ begin end else cell := FWorksheet.AddCell(ARow, ACol); - FWorksheet.WriteUTF8Text(cell, FSharedStringTable[SSTIndex]); + FWorksheet.WriteText(cell, FSharedStringTable[SSTIndex]); { Add attributes } ApplyCellFormatting(cell, XF); diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index 227c7a3cd..75934aa86 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -900,7 +900,6 @@ procedure TsBIFFDefinedName.UpdateSheetIndex(ASheetName: String; ASheetIndex: In var elem: TsFormulaElement; i, p: Integer; - s: String; begin for i:=0 to Length(FFormula)-1 do begin elem := FFormula[i]; @@ -1200,7 +1199,6 @@ end; procedure TsSpreadBIFFReader.FixDefinedNames(AWorksheet: TsWorksheet); var - sheetName1, sheetName2: String; i: Integer; defname: TsBiffDefinedName; sheetIndex: Integer; @@ -2184,6 +2182,7 @@ end; function TsSpreadBIFFReader.ReadRPNCellRange3D(AStream: TStream; var ARPNItem: PRPNItem): Boolean; begin + Unused(AStream, ARPNItem); Result := false; // "false" means: "not supported" // must be overridden end; @@ -2433,7 +2432,6 @@ function TsSpreadBIFFReader.ReadRPNTokenArray(AStream: TStream; ARpnTokenArraySize: Word; out ARpnFormula: TsRPNFormula; ACell: PCell = nil; ASharedFormulaBase: PCell = nil): Boolean; var - n: Word; p0: Int64; token: Byte; rpnItem: PRPNItem; @@ -2442,7 +2440,6 @@ var flags: TsRelFlags; r, c, r2, c2: Cardinal; dr, dc, dr2, dc2: Integer; - sheetIndex: Integer; fek: TFEKind; exprDef: TsBuiltInExprIdentifierDef; funcCode: Word; @@ -3302,6 +3299,8 @@ end; procedure TsSpreadBIFFWriter.WriteDefinedName(AStream: TStream; AWorksheet: TsWorksheet; const AName: String; AIndexToREF: Word); begin + Unused(AStream, AWorksheet); + Unused(Aname, AIndexToREF); // Override end; diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 23a2aca51..cee0790e4 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -107,16 +107,19 @@ type TsSpreadOOXMLWriter = class(TsCustomSpreadWriter) private - FNext_rId: Integer; FFirstNumFormatIndexInFile: Integer; + vmlDrawingCounter: Integer; protected FDateMode: TDateMode; FPointSeparatorSettings: TFormatSettings; FSharedStringsCount: Integer; FFillList: array of PsCellFormat; FBorderList: array of PsCellFormat; + procedure Get_rId(AWorksheet: TsWorksheet; + out AComment_rId, AFirstHyperlink_rId, ADrawing_rId, ADrawingHF_rId: Integer); protected procedure AddBuiltinNumFormats; override; + function CreateStream(AFilenameBase: String): TStream; procedure CreateStreams; procedure DestroyStreams; function FindBorderInList(AFormat: PsCellFormat): Integer; @@ -132,13 +135,13 @@ type procedure WriteDefinedNames(AStream: TStream); procedure WriteDimension(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteDrawings(AWorksheet: TsWorksheet); - procedure WriteDrawingsRels(AWorksheet: TsWorksheet); - procedure WriteDrawingsOfSheet(AStream: TStream; AWorksheet: TsWorksheet); + procedure WriteDrawingRels(AWorksheet: TsWorksheet); +// procedure WriteDrawingsOfSheet(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteFillList(AStream: TStream); procedure WriteFont(AStream: TStream; AFont: TsFont; UseInStyleNode: Boolean); procedure WriteFontList(AStream: TStream); procedure WriteHeaderFooter(AStream: TStream; AWorksheet: TsWorksheet); - procedure WriteHyperlinks(AStream: TStream; AWorksheet: TsWorksheet); + procedure WriteHyperlinks(AStream: TStream; AWorksheet: TsWorksheet; rId: Integer); procedure WriteMergedCells(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteNumFormatList(AStream: TStream); procedure WritePalette(AStream: TStream); @@ -150,6 +153,9 @@ type procedure WriteSheetViews(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteStyleList(AStream: TStream; ANodeName: String); procedure WriteVmlDrawings(AWorksheet: TsWorksheet); + procedure WriteVMLDrawings_Comments(AWorksheet: TsWorksheet); + procedure WriteVMLDrawings_HeaderFooterImages(AWorksheet: TsWorksheet); + procedure WriteVMLDrawingRels(AWorksheet: TsWorksheet); procedure WriteWorkbook(AStream: TStream); procedure WriteWorkbookRels(AStream: TStream); procedure WriteWorksheet(AWorksheet: TsWorksheet); @@ -170,6 +176,7 @@ type FSDrawings: array of TStream; FSDrawingsRels: array of TStream; FSVmlDrawings: array of TStream; + FSVmlDrawingsRels: array of TStream; FCurSheetNum: Integer; protected { Routines to write the files } @@ -256,8 +263,10 @@ const SCHEMAS_STYLES = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/styles'; SCHEMAS_STRINGS = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/sharedStrings'; SCHEMAS_COMMENTS = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/comments'; - SCHEMAS_DRAWINGS = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/vmlDrawing'; - SCHEMAS_HYPERLINKS = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink'; + SCHEMAS_DRAWING = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/drawing'; + SCHEMAS_VMLDRAWING = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/vmlDrawing'; + SCHEMAS_HYPERLINK = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink'; + SCHEMAS_IMAGE = 'http://schemas.openxmlformats.org/officeDocument/2006/relationships/image'; SCHEMAS_SPREADML = 'http://schemas.openxmlformats.org/spreadsheetml/2006/main'; { OOXML mime types constants } @@ -686,7 +695,7 @@ begin if s = 's' then begin // String from shared strings table sstIndex := StrToInt(dataStr); - AWorksheet.WriteUTF8Text(cell, FSharedStrings[sstIndex]); + AWorksheet.WriteText(cell, FSharedStrings[sstIndex]); // Read rich-text parameters from the stream stored in the Objects of the stringlist if FSharedStrings.Objects[sstIndex] <> nil then begin @@ -699,7 +708,7 @@ begin end else if (s = 'str') or (s = 'inlineStr') then // literal string - AWorksheet.WriteUTF8Text(cell, datastr) + AWorksheet.WriteText(cell, datastr) else if s = 'b' then // boolean @@ -1066,7 +1075,7 @@ end; procedure TsSpreadOOXMLReader.ReadDefinedNames(ANode: TDOMNode); var - node, childnode: TDOMNode; + node: TDOMNode; nodeName: String; r1,c1,r2,c2: Cardinal; id, j, p: Integer; @@ -1457,7 +1466,7 @@ begin if nodename = 'Relationship' then begin s := GetAttrValue(node, 'Type'); - if s = SCHEMAS_HYPERLINKS then + if s = SCHEMAS_HYPERLINK then begin s := GetAttrValue(node, 'Id'); if s <> '' then @@ -2285,6 +2294,46 @@ begin Result := -1; end; +{ Calculates the rIds for comments, hyperlinks, image, and + header/footer images of the specified worksheet } +procedure TsSpreadOOXMLWriter.Get_rId(AWorksheet: TsWorksheet; + out AComment_rId, AFirstHyperlink_rId, ADrawing_rId, ADrawingHF_rId: Integer); +var + next_rId: Integer; +begin + AComment_rId := -1; + AFirstHyperlink_rId := -1; + ADrawing_rId := -1; + ADrawingHF_rId := -1; + next_rId := 1; + + // Comments first + if AWorksheet.Comments.Count > 0 then + begin + AComment_rId := next_rId; + inc(next_rId, 2); // there are two .rels entries in case of comments + end; + + // Embedded images next + if AWorksheet.GetImageCount > 0 then + begin + ADrawing_rId := next_rId; + inc(next_rId); + end; + + // HeaderFooter images next + if AWorksheet.PageLayout.HasHeaderFooterImages then + begin + ADrawingHF_rId := next_rId; + inc(next_rId); + end; + + // Hyperlinks at the end because it is not clear how many rIds will be + // used without analyzing the hyperlink. + if AWorksheet.Hyperlinks.Count > 0 then + AFirstHyperlink_rId := next_rId; +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. } @@ -2458,6 +2507,8 @@ begin // Create the comments stream SetLength(FSComments, FCurSheetNum + 1); + FSComments[FCurSheetNum] := CreateStream(Format('fpsCMNT%d', [FCurSheetNum])); + { if boFileStream in FWorkbook.Options then FSComments[FCurSheetNum] := TFileStream.Create(GetTempFileName('', Format('fpsCMNT%d', [FCurSheetNum])), fmCreate) else @@ -2465,6 +2516,7 @@ begin FSComments[FCurSheetNum] := TBufStream.Create(GetTempFileName('', Format('fpsCMNT%d', [FCurSheetNum]))) else FSComments[FCurSheetNum] := TMemoryStream.Create; + } // Header AppendToStream(FSComments[FCurSheetNum], @@ -2681,7 +2733,7 @@ begin end; procedure TsSpreadOOXMLWriter.WriteHyperlinks(AStream: TStream; - AWorksheet: TsWorksheet); + AWorksheet: TsWorksheet; rId: Integer); var hyperlink: PsHyperlink; target, bookmark: String; @@ -2695,9 +2747,6 @@ begin AppendToStream(AStream, ''); - // Keep in sync with WriteWorksheetRels ! - FNext_rID := IfThen(AWorksheet.Comments.Count = 0, 1, 3); - AVLNode := AWorksheet.Hyperlinks.FindLowest; while AVLNode <> nil do begin hyperlink := PsHyperlink(AVLNode.Data); @@ -2705,8 +2754,8 @@ begin s := Format('ref="%s"', [GetCellString(hyperlink^.Row, hyperlink^.Col)]); if target <> '' then begin - s := Format('%s r:id="rId%d"', [s, FNext_rId]); - inc(FNext_rId); + s := Format('%s r:id="rId%d"', [s, rId]); + inc(rId); end; if bookmark <> '' then //target = '' then s := Format('%s location="%s"', [s, bookmark]); @@ -3226,6 +3275,8 @@ begin exit; SetLength(FSDrawings, FCurSheetNum + 1); + FSDrawings[FCurSheetNum] := CreateStream(Format('fpsD%d', [FCurSheetNum])); + { if boFileStream in FWorkbook.Options then FSDrawings[FCurSheetNum] := TFileStream.Create(GetTempFileName('', Format('fpsD%d', [FCurSheetNum])), fmCreate) else @@ -3233,6 +3284,7 @@ begin FSDrawings[FCurSheetNum] := TBufStream.Create(GetTempFileName('', Format('fpsD%d', [FCurSheetNum]))) else FSDrawings[FCurSheetNum] := TMemoryStream.Create; + } // Header AppendToStream(FSDrawings[FCurSheetNum], @@ -3311,48 +3363,42 @@ begin ''); end; -procedure TsSpreadOOXMLWriter.WriteDrawingsRels(AWorksheet: TsWorksheet); +// For each sheet, writes a "drawingX.xml.rels" file to +// folder "../drawings/_rels". X matches the (1-base) sheet index. +// See also: WriteVmlDrawingRels +procedure TsSpreadOOXMLWriter.WriteDrawingRels(AWorksheet: TsWorksheet); var i: Integer; - img: TsImage; ext: String; begin - if AWorksheet.GetImageCount= 0 then + if (AWorksheet.GetImageCount = 0) then exit; SetLength(FSDrawingsRels, FCurSheetNum + 1); - if boFileStream in FWorkbook.Options then - FSDrawingsRels[FCurSheetNum] := TFileStream.Create(GetTempFileName('', Format('fpsDR%d', [FCurSheetNum])), fmCreate) - else - if boBufStream in FWorkbook.Options then - FSDrawingsRels[FCurSheetNum] := TBufStream.Create(GetTempFileName('', Format('fpsDR%d', [FCurSheetNum]))) - else - FSDrawingsRels[FCurSheetNum] := TMemoryStream.Create; + FSDrawingsRels[FCurSheetNum] := CreateStream(Format('fpsDR%d', [FCurSheetNum])); // Header AppendToStream(FSDrawingsRels[FCurSheetNum], - XML_HEADER, - ''); + XML_HEADER + LineEnding, + '' + LineEnding); // Repeat for each image for i:=0 to AWorksheet.GetImageCount - 1 do begin - img := AWorksheet.GetImage(i); ext := ExtractFileExt(FWorkbook.GetEmbeddedStream(i).Name); AppendToStream(FSDrawingsRels[FCurSheetNum], Format( - '', [ - i+1, i+1, ext - ])); + ' ' + LineEnding, [ + i+1, SCHEMAS_IMAGE, i+1, ext + ])); end; AppendToStream(FSDrawingsRels[FCurSheetNum], ''); end; - + (* procedure TsSpreadOOXMLWriter.WriteDrawingsOfSheet(AStream: TStream; - AWorksheet: TsWorksheet); + AWorksheet: TsWorksheet; rId: Integer); +// Use stream FSDrawingS[sheetindex] var i: Integer; AVLNode: TAVLTreeNode; @@ -3374,39 +3420,62 @@ begin '', [FNext_rId])); inc(FNext_rId); end; +end; *) + +{@ ----------------------------------------------------------------------------- + Writes a VmlDrawings file for the specified worksheet. + + This file contains information on drawing of shapes etc. + Currently fpspreadsheet supports only comments and embedded header/footer + images. + + Each worksheet writes a vmlDrawing file if it contains comments or + header/footer images. All comments are packed into the same file, all + images as well. The comments file is written first, the Images file next. + All files are numbered consecutively for ALL sheets. + + Example + vmlDrawing1.vml --> Sheet 1 comments + vmlDrawing2.vml --> Sheet 1 header/footer images + vmlDrawing3.vml --> Sheet 2 header/footer images + vmlDrawing4.vml --> Sheet 3 comments +-------------------------------------------------------------------------------} +procedure TsSpreadOOXMLWriter.WriteVmlDrawings(AWorksheet: TsWorksheet); +begin + // At first write the VmlDrawings related to comments + WriteVmlDrawings_Comments(AWorksheet); + + // Now write the vmlDrawings related to headers/footers + WriteVmlDrawings_HeaderFooterImages(AWorksheet); end; -procedure TsSpreadOOXMLWriter.WriteVmlDrawings(AWorksheet: TsWorksheet); -// My xml viewer does not format vml files property --> format in code. +procedure TsSpreadOOXMLWriter.WriteVMLDrawings_Comments(AWorksheet: TsWorksheet); var comment: PsComment; + fileindex: Integer; index: Integer; id: Integer; begin if AWorksheet.Comments.Count = 0 then exit; - SetLength(FSVmlDrawings, FCurSheetNum + 1); - if boFileStream in FWorkbook.Options then - FSVmlDrawings[FCurSheetNum] := TFileStream.Create(GetTempFileName('', Format('fpsVMLD%d', [FCurSheetNum])), fmCreate) - else - if (boBufStream in Workbook.Options) then - FSVmlDrawings[FCurSheetNum] := TBufStream.Create(GetTempFileName('', Format('fpsVMLD%d', [FCurSheetNum]))) - else - FSVmlDrawings[FCurSheetNum] := TMemoryStream.Create; + fileIndex := Length(FSVmlDrawings); - // Header - AppendToStream(FSVmlDrawings[FCurSheetNum], + SetLength(FSVmlDrawings, fileIndex+1); + FSVmlDrawings[fileIndex] := CreateStream(Format('fpsVMLD%', [fileIndex+1])); + + // Header of file + AppendToStream(FSVmlDrawings[fileIndex], '' + LineEnding); // My xml viewer does not format vml files property --> format in code. - AppendToStream(FSVmlDrawings[FCurSheetNum], + AppendToStream(FSVmlDrawings[fileIndex], ' ' + LineEnding + ' ' + LineEnding + // "data" is a comma-separated list with the ids of groups of 1024 comments -- really? ' ' + LineEnding); - AppendToStream(FSVmlDrawings[FCurSheetNum], + AppendToStream(FSVmlDrawings[fileIndex], ' '+LineEnding+ ' ' + LineEnding + ' ' + LineEnding + @@ -3416,8 +3485,8 @@ begin index := 1; for comment in AWorksheet.Comments do begin - id := 1024 + index; // if more than 1024 comments then use data="1,2,etc" above! -- not implemented yet - AppendToStream(FSVmlDrawings[FCurSheetNum], LineEnding + Format( + id := 1024*(FCurSheetNum+1) + index; // if more than 1024 comments then use data="1,2,etc" above! -- not implemented yet + AppendToStream(FSVmlDrawings[fileIndex], LineEnding + Format( ' '); end; +(* + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + *) + +procedure TsSpreadOOXMLWriter.WriteVMLDrawings_HeaderFooterImages( + AWorksheet: TsWorksheet); + + { AName = 'header' or 'footer' + ATag = 'L', 'C', 'R', 'x', or ' ' + AChar = 'H' or 'F' } + procedure Process(AStream: TStream; AName: String; ATag, AChar: Char; + AImage: TsHeaderFooterImage; var id, index: Integer); + var + fn: String; + begin + if AImage.Index = -1 then + exit; + if ATag = 'x' then + begin + FWorkbook.AddErrorMsg(rsOnlyOneHeaderFooterImageAllowed, [AName]); + exit; + end; + if ATag = ' ' then + begin + FWorkbook.AddErrorMsg(rsIncorrectPositionOfImageInHeaderFooter, [AName]); + exit; + end; + fn := Workbook.GetEmbeddedStream(AImage.Index).Name; + fn := ChangeFileExt(ExtractFileName(fn), ''); + AppendToStream(AStream, Format( + ' ' + LineEnding + + // e.g. z-index:1 + ' ' + LineEnding + + // e.g. "rId1" "arrow_down" + ' ' + LineEnding + + ' ' + LineEnding, [ + ATag + AChar, id, index, index, fn + ])); + inc(id); + inc(index); + end; + +var + fileindex: Integer; + id, index: Integer; + tagIndex: Integer; + img: TsHeaderFooterImage; + sec: TsHeaderFooterSectionIndex; + headerTags, footerTags: String; +begin + if not AWorksheet.PageLayout.HasHeaderFooterImages then + exit; + + fileIndex := Length(FSVmlDrawings); + SetLength(FSVmlDrawings, fileIndex+1); + FSVmlDrawings[fileIndex] := CreateStream(Format('fpsVMLD%d', [fileIndex+1])); + + // Header of file + AppendToStream(FSVmlDrawings[fileIndex], + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding + + ' ' + LineEnding); + + index := 1; + id := 1024 * (FCurSheetNum+1) + index; + + AWorksheet.PageLayout.GetImageSections(headerTags, footerTags); + + // Write the data for the image in each section of the header + for sec in TsHeaderFooterSectionIndex do + begin + tagIndex := ord(sec) + 1; + img := AWorksheet.PageLayout.HeaderImages[sec]; + Process(FSVmlDrawings[fileIndex], rsHeader, headerTags[tagIndex], 'H', img, id, index); + end; + // Repeat with footer + for sec in TsHeaderFooterSectionIndex do + begin + img := AWorksheet.PageLayout.FooterImages[sec]; + tagIndex := ord(sec) + 1; + Process(FSVmlDrawings[fileIndex], rsFooter, footerTags[tagIndex], 'F', img, id, index); + end; + + // Footer of file + AppendToStream(FSVmlDrawings[fileIndex], + ''); +end; + +{ + + + + + } + +{@@ ---------------------------------------------------------------------------- + Writes a relationship file (*.rels) for a vmlDrawing.xml file to a media file. + Destination folder will be "../drawings/_rels". + Needed for header/footer images. + Note: vmlDrawing files of comments do not have a correspondig rels file. + The index of the rels file must match that of the vmlDrawingX.vml file. +-------------------------------------------------------------------------------} +procedure TsSpreadOOXMLWriter.WriteVmlDrawingRels(AWorksheet: TsWorksheet); +var + fileindex: Integer; +// fn: String; + sec: TsHeaderFooterSectionIndex; + rId: Integer; + img: TsHeaderFooterImage; + imgIdx: Integer; + imgName: String; +begin + if not AWorksheet.PageLayout.HasHeaderFooterImages then + exit; + + fileIndex := Length(FSVmlDrawingsRels); + if AWorksheet.Comments.Count > 0 then + inc(fileIndex); // skip comments for numbering + + SetLength(FSVmlDrawingsRels, fileIndex+1); + FsVmlDrawingsRels[fileIndex] := CreateStream(Format('fpsVMSDR%d', [fileIndex])); + + // Write file header + AppendToStream(FSVmlDrawingsRels[fileIndex], + '' + LineEnding + + '' + LineEnding + ); + + // Write entry for each header/footer image + // Note: use same order as for writing of VmlDrawing files. + + rId := 1; + + // Write the data for the image in each section of the header + for sec in TsHeaderFooterSectionIndex do begin + img := AWorksheet.PageLayout.HeaderImages[sec]; + if img.Index = -1 then + continue; + imgName := FWorkbook.GetEmbeddedStream(img.Index).Name; + imgIdx := FWorkbook.FindEmbeddedStream(imgName); + AppendToStream(FSVmlDrawingsRels[fileIndex], Format( + ' ' + LineEnding, [ + rId, // Id="rID1" + imgIdx + 1, ExtractFileExt(imgName) // Target="../media/image1.png" + ])); + inc(rId); + end; + + // Repeat with footer + for sec in TsHeaderFooterSectionIndex do begin + img := AWorksheet.PageLayout.FooterImages[sec]; + if img.Index = -1 then + continue; + imgName := FWorkbook.GetEmbeddedStream(img.Index).Name; + imgIdx := FWorkbook.FindEmbeddedStream(imgName); + AppendToStream(FSVmlDrawingsRels[fileIndex], Format( + ' ', [ + rId, + imgIdx, ExtractFileExt(imgName) + ])); + inc(rId); + end; + + // Write file footer + AppendToStream(FSVmlDrawingsRels[fileIndex], + ''); +end; + procedure TsSpreadOOXMLWriter.WriteWorksheetRels(AWorksheet: TsWorksheet); var AVLNode: TAVLTreeNode; hyperlink: PsHyperlink; s: String; target, bookmark: String; - i: Integer; + rId_Comments, rId_Hyperlink, rId_Drawing, rId_DrawingHF: Integer; begin // Extend stream array + // NOTE: If no .rels file is written for this sheet at least an empty stream + // must be provided to keep the numbering intact. SetLength(FSSheetRels, FCurSheetNum + 1); // Anything to write? if (AWorksheet.Comments.Count = 0) and (AWorksheet.Hyperlinks.Count = 0) and - (AWorksheet.GetImageCount = 0) + (AWorksheet.GetImageCount = 0) and not (AWorksheet.PageLayout.HasHeaderFooterImages) then exit; + Get_rId(AWorksheet, rID_Comments, rId_Hyperlink, rId_Drawing, rId_DrawingHF); + // Create stream - if boFileStream in FWorkbook.Options then - FSSheetRels[FCurSheetNum] := TFileStream.Create(GetTempFileName('', Format('fpsWSR%d', [FCurSheetNum])), fmCreate) - else - if (boBufStream in Workbook.Options) then - FSSheetRels[FCurSheetNum] := TBufStream.Create(GetTempFileName('', Format('fpsWSR%d', [FCurSheetNum]))) - else - FSSheetRels[FCurSheetNum] := TMemoryStream.Create; + FSSheetRels[FCurSheetNum] := CreateStream(Format('fpsWSR%d', [FCurSheetNum])); // Header AppendToStream(FSSheetRels[FCurSheetNum], - XML_HEADER); + XML_HEADER + LineEnding); AppendToStream(FSSheetRels[FCurSheetNum], Format( - '', [SCHEMAS_RELS])); - - FNext_rId := 1; + '' + LineEnding, [SCHEMAS_RELS])); // Relationships for comments if AWorksheet.Comments.Count > 0 then begin AppendToStream(FSSheetRels[FCurSheetNum], Format( - '', - [SCHEMAS_DRAWINGS, FCurSheetNum+1])); + ' ' + LineEnding, + [rId_Comments+1, FCurSheetNum+1, SCHEMAS_COMMENTS])); AppendToStream(FSSheetRels[FCurSheetNum], Format( - '', - [SCHEMAS_COMMENTS, FCurSheetNum+1])); - FNext_rId := 3; + ' ' + LineEnding, + [rId_Comments, vmlDrawingCounter, SCHEMAS_VMLDRAWING])); + inc(vmlDrawingCounter); end; // Relationships for hyperlinks @@ -3507,26 +3807,32 @@ begin begin if (pos('file:', target) = 0) and FileNameIsAbsolute(target) then FileNameToURI(target); - s := Format('Id="rId%d" Type="%s" Target="%s" TargetMode="External"', - [FNext_rId, SCHEMAS_HYPERLINKS, target]); + s := Format('Id="rId%d" Target="%s" TargetMode="External" Type="%s"', + [rId_Hyperlink, target, SCHEMAS_HYPERLINK]); AppendToStream(FSSheetRels[FCurSheetNum], - ''); - inc(FNext_rId); + ' ' + LineEnding); + inc(rId_Hyperlink); end; AVLNode := AWorksheet.Hyperlinks.FindSuccessor(AVLNode); end; end; // Relationships for embedded images - for i:= 0 to AWorksheet.GetImageCount-1 do + // relationship with to the ../drawings/drawingX.xml file containing all + // image infos. X is the 1-base sheet index + if AWorksheet.GetImageCount > 0 then + AppendToStream(FSSheetRels[FCurSheetNum], Format( + ' ' + LineEnding, + [rId_Drawing, FCurSheetNum + 1, SCHEMAS_DRAWING] + )); + + // Relationships for embedded header/footer images + if AWorksheet.PageLayout.HasHeaderFooterImages then begin - AppendToStream(FSSheetrels[FCurSheetNum], Format( - '', [ - FNext_rID, i+1 - ])); - inc(FNext_rId); + AppendToStream(FSSheetRels[FCurSheetnum], Format( + ' ' + LineEnding, + [rId_DrawingHF, vmlDrawingCounter, SCHEMAS_VMLDRAWING])); + inc(vmlDrawingCounter); end; // Footer @@ -3540,17 +3846,18 @@ begin // Will be written at the end of WriteToStream when all Sheet.rels files are // known - { --- RelsRels --- } + { --- _rels/.rels --- } AppendToStream(FSRelsRels, - XML_HEADER); + XML_HEADER + LineEnding); AppendToStream(FSRelsRels, Format( - '', [SCHEMAS_RELS])); + '' + LineEnding, [SCHEMAS_RELS])); AppendToStream(FSRelsRels, Format( - '', [SCHEMAS_DOCUMENT])); + ' ' + LineEnding, + [SCHEMAS_DOCUMENT])); AppendToStream(FSRelsRels, ''); - { --- Styles --- } + { --- xl/styles --- } AppendToStream(FSStyles, XML_Header); AppendToStream(FSStyles, Format( @@ -3637,16 +3944,16 @@ begin FSharedStringsCount := 0; { Write all worksheets which fills also the shared strings. - Also: write comments and related files } - FNext_rId := 1; + Also: write comments, Drawings, vmlDrawings and relationship files } for i := 0 to Workbook.GetWorksheetCount - 1 do begin FWorksheet := Workbook.GetWorksheetByIndex(i); WriteWorksheet(FWorksheet); WriteComments(FWorksheet); WriteVmlDrawings(FWorksheet); + WriteVmlDrawingRels(FWorksheet); WriteDrawings(FWorksheet); - WriteDrawingsRels(FWorksheet); + WriteDrawingRels(FWorksheet); WriteWorksheetRels(FWorksheet); end; @@ -3676,16 +3983,16 @@ var sheet: TsWorksheet; begin AppendToStream(FSContentTypes, - XML_HEADER); + XML_HEADER + LineEnding); AppendToStream(FSContentTypes, - ''); + '' + LineEnding); AppendToStream(FSContentTypes, Format( - '', [MIME_RELS])); + '' + LineEnding, [MIME_RELS])); AppendToStream(FSContentTypes, Format( - '', [MIME_XML])); + '' + LineEnding, [MIME_XML])); AppendToStream(FSContentTypes, Format( - '', [MIME_VMLDRAWING])); + '' + LineEnding, [MIME_VMLDRAWING])); if Workbook.GetEmbeddedStreamCount > 0 then begin @@ -3700,36 +4007,36 @@ begin end; for i := 0 to imgExt.Count-1 do AppendToStream(FSContentTypes, Format( - '', [ext, ext])); + '' + LineEnding, [ext, ext])); finally imgExt.Free; end; end; AppendToStream(FSContentTypes, - ''); + '' + LineEnding); for i:=1 to Workbook.GetWorksheetCount do begin AppendToStream(FSContentTypes, Format( - '', + '' + LineEnding, [i, MIME_WORKSHEET])); sheet := Workbook.GetWorksheetByIndex(i-1); if sheet.GetImageCount > 0 then AppendToStream(FSContentTypes, Format( - '', + '' + LineEnding, [i, MIME_DRAWING])); end; for i:=1 to Length(FSComments) do AppendToStream(FSContentTypes, Format( - '', + '' + LineEnding, [i, MIME_COMMENTS])); AppendToStream(FSContentTypes, - ''); + '' + LineEnding); AppendToStream(FSContentTypes, - ''); + '' + LineEnding); { AppendToStream(FSContentTypes, ''); @@ -3800,7 +4107,7 @@ begin // Write to stream if any defined names exist if stotal <> '' then - AppendtoStream(FSWorkbook, + AppendtoStream(AStream, '' + stotal + ''); end; @@ -3813,36 +4120,36 @@ begin actTab := IfThen(FWorkbook.ActiveWorksheet = nil, '', 'activeTab="' + IntToStr(FWorkbook.GetWorksheetIndex(FWorkbook.ActiveWorksheet)) + '"'); - AppendToStream(FSWorkbook, + AppendToStream(AStream, XML_HEADER); - AppendToStream(FSWorkbook, Format( + AppendToStream(AStream, Format( '', [SCHEMAS_SPREADML, SCHEMAS_DOC_RELS])); - AppendToStream(FSWorkbook, + AppendToStream(AStream, ''); - AppendToStream(FSWorkbook, + AppendToStream(AStream, ''); - AppendToStream(FSWorkbook, + AppendToStream(AStream, '' + '' + ''); - AppendToStream(FSWorkbook, + AppendToStream(AStream, ''); for counter:=1 to Workbook.GetWorksheetCount do begin sheetname := UTF8TextToXMLText(Workbook.GetWorksheetByIndex(counter-1).Name); - AppendToStream(FSWorkbook, Format( + AppendToStream(AStream, Format( '', [sheetname, counter, counter])); end; - AppendToStream(FSWorkbook, + AppendToStream(AStream, ''); - WriteDefinedNames(FSWorkbook); + WriteDefinedNames(AStream); - AppendToStream(FSWorkbook, + AppendToStream(AStream, ''); - AppendToStream(FSWorkbook, + AppendToStream(AStream, ''); end; @@ -3850,40 +4157,49 @@ procedure TsSpreadOOXMLWriter.WriteWorkbookRels(AStream: TStream); var counter: Integer; begin - AppendToStream(FSWorkbookRels, - XML_HEADER, - ''); + AppendToStream(AStream, + XML_HEADER + LineEnding, + '' + LineEnding); counter := 1; while counter <= Workbook.GetWorksheetCount do begin - AppendToStream(FSWorkbookRels, Format( - '', - [counter, SCHEMAS_WORKSHEET, counter])); + AppendToStream(AStream, Format( + ' ' + LineEnding, + [counter, counter, SCHEMAS_WORKSHEET])); inc(counter); end; - AppendToStream(FSWorkbookRels, Format( - '', + AppendToStream(AStream, Format( + ' ' + LineEnding, [counter, SCHEMAS_STYLES])); inc(counter); if FSharedStringsCount > 0 then begin - AppendToStream(FSWorkbookRels, Format( - '', + AppendToStream(AStream, Format( + ' ' + LineEnding, [counter, SCHEMAS_STRINGS])); inc(counter); end; - AppendToStream(FSWorkbookRels, + AppendToStream(AStream, ''); end; procedure TsSpreadOOXMLWriter.WriteWorksheet(AWorksheet: TsWorksheet); +var + rId_Comments: Integer; + rId_FirstHyperlink: Integer; + rId_Drawing, rId_DrawingHF: Integer; begin FCurSheetNum := Length(FSSheets); SetLength(FSSheets, FCurSheetNum + 1); + Get_rId(AWorksheet, rID_Comments, rId_FirstHyperlink, rId_Drawing, + rId_DrawingHF); + // Create the stream + FSSheets[FCurSheetNum] := CreateStream(Format('fpsSH%d', [FCurSheetNum])); + { if boFileStream in FWorkbook.Options then FSSheets[FCurSheetNum] := TFileStream.Create(GetTempFileName('', Format('fpsSH%d', [FCurSheetNum])), fmCreate) @@ -3893,6 +4209,7 @@ begin Format('fpsSH%d', [FCurSheetNum]))) else FSSheets[FCurSheetNum] := TMemoryStream.Create; + } // Header AppendToStream(FSSheets[FCurSheetNum], @@ -3906,16 +4223,36 @@ begin WriteCols(FSSheets[FCurSheetNum], AWorksheet); WriteSheetData(FSSheets[FCurSheetNum], AWorksheet); WriteMergedCells(FSSheets[FCurSheetNum], AWorksheet); - WriteHyperlinks(FSSheets[FCurSheetNum], AWorksheet); // must be after MergedCells, otherwise Excel2007 cannot read it !!! + WriteHyperlinks(FSSheets[FCurSheetNum], AWorksheet, rId_FirstHyperlink); + WritePrintOptions(FSSheets[FCurSheetNum], AWorksheet); WritePageMargins(FSSheets[FCurSheetNum], AWorksheet); WritePageSetup(FSSheets[FCurSheetNum], AWorksheet); WriteHeaderFooter(FSSheets[FCurSheetNum], AWorksheet); - WriteDrawingsOfSheet(FSSheets[FCurSheetNum], AWorksheet); + { This item is required for all embedded images. + There must be a matching file in "drawingX.xml" file in "../drawings" + which contains the image-related data of all images in this sheet. + The file in turn requires an entry "drawingX.xml.rels" in the drawings rels + folder } + if AWorksheet.GetImageCount > 0 then + AppendToStream(FSSheets[FCurSheetNum], Format( + '', [rId_Drawing])); + + { This item is required for all comments of a worksheet. + Comments have two entries in the sheet's .rels file, one for the + "../comments.xml" file, and one for the "../drawings/vmlDrawingX.vml" file. + The vmlDrawing file must have an entry "vmlDrawingX.vml.rels" in the drawings + rels folder. } if AWorksheet.Comments.Count > 0 then - AppendToStream(FSSheets[FCurSheetNum], - ''); + AppendToStream(FSSheets[FCurSheetNum], Format( + '', [rId_Comments])); + + { This item is required for all images embedded to a header/footer. + There must be a corresponding "vmlDrawingX.vml" file in "../drawings". } + if AWorksheet.PageLayout.HasHeaderFooterImages then + AppendToStream(FSSheets[FCurSheetNum], Format( + '', [rId_DrawingHF])); // Footer AppendToStream(FSSheets[FCurSheetNum], @@ -3934,11 +4271,39 @@ begin end; {@@ ---------------------------------------------------------------------------- - Creates the streams for the individual data files. Will be zipped into a - single xlsx file. + Creates a basic stream for storing of the individual files. Depending on + the set workbook options the stream is created as a memory stream (default), + buffered stream or file stream. + + In the latter two cases a filename mask is provided to create a temporary + filename around this mask. +-------------------------------------------------------------------------------} +function TsSpreadOOXMLWriter.CreateStream(AFilenameBase: String): TStream; +begin + if boFileStream in FWorkbook.Options then + Result := TFileStream.Create(GetTempFileName('', AFilenameBase), fmCreate) + else + if boBufStream in Workbook.Options then + Result := TBufStream.Create(GetTempFileName('', AFilenameBase)) + else + Result := TMemoryStream.Create; +end; + +{@@ ---------------------------------------------------------------------------- + Creates the basic streams for the individual data files. + Will be zipped into a single xlsx file. + Other stream depending on the count of sheets will be created when needed. -------------------------------------------------------------------------------} procedure TsSpreadOOXMLWriter.CreateStreams; begin + FSContentTypes := CreateStream('fpsCT'); + FSRelsRels := CreateStream('fpsRR'); + FSWorkbookRels := CreateStream('fpsWBR'); + FSWorkbook := CreateStream('fpsWB'); + FSStyles := CreateStream('fpsSTY'); + FSSharedStrings := CreateStream('fpsSS'); + FSSharedStrings_complete := CreateStream('fpsSSC'); + { if boFileStream in FWorkbook.Options then begin FSContentTypes := TFileStream.Create(GetTempFileName('', 'fpsCT'), fmCreate); @@ -3967,6 +4332,7 @@ begin FSSharedStrings := TMemoryStream.Create; FSSharedStrings_complete := TMemoryStream.Create; end; + } // FSSheets will be created when needed. end; @@ -3979,7 +4345,8 @@ procedure TsSpreadOOXMLWriter.DestroyStreams; var fn: String; begin - if AStream is TFileStream then begin + if AStream is TFileStream then + begin fn := TFileStream(AStream).Filename; DeleteFile(fn); end; @@ -4004,6 +4371,8 @@ begin SetLength(FSSheetRels, 0); for stream in FSVmlDrawings do DestroyStream(stream); SetLength(FSVmlDrawings, 0); + for stream in FSVmlDrawingsRels do DestroyStream(stream); + SetLength(FSVmlDrawingsRels, 0); for stream in FSDrawings do DestroyStream(stream); SetLength(FSDrawings, 0); for stream in FSDrawingsRels do DestroyStream(stream); @@ -4038,6 +4407,7 @@ begin for i:=0 to High(FSSheetRels) do ResetStream(FSSheetRels[i]); for i:=0 to High(FSComments) do ResetStream(FSComments[i]); for i:=0 to High(FSVmlDrawings) do ResetStream(FSVmlDrawings[i]); + for i:=0 to High(FSVmlDrawingsRels) do ResetStream(FSVmlDrawingsRels[i]); for i:=0 to High(FSDrawings) do ResetStream(FSDrawings[i]); for i:=0 to High(FSDrawingsRels) do ResetStream(FSDrawingsRels[i]); end; @@ -4069,6 +4439,7 @@ var i: Integer; begin Unused(AParams); + vmlDrawingCounter := 1; { Analyze the workbook and collect all information needed } ListAllNumFormats; @@ -4137,6 +4508,11 @@ begin FSDrawingsRels[i].Position := 0; FZip.Entries.AddFileEntry(FSDrawingsRels[i], OOXML_PATH_XL_DRAWINGS_RELS + Format('drawing%d.xml.rels', [i+1])); end; + for i:=0 to High(FSVmlDrawingsRels) do begin + if (FSVmlDrawingsRels[i] = nil) or (FSVmlDrawingsRels[i].Size = 0) then continue; + FSVmlDrawingsRels[i].Position := 0; + FZip.Entries.AddFileEntry(FSVmlDrawingsRels[i], OOXML_PATH_XL_DRAWINGS_RELS + Format('vmlDrawing%d.vml.rels', [i+1])); + end; FZip.SaveToStream(AStream);