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

fpspreadsheet: Done - Excel2003/XML format passes all tests.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7058 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-07-19 22:42:59 +00:00
parent 4fc6f4949a
commit cb76d86aff
2 changed files with 50 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

58
components/fpspreadsheet/source/common/xlsxml.pas
View File

@ -109,6 +109,8 @@ type
const AValue: TDateTime; ACell: PCell); override;
procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TsErrorValue; ACell: PCell); override;
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
@ -1407,11 +1409,19 @@ begin
ANode := ANode.NextSibling;
end;
// The ScalingFactor is always written to the xml file. This makes TsPageLayout
// automatically remove the poFitPages option which is restored here.
if hasFitToPage and (sheet.PageLayout.ScalingFactor <> 100) then begin
sheet.PageLayout.ScalingFactor := 100;
sheet.Pagelayout.Options := sheet.PageLayout.Options + [poFitPages];
if hasFitToPage then begin
// The ScalingFactor is always written to the xml file. This makes TsPageLayout
// automatically remove the poFitPages option which is restored here.
if (sheet.PageLayout.ScalingFactor <> 100) then begin
sheet.PageLayout.ScalingFactor := 100;
sheet.Pagelayout.Options := sheet.PageLayout.Options + [poFitPages];
end;
// When FitToPages is active, but FitWidthToPages and/or FitHeightToPages
// are not specified, they should be set to 1
if sheet.PageLayout.FitWidthToPages = 0 then
sheet.PageLayout.FitWidthToPages := 1;
if sheet.PageLayout.FitHeightToPages = 0 then
sheet.PageLayout.FitHeightToPages := 1;
end;
end;
@ -1774,6 +1784,8 @@ begin
WriteNumber(AStream, ACell^.Row, ACell^.Col, ACell^.NumberValue, ACell);
cctUTF8String:
WriteLabel(AStream, ACell^.Row, ACell^.Col, ACell^.UTF8StringValue, ACell);
cctFormula:
WriteFormula(AStream, ACell^.Row, ACell^.Col, ACell);
end;
if (FWorksheet as TsWorksheet).ReadComment(ACell) <> '' then
@ -1973,6 +1985,32 @@ begin
'</ExcelWorkbook>' + LF);
end;
procedure TsSpreadExcelXMLWriter.WriteFormula(AStream: TStream;
const ARow, ACol: Cardinal; ACell: PCell);
var
xmlnsStr: String;
dataTagStr: String;
begin
if ACell^.ContentType <> cctFormula then
raise Exception.Create('WriteFormula called for calculated cell.');
xmlnsStr := ' xmlns="http://www.w3.org/TR/REC-html40"';
dataTagStr := ''; // or 'ss:' -- to do...
AppendToStream(AStream, Format(CELL_INDENT +
'<Cell%s%s%s%s%s>' + LF + VALUE_INDENT + // colIndex, style, formula, hyperlink, merge
'<%sData%s>'+ // "ss:", data type, "xmlns=.."
'</%sData>' + LF + CELL_INDENT + // "ss:"
'%s' + // Comment
'</Cell>' + LF, [
GetIndexStr(ACell^.Col, FPrevCol), GetStyleStr(ACell^.FormatIndex), GetFormulaStr(ACell),
GetHyperlinkStr(ACell), GetMergeStr(ACell),
dataTagStr, xmlnsStr,
dataTagStr,
GetCommentStr(ACell)
]));
end;
procedure TsSpreadExcelXMLWriter.WriteLabel(AStream: TStream; const ARow,
ACol: Cardinal; const AValue: string; ACell: PCell);
const
@ -2367,12 +2405,10 @@ begin
// Protection
s := '';
if FWorkbook.IsProtected then begin
if not (cpLockCell in fmt^.Protection) then
s := s + 'ss:Protected="0" ';
if cpHideFormulas in fmt^.Protection then
s := s + 'x:HideFormula="1" ';
end;
if not (cpLockCell in fmt^.Protection) then
s := s + 'ss:Protected="0" ';
if cpHideFormulas in fmt^.Protection then
s := s + 'x:HideFormula="1" ';
if s <> '' then
AppendToStream(AStream, INDENT3 +
'<Protection ' + s + '/>' + LF);

7
components/fpspreadsheet/tests/protectiontests.pas
View File

@ -94,7 +94,6 @@ type
procedure TestWriteRead_OOXML_WorksheetProtection_Objects;
procedure TestWriteRead_OOXML_CellProtection;
procedure TestWriteRead_OOXML_Passwords;
{ Excedl2003/XML protection tests }
@ -116,6 +115,7 @@ type
procedure TestWriteRead_XML_WorksheetProtection_SelectLockedCells;
procedure TestWriteRead_XML_WorksheetProtection_SelectUnlockedCells;
procedure TestWriteRead_XML_WorksheetProtection_Objects;
procedure TestWriteRead_XML_CellProtection;
//procedure TestWriteRead_XML_Passwords; // not allowed
@ -130,7 +130,6 @@ type
procedure TestWriteRead_ODS_WorksheetProtection_SelectUnlockedCells;
procedure TestWriteRead_ODS_CellProtection;
procedure TestWriteRead_ODS_Passwords;
end;
@ -314,10 +313,10 @@ begin
// A1 --> lock cell
cell := Myworksheet.WriteText(0, 0, 'Protected');
MyWorksheet.WriteCellProtection(cell, [cpLockCell]);
// B1 --> not protected at all
// A2 --> not protected at all
cell := MyWorksheet.WriteText(1, 0, 'Not protected');
MyWorksheet.WriteCellProtection(cell, []);
// A2 --> lock cell & hide formulas
// B1 --> lock cell & hide formulas
cell := Myworksheet.WriteFormula(0, 1, '=A1');
MyWorksheet.WriteCellProtection(cell, [cpLockCell, cpHideFormulas]);
// B2 --> hide formula only