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

fpspreadsheet: Add 1904-DateMode to ExcelXML writer.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4344 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-09-20 14:20:04 +00:00
parent 3b55c6c835
commit 9f593aa10a
2 changed files with 37 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
components/fpspreadsheet/xlscommon.pas
View File

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

43
components/fpspreadsheet/xlsxml.pas
View File

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