pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4503 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-02-15 21:12:17 +00:00
parent ad4813947b
commit 1504384e79
11 changed files with 646 additions and 197 deletions
Download Patch File Download Diff File Expand all files Collapse all files

74
components/fpspreadsheet/examples/visual/fpsctrls/main.lfm
View File

@ -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 = '-'

2
components/fpspreadsheet/fpshtml.pas
View File

@ -142,7 +142,7 @@ implementation
uses
LConvEncoding, LazUTF8, URIParser, StrUtils, Math,
fpsStrings, fpsRegFileFormats, fpsUtils, fpsNumFormat;
fpsStrings, fpsRegFileFormats, fpsUtils, fpsXMLCommon, fpsNumFormat;
const
MIN_FONTSIZE = 6;

90
components/fpspreadsheet/fpsopendocument.pas
View File

@ -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(
'<table:table table:name="%s" table:style-name="ta%d" %s>', [
FWorkSheet.Name, ASheetIndex+1, WritePrintRangesAsXMLString(FWorksheet)
UTF8TextToXMLText(FWorkSheet.Name), ASheetIndex+1, WritePrintRangesAsXMLString(FWorksheet)
]));
// columns
@ -4668,6 +4705,8 @@ var
Result := Result + '</style:master-page>';
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(
'<table:named-expression table:name="_xlnm.Print_Area" table:base-cell-address="$%s.$A$1" table:expression="%s" />',
[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 := '&apos;' + UTF8TextToXMLText(ASheet.Name) + '&apos;' 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,
'<config:config-item-map-entry config:name="' + sheet.Name + '">');
'<config:config-item-map-entry config:name="' + sheetname + '">');
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
'<style:style style:name="ta%d" style:family="table" style:master-page-name="PageStyle_5f_%s">' +
'<style:table-properties table:display="true" %s/>' +
'</style:style>', [
i+1, sheet.Name,
i+1, UTF8TextToXMLText(sheetname),
bidi
]));
end;

26
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -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;
{@@ ----------------------------------------------------------------------------

205
components/fpspreadsheet/fpsutils.pas
View File

@ -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 --> '&#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('&amp;', AppoSt) = 1) or
(Pos('&lt;', AppoSt) = 1) or
(Pos('&gt;', AppoSt) = 1) or
(Pos('&quot;', AppoSt) = 1) or
(Pos('&apos;', AppoSt) = 1) or
(Pos('&#37;', 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 + '&amp;';
end;
end;
'<': Result := Result + '&lt;';
'>': Result := Result + '&gt;';
'"': Result := Result + '&quot;';
'''':Result := Result + '&apos;';
'%': Result := Result + '&#37;';
#10: if ProcessLineEndings then
Result := Result + '&#10;' else
Result := Result + #10;
#13: if ProcessLineEndings then
Result := Result + '&#13;' else
Result := Result + #13;
{ this breaks multi-line labels in xlsx
#10: begin
Result := Result + '<br />';
if (idx < Length(AText)) and (AText[idx+1] = #13) then inc(idx);
end;
#13: begin
Result := Result + '<br />';
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. '>' --> '&gt;')
@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;
(*

101
components/fpspreadsheet/fpsxmlcommon.pas
View File

@ -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 --> '&#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('&amp;', AppoSt) = 1) or
(Pos('&lt;', AppoSt) = 1) or
(Pos('&gt;', AppoSt) = 1) or
(Pos('&quot;', AppoSt) = 1) or
(Pos('&apos;', AppoSt) = 1) or
(Pos('&#37;', 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 + '&amp;';
end;
end;
'<': Result := Result + '&lt;';
'>': Result := Result + '&gt;';
'"': Result := Result + '&quot;';
'''':Result := Result + '&apos;';
'%': Result := Result + '&#37;';
#10: if ProcessLineEndings then
Result := Result + '&#10;' else
Result := Result + #10;
#13: if ProcessLineEndings then
Result := Result + '&#13;' else
Result := Result + #13;
{ this breaks multi-line labels in xlsx
#10: begin
Result := Result + '<br />';
if (idx < Length(AText)) and (AText[idx+1] = #13) then inc(idx);
end;
#13: begin
Result := Result + '<br />';
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. '>' --> '&gt;')
@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 }

108
components/fpspreadsheet/tests/internaltests.pas
View File

@ -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:'<sheet>'), // 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;

109
components/fpspreadsheet/tests/pagelayouttests.pas
View File

@ -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

2
components/fpspreadsheet/wikitable.pas
View File

@ -110,7 +110,7 @@ var
implementation
uses
fpsStrings, fpsRegFileFormats;
fpsStrings, fpsXMLCommon, fpsRegFileFormats;
{ TWikiTableTokenizer }

4
components/fpspreadsheet/xlsxml.pas
View File

@ -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(
' <Worksheet ss:Name="%s">' + LF, [AWorksheet.Name]) );
' <Worksheet ss:Name="%s">' + LF, [UTF8TextToXMLText(AWorksheet.Name)]) );
WriteTable(AStream, AWorksheet);
WriteWorksheetOptions(AStream, AWorksheet);
AppendToStream(AStream,

122
components/fpspreadsheet/xlsxooxml.pas
View File

@ -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,
'<sheets>');
for counter:=1 to Workbook.GetWorksheetCount do
begin
sheetname := UTF8TextToXMLText(Workbook.GetWorksheetByIndex(counter-1).Name);
AppendToStream(FSWorkbook, Format(
'<sheet name="%s" sheetId="%d" r:id="rId%d" />',
[Workbook.GetWorksheetByIndex(counter-1).Name, counter, counter]));
[sheetname, counter, counter]));
end;
AppendToStream(FSWorkbook,
'</sheets>');
@ -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);