fpspreadsheet: Add writing of cell comments for opendocument files.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3914 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-01-30 17:46:06 +00:00
parent b267fd7694
commit cf5ece6e86
3 changed files with 38 additions and 1 deletions

View File

@ -144,6 +144,7 @@ type
function WriteBackgroundColorStyleXMLAsString(const AFormat: TsCellFormat): String; function WriteBackgroundColorStyleXMLAsString(const AFormat: TsCellFormat): String;
function WriteBorderStyleXMLAsString(const AFormat: TsCellFormat): String; function WriteBorderStyleXMLAsString(const AFormat: TsCellFormat): String;
function WriteCommentXMLAsString(AComment: String): String;
function WriteDefaultFontXMLAsString: String; function WriteDefaultFontXMLAsString: String;
function WriteFontStyleXMLAsString(const AFormat: TsCellFormat): String; function WriteFontStyleXMLAsString(const AFormat: TsCellFormat): String;
function WriteHorAlignmentStyleXMLAsString(const AFormat: TsCellFormat): String; function WriteHorAlignmentStyleXMLAsString(const AFormat: TsCellFormat): String;
@ -3028,6 +3029,37 @@ begin
end; end;
end; end;
function TsSpreadOpenDocWriter.WriteCommentXMLAsString(AComment: String): String;
var
L: TStringList;
s: String;
err: Boolean;
i: Integer;
begin
Result := '';
if AComment = '' then exit;
result := '<office:annotation>';
err := false;
L := TStringList.Create;
try
L.Text := AComment;
for i:=0 to L.Count-1 do begin
s := L[i];
if not ValidXMLText(s) then begin
if not err then
Workbook.AddErrorMsg(rsInvalidCharacterInCellComment, [AComment]);
err := true;
end;
Result := Result + '<text:p>' + s + '</text:p>';
end;
finally
L.Free;
end;
Result := Result + '</office:annotation>';
end;
procedure TsSpreadOpenDocWriter.WriteFontNames(AStream: TStream); procedure TsSpreadOpenDocWriter.WriteFontNames(AStream: TStream);
var var
L: TStringList; L: TStringList;
@ -4004,6 +4036,7 @@ var
spannedStr: String; spannedStr: String;
r1,c1,r2,c2: Cardinal; r1,c1,r2,c2: Cardinal;
str: ansistring; str: ansistring;
comment: String;
fmt: TsCellFormat; fmt: TsCellFormat;
begin begin
Unused(ARow, ACol); Unused(ARow, ACol);
@ -4033,9 +4066,12 @@ begin
GetCellString(ARow, ACol) GetCellString(ARow, ACol)
]); ]);
comment := WriteCommentXMLAsString(ACell^.Comment);
// Write it ... // Write it ...
AppendToStream(AStream, Format( AppendToStream(AStream, Format(
'<table:table-cell office:value-type="string" %s %s>' + '<table:table-cell office:value-type="string" %s %s>' +
comment+
'<text:p>%s</text:p>'+ '<text:p>%s</text:p>'+
'</table:table-cell>', [ '</table:table-cell>', [
lStyle, spannedStr, lStyle, spannedStr,

View File

@ -1509,7 +1509,7 @@ end;
Draws the red rectangle in the upper right corner of a cell to indicate that Draws the red rectangle in the upper right corner of a cell to indicate that
this cell contains a popup comment this cell contains a popup comment
-------------------------------------------------------------------------------} -------------------------------------------------------------------------------}
procedure TscustomWorksheetGrid.DrawCommentMarker(ARect: TRect); procedure TsCustomWorksheetGrid.DrawCommentMarker(ARect: TRect);
const const
COMMENT_SIZE = 8; COMMENT_SIZE = 8;
var var

View File

@ -47,6 +47,7 @@ resourcestring
rsColumnStyleNotFound = 'Column style not found.'; rsColumnStyleNotFound = 'Column style not found.';
rsRowStyleNotFound = 'Row style not found.'; rsRowStyleNotFound = 'Row style not found.';
rsInvalidCharacterInCell = 'Invalid character(s) in cell %s.'; rsInvalidCharacterInCell = 'Invalid character(s) in cell %s.';
rsInvalidCharacterInCellComment = 'Invalid character(s) in cell comment "%s".';
rsUTF8TextExpectedButANSIFoundInCell = 'Expected UTF8 text but probably ANSI '+ rsUTF8TextExpectedButANSIFoundInCell = 'Expected UTF8 text but probably ANSI '+
'text found in cell %s.'; 'text found in cell %s.';
rsIndexInSSTOutOfRange = 'Index %d in SST out of range (0-%d).'; rsIndexInSSTOutOfRange = 'Index %d in SST out of range (0-%d).';