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

fpspreadsheet: Fix writing of RichText in Excel2003/XML format.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7034 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-07-14 20:37:29 +00:00
parent 73f87c6979
commit 5aff5d6d37
4 changed files with 33 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
components/fpspreadsheet/examples/read_write/excelxmldemo/excelxmlread.lpr
View File

@ -23,8 +23,7 @@ var
begin
// Open the input file
dir := ExtractFilePath(ParamStr(0));
// inputFileName := dir + 'test.xml';
inputFileName := dir + 'datatypes.xml';
inputFileName := dir + 'test.xml';
if not FileExists(inputFileName) then begin
WriteLn('Input file ', inputFileName, ' does not exist. Please run excelxmlwrite first.');

11
components/fpspreadsheet/examples/read_write/excelxmldemo/excelxmlwrite.lpi
View File

@ -1,14 +1,14 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<LRSInOutputDirectory Value="False"/>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="excelxmlwrite"/>
<UseAppBundle Value="False"/>
</General>
@ -17,19 +17,16 @@
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default">
<local>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T &apos;Lazarus Run Output&apos; -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local>
</Mode0>
</Modes>

7
components/fpspreadsheet/examples/read_write/excelxmldemo/excelxmlwrite.lpr
View File

@ -126,7 +126,6 @@ begin
MyWorksheet.WriteBorderLineStyle(5, 13, cbSouth, lsDotted);
// N6 empty cell, left border: double
// MyWorksheet.WriteBlank(5, 14);
MyWorksheet.WriteBorders(5, 14, [cbWest]);
MyWorksheet.WriteBorderLineStyle(5, 14, cbWest, lsDouble);
@ -142,6 +141,8 @@ begin
MyWorksheet.WriteText(8, 3, 'Colors...');
MyWorksheet.WriteFont(8, 3, 'Courier New', 12, [fssUnderline], scBlue);
MyWorksheet.WriteBackgroundColor(8, 3, scYellow);
(********************* to do...
MyWorksheet.WriteComment(8, 3, 'This is font "Courier New", Size 12.');
// Write the string formula E1 = A1 + B1 ...
@ -169,7 +170,7 @@ begin
RPNSTring('B',
RPNFunc(fekConcat,
nil)))));
*)
r := 10;
MyWorksheet.WriteText(r, 0, 'Writing current date/time:');
inc(r, 2);
@ -377,6 +378,8 @@ begin
// Set height of rows 0
MyWorksheet.WriteRowHeight(0, 5, suLines); // 5 lines
//----------------------------------------------------------------------------
// Creates a new worksheet
MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet2);

25
components/fpspreadsheet/source/common/xlsxml.pas
View File

@ -1174,6 +1174,9 @@ var
cctStr: String;
xmlnsStr: String;
dataTagStr: String;
p: Integer;
tmp: String;
ch:char;
begin
if Length(ACell^.RichTextParams) > 0 then
begin
@ -1187,6 +1190,24 @@ begin
);
xmlnsStr := ' xmlns="http://www.w3.org/TR/REC-html40"';
dataTagStr := 'ss:';
// Excel does not like units in font size specification...
tmp := valueStr;
p := pos('<Font html:Size="', valueStr);
if p > 0 then begin
valueStr := '';
while p > 0 do begin
inc(p, Length('<Font html:Size="'));
valueStr := valueStr + copy(tmp, 1, p-1);
while (tmp[p] <> '"') do begin
if (tmp[p] in ['0'..'9', '.']) then valueStr := valueStr + tmp[p];
inc(p);
end;
tmp := copy(tmp, p, MaxInt);
p := pos('<Font html:Size="', tmp);
end;
valueStr := valuestr + tmp;
end;
end else
begin
valueStr := AValue;
@ -1597,8 +1618,8 @@ begin
// Protection
protectStr := Format(INDENT3 + '<ProtectObjects>%s</ProtectObjects>' + LF +
INDENT3 + '<ProtectScenarios>%s</ProtectScenarios>' + LF, [
StrUtils.IfThen(AWorksheet.IsProtected and (spObjects in AWorksheet.Protection), '1', '0'),
StrUtils.IfThen(AWorksheet.IsProtected {and [spScenarios in AWorksheet.Protection])}, '1', '0')
StrUtils.IfThen(AWorksheet.IsProtected and (spObjects in AWorksheet.Protection), 'True', 'False'),
StrUtils.IfThen(AWorksheet.IsProtected {and [spScenarios in AWorksheet.Protection])}, 'True', 'False')
]);
// Put it all together...