From 9f593aa10ac0b905b9b1d3aad32bfb8ca9e7a2b4 Mon Sep 17 00:00:00 2001
From: wp_xxyyzz <wp_xxyyzz@8e941d3f-bd1b-0410-a28a-d453659cc2b4>
Date: Sun, 20 Sep 2015 14:20:04 +0000
Subject: [PATCH] fpspreadsheet: Add 1904-DateMode to ExcelXML writer.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4344 8e941d3f-bd1b-0410-a28a-d453659cc2b4
---
 components/fpspreadsheet/xlscommon.pas |  6 ++--
 components/fpspreadsheet/xlsxml.pas    | 43 ++++++++++++++++++++------
 2 files changed, 37 insertions(+), 12 deletions(-)

diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas
index eabee763f..e8456610d 100644
--- a/components/fpspreadsheet/xlscommon.pas
+++ b/components/fpspreadsheet/xlscommon.pas
@@ -661,9 +661,9 @@ function ConvertExcelDateTimeToDateTime(const AExcelDateNum: Double;
   ADateMode: TDateMode): TDateTime;
 begin
   // Time only:
-  if (AExcelDateNum<1) and (AExcelDateNum>=0)  then
+  if (AExcelDateNum < 1) and (AExcelDateNum >= 0)  then
   begin
-    Result:=AExcelDateNum;
+    Result := AExcelDateNum;
   end
   else
   begin
@@ -699,7 +699,7 @@ end;
 function ConvertDateTimeToExcelDateTime(const ADateTime: TDateTime;
   ADateMode: TDateMode): Double;
 begin
-  // Time only:
+  // Time only
   if (ADateTime<1) and (ADateTime>=0) then
   begin
     Result:=ADateTime;
diff --git a/components/fpspreadsheet/xlsxml.pas b/components/fpspreadsheet/xlsxml.pas
index 6bf014b96..858bb9aa7 100644
--- a/components/fpspreadsheet/xlsxml.pas
+++ b/components/fpspreadsheet/xlsxml.pas
@@ -25,9 +25,11 @@ type
     function GetMergeStr(ACell: PCell): String;
     function GetStyleStr(ACell: PCell): String;
     procedure WriteCells(AStream: TStream; AWorksheet: TsWorksheet);
+    procedure WriteExcelWorkbook(AStream: TStream);
     procedure WriteStyle(AStream: TStream; AIndex: Integer);
     procedure WriteStyles(AStream: TStream);
     procedure WriteWorksheet(AStream: TStream; AWorksheet: TsWorksheet);
+    procedure WriteWorksheets(AStream: TStream);
 
   protected
     procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
@@ -302,12 +304,15 @@ var
 begin
   ExcelDate := AValue;
   fmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex);
-  // Times have an offset by 1 day - for some unknown reason.
+  // Times have an offset of 1 day!
   if (fmt <> nil) and (uffNumberFormat in fmt^.UsedFormattingFields) then
   begin
     nfp := FWorkbook.GetNumberFormat(fmt^.NumberFormatIndex);
     if IsTimeIntervalFormat(nfp) or IsTimeFormat(nfp) then
-      ExcelDate := AValue + 1.0;
+      case FDateMode of
+        dm1900: ExcelDate := AValue + DATEMODE_1900_BASE;
+        dm1904: ExcelDate := AValue + DATEMODE_1904_BASE;
+      end;
   end;
   valueStr := FormatDateTime('yyyy-mm-dd"T"hh:nn:ss.zzz', ExcelDate);
 
@@ -364,6 +369,22 @@ begin
   ]));
 end;
 
+procedure TsSpreadExcelXMLWriter.WriteExcelWorkbook(AStream: TStream);
+var
+  datemodeStr: String;
+begin
+  if FDateMode = dm1904 then
+    datemodeStr := '  <Date1904/>' + LineEnding else
+    datemodeStr := '';
+
+  AppendToStream(AStream,
+    '<ExcelWorkbook xmlns="urn:schemas-microsoft-com:office:excel">' + LineEnding +
+      datemodeStr +
+      '<ProtectStructure>False</ProtectStructure>' + LineEnding +
+      '<ProtectWindows>False</ProtectWindows>' + LineEnding +
+    '</ExcelWorkbook>' + LineEnding);
+end;
+
 procedure TsSpreadExcelXMLWriter.WriteLabel(AStream: TStream; const ARow,
   ACol: Cardinal; const AValue: string; ACell: PCell);
 var
@@ -631,8 +652,6 @@ end;
   Writes an ExcelXML document to a stream
 -------------------------------------------------------------------------------}
 procedure TsSpreadExcelXMLWriter.WriteToStream(AStream: TStream);
-var
-  i: Integer;
 begin
   AppendToStream(AStream,
     '<?xml version="1.0"?>' + LineEnding +
@@ -645,12 +664,9 @@ begin
     ' xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"' + LineEnding +
     ' xmlns:html="http://www.w3.org/TR/REC-html40">' + LineEnding);
 
+  WriteExcelWorkbook(AStream);
   WriteStyles(AStream);
-
-  for i:=0 to FWorkbook.GetWorksheetCount-1 do begin
-    FWorksheet := FWorkbook.GetWorksheetByIndex(i);
-    WriteWorksheet(AStream, FWorksheet);
-  end;
+  WriteWorksheets(AStream);
 
   AppendToStream(AStream,
     '</Workbook>');
@@ -659,6 +675,7 @@ end;
 procedure TsSpreadExcelXMLWriter.WriteWorksheet(AStream: TStream;
   AWorksheet: TsWorksheet);
 begin
+  FWorksheet := AWorksheet;
   AppendToStream(AStream, Format(
     '<Worksheet ss:Name="%s">' + LineEnding, [AWorksheet.Name])
   );
@@ -668,6 +685,14 @@ begin
   );
 end;
 
+procedure TsSpreadExcelXMLWriter.WriteWorksheets(AStream: TStream);
+var
+  i: Integer;
+begin
+  for i:=0 to FWorkbook.GetWorksheetCount-1 do
+    WriteWorksheet(AStream, FWorkbook.GetWorksheetByIndex(i));
+end;
+
 
 initialization