From 1504384e792f7d3a7af7666d21d4d036d6cc2258 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 15 Feb 2016 21:12:17 +0000 Subject: [PATCH] fpspreadsheet: Add reading of print ranges and repeated print cols/rows for xlsx. xlsx unit test for print ranges. Fix reading/writing of worksheets with spaces and special xml entities in the sheet name. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4503 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/visual/fpsctrls/main.lfm | 74 ++++++- components/fpspreadsheet/fpshtml.pas | 2 +- components/fpspreadsheet/fpsopendocument.pas | 90 ++++++-- components/fpspreadsheet/fpspreadsheet.pas | 26 ++- components/fpspreadsheet/fpsutils.pas | 205 ++++++------------ components/fpspreadsheet/fpsxmlcommon.pas | 101 +++++++++ .../fpspreadsheet/tests/internaltests.pas | 108 ++++++++- .../fpspreadsheet/tests/pagelayouttests.pas | 109 ++++++++-- components/fpspreadsheet/wikitable.pas | 2 +- components/fpspreadsheet/xlsxml.pas | 4 +- components/fpspreadsheet/xlsxooxml.pas | 122 ++++++++++- 11 files changed, 646 insertions(+), 197 deletions(-) diff --git a/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm b/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm index c65a81ec6..8c63ac616 100644 --- a/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm +++ b/components/fpspreadsheet/examples/visual/fpsctrls/main.lfm @@ -30,7 +30,7 @@ object MainForm: TMainForm FrozenCols = 0 FrozenRows = 0 ReadFormulas = True - SelectionPen.Width = 1 + SelectionPen.Width = 2 TextOverflow = True WorkbookSource = WorkbookSource Align = alClient @@ -5913,9 +5913,81 @@ object MainForm: TMainForm end object MenuItem142: TMenuItem Action = AcCellBorderDiagUp + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000000 + 00AC010101390101015401010115010101A401010115010101A4010101150101 + 01A401010115010101A4010101150101017BFFFFFF00FFFFFF00FFFFFF000101 + 0138000000D90101013601010100010101000101010001010100010101000101 + 010001010100010101000101010001010113FFFFFF00FFFFFF00FFFFFF000101 + 014500000034010101CC01010133010101000101010001010100010101000101 + 010001010100010101000101010001010189FFFFFF00FFFFFF00FFFFFF000000 + 00110000000001010132010101C7010101320101010001010100010101000101 + 010001010100010101000000000000000011FFFFFF00FFFFFF00FFFFFF000000 + 0080000000000101010001010132010101C40101013101010100010101000101 + 010000000000000000000000000000000080FFFFFF00FFFFFF00FFFFFF000000 + 001000000000010101000101010001010131010101C001010130010101000101 + 010001010100000000000000000000000010FFFFFF00FFFFFF00FFFFFF000000 + 00780000000000000000010101000101010001010130010101BC0101012F0101 + 010001010100000000000000000000000078FFFFFF00FFFFFF00FFFFFF000000 + 000F00000000000000000101010001010100010101000101012F010101B90101 + 012E0101010001010100000000000000000FFFFFFF00FFFFFF00FFFFFF000000 + 00710000000000000000000000000101010001010100010101000101012E0101 + 01B60101012E010101000000000000000071FFFFFF00FFFFFF00FFFFFF000000 + 000E000000000000000000000000000000000101010001010100010101000101 + 012D010101B30101012D010101000000000EFFFFFF00FFFFFF00FFFFFF000000 + 006B000000000000000000000000000000000000000000000000010101000101 + 01000101012C010101B00101012C00000036FFFFFF00FFFFFF00FFFFFF000000 + 000E000000000000000000000000000000000000000000000000000000000000 + 0000010101000101012C010101AE0101012CFFFFFF00FFFFFF00FFFFFF000000 + 004D0000000D000000670000000D000000670000000D000000670000000D0000 + 00670000000D000000330101012B01010181FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } end object MenuItem141: TMenuItem Action = AcCellBorderDiagDown + Bitmap.Data = { + 36040000424D3604000000000000360000002800000010000000100000000100 + 2000000000000004000064000000640000000000000000000000FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF000101 + 017B01010115010101A401010115010101A401010115010101A4010101150101 + 01A4010101150101015401010139000000ACFFFFFF00FFFFFF00FFFFFF000101 + 0114010101000101010001010100010101000101010001010100010101000101 + 01000101010001010136000000D901010138FFFFFF00FFFFFF00FFFFFF000101 + 0189010101000101010001010100010101000101010001010100010101000101 + 010001010133010101CC0000003401010145FFFFFF00FFFFFF00FFFFFF000000 + 0011000000000101010001010100010101000101010001010100010101000101 + 0132010101C7010101320000000000000011FFFFFF00FFFFFF00FFFFFF000000 + 0080000000000000000000000000010101000101010001010100010101310101 + 01C401010132010101000000000000000080FFFFFF00FFFFFF00FFFFFF000000 + 0010000000000000000001010100010101000101010001010130010101C00101 + 013101010100010101000000000000000010FFFFFF00FFFFFF00FFFFFF000000 + 0078000000000000000001010100010101000101012F010101BC010101300101 + 010001010100000000000000000000000078FFFFFF00FFFFFF00FFFFFF000000 + 000F0000000001010100010101000101012E010101B90101012F010101000101 + 01000101010000000000000000000000000FFFFFFF00FFFFFF00FFFFFF000000 + 007100000000010101000101012E010101B60101012E01010100010101000101 + 010000000000000000000000000000000071FFFFFF00FFFFFF00FFFFFF000000 + 000E010101000101012D010101B30101012D0101010001010100010101000000 + 00000000000000000000000000000000000EFFFFFF00FFFFFF00FFFFFF000000 + 00360101012C010101B00101012C010101000101010000000000000000000000 + 00000000000000000000000000000000006BFFFFFF00FFFFFF00FFFFFF000101 + 012C010101AE0101012C01010100000000000000000000000000000000000000 + 00000000000000000000000000000000000DFFFFFF00FFFFFF00FFFFFF000101 + 01810101012B000000330000000D000000670000000D000000670000000D0000 + 00670000000D000000670000000D0000004DFFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF + FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00 + } end object MenuItem143: TMenuItem Caption = '-' diff --git a/components/fpspreadsheet/fpshtml.pas b/components/fpspreadsheet/fpshtml.pas index 0dbcf8381..b737f1bd6 100644 --- a/components/fpspreadsheet/fpshtml.pas +++ b/components/fpspreadsheet/fpshtml.pas @@ -142,7 +142,7 @@ implementation uses LConvEncoding, LazUTF8, URIParser, StrUtils, Math, - fpsStrings, fpsRegFileFormats, fpsUtils, fpsNumFormat; + fpsStrings, fpsRegFileFormats, fpsUtils, fpsXMLCommon, fpsNumFormat; const MIN_FONTSIZE = 6; diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index cdd6eb593..789e5273c 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -2958,31 +2958,68 @@ var s, sheetname: String; i, p: Integer; r1,c1,r2,c2: Cardinal; + inName: Boolean; + ch:Char; begin s := GetAttrValue(ATableNode, 'table:print-ranges'); if s = '' then exit; L := TStringList.Create; try - L.Delimiter := ' '; - L.StrictDelimiter := true; - L.DelimitedText := s; + // Scan the string for spaces. But note: Spaces may be contained also in + // the sheet names! + s := s + ' '; + i := 1; + p := 1; + inName := false; + while (i <= Length(s)) do + begin + case s[i] of + '''': inName := not inName; + ' ' : if not inName then begin + L.Add(Copy(s, p, i-p)); + while (i <= Length(s)) and (s[i] = ' ') do + inc(i); + p := i; + ch := s[p]; + Continue; + end; + end; + inc(i); + end; + + // L lists all the ranges. Split each range into its components. for i:=0 to L.Count-1 do begin + s := L[i]; p := pos(':', L[i]); s := Copy(L[i], 1, p-1); ParseSheetCellString(s, sheetname, r1, c1, '.'); - if (sheetname <> '') and (sheetname <> ASheet.Name) then + if (sheetname <> '') then begin - FWorkbook.AddErrorMsg(rsDifferentSheetPrintRange, [L[i]]); - Continue; + if (sheetname[1] = '''') then + Delete(sheetname, 1,1); + if (sheetname[Length(sheetname)] = '''') then + Delete(sheetname, Length(sheetname), 1); + if (sheetname <> ASheet.Name) then + begin + FWorkbook.AddErrorMsg(rsDifferentSheetPrintRange, [L[i]]); + Continue; + end; end; s := Copy(L[i], p+1, Length(L[i])); ParseSheetCellString(s, sheetname, r2, c2, '.'); - if (sheetname <> '') and (sheetname <> ASheet.name) then - begin - FWorkbook.AddErrorMsg(rsDifferentSheetPrintRange, [L[i]]); - Continue; + if (sheetname <> '') then begin + if (sheetname[1] = '''') then + Delete(sheetname, 1, 1); + if (sheetname[Length(sheetname)] = '''') then + Delete(sheetname, Length(sheetname), 1); + if (sheetname <> ASheet.name) then + begin + FWorkbook.AddErrorMsg(rsDifferentSheetPrintRange, [L[i]]); + Continue; + end; end; + // Add found range to worksheet ASheet.AddPrintRange(r1, c1, r2, c2); end; finally @@ -4143,7 +4180,7 @@ begin for i:=0 to Workbook.GetWorksheetCount-1 do begin sheet := Workbook.GetWorksheetByIndex(i); - if sheet = Workbook.ActiveWorksheet then actSheet := sheet.Name; + if sheet = Workbook.ActiveWorksheet then actSheet := UTF8TextToXMLText(sheet.Name); if not (soShowGridLines in sheet.Options) then showGrid := false; if not (soShowHeaders in sheet.Options) then showHeaders := false; end; @@ -4331,7 +4368,7 @@ begin // Header AppendToStream(AStream, Format( '', [ - FWorkSheet.Name, ASheetIndex+1, WritePrintRangesAsXMLString(FWorksheet) + UTF8TextToXMLText(FWorkSheet.Name), ASheetIndex+1, WritePrintRangesAsXMLString(FWorksheet) ])); // columns @@ -4668,6 +4705,8 @@ var Result := Result + ''; end; +var + sheetname: String; begin defFnt := TsHeaderFooterFont.Create(Workbook.GetDefaultFont); @@ -4684,8 +4723,9 @@ begin for i:=0 to FWorkbook.GetWorksheetCount-1 do begin sheet := FWorkbook.GetWorksheetByIndex(i); + sheetname := UTF8TextToXMLText(sheet.name); AppendToStream(AStream, - MasterPageAsString('PageStyle_5f_' + sheet.Name, 'PageStyle_' + sheet.Name, + MasterPageAsString('PageStyle_5f_' + sheetName, 'PageStyle_' + sheetname, 'Mpm' + IntToStr(3+i), sheet.PageLayout)); end; @@ -4703,10 +4743,11 @@ end; procedure TsSpreadOpenDocWriter.WriteNamedExpressions(AStream: TStream; ASheet: TsWorksheet); var - stotal, srng: String; + stotal, srng, sheetname: String; j: Integer; prng: TsCellRange; begin + sheetname := UTF8TextToXMLText(ASheet.Name); stotal := ''; // Cell block of print range @@ -4715,7 +4756,7 @@ begin begin prng := ASheet.GetPrintRange(j); srng := srng + ';' + Format('[$%s.%s]', [ - ASheet.Name, GetCellRangeString(prng.Row1, prng.Col1, prng.Row2, prng.Col2, []) + sheetname, GetCellRangeString(prng.Row1, prng.Col1, prng.Row2, prng.Col2, []) ]); end; if srng <> '' then @@ -4723,7 +4764,7 @@ begin Delete(srng, 1, 1); stotal := stotal + Format( '', - [ASheet.Name, srng] + [sheetname, srng] ); end; @@ -5647,6 +5688,7 @@ var i: Integer; rng: TsCellRange; srng: String; + sheetName: String; begin if ASheet.NumPrintRanges > 0 then begin @@ -5654,9 +5696,12 @@ begin for i := 0 to ASheet.NumPrintRanges - 1 do begin rng := ASheet.GetPrintRange(i); + if pos(' ', ASheet.Name) > 0 then + sheetName := ''' + UTF8TextToXMLText(ASheet.Name) + ''' else + sheetname := UTF8TextToXMLText(ASheet.Name); Result := Result + ' ' + Format('%s.%s:%s.%s', [ - ASheet.Name, GetCellString(rng.Row1,rng.Col1), - ASheet.Name, GetCellString(rng.Row2,rng.Col2) + sheetName, GetCellString(rng.Row1,rng.Col1), + sheetName, GetCellString(rng.Row2,rng.Col2) ]); end; if Result <> '' then @@ -5672,6 +5717,7 @@ procedure TsSpreadOpenDocWriter.WriteTableSettings(AStream: TStream); var i: Integer; sheet: TsWorkSheet; + sheetname: String; hsm: Integer; // HorizontalSplitMode vsm: Integer; // VerticalSplitMode asr: Integer; // ActiveSplitRange @@ -5680,9 +5726,10 @@ begin for i:=0 to Workbook.GetWorksheetCount-1 do begin sheet := Workbook.GetWorksheetByIndex(i); + sheetname := UTF8TextToXMLText(sheet.Name); AppendToStream(AStream, - ''); + ''); hsm := 0; vsm := 0; asr := 2; if (soHasFrozenPanes in sheet.Options) then @@ -5745,11 +5792,12 @@ procedure TsSpreadOpenDocWriter.WriteTableStyles(AStream: TStream); var i: Integer; sheet: TsWorksheet; - bidi: String; + sheetname, bidi: String; begin for i:=0 to FWorkbook.GetWorksheetCount-1 do begin sheet := FWorkbook.GetWorksheetByIndex(i); + sheetname := UTF8TextToXMLText(sheet.Name); case sheet.BiDiMode of bdDefault: bidi := ''; bdLTR : bidi := 'style:writing-mode="lr-tb" '; @@ -5759,7 +5807,7 @@ begin '' + '' + '', [ - i+1, sheet.Name, + i+1, UTF8TextToXMLText(sheetname), bidi ])); end; diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 5311b6959..e8b1ce4bb 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -3302,10 +3302,24 @@ begin SetLength(FPrintRanges, Result + 1); with FPrintRanges[Result] do begin - Row1 := ARow1; - Col1 := ACol1; - Row2 := ARow2; - Col2 := ACol2; + if ARow1 < ARow2 then + begin + Row1 := ARow1; + Row2 := ARow2; + end else + begin + Row1 := ARow2; + Row2 := ARow1; + end; + if ACol1 < ACol2 then + begin + Col1 := ACol1; + Col2 := ACol2; + end else + begin + Col1 := ACol2; + Col2 := ACol1; + end; end; end; @@ -3383,7 +3397,7 @@ end; -------------------------------------------------------------------------------} function TsWorksheet.HasRepeatedPrintCols: Boolean; begin - Result := PageLayout.RepeatedCols.FirstIndex <> UNASSIGNED_ROW_COL_INDEX; + Result := Cardinal(PageLayout.RepeatedCols.FirstIndex) <> Cardinal(UNASSIGNED_ROW_COL_INDEX); end; {@@ ---------------------------------------------------------------------------- @@ -3391,7 +3405,7 @@ end; -------------------------------------------------------------------------------} function TsWorksheet.HasRepeatedPrintRows: Boolean; begin - Result := PageLayout.RepeatedRows.FirstIndex <> UNASSIGNED_ROW_COL_INDEX; + Result := Cardinal(PageLayout.RepeatedRows.FirstIndex) <> Cardinal(UNASSIGNED_ROW_COL_INDEX); end; {@@ ---------------------------------------------------------------------------- diff --git a/components/fpspreadsheet/fpsutils.pas b/components/fpspreadsheet/fpsutils.pas index 880947a63..8b1f82994 100644 --- a/components/fpspreadsheet/fpsutils.pas +++ b/components/fpspreadsheet/fpsutils.pas @@ -72,10 +72,8 @@ function ParseCellString(const AStr: string; out ACellRow, ACellCol: Cardinal): Boolean; overload; function ParseSheetCellString(const AStr: String; out ASheetName: String; out ACellRow, ACellCol: Cardinal; ASheetSeparator: Char = '!'): Boolean; -function ParseCellRowString(const AStr: string; - out AResult: Cardinal): Boolean; -function ParseCellColString(const AStr: string; - out AResult: Cardinal): Boolean; +function ParseCellRowString(const AStr: string; out ARow: Cardinal): Boolean; +function ParseCellColString(const AStr: string; out ACol: Cardinal): Boolean; function GetCellRangeString(ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: TsRelFlags = rfAllRel; Compact: Boolean = false): String; overload; @@ -135,10 +133,6 @@ function pxToPts(AValue, AScreenPixelsPerInch: Integer): Double; inline; function PtsToPx(AValue: Double; AScreenPixelsPerInch: Integer): Integer; inline; function HTMLLengthStrToPts(AValue: String; DefaultUnits: String = 'pt'): Double; -function UTF8TextToXMLText(AText: ansistring; ProcessLineEndings: Boolean = false): ansistring; -function ValidXMLText(var AText: ansistring; ReplaceSpecialChars: Boolean = true; - ProcessLineEndings: Boolean = false): Boolean; - function ColorToHTMLColorStr(AValue: TsColor; AExcelDialect: Boolean = false): String; function HTMLColorStrToColor(AValue: String): TsColor; @@ -199,6 +193,9 @@ implementation uses Math, lazutf8, lazfileutils, fpsStrings, fpsRegFileFormats; +const + INT_NUM_LETTERS = 26; + {******************************************************************************} { Endianess helper functions } {******************************************************************************} @@ -797,42 +794,65 @@ begin ASheetName := ''; end else begin ASheetName := UTF8Copy(AStr, 1, p-1); - Result := ParseCellString(UTF8Copy(AStr, p+1, UTF8Length(AStr)), ACellRow, ACellCol); + Result := ParseCellString(Copy(AStr, p+1, Length(AStr)), ACellRow, ACellCol); +// Result := ParseCellString(UTF8Copy(AStr, p+1, UTF8Length(AStr)), ACellRow, ACellCol); end; end; {@@ ---------------------------------------------------------------------------- Parses a cell row string to a zero-based row number. - @param AStr Cell row string, such as '1', 1-based! - @param AResult Index of the row (zero-based!) (putput) - @return False if the string is not a valid cell row string + @param AStr Cell row string, such as '1', 1-based! + @param ARow Index of the row (zero-based!) (putput) + @return False if the string is not a valid cell row string -------------------------------------------------------------------------------} -function ParseCellRowString(const AStr: string; out AResult: Cardinal): Boolean; +function ParseCellRowString(const AStr: string; out ARow: Cardinal): Boolean; begin - try - AResult := StrToInt(AStr) - 1; - except - Result := False; - end; - Result := True; + if AStr = '' then + exit(false); + if AStr[1] = '$' then + Result := TryStrToInt(Copy(AStr, 2, Length(AStr)-1), LongInt(ARow)) else + Result := TryStrToInt(AStr, LongInt(ARow)); + if Result then dec(ARow); end; {@@ ---------------------------------------------------------------------------- Parses a cell column string, like 'A' or 'CZ', into a zero-based column number. Note that there can be several letters to address more than 26 columns. - @param AStr Cell range string, such as A1 - @param AResult Zero-based index of the column (output) - @return False if the string is not a valid cell column string + @param AStr Cell range string, such as A1 + @param ACol Zero-based index of the column (output) + @return False if the string is not a valid cell column string -------------------------------------------------------------------------------} -function ParseCellColString(const AStr: string; out AResult: Cardinal): Boolean; -const - INT_NUM_LETTERS = 26; +function ParseCellColString(const AStr: string; out ACol: Cardinal): Boolean; +var + j, j1: Integer; begin Result := False; - AResult := 0; + ACol := 0; + if AStr = '' then + exit; + + if AStr[1] = '$' then + j1 := 2 else + j1 := 1; + + for j := j1 to Length(AStr) do + begin + if AStr[j] in ['A'..'Z'] then + ACol := ACol * INT_NUM_LETTERS + ord(AStr[j]) - ord('A') + 1 + else + if AStr[j] in ['a'..'z'] then + ACol := ACol * INT_NUM_LETTERS + ord(AStr[j]) - ord('a') + 1 + else + exit; + end; + + dec(ACol); + Result := true; + + { if Length(AStr) = 1 then AResult := Ord(AStr[1]) - Ord('A') else if Length(AStr) = 2 then begin @@ -847,7 +867,7 @@ begin end else Exit(False); - Result := True; + Result := True; } end; function Letter(AValue: Integer): char; @@ -872,9 +892,9 @@ begin Result := ''; n := AColIndex + 1; while (n > 0) do begin - c := (n - 1) mod 26; + c := (n - 1) mod INT_NUM_LETTERS; Result := char(c + ord('A')) + Result; - n := (n - c) div 26; + n := (n - c) div INT_NUM_LETTERS; end; end; @@ -1816,106 +1836,6 @@ begin Result := Format('#%.2x%.2x%.2x', [rgb.r, rgb.g, rgb.b]); end; -{@@ ---------------------------------------------------------------------------- - Converts a string encoded in UTF8 to a string usable in XML. For this purpose, - some characters must be translated. - - @param AText Input string encoded as UTF8 - @param ProcessLineEndings If TRUE line ending characters are replaced by - their HTML entities (e.g., #10 --> ' ' - @return String usable in XML with some characters replaced by the HTML codes. --------------------------------------------------------------------------------} -function UTF8TextToXMLText(AText: ansistring; - ProcessLineEndings: Boolean = false): ansistring; -var - Idx: Integer; - AppoSt:ansistring; -begin - Result := ''; - idx := 1; - while idx <= Length(AText) do - begin - case AText[Idx] of - '&': begin - AppoSt := Copy(AText, Idx, 6); - if (Pos('&', AppoSt) = 1) or - (Pos('<', AppoSt) = 1) or - (Pos('>', AppoSt) = 1) or - (Pos('"', AppoSt) = 1) or - (Pos(''', AppoSt) = 1) or - (Pos('%', AppoSt) = 1) // % - then begin - //'&' is the first char of a special chat, it must not be converted - Result := Result + AText[Idx]; - end else begin - Result := Result + '&'; - end; - end; - '<': Result := Result + '<'; - '>': Result := Result + '>'; - '"': Result := Result + '"'; - '''':Result := Result + '''; - '%': Result := Result + '%'; - #10: if ProcessLineEndings then - Result := Result + ' ' else - Result := Result + #10; - #13: if ProcessLineEndings then - Result := Result + ' ' else - Result := Result + #13; - { this breaks multi-line labels in xlsx - #10: begin - Result := Result + '
'; - if (idx < Length(AText)) and (AText[idx+1] = #13) then inc(idx); - end; - #13: begin - Result := Result + '
'; - if (idx < Length(AText)) and (AText[idx+1] = #10) then inc(idx); - end; - } - else - Result := Result + AText[Idx]; - end; - inc(idx); - end; -end; - -{@@ ---------------------------------------------------------------------------- - Checks a string for characters that are not permitted in XML strings. - The function returns FALSE if a character <#32 is contained (except for - #9, #10, #13), TRUE otherwise. Invalid characters are replaced by a box symbol. - - If ReplaceSpecialChars is TRUE, some other characters are converted - to valid HTML codes by calling UTF8TextToXMLText - - @param AText String to be checked. Is replaced by valid string. - @param ReplaceSpecialChars Special characters are replaced by their HTML - codes (e.g. '>' --> '>') - @param ProcessLineEndings If TRUE line ending characters are replaced by - their HTML entities. - @return FALSE if characters < #32 were replaced, TRUE otherwise. --------------------------------------------------------------------------------} -function ValidXMLText(var AText: ansistring; - ReplaceSpecialChars: Boolean = true; - ProcessLineEndings: Boolean = false): Boolean; -const - BOX = #$E2#$8E#$95; -var - i: Integer; -begin - Result := true; - for i := Length(AText) downto 1 do - if (AText[i] < #32) and not (AText[i] in [#9, #10, #13]) then begin - // Replace invalid character by box symbol - Delete(AText, i, 1); - Insert(BOX, AText, i); -// AText[i] := '?'; - Result := false; - end; - if ReplaceSpecialChars then - AText := UTF8TextToXMLText(AText, ProcessLineEndings); -end; - - {@@ ---------------------------------------------------------------------------- Extracts compare information from an input string such as "<2.4". Is needed for some Excel-strings. @@ -2245,12 +2165,31 @@ begin (AFont.Position = APos); end; +{@@ ---------------------------------------------------------------------------- + Creates a TsCellRange record from the provided cell corner coordinates. + Put the coordinates into right order if needed. +-------------------------------------------------------------------------------} function Range(ARow1, ACol1, ARow2, ACol2: Cardinal): TsCellRange; begin - Result.Row1 := ARow1; - Result.Col1 := ACol1; - Result.Row2 := ARow2; - Result.Col2 := ACol2; + if ARow1 <= ARow2 then + begin + Result.Row1 := ARow1; + Result.Row2 := ARow2; + end else + begin + Result.Row1 := ARow2; + Result.Row2 := ARow1; + end; + + if ACol1 <= ACol2 then + begin + Result.Col1 := ACol1; + Result.Col2 := ACol2; + end else + begin + Result.Col1 := ACol2; + Result.Col2 := ACol1; + end; end; (* diff --git a/components/fpspreadsheet/fpsxmlcommon.pas b/components/fpspreadsheet/fpsxmlcommon.pas index 7fa131ff9..c8627f62d 100644 --- a/components/fpspreadsheet/fpsxmlcommon.pas +++ b/components/fpspreadsheet/fpsxmlcommon.pas @@ -22,6 +22,10 @@ type function GetAttrValue(ANode : TDOMNode; AAttrName : string) : string; function GetNodeValue(ANode: TDOMNode): String; +function UTF8TextToXMLText(AText: string; ProcessLineEndings: Boolean = false): string; +function ValidXMLText(var AText: string; ReplaceSpecialChars: Boolean = true; + ProcessLineEndings: Boolean = false): Boolean; + procedure UnzipFile(AZipFileName, AZippedFile, ADestFolder: String); function UnzipToStream(AZipStream: TStream; const AZippedFile: String; ADestStream: TStream): Boolean; @@ -75,6 +79,103 @@ begin Result := child.NodeValue; end; +{@@ ---------------------------------------------------------------------------- + Converts a string encoded in UTF8 to a string usable in XML. For this purpose, + some characters must be translated. + + @param AText Input string encoded as UTF8 + @param ProcessLineEndings If TRUE line ending characters are replaced by + their HTML entities (e.g., #10 --> ' ' + @return String usable in XML with some characters replaced by the HTML codes. +-------------------------------------------------------------------------------} +function UTF8TextToXMLText(AText: string; + ProcessLineEndings: Boolean = false): string; +var + Idx: Integer; + AppoSt: string; +begin + Result := ''; + idx := 1; + while idx <= Length(AText) do + begin + case AText[Idx] of + '&': begin + AppoSt := Copy(AText, Idx, 6); + if (Pos('&', AppoSt) = 1) or + (Pos('<', AppoSt) = 1) or + (Pos('>', AppoSt) = 1) or + (Pos('"', AppoSt) = 1) or + (Pos(''', AppoSt) = 1) or + (Pos('%', AppoSt) = 1) // % + then begin + //'&' is the first char of a special chat, it must not be converted + Result := Result + AText[Idx]; + end else begin + Result := Result + '&'; + end; + end; + '<': Result := Result + '<'; + '>': Result := Result + '>'; + '"': Result := Result + '"'; + '''':Result := Result + '''; + '%': Result := Result + '%'; + #10: if ProcessLineEndings then + Result := Result + ' ' else + Result := Result + #10; + #13: if ProcessLineEndings then + Result := Result + ' ' else + Result := Result + #13; + { this breaks multi-line labels in xlsx + #10: begin + Result := Result + '
'; + if (idx < Length(AText)) and (AText[idx+1] = #13) then inc(idx); + end; + #13: begin + Result := Result + '
'; + if (idx < Length(AText)) and (AText[idx+1] = #10) then inc(idx); + end; + } + else + Result := Result + AText[Idx]; + end; + inc(idx); + end; +end; + +{@@ ---------------------------------------------------------------------------- + Checks a string for characters that are not permitted in XML strings. + The function returns FALSE if a character <#32 is contained (except for + #9, #10, #13), TRUE otherwise. Invalid characters are replaced by a box symbol. + + If ReplaceSpecialChars is TRUE, some other characters are converted + to valid HTML codes by calling UTF8TextToXMLText + + @param AText String to be checked. Is replaced by valid string. + @param ReplaceSpecialChars Special characters are replaced by their HTML + codes (e.g. '>' --> '>') + @param ProcessLineEndings If TRUE line ending characters are replaced by + their HTML entities. + @return FALSE if characters < #32 were replaced, TRUE otherwise. +-------------------------------------------------------------------------------} +function ValidXMLText(var AText: string; + ReplaceSpecialChars: Boolean = true; + ProcessLineEndings: Boolean = false): Boolean; +const + BOX = #$E2#$8E#$95; +var + i: Integer; +begin + Result := true; + for i := Length(AText) downto 1 do + if (AText[i] < #32) and not (AText[i] in [#9, #10, #13]) then begin + // Replace invalid character by box symbol + Delete(AText, i, 1); + Insert(BOX, AText, i); + Result := false; + end; + if ReplaceSpecialChars then + AText := UTF8TextToXMLText(AText, ProcessLineEndings); +end; {------------------------------------------------------------------------------} { Unzipping } diff --git a/components/fpspreadsheet/tests/internaltests.pas b/components/fpspreadsheet/tests/internaltests.pas index 5e0929b31..8958f3c3e 100644 --- a/components/fpspreadsheet/tests/internaltests.pas +++ b/components/fpspreadsheet/tests/internaltests.pas @@ -35,6 +35,8 @@ type procedure FractionTest(AMaxDigits: Integer); procedure WriteToStreamTest(AFormat: TsSpreadsheetFormat); + procedure InvalidSheetName(AFormat: TsSpreadsheetFormat); + published // Tests getting Excel style A1 cell locations from row/column based locations. // Bug 26447 @@ -42,6 +44,9 @@ type // Tests cell references given in the "R1C1" syntax. procedure TestCellString_R1C1; procedure TestCellRangeString_R1C1; + // Tests row and column string names + procedure TestRowString; + procedure TestColString; //todo: add more calls, rename sheets, try to get sheets with invalid indexes etc //(see strings tests for how to deal with expected exceptions) @@ -50,7 +55,9 @@ type // GetSheetByName was implemented in SVN revision 2857 procedure GetSheetByName; // Test for invalid sheet names - procedure InvalidSheetName; + procedure InvalidSheetName_BIFF8; + procedure InvalidSheetName_XLSX; + procedure InvalidSheetName_ODS; // Tests whether overwriting existing file works procedure OverwriteExistingFile; // Write out date cell and try to read as UTF8; verify if contents the same @@ -112,19 +119,23 @@ begin end; end; -procedure TSpreadInternalTests.InvalidSheetName; +procedure TSpreadInternalTests.InvalidSheetName(AFormat: TsSpreadsheetFormat); type TSheetNameCheck = record Valid: Boolean; SheetName: String; end; +var + TempFile: String; const - TestCases: array[0..9] of TSheetNameCheck = ( + TestCases: array[0..11] of TSheetNameCheck = ( (Valid: true; SheetName:'Sheet'), - (Valid: true; SheetName:'äöü'), // UFt8-characters are ok - (Valid: false; SheetName:'Test'), // duplicate - (Valid: false; SheetName:'TEST'), // duplicate since case is ignored - (Valid: false; SheetName:''), // empty string + (Valid: true; SheetName:'äöü'), // UFt8-characters are ok + (Valid: true; SheetName:''), // forbidden xml characters + (Valid: true; SheetName:'sheet 1'), // space in name + (Valid: false; SheetName:'Test'), // duplicate + (Valid: false; SheetName:'TEST'), // duplicate since case is ignored + (Valid: false; SheetName:''), // empty string (Valid: false; SheetName:'Very very very very very very very very long'), // too long (Valid: false; SheetName:'[sheet]'), // forbidden characters in following cases (Valid: false; SheetName:'/sheet/'), @@ -134,8 +145,10 @@ const var i: Integer; MyWorkbook: TsWorkbook; + MyWorksheet: TsWorksheet; ok: Boolean; begin + TempFile := NewTempFile; MyWorkbook := TsWorkbook.Create; try MyWorkbook.AddWorksheet('Test'); @@ -143,10 +156,44 @@ begin begin ok := MyWorkbook.ValidWorksheetName(TestCases[i].SheetName); CheckEquals(TestCases[i].Valid, ok, 'Sheet name validity check mismatch: ' + TestCases[i].SheetName); + if TestCases[i].Valid then + MyWorksheet := MyWorkbook.AddWorksheet(TestCases[i].SheetName); end; + MyWorkbook.WriteToFile(TempFile, AFormat, true); finally MyWorkbook.Free; end; + + MyWorkbook := TsWorkbook.Create; + try + MyWorkbook.ReadFromFile(TempFile, AFormat); + for i:=0 to High(TestCases) do + if TestCases[i].Valid then + begin + MyWorksheet := MyWorkbook.GetWorksheetByName(TestCases[i].SheetName); + if MyWorksheet = nil then + fail('Test case '+IntToStr(i) + ': Worksheet not found after reading. '+ + 'Expected sheet name: '+TestCases[i].SheetName); + end; + finally + MyWorkbook.Free; + DeleteFile(TempFile); + end; +end; + +procedure TSpreadInternalTests.InvalidSheetName_BIFF8; +begin + InvalidSheetname(sfExcel8); +end; + +procedure TSpreadInternalTests.InvalidSheetName_XLSX; +begin + InvalidSheetname(sfOOXML); +end; + +procedure TSpreadInternalTests.InvalidSheetName_ODS; +begin + InvalidSheetname(sfOpenDocument); end; procedure TSpreadInternalTests.OverwriteExistingFile; @@ -649,6 +696,53 @@ begin CheckEquals(true, flags = [rfRelRow, rfRelCol], 'Flags mismatch in test 4'); end; +procedure TSpreadInternalTests.TestColString; +var + res: Boolean; + c: Cardinal; +begin + // (1) Check column 0 ("A") + res := ParseCellColString('A', c); + CheckEquals(res, true, 'Result mismatch in test 1'); + CheckEquals(res, true, 'Col mismatch in test 1'); + + // (2) Check column 25 ("Z") + res := ParseCellColString('Z', c); + CheckEquals(res, true, 'Result mismatch in test 2'); + CheckEquals(c, 25, 'Col mismatch in test 2'); + + // (3) Check column 26 ("AA") + res := ParseCellColString('AA', c); + CheckEquals(res, true, 'Result mismatch in test 3'); + CheckEquals(c, 26, 'Col mismatch in test 3'); + + // (3) Check column 26 ("$AA") with $ + res := ParseCellColString('$AA', c); + CheckEquals(res, true, 'Result mismatch in test 4'); + CheckEquals(c, 26, 'Col mismatch in test 4'); +end; + +procedure TSpreadInternalTests.TestRowString; +var + res: Boolean; + r: Cardinal; +begin + // (1) Check row 0 ("1") + res := ParseCellRowString('1', r); + CheckEquals(res, true, 'Result mismatch in test 1'); + CheckEquals(r, 0, 'Row mismatch in test 1'); + + // (2) Check row 99 ("100") + res := ParseCellRowString('100', r); + CheckEquals(res, true, 'Result mismatch in test 2'); + CheckEquals(r, 99, 'Row mismatch in test 2'); + + // (2) Check row 99 ("100") with $ + res := ParseCellRowString('$100', r); + CheckEquals(res, true, 'Result mismatch in test 3'); + CheckEquals(r, 99, 'Row mismatch in test 3'); +end; + procedure TSpreadInternalTests.FractionTest(AMaxDigits: Integer); const N = 300; diff --git a/components/fpspreadsheet/tests/pagelayouttests.pas b/components/fpspreadsheet/tests/pagelayouttests.pas index a23cb0c58..1869c6011 100644 --- a/components/fpspreadsheet/tests/pagelayouttests.pas +++ b/components/fpspreadsheet/tests/pagelayouttests.pas @@ -26,7 +26,8 @@ type procedure TearDown; override; procedure TestWriteRead_PageLayout(AFormat: TsSpreadsheetFormat; ANumSheets, ATestMode: Integer); procedure TestWriteRead_PageMargins(AFormat: TsSpreadsheetFormat; ANumSheets, AHeaderFooterMode: Integer); - procedure TestWriteRead_PrintRanges(AFormat: TsSpreadsheetFormat; ANumSheets, ANumRanges: Integer); + procedure TestWriteRead_PrintRanges(AFormat: TsSpreadsheetFormat; + ANumSheets, ANumRanges: Integer; ASpaceInName: Boolean); published { BIFF2 page layout tests } @@ -220,6 +221,16 @@ type procedure TestWriteRead_OOXML_HeaderFooterFontColor_2sheets; procedure TestWriteRead_OOXML_HeaderFooterFontColor_3sheets; + procedure TestWriteRead_OOXML_PrintRanges_1sheet_1Range_NoSpace; + procedure TestWriteRead_OOXML_PrintRanges_1sheet_2Ranges_NoSpace; + procedure TestWriteRead_OOXML_PrintRanges_2sheet_1Range_NoSpace; + procedure TestWriteRead_OOXML_PrintRanges_2sheet_2Ranges_NoSpace; + + procedure TestWriteRead_OOXML_PrintRanges_1sheet_1Range_Space; + procedure TestWriteRead_OOXML_PrintRanges_1sheet_2Ranges_Space; + procedure TestWriteRead_OOXML_PrintRanges_2sheet_1Range_Space; + procedure TestWriteRead_OOXML_PrintRanges_2sheet_2Ranges_Space; + { OpenDocument page layout tests } procedure TestWriteRead_ODS_PageMargins_1sheet_0; procedure TestWriteRead_ODS_PageMargins_1sheet_1; @@ -274,17 +285,21 @@ type procedure TestWriteRead_ODS_HeaderFooterFontColor_2sheets; procedure TestWriteRead_ODS_HeaderFooterFontColor_3sheets; - procedure TestWriteRead_ODS_PrintRanges_1sheet_1Range; - procedure TestWriteRead_ODS_PrintRanges_1sheet_2Ranges; - procedure TestWriteRead_ODS_PrintRanges_2sheet_1Range; - procedure TestWriteRead_ODS_PrintRanges_2sheet_2Ranges; + procedure TestWriteRead_ODS_PrintRanges_1sheet_1Range_NoSpace; + procedure TestWriteRead_ODS_PrintRanges_1sheet_2Ranges_NoSpace; + procedure TestWriteRead_ODS_PrintRanges_2sheet_1Range_NoSpace; + procedure TestWriteRead_ODS_PrintRanges_2sheet_2Ranges_NoSpace; + procedure TestWriteRead_ODS_PrintRanges_1sheet_1Range_Space; + procedure TestWriteRead_ODS_PrintRanges_1sheet_2Ranges_Space; + procedure TestWriteRead_ODS_PrintRanges_2sheet_1Range_Space; + procedure TestWriteRead_ODS_PrintRanges_2sheet_2Ranges_Space; end; implementation uses - typinfo, contnrs, + typinfo, contnrs, strutils, fpsutils, fpsHeaderFooterParser; // uriparser, lazfileutils, fpsutils; @@ -673,13 +688,14 @@ actual: procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_PrintRanges( - AFormat: TsSpreadsheetFormat; ANumSheets, ANumRanges: Integer); + AFormat: TsSpreadsheetFormat; ANumSheets, ANumRanges: Integer; ASpaceInName: Boolean); var tempFile: String; i, j: Integer; MyWorkbook: TsWorkbook; MyWorksheet: TsWorksheet; rng: TsCellRange; + sheetname: String; begin TempFile := GetTempFileName; @@ -687,7 +703,8 @@ begin try for i:= 1 to ANumSheets do begin - MyWorksheet := MyWorkbook.AddWorksheet(PageLayoutSheet+IntToStr(i)); + sheetname := PageLayoutSheet + IfThen(ASpaceInName, ' ', '') + IntToStr(i); + MyWorksheet := MyWorkbook.AddWorksheet(sheetname); for j:=1 to ANumRanges do MyWorksheet.AddPrintRange(SollRanges[j]); end; @@ -1508,6 +1525,46 @@ begin TestWriteRead_PageLayout(sfOOXML, 3, 9); end; +procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_OOXML_PrintRanges_1sheet_1Range_NoSpace; +begin + TestWriteRead_PrintRanges(sfOOXML, 1, 1, false); +end; + +procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_OOXML_PrintRanges_1sheet_2Ranges_NoSpace; +begin + TestWriteRead_PrintRanges(sfOOXML, 1, 2, false); +end; + +procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_OOXML_PrintRanges_2sheet_1Range_NoSpace; +begin + TestWriteRead_PrintRanges(sfOOXML, 2, 1, false); +end; + +procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_OOXML_PrintRanges_2sheet_2Ranges_NoSpace; +begin + TestWriteRead_PrintRanges(sfOOXML, 2, 2, false); +end; + +procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_OOXML_PrintRanges_1sheet_1Range_Space; +begin + TestWriteRead_PrintRanges(sfOOXML, 1, 1, true); +end; + +procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_OOXML_PrintRanges_1sheet_2Ranges_Space; +begin + TestWriteRead_PrintRanges(sfOOXML, 1, 2, true); +end; + +procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_OOXML_PrintRanges_2sheet_1Range_Space; +begin + TestWriteRead_PrintRanges(sfOOXML, 2, 1, true); +end; + +procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_OOXML_PrintRanges_2sheet_2Ranges_Space; +begin + TestWriteRead_PrintRanges(sfOOXML, 2, 2, true); +end; + { Tests for Open Document file format } @@ -1733,24 +1790,44 @@ begin TestWriteRead_PageLayout(sfOpenDocument, 3, 9); end; -procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_PrintRanges_1sheet_1Range; +procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_PrintRanges_1sheet_1Range_NoSpace; begin - TestWriteRead_PrintRanges(sfOpenDocument, 1, 1); + TestWriteRead_PrintRanges(sfOpenDocument, 1, 1, false); end; -procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_PrintRanges_1sheet_2Ranges; +procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_PrintRanges_1sheet_2Ranges_NoSpace; begin - TestWriteRead_PrintRanges(sfOpenDocument, 1, 2); + TestWriteRead_PrintRanges(sfOpenDocument, 1, 2, false); end; -procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_PrintRanges_2sheet_1Range; +procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_PrintRanges_2sheet_1Range_NoSpace; begin - TestWriteRead_PrintRanges(sfOpenDocument, 2, 1); + TestWriteRead_PrintRanges(sfOpenDocument, 2, 1, false); end; -procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_PrintRanges_2sheet_2Ranges; +procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_PrintRanges_2sheet_2Ranges_NoSpace; begin - TestWriteRead_PrintRanges(sfOpenDocument, 2, 2); + TestWriteRead_PrintRanges(sfOpenDocument, 2, 2, false); +end; + +procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_PrintRanges_1sheet_1Range_Space; +begin + TestWriteRead_PrintRanges(sfOpenDocument, 1, 1, true); +end; + +procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_PrintRanges_1sheet_2Ranges_Space; +begin + TestWriteRead_PrintRanges(sfOpenDocument, 1, 2, true); +end; + +procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_PrintRanges_2sheet_1Range_Space; +begin + TestWriteRead_PrintRanges(sfOpenDocument, 2, 1, true); +end; + +procedure TSpreadWriteReadPageLayoutTests.TestWriteRead_ODS_PrintRanges_2sheet_2Ranges_Space; +begin + TestWriteRead_PrintRanges(sfOpenDocument, 2, 2, true); end; initialization diff --git a/components/fpspreadsheet/wikitable.pas b/components/fpspreadsheet/wikitable.pas index f33a87396..05e5226f9 100644 --- a/components/fpspreadsheet/wikitable.pas +++ b/components/fpspreadsheet/wikitable.pas @@ -110,7 +110,7 @@ var implementation uses - fpsStrings, fpsRegFileFormats; + fpsStrings, fpsXMLCommon, fpsRegFileFormats; { TWikiTableTokenizer } diff --git a/components/fpspreadsheet/xlsxml.pas b/components/fpspreadsheet/xlsxml.pas index d0fa033f3..6a6620e9f 100644 --- a/components/fpspreadsheet/xlsxml.pas +++ b/components/fpspreadsheet/xlsxml.pas @@ -90,7 +90,7 @@ implementation uses StrUtils, Math, - fpsStrings, fpsRegFileFormats, fpsUtils, fpsNumFormat, fpsHTMLUtils; + fpsStrings, fpsRegFileFormats, fpsUtils, fpsNumFormat, fpsXmlCommon, fpsHTMLUtils; const FMT_OFFSET = 61; @@ -776,7 +776,7 @@ procedure TsSpreadExcelXMLWriter.WriteWorksheet(AStream: TStream; begin FWorksheet := AWorksheet; AppendToStream(AStream, Format( - ' ' + LF, [AWorksheet.Name]) ); + ' ' + LF, [UTF8TextToXMLText(AWorksheet.Name)]) ); WriteTable(AStream, AWorksheet); WriteWorksheetOptions(AStream, AWorksheet); AppendToStream(AStream, diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 2376419f0..8abbebeb3 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -73,6 +73,7 @@ type procedure ReadCols(ANode: TDOMNode; AWorksheet: TsWorksheet); procedure ReadComments(ANode: TDOMNode; AWorksheet: TsWorksheet); procedure ReadDateMode(ANode: TDOMNode); + procedure ReadDefinedNames(ANode: TDOMNode); procedure ReadFileVersion(ANode: TDOMNode); procedure ReadFills(ANode: TDOMNode); function ReadFont(ANode: TDOMNode): Integer; @@ -1051,6 +1052,93 @@ begin end; end; +procedure TsSpreadOOXMLReader.ReadDefinedNames(ANode: TDOMNode); +var + node, childnode: TDOMNode; + nodeName: String; + r1,c1,r2,c2: Cardinal; + id, j, p: Integer; + sheet: TsWorksheet; + localSheetID: String; + namestr: String; + s, sheetname: String; + L: TStringList; +begin + if ANode = nil then + exit; + node := ANode.FirstChild; + while node <> nil do begin + nodename := node.NodeName; + if nodename = 'definedName' then + begin + localSheetID := GetAttrValue(node, 'localSheetId'); + if (localSheetID = '') or not TryStrToInt(localSheetID, id) then + begin + FWorkbook.AddErrorMsg('no/invalid localID in "definedName" node'); + node := node.NextSibling; + Continue; + end; + namestr := GetAttrValue(node, 'name'); + sheet := FWorkbook.GetWorksheetByIndex(id); + if namestr = '_xlnm.Print_Area' then + begin + L := TStringList.Create; + try + L.Delimiter := ','; + L.StrictDelimiter := true; + L.DelimitedText := GetNodeValue(node); + for j:=0 to L.Count-1 do + begin + s := ReplaceStr(L[j], '''', ''); + p := pos(':', s); + if p = 0 then + begin + FWorkbook.AddErrorMsg('invalid cell range reference in "definedName" node'); + break; + end; + ParseSheetCellString(Copy(s, 1, p-1), sheetname, r1, c1); + ParseSheetCellString(Copy(s, p+1, MaxInt), sheetname, r2, c2); + sheet.AddPrintRange(r1, c1, r2, c2); + end; + finally + L.Free; + end; + end else + if nameStr = '_xlnm.Print_Titles' then + begin + L := TStringList.Create; + try + L.Delimiter := ','; + L.StrictDelimiter := true; + L.DelimitedText := GetNodeValue(node); + for j:=0 to L.Count-1 do + begin + s := ReplaceStr(L[j], '''', ''); + p := pos('!', s); + if p > 0 then s := Copy(s, p+1, MaxInt); + p := pos(':', s); + if not ParseCellColString(copy(s, 1, p-1), c1) then + c1 := UNASSIGNED_ROW_COL_INDEX; + if not ParseCellColString(copy(s, p+1, MaxInt), c2) then + c2 := UNASSIGNED_ROW_COL_INDEX; + if not ParseCellRowString(copy(s, 1, p-1), r1) then + r1 := UNASSIGNED_ROW_COL_INDEX; + if not ParseCellRowString(copy(s, p+1, MaxInt), r2) then + r2 := UNASSIGNED_ROW_COL_INDEX; + if (r1 <> cardinal(UNASSIGNED_ROW_COL_INDEX)) then + sheet.SetRepeatedPrintRows(r1, r2); + if (c1 <> cardinal(UNASSIGNED_ROW_COL_INDEX)) then + sheet.SetRepeatedPrintCols(c1, c2); + end; + finally + L.Free; + end; + end; + end; + node := node.NextSibling; + end; +end; + procedure TsSpreadOOXMLReader.ReadFileVersion(ANode: TDOMNode); begin FWrittenByFPS := GetAttrValue(ANode, 'appName') = 'fpspreadsheet'; @@ -1937,7 +2025,7 @@ begin XMLStream.Free; end; - // process the workbook.xml file + // process the workbook.xml file (1st run) XMLStream := CreateXMLStream; try if not UnzipToStream(AStream, OOXML_PATH_XL_WORKBOOK, XMLStream) then @@ -1946,6 +2034,7 @@ begin ReadFileVersion(Doc.DocumentElement.FindNode('fileVersion')); ReadDateMode(Doc.DocumentElement.FindNode('workbookPr')); ReadSheetList(Doc.DocumentElement.FindNode('sheets'), SheetList); + //ReadDefinedNames(Doc.DocumentElement.FindNode('definedNames')); -- don't read here because sheets do not yet exist ReadActiveSheet(Doc.DocumentElement.FindNode('bookViews'), actSheetIndex); FreeAndNil(Doc); finally @@ -2070,6 +2159,19 @@ begin FWorkbook.SelectWorksheet(FWorksheet); end; // for + // 2nd run for the workbook.xml file + // Read defined names + XMLStream := CreateXMLStream; + try + if not UnzipToStream(AStream, OOXML_PATH_XL_WORKBOOK, XMLStream) then + raise Exception.CreateFmt(rsDefectiveInternalStructure, ['xlsx']); + ReadXMLStream(Doc, XMLStream); + ReadDefinedNames(Doc.DocumentElement.FindNode('definedNames')); + FreeAndNil(Doc); + finally + XMLStream.Free; + end; + finally SheetList.Free; FreeAndNil(Doc); @@ -3310,7 +3412,7 @@ end; procedure TsSpreadOOXMLWriter.WriteContent; var i, counter: Integer; - actTab: String; + actTab, sheetname: String; begin { --- WorkbookRels --- } { Workbook relations - Mark relation to all sheets } @@ -3355,9 +3457,12 @@ begin AppendToStream(FSWorkbook, ''); for counter:=1 to Workbook.GetWorksheetCount do + begin + sheetname := UTF8TextToXMLText(Workbook.GetWorksheetByIndex(counter-1).Name); AppendToStream(FSWorkbook, Format( '', - [Workbook.GetWorksheetByIndex(counter-1).Name, counter, counter])); + [sheetname, counter, counter])); + end; AppendToStream(FSWorkbook, ''); @@ -3438,7 +3543,7 @@ end; procedure TsSpreadOOXMLWriter.WriteDefinedNames(AStream: TStream); var sheet: TsWorksheet; - stotal, srng: String; + stotal, srng, sheetname: String; i, j: Integer; prng: TsCellRange; firstIndex, lastIndex: Integer; @@ -3449,16 +3554,15 @@ begin for i := 0 to Workbook.GetWorksheetCount-1 do begin sheet := Workbook.GetWorksheetByIndex(i); + sheetname := '''' + UTF8TextToXMLText(sheet.Name) + ''''; // 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, []) + sheetname, GetCellRangeString(prng.Row1, prng.Col1, prng.Row2, prng.Col2, []) ]); end; if srng <> '' then @@ -3477,7 +3581,7 @@ 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)]); + srng := srng + ',' + Format('%s!$%s:$%s', [sheetname, GetColString(firstindex), GetColString(lastindex)]); end; // ... and repeated rows if sheet.PageLayout.RepeatedRows.FirstIndex <> UNASSIGNED_ROW_COL_INDEX then @@ -3485,7 +3589,7 @@ 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]); + srng := srng + ',' + Format('%s!$%d:$%d', [sheetname, firstindex+1, lastindex+1]); end; if srng <> '' then begin Delete(srng, 1,1);