FPSpreadsheet: Patch from bug 19422: Copy file OSD with

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1657 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2011-05-29 17:42:56 +00:00
parent 5270dd2eb6
commit a267e89ae8
3 changed files with 44 additions and 4 deletions

View File

@ -170,8 +170,8 @@ begin
WriteSecondWorksheet(); WriteSecondWorksheet();
// Save the spreadsheet to a file // Save the spreadsheet to a file
MyWorkbook.WriteToFile(MyDir + 'test3.xls', sfExcel8, False); // MyWorkbook.WriteToFile(MyDir + 'test3.xls', sfExcel8, False);
// MyWorkbook.WriteToFile(MyDir + 'test3.odt', sfOpenDocument, False); MyWorkbook.WriteToFile(MyDir + 'test3.odt', sfOpenDocument, False);
MyWorkbook.Free; MyWorkbook.Free;
end. end.

View File

@ -30,7 +30,9 @@ uses
Classes, SysUtils, Classes, SysUtils,
fpszipper, {NOTE: fpszipper is the latest zipper.pp Change to standard zipper when FPC 2.4 is released. Changed by JLJR} fpszipper, {NOTE: fpszipper is the latest zipper.pp Change to standard zipper when FPC 2.4 is released. Changed by JLJR}
fpspreadsheet, fpspreadsheet,
xmlread, DOM, AVL_Tree,math; xmlread, DOM, AVL_Tree,
math,
fpsutils;
type type
@ -632,7 +634,7 @@ begin
// The row should already be the correct one // The row should already be the correct one
FContent := FContent + FContent := FContent +
' <table:table-cell office:value-type="string"' + lStyle + '>' + LineEnding + ' <table:table-cell office:value-type="string"' + lStyle + '>' + LineEnding +
' <text:p>' + AValue + '</text:p>' + LineEnding + ' <text:p>' + UTF8TextToXMLText(AValue) + '</text:p>' + LineEnding +
' </table:table-cell>' + LineEnding; ' </table:table-cell>' + LineEnding;
end; end;

View File

@ -34,6 +34,7 @@ function ParseCellRowString(const AStr: string;
var AResult: Integer): Boolean; var AResult: Integer): Boolean;
function ParseCellColString(const AStr: string; function ParseCellColString(const AStr: string;
var AResult: Integer): Boolean; var AResult: Integer): Boolean;
function UTF8TextToXMLText(AText: ansistring): ansistring;
implementation implementation
@ -264,5 +265,42 @@ begin
Result := True; Result := True;
end; end;
{In XML files some chars must be translated}
function UTF8TextToXMLText(AText: ansistring): ansistring;
var
Idx:Integer;
WrkStr, AppoSt:ansistring;
begin
WrkStr:='';
for Idx:=1 to Length(AText) do
begin
case AText[Idx] of
'&': begin
AppoSt:=Copy(AText, Idx, 6);
if (Pos('&amp;', AppoSt) = 1) or
(Pos('&lt;', AppoSt) = 1) or
(Pos('&gt;', AppoSt) = 1) or
(Pos('&quot;', AppoSt) = 1) or
(Pos('&apos;', AppoSt) = 1) then begin
//'&' is the first char of a special chat, it must not be converted
WrkStr:=WrkStr + AText[Idx];
end else begin
WrkStr:=WrkStr + '&amp;';
end;
end;
'<': WrkStr:=WrkStr + '&lt;';
'>': WrkStr:=WrkStr + '&gt;';
'"': WrkStr:=WrkStr + '&quot;';
'''':WrkStr:=WrkStr + '&apos;';
else
WrkStr:=WrkStr + AText[Idx];
end;
end;
Result:=WrkStr;
end;
end. end.