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

fpspreadsheet: Add hyperlink support to ExcelXML writer, complete comment support.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4342 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-09-20 12:22:28 +00:00
parent 995c1a737e
commit 6b92de4051
1 changed files with 165 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

176
components/fpspreadsheet/xlsxml.pas
View File

@ -104,14 +104,39 @@ procedure TsSpreadExcelXMLWriter.WriteBlank(AStream: TStream;
const ARow, ACol: Cardinal; ACell: PCell); const ARow, ACol: Cardinal; ACell: PCell);
var var
styleStr: String; styleStr: String;
hyperlink: PsHyperlink;
hyperlinkStr: String;
comment: PsComment;
commentStr: String;
begin begin
if ACell^.FormatIndex > 0 then if ACell^.FormatIndex > 0 then
styleStr := Format(' ss:StyleID="s%d"', [ACell^.FormatIndex + FMT_OFFSET]) else styleStr := Format(' ss:StyleID="s%d"', [ACell^.FormatIndex + FMT_OFFSET]) else
styleStr := ''; styleStr := '';
hyperlink := FWorksheet.FindHyperlink(ACell);
if Assigned(hyperlink) then
hyperlinkStr := ' ss:HRef="' + hyperlink^.Target + '"' else
hyperlinkStr := '';
comment := FWorksheet.FindComment(ACell);
if Assigned(comment) then
// commentStr := '<Comment><ss:Data xmlns="http://www.w3.org/TR/REC-html40">'+comment^.Text+'</ss:Data></Comment>' else
commentStr := '<Comment><Data>'+comment^.Text+'</Data></Comment>' else
commentStr := '';
AppendToStream(AStream, Format(
' <Cell%s%s>' + // style, hyperlink
'%s' + // Comment <Comment>...</Comment>
'</Cell>' + LineEnding, [
styleStr, hyperlinkStr,
commentStr
]));
{
AppendToStream(AStream, Format( AppendToStream(AStream, Format(
' <Cell%s />' + LineEnding, ' <Cell%s />' + LineEnding,
[styleStr]) [styleStr])
); ); }
end; end;
procedure TsSpreadExcelXMLWriter.WriteBool(AStream: TStream; procedure TsSpreadExcelXMLWriter.WriteBool(AStream: TStream;
@ -121,6 +146,10 @@ var
formulaStr: String; formulaStr: String;
cctStr: String; cctStr: String;
stylestr: String; stylestr: String;
hyperlink: PsHyperlink;
hyperlinkStr: String;
comment: PsComment;
commentStr: String;
begin begin
valueStr := StrUtils.IfThen(AValue, '1', '0'); valueStr := StrUtils.IfThen(AValue, '1', '0');
cctStr := 'Boolean'; cctStr := 'Boolean';
@ -134,9 +163,33 @@ begin
styleStr := Format(' ss:StyleID="s%d"', [ACell^.FormatIndex + FMT_OFFSET]) else styleStr := Format(' ss:StyleID="s%d"', [ACell^.FormatIndex + FMT_OFFSET]) else
styleStr := ''; styleStr := '';
hyperlink := FWorksheet.FindHyperlink(ACell);
if Assigned(hyperlink) then
hyperlinkStr := ' ss:HRef="' + hyperlink^.Target + '"' else
hyperlinkStr := '';
comment := FWorksheet.FindComment(ACell);
if Assigned(comment) then
commentStr := '<Comment><Data>'+comment^.Text+'</Data></Comment>' else
commentStr := '';
AppendToStream(AStream, Format(
' <Cell%s%s%s>' + // style, formula, hyperlink
'<Data ss:Type="%s">' + // data type
'%s' + // value string
'</Data>' +
'%s' + // Comment <Comment>...</Comment>
'</Cell>' + LineEnding, [
styleStr, formulaStr, hyperlinkStr,
cctStr,
valueStr,
commentStr
]));
{
AppendToStream(AStream, Format( AppendToStream(AStream, Format(
' <Cell%s%s><Data ss:Type="%s">%s</Data></Cell>' + LineEnding, ' <Cell%s%s><Data ss:Type="%s">%s</Data></Cell>' + LineEnding,
[styleStr, formulaStr, cctStr, valueStr])); [styleStr, formulaStr, cctStr, valueStr])); }
end; end;
procedure TsSpreadExcelXMLWriter.WriteCells(AStream: TStream; AWorksheet: TsWorksheet); procedure TsSpreadExcelXMLWriter.WriteCells(AStream: TStream; AWorksheet: TsWorksheet);
@ -207,6 +260,10 @@ var
ExcelDate: TDateTime; ExcelDate: TDateTime;
nfp: TsNumFormatParams; nfp: TsNumFormatParams;
fmt: PsCellFormat; fmt: PsCellFormat;
hyperlink: PsHyperlink;
hyperlinkStr: String;
comment: PsComment;
commentStr: String;
begin begin
ExcelDate := AValue; ExcelDate := AValue;
fmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex); fmt := FWorkbook.GetPointerToCellFormat(ACell^.FormatIndex);
@ -230,10 +287,33 @@ begin
styleStr := Format(' ss:StyleID="s%d"', [ACell^.FormatIndex + FMT_OFFSET]) else styleStr := Format(' ss:StyleID="s%d"', [ACell^.FormatIndex + FMT_OFFSET]) else
styleStr := ''; styleStr := '';
hyperlink := FWorksheet.FindHyperlink(ACell);
if Assigned(hyperlink) then
hyperlinkStr := ' ss:HRef="' + hyperlink^.Target + '"' else
hyperlinkStr := '';
comment := FWorksheet.FindComment(ACell);
if Assigned(comment) then
commentStr := '<Comment><Data>'+comment^.Text+'</Data></Comment>' else
commentStr := '';
AppendToStream(AStream, Format(
' <Cell%s%s%s>' + // style, formula, hyperlink
'<Data ss:Type="%s">' + // data type
'%s' + // value string
'</Data>' +
'%s' + // Comment <Comment>...</Comment>
'</Cell>' + LineEnding, [
styleStr, formulaStr, hyperlinkStr,
cctStr,
valueStr,
commentStr
]));
{
AppendToStream(AStream, Format( AppendToStream(AStream, Format(
' <Cell%s%s><Data ss:Type="%s">%s</Data></Cell>' + LineEnding, ' <Cell%s%s><Data ss:Type="%s">%s</Data></Cell>' + LineEnding,
[styleStr, formulaStr, cctStr, valueStr]) [styleStr, formulaStr, cctStr, valueStr])
); ); }
end; end;
procedure TsSpreadExcelXMLWriter.WriteError(AStream: TStream; procedure TsSpreadExcelXMLWriter.WriteError(AStream: TStream;
@ -243,8 +323,13 @@ var
cctStr: String; cctStr: String;
formulaStr: String; formulaStr: String;
styleStr: String; styleStr: String;
hyperlink: PsHyperlink;
hyperlinkStr: String;
comment: PsComment;
commentStr: String;
begin begin
valueStr := GetErrorValueStr(AValue); valueStr := GetErrorValueStr(AValue);
formulaStr := ''; formulaStr := '';
cctStr := 'Error'; cctStr := 'Error';
if HasFormula(ACell) then if HasFormula(ACell) then
@ -252,14 +337,41 @@ begin
cctStr := GetCellContentTypeStr(ACell); cctStr := GetCellContentTypeStr(ACell);
formulaStr := Format(' ss:Formula="=%s"', [ACell^.FormulaValue]); formulaStr := Format(' ss:Formula="=%s"', [ACell^.FormulaValue]);
end; end;
if ACell^.FormatIndex > 0 then if ACell^.FormatIndex > 0 then
styleStr := Format(' ss:StyleID="s%d"', [ACell^.FormatIndex + FMT_OFFSET]) else styleStr := Format(' ss:StyleID="s%d"', [ACell^.FormatIndex + FMT_OFFSET]) else
styleStr := ''; styleStr := '';
hyperlink := FWorksheet.FindHyperlink(ACell);
if Assigned(hyperlink) then
hyperlinkStr := ' ss:HRef="' + hyperlink^.Target + '"' else
hyperlinkStr := '';
comment := FWorksheet.FindComment(ACell);
if Assigned(comment) then
// commentStr := '<Comment><ss:Data xmlns="http://www.w3.org/TR/REC-html40">'+comment^.Text+'</ss:Data></Comment>' else
commentStr := '<Comment><Data>'+comment^.Text+'</Data></Comment>' else
commentStr := '';
AppendToStream(AStream, Format(
' <Cell%s%s%s>' + // style, formula, hyperlink
'<Data ss:Type="%s">' + // data type
'%s' + // value string
'</Data>' +
'%s' + // Comment <Comment>...</Comment>
'</Cell>' + LineEnding, [
styleStr, formulaStr, hyperlinkStr,
cctStr,
valueStr,
commentStr
]));
{
AppendToStream(AStream, Format( AppendToStream(AStream, Format(
' <Cell%s%s><Data ss:Type="%s">%s</Data></Cell>' + LineEnding, ' <Cell%s%s><Data ss:Type="%s">%s</Data></Cell>' + LineEnding,
[styleStr, formulaStr, cctStr, valueStr]) [styleStr, formulaStr, cctStr, valueStr])
); );
}
end; end;
procedure TsSpreadExcelXMLWriter.WriteLabel(AStream: TStream; const ARow, procedure TsSpreadExcelXMLWriter.WriteLabel(AStream: TStream; const ARow,
@ -269,10 +381,12 @@ var
cctStr: String; cctStr: String;
formulaStr: String; formulaStr: String;
styleStr: String; styleStr: String;
xmlns: String; xmlnsStr: String;
dataTagStr: String; dataTagStr: String;
comment: PsComment; comment: PsComment;
commentStr: String; commentStr: String;
hyperlink: PsHyperlink;
hyperlinkStr: String;
begin begin
if Length(ACell^.RichTextParams) > 0 then if Length(ACell^.RichTextParams) > 0 then
begin begin
@ -284,7 +398,7 @@ begin
valueStr, // html-formatted rich text valueStr, // html-formatted rich text
'html:', tcProperCase 'html:', tcProperCase
); );
xmlns := ' xmlns="http://www.w3.org/TR/REC-html40"'; xmlnsStr := ' xmlns="http://www.w3.org/TR/REC-html40"';
dataTagStr := 'ss:'; dataTagStr := 'ss:';
end else end else
begin begin
@ -294,7 +408,7 @@ begin
rsInvalidCharacterInCell, [ rsInvalidCharacterInCell, [
GetCellString(ARow, ACol) GetCellString(ARow, ACol)
]); ]);
xmlns := ''; xmlnsStr := '';
dataTagStr := ''; dataTagStr := '';
end; end;
@ -309,6 +423,11 @@ begin
styleStr := Format(' ss:StyleID="s%d"', [ACell^.FormatIndex + FMT_OFFSET]) else styleStr := Format(' ss:StyleID="s%d"', [ACell^.FormatIndex + FMT_OFFSET]) else
styleStr := ''; styleStr := '';
hyperlink := FWorksheet.FindHyperlink(ACell);
if Assigned(hyperlink) then
hyperlinkStr := ' ss:HRef="' + hyperlink^.Target + '"' else
hyperlinkStr := '';
comment := FWorksheet.FindComment(ACell); comment := FWorksheet.FindComment(ACell);
if Assigned(comment) then if Assigned(comment) then
// commentStr := '<Comment><ss:Data xmlns="http://www.w3.org/TR/REC-html40">'+comment^.Text+'</ss:Data></Comment>' else // commentStr := '<Comment><ss:Data xmlns="http://www.w3.org/TR/REC-html40">'+comment^.Text+'</ss:Data></Comment>' else
@ -316,18 +435,30 @@ begin
commentStr := ''; commentStr := '';
AppendToStream(AStream, Format( AppendToStream(AStream, Format(
' <Cell%s%s><%sData ss:Type="%s"%s>%s</%sData>%s</Cell>' + LineEnding, ' <Cell%s%s%s>' + // style, formula, hyperlink
[styleStr, formulaStr, dataTagStr, cctStr, xmlns, valueStr, dataTagStr, commentStr]) '<%sData ss:Type="%s"%s>'+ // "ss:", data type, "xmlns=.."
); '%s' + // value string
'</%sData>' + // "ss:"
'%s' + // Comment
'</Cell>' + LineEnding, [
styleStr, formulaStr, hyperlinkStr,
dataTagStr, cctStr, xmlnsStr,
valueStr,
dataTagStr,
commentStr
]));
end; end;
procedure TsSpreadExcelXMLWriter.WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; procedure TsSpreadExcelXMLWriter.WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: double; ACell: PCell); const AValue: double; ACell: PCell);
var var
formulaStr: String; formulaStr: String;
cctStr: String; cctStr: String;
styleStr: String; styleStr: String;
hyperlink: PsHyperlink;
hyperlinkStr: String;
comment: PsComment;
commentStr: String;
begin begin
cctStr := 'Number'; cctStr := 'Number';
if HasFormula(ACell) then if HasFormula(ACell) then
@ -339,10 +470,33 @@ begin
styleStr := Format(' ss:StyleID="s%d"', [ACell^.FormatIndex + FMT_OFFSET]) else styleStr := Format(' ss:StyleID="s%d"', [ACell^.FormatIndex + FMT_OFFSET]) else
styleStr := ''; styleStr := '';
hyperlink := FWorksheet.FindHyperlink(ACell);
if Assigned(hyperlink) then
hyperlinkStr := ' ss:HRef="' + hyperlink^.Target + '"' else
hyperlinkStr := '';
comment := FWorksheet.FindComment(ACell);
if Assigned(comment) then
commentStr := '<Comment><Data>'+comment^.Text+'</Data></Comment>' else
commentStr := '';
AppendToStream(AStream, Format(
' <Cell%s%s%s>' + // style, formula, hyperlink
'<Data ss:Type="%s">' + // data type
'%g' + // value
'</Data>' +
'%s' + // Comment <Comment>...</Comment>
'</Cell>' + LineEnding, [
styleStr, formulaStr, hyperlinkStr,
cctStr,
AValue,
commentStr
]));
{
AppendToStream(AStream, Format( AppendToStream(AStream, Format(
' <Cell%s%s><Data ss:Type="%s">%g</Data></Cell>' + LineEnding, ' <Cell%s%s><Data ss:Type="%s">%g</Data></Cell>' + LineEnding,
[styleStr, formulaStr, cctStr, AValue], FPointSeparatorSettings) [styleStr, formulaStr, cctStr, AValue], FPointSeparatorSettings)
); ); }
end; end;
procedure TsSpreadExcelXMLWriter.WriteStyle(AStream: TStream; AIndex: Integer); procedure TsSpreadExcelXMLWriter.WriteStyle(AStream: TStream; AIndex: Integer);