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

fpspreadsheet: Fix writing of empty strings to cell. Fix biff8 stream read error of hyperlinks.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3981 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-03-03 00:06:15 +00:00
parent 135ceb1eef
commit 23d6bdc557
4 changed files with 53 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files

46
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -4060,11 +4060,39 @@ end;
@param AText The text to be written encoded in utf-8
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteUTF8Text(ACell: PCell; AText: ansistring);
var
r, c: Cardinal;
hyperlink: TsHyperlink;
begin
if ACell = nil then
exit;
if (AText = '') and HasHyperlink(ACell) then
begin
hyperlink := ReadHyperlink(ACell);
AText := hyperlink.Target;
end;
if (AText = '') then
begin
if (Workbook.GetCellFormat(ACell^.FormatIndex).UsedFormattingFields = []) and
(ACell^.Flags * [cfHyperlink, cfHasComment, cfMerged] = []) and
(ACell^.SharedFormulaBase = nil) and
(ACell^.FormulaValue = '')
then
begin
r := ACell^.Row;
c := ACell^.Col;
RemoveCell(r, c);
ChangedCell(r, c);
end else
WriteBlank(ACell);
exit;
end;
ACell^.ContentType := cctUTF8String;
ACell^.UTF8StringValue := AText;
ChangedCell(ACell^.Row, ACell^.Col);
end;
@ -4246,11 +4274,18 @@ end;
along a range of cells including empty cells.
-------------------------------------------------------------------------------}
procedure TsWorksheet.WriteBlank(ACell: PCell);
var
hyperlink: TsHyperlink;
begin
if ACell <> nil then begin
if HasHyperlink(ACell) then
WriteUTF8Text(ACell, '') // '' will be replaced by the hyperlink target.
else
begin
ACell^.ContentType := cctEmpty;
ChangedCell(ACell^.Row, ACell^.Col);
end;
end;
end;
{@@ ----------------------------------------------------------------------------
@ -4315,7 +4350,6 @@ procedure TsWorksheet.WriteCellValueAsString(ACell: PCell; AValue: String);
var
isPercent: Boolean;
number: Double;
r, c: Cardinal;
currSym: String;
fmt: TsCellFormat;
begin
@ -4324,15 +4358,9 @@ begin
fmt := Workbook.GetCellFormat(ACell^.FormatIndex);
if AValue = '' then begin
if fmt.UsedFormattingFields = [] then
if AValue = '' then
begin
r := ACell^.Row;
c := ACell^.Col;
RemoveAndFreeCell(r, c);
end
else
WriteBlank(ACell);
WriteUTF8Text(ACell, '');
exit;
end;

1
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -4000,6 +4000,7 @@ begin
if (Workbook <> nil) and (Worksheet <> nil) then begin
cell := Worksheet.FindCell(GetWorksheetRow(ARow), GetWorksheetCol(ACol));
fnt := Worksheet.ReadCellFont(cell);
if fnt <> nil then
Result := fnt.FontName;
end;
end;

10
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@ -8,7 +8,6 @@
<MainUnit Value="0"/>
<Title Value="spreadtestgui"/>
<ResourceType Value="res"/>
<Icon Value="-1"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
@ -49,12 +48,10 @@
<Unit1>
<Filename Value="datetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="datetests"/>
</Unit1>
<Unit2>
<Filename Value="stringtests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="stringtests"/>
</Unit2>
<Unit3>
<Filename Value="numberstests.pas"/>
@ -71,17 +68,14 @@
<Unit6>
<Filename Value="internaltests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="internaltests"/>
</Unit6>
<Unit7>
<Filename Value="formattests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="formattests"/>
</Unit7>
<Unit8>
<Filename Value="colortests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="colortests"/>
</Unit8>
<Unit9>
<Filename Value="fonttests.pas"/>
@ -98,12 +92,10 @@
<Unit12>
<Filename Value="rpnformulaunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rpnFormulaUnit"/>
</Unit12>
<Unit13>
<Filename Value="formulatests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="formulatests"/>
</Unit13>
<Unit14>
<Filename Value="emptycelltests.pas"/>
@ -112,7 +104,6 @@
<Unit15>
<Filename Value="errortests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="errortests"/>
</Unit15>
<Unit16>
<Filename Value="virtualmodetests.pas"/>
@ -134,7 +125,6 @@
<Unit20>
<Filename Value="copytests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="copytests"/>
</Unit20>
<Unit21>
<Filename Value="commenttests.pas"/>

20
components/fpspreadsheet/xlsbiff8.pas
View File

@ -1430,14 +1430,12 @@ var
flags: DWord;
widestr: widestring;
len: DWord;
isInternal: Boolean;
link: String;
linkDos: String;
mark: String;
dirUpCount: Word;
ansistr: ansistring;
size: DWord;
buf: array of byte;
begin
{ Row and column index range of cells using the hyperlink }
row1 := WordLEToN(AStream.ReadWord);
@ -1474,13 +1472,15 @@ begin
// Check for URL
if GuidToString(guid) = '{79EAC9E0-BAF9-11CE-8C82-00AA004BA90B}' then
begin
// Character count incl trailing zero
len := DWordLEToN(AStream.ReadDWord);
// Size of character array incl trailing zero
size := DWordLEToN(AStream.ReadDWord);
len := size div 2 -1;
// Character array of URL (16-bit-characters, with trailing zero word)
SetLength(wideStr, len);
AStream.ReadBuffer(wideStr[1], len*SizeOf(wideChar));
SetLength(wideStr, len-1); // Remove trailing zero word
link := UTF8Encode(wideStr);
AStream.ReadBuffer(wideStr[1], size);
SetLength(link, size);
len := System.UnicodeToUTF8(PChar(link), PWideChar(wideStr), size);
SetLength(link, len);
end else
// Check for local file
if GuidToString(guid) = '{00000303-0000-0000-C000-000000000046}' then
@ -1520,8 +1520,10 @@ begin
// Character array of the extended file path and name
// no Unicode string header, always 16-bit characters, not zero-terminated
SetLength(wideStr, len);
AStream.ReadBuffer(wideStr[1], len*SizeOf(wideChar));
link := UTF8Encode(widestr);
AStream.ReadBuffer(wideStr[1], size);
SetLength(link, size);
len := System.UnicodeToUTF8(PChar(link), PWideChar(widestr), size);
SetLength(link, len);
end else
link := linkDos;
end;