You've already forked lazarus-ccr
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
This commit is contained in:
@@ -661,9 +661,9 @@ function ConvertExcelDateTimeToDateTime(const AExcelDateNum: Double;
|
|||||||
ADateMode: TDateMode): TDateTime;
|
ADateMode: TDateMode): TDateTime;
|
||||||
begin
|
begin
|
||||||
// Time only:
|
// Time only:
|
||||||
if (AExcelDateNum<1) and (AExcelDateNum>=0) then
|
if (AExcelDateNum < 1) and (AExcelDateNum >= 0) then
|
||||||
begin
|
begin
|
||||||
Result:=AExcelDateNum;
|
Result := AExcelDateNum;
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
@@ -699,7 +699,7 @@ end;
|
|||||||
function ConvertDateTimeToExcelDateTime(const ADateTime: TDateTime;
|
function ConvertDateTimeToExcelDateTime(const ADateTime: TDateTime;
|
||||||
ADateMode: TDateMode): Double;
|
ADateMode: TDateMode): Double;
|
||||||
begin
|
begin
|
||||||
// Time only:
|
// Time only
|
||||||
if (ADateTime<1) and (ADateTime>=0) then
|
if (ADateTime<1) and (ADateTime>=0) then
|
||||||
begin
|
begin
|
||||||
Result:=ADateTime;
|
Result:=ADateTime;
|
||||||
|
@@ -25,9 +25,11 @@ type
|
|||||||
function GetMergeStr(ACell: PCell): String;
|
function GetMergeStr(ACell: PCell): String;
|
||||||
function GetStyleStr(ACell: PCell): String;
|
function GetStyleStr(ACell: PCell): String;
|
||||||
procedure WriteCells(AStream: TStream; AWorksheet: TsWorksheet);
|
procedure WriteCells(AStream: TStream; AWorksheet: TsWorksheet);
|
||||||
|
procedure WriteExcelWorkbook(AStream: TStream);
|
||||||
procedure WriteStyle(AStream: TStream; AIndex: Integer);
|
procedure WriteStyle(AStream: TStream; AIndex: Integer);
|
||||||
procedure WriteStyles(AStream: TStream);
|
procedure WriteStyles(AStream: TStream);
|
||||||
procedure WriteWorksheet(AStream: TStream; AWorksheet: TsWorksheet);
|
procedure WriteWorksheet(AStream: TStream; AWorksheet: TsWorksheet);
|
||||||
|
procedure WriteWorksheets(AStream: TStream);
|
||||||
|
|
||||||
protected
|
protected
|
||||||
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
|
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
|
||||||
@@ -302,12 +304,15 @@ var
|
|||||||
begin
|
begin
|
||||||
ExcelDate := AValue;
|
ExcelDate := AValue;
|
||||||
fmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex);
|
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
|
if (fmt <> nil) and (uffNumberFormat in fmt^.UsedFormattingFields) then
|
||||||
begin
|
begin
|
||||||
nfp := FWorkbook.GetNumberFormat(fmt^.NumberFormatIndex);
|
nfp := FWorkbook.GetNumberFormat(fmt^.NumberFormatIndex);
|
||||||
if IsTimeIntervalFormat(nfp) or IsTimeFormat(nfp) then
|
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;
|
end;
|
||||||
valueStr := FormatDateTime('yyyy-mm-dd"T"hh:nn:ss.zzz', ExcelDate);
|
valueStr := FormatDateTime('yyyy-mm-dd"T"hh:nn:ss.zzz', ExcelDate);
|
||||||
|
|
||||||
@@ -364,6 +369,22 @@ begin
|
|||||||
]));
|
]));
|
||||||
end;
|
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,
|
procedure TsSpreadExcelXMLWriter.WriteLabel(AStream: TStream; const ARow,
|
||||||
ACol: Cardinal; const AValue: string; ACell: PCell);
|
ACol: Cardinal; const AValue: string; ACell: PCell);
|
||||||
var
|
var
|
||||||
@@ -631,8 +652,6 @@ end;
|
|||||||
Writes an ExcelXML document to a stream
|
Writes an ExcelXML document to a stream
|
||||||
-------------------------------------------------------------------------------}
|
-------------------------------------------------------------------------------}
|
||||||
procedure TsSpreadExcelXMLWriter.WriteToStream(AStream: TStream);
|
procedure TsSpreadExcelXMLWriter.WriteToStream(AStream: TStream);
|
||||||
var
|
|
||||||
i: Integer;
|
|
||||||
begin
|
begin
|
||||||
AppendToStream(AStream,
|
AppendToStream(AStream,
|
||||||
'<?xml version="1.0"?>' + LineEnding +
|
'<?xml version="1.0"?>' + LineEnding +
|
||||||
@@ -645,12 +664,9 @@ begin
|
|||||||
' xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"' + LineEnding +
|
' xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"' + LineEnding +
|
||||||
' xmlns:html="http://www.w3.org/TR/REC-html40">' + LineEnding);
|
' xmlns:html="http://www.w3.org/TR/REC-html40">' + LineEnding);
|
||||||
|
|
||||||
|
WriteExcelWorkbook(AStream);
|
||||||
WriteStyles(AStream);
|
WriteStyles(AStream);
|
||||||
|
WriteWorksheets(AStream);
|
||||||
for i:=0 to FWorkbook.GetWorksheetCount-1 do begin
|
|
||||||
FWorksheet := FWorkbook.GetWorksheetByIndex(i);
|
|
||||||
WriteWorksheet(AStream, FWorksheet);
|
|
||||||
end;
|
|
||||||
|
|
||||||
AppendToStream(AStream,
|
AppendToStream(AStream,
|
||||||
'</Workbook>');
|
'</Workbook>');
|
||||||
@@ -659,6 +675,7 @@ end;
|
|||||||
procedure TsSpreadExcelXMLWriter.WriteWorksheet(AStream: TStream;
|
procedure TsSpreadExcelXMLWriter.WriteWorksheet(AStream: TStream;
|
||||||
AWorksheet: TsWorksheet);
|
AWorksheet: TsWorksheet);
|
||||||
begin
|
begin
|
||||||
|
FWorksheet := AWorksheet;
|
||||||
AppendToStream(AStream, Format(
|
AppendToStream(AStream, Format(
|
||||||
'<Worksheet ss:Name="%s">' + LineEnding, [AWorksheet.Name])
|
'<Worksheet ss:Name="%s">' + LineEnding, [AWorksheet.Name])
|
||||||
);
|
);
|
||||||
@@ -668,6 +685,14 @@ begin
|
|||||||
);
|
);
|
||||||
end;
|
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
|
initialization
|
||||||
|
|
||||||
|
Reference in New Issue
Block a user