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

fpspreadsheet: Log warning if BIFF writer tries to write more than 64 colors. More clean-up.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3468 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-08-11 11:16:43 +00:00
parent 61ae361d37
commit ad1ae69544
12 changed files with 35 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
components/fpspreadsheet/fpsfunc.pas
View File

@ -1293,6 +1293,7 @@ end;
function fpsPI(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
begin
Unused(Args);
Unused(NumArgs);
Result := CreateNumberArg(pi);
end;
@ -1308,6 +1309,7 @@ end;
function fpsRAND(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
begin
Unused(Args);
Unused(NumArgs);
Result := CreateNumberArg(random);
end;
@ -1493,6 +1495,7 @@ end;
function fpsNOW(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
// NOW()
begin
Unused(Args);
Unused(NumArgs);
Result := CreateNumberArg(now);
end;
@ -1532,6 +1535,7 @@ end;
function fpsToday(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
// TODAY()
begin
Unused(Args);
Unused(NumArgs);
Result := CreateNumberArg(Date());
end;
@ -1899,6 +1903,7 @@ end;
function fpsFALSE(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
// FALSE( )
begin
Unused(Args);
Unused(NumArgs);
Result := CreateBoolArg(false);
end;
@ -1908,7 +1913,6 @@ function fpsIF(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
condition: TsArgument;
case1, case2: TsArgument;
err: TsErrorValue;
begin
if NumArgs = 3 then
case2 := Args.Pop;
@ -1954,6 +1958,7 @@ end;
function fpsTRUE(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
// TRUE ( )
begin
Unused(Args);
Unused(NumArgs);
Result := CreateBoolArg(true);
end;
@ -2118,7 +2123,6 @@ function fpsSUBSTITUTE(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
number: Double;
n: Integer;
arg: TsArgument;
data: TsArgStringArray;
s, s_old, s_new: String;
begin
@ -2310,7 +2314,6 @@ var
arg: TsArgument;
cell: PCell;
sname: String;
data: TsArgStringArray;
res: TsArgument;
begin
if NumArgs < 2 then begin

2
components/fpspreadsheet/fpsopendocument.pas
View File

@ -1035,7 +1035,6 @@ var
s: String;
defCellStyleIndex: Integer;
colStyleIndex: Integer;
colStyleData: TColumnStyleData;
colData: TColumnData;
colsRepeated: Integer;
j: Integer;
@ -1052,7 +1051,6 @@ begin
colStyleIndex := FindColStyleByName(s);
if colStyleIndex <> -1 then begin
defCellStyleIndex := -1;
colStyleData := TColumnStyleData(FColumnStyleList[colStyleIndex]);
s := GetAttrValue(ColNode, 'table:default-cell-style-name');
if s <> '' then begin
defCellStyleIndex := FindCellStyleByName(s);

1
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -4535,7 +4535,6 @@ end;
procedure TsWorksheet.InsertCol(ACol: Cardinal);
var
cellnode: TAVLTreeNode;
cell: PCell;
col: PCol;
i: Integer;
begin

6
components/fpspreadsheet/fpsutils.pas
View File

@ -155,6 +155,9 @@ implementation
uses
Math, lazutf8;
type
TRGBA = record r, g, b, a: byte end;
{******************************************************************************}
{ Endianess helper functions }
{******************************************************************************}
@ -2101,8 +2104,6 @@ end;
(with the exception that max hue is 240, nur 255!)
}
function TintedColor(AColor: TsColorValue; tint: Double): TsColorValue;
type
TRGBA = record r, g, b, a: byte end;
const
HLSMAX = 255;
var
@ -2135,7 +2136,6 @@ begin
TRGBA(Result).a := 0;
end;
{$PUSH}{$HINTS OFF}
{@@ Silence warnings due to an unused parameter }
procedure Unused(const A1);

2
components/fpspreadsheet/tests/formattests.pas
View File

@ -616,8 +616,6 @@ var
MyWorkbook: TsWorkbook;
MyCell: PCell;
col, maxCol: Integer;
expected: String;
current: String;
TempFile: string; //write xls/xml to this file and read back from it
function GetBordersAsText(ABorders: TsCellBorders): String;

2
components/fpspreadsheet/tests/formulatests.pas
View File

@ -190,8 +190,8 @@ begin
The test file contains the text representation in column A, and the
formula in column B. }
Row := 0;
{$I testcases_calcrpnformula.inc}
TempFile:=GetTempFileName;
{$I testcases_calcrpnformula.inc}
MyWorkBook.WriteToFile(TempFile, AFormat, true);
finally
MyWorkbook.Free;

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

@ -48,10 +48,12 @@
<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"/>
@ -70,6 +72,7 @@
<Unit6>
<Filename Value="internaltests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="internaltests"/>
</Unit6>
<Unit7>
<Filename Value="formattests.pas"/>
@ -95,7 +98,6 @@
<Unit12>
<Filename Value="rpnformulaunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rpnFormulaUnit"/>
</Unit12>
<Unit13>
<Filename Value="formulatests.pas"/>
@ -105,7 +107,6 @@
<Unit14>
<Filename Value="emptycelltests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="emptycelltests"/>
</Unit14>
<Unit15>
<Filename Value="errortests.pas"/>

2
components/fpspreadsheet/tests/virtualmodetests.pas
View File

@ -59,6 +59,8 @@ end;
procedure TSpreadVirtualModeTests.WriteVirtualCellDataHandler(Sender: TObject;
ARow, ACol: Cardinal; var AValue:Variant; var AStyleCell: PCell);
begin
Unused(ACol);
Unused(AStyleCell);
// First read the SollNumbers, then the first 4 SollStrings
// See comment in TestVirtualMode().
if ARow < Length(SollNumbers) then

9
components/fpspreadsheet/xlsbiff2.pas
View File

@ -1529,13 +1529,8 @@ procedure TsSpreadBIFF2Writer.WriteRPNFormula(AStream: TStream;
const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell);
var
FormulaResult: double;
i: Integer;
RPNLength: Word;
TokenArraySizePos, RecordSizePos, FinalPos: Cardinal;
FormulaKind, ExtraInfo: Word;
r: Cardinal;
len: Integer;
s: ansistring;
RecordSizePos, FinalPos: Cardinal;
xf: Word;
begin
if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
@ -1697,7 +1692,6 @@ const
var
L: Byte;
AnsiText: ansistring;
TextTooLong: boolean=false;
rec: TBIFF2LabelRecord;
buf: array of byte;
var
@ -1715,7 +1709,6 @@ begin
// so BIFF2 won't either
// Rather than lose data when reading it, let the application programmer deal
// with the problem or purposefully ignore it.
TextTooLong:=true;
AnsiText := Copy(AnsiText, 1, MAXBYTES);
Workbook.AddErrorMsg(
'Text value exceeds %d character limit in cell %s. ' +

2
components/fpspreadsheet/xlsbiff5.pas
View File

@ -952,7 +952,6 @@ const
var
L: Word;
AnsiValue: ansistring;
TextTooLong: boolean=false;
rec: TBIFF5LabelRecord;
buf: array of byte;
begin
@ -983,7 +982,6 @@ begin
if Length(AnsiValue) > MAXBYTES then begin
// Rather than lose data when reading it, let the application programmer deal
// with the problem or purposefully ignore it.
TextTooLong := true;
AnsiValue := Copy(AnsiValue, 1, MAXBYTES);
Workbook.AddErrorMsg(
'Text value exceeds %d character limit in cell %s. ' +

33
components/fpspreadsheet/xlscommon.pas
View File

@ -400,7 +400,7 @@ type
ANumberFormatStr: String; out ADateTime: TDateTime): Boolean;
// Here we can add reading of records which didn't change across BIFF5-8 versions
// Read a blank cell
procedure ReadBlank(AStream: TStream); virtual;
procedure ReadBlank(AStream: TStream); override;
procedure ReadCodePage(AStream: TStream);
// Read column info
procedure ReadColInfo(const AStream: TStream);
@ -529,7 +529,7 @@ type
implementation
uses
Variants, fpsStreams, fpsNumFormatParser;
Math, Variants, fpsStreams, fpsNumFormatParser;
{ Helper table for rpn formulas:
Assignment of FormulaElementKinds (fekXXXX) to EXCEL_TOKEN IDs. }
@ -685,6 +685,11 @@ const
INT_EXCEL_TOKEN_TATTR {fekOpSum}
);
resourcestring
rsTooManyPaletteColors = 'This workbook contains more colors (%d) than are ' +
'supported by the file format (%d). The redundant colors are replaced by '+
'the best-matching palette colors.';
type
TBIFF58BlankRecord = packed record
RecordID: Word;
@ -1151,7 +1156,6 @@ var
XF: WORD;
ResultFormula: Double = 0.0;
Data: array [0..7] of byte;
Flags: WORD;
dt: TDateTime;
nf: TsNumberFormat;
nfs: String;
@ -1169,7 +1173,7 @@ begin
AStream.ReadBuffer(Data, Sizeof(Data));
{ Options flags }
Flags := WordLEtoN(AStream.ReadWord);
WordLEtoN(AStream.ReadWord);
{ Not used }
AStream.ReadDWord;
@ -1779,7 +1783,6 @@ end;
function TsSpreadBIFFWriter.FindXFIndex(ACell: PCell): Integer;
var
idx: Integer;
xfIndex: Word;
cell: TCell;
begin
// First try the fast methods for default formats
@ -2080,6 +2083,7 @@ end; *)
procedure TsSpreadBIFFWriter.WritePalette(AStream: TStream);
var
i, n: Integer;
rgb: TsColorValue;
begin
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_PALETTE));
@ -2089,13 +2093,17 @@ begin
AStream.WriteWord(WordToLE(56));
{ Take the colors from the palette of the Worksheet }
{ Skip the first 8 entries - they are hard-coded into Excel }
n := Workbook.GetPaletteSize;
if n > 64 then
Workbook.AddErrorMsg(rsTooManyPaletteColors, [n, 64]);
{ Skip the first 8 entries - they are hard-coded into Excel }
for i:=8 to 63 do
if i < n then
AStream.WriteDWord(DWordToLE(Workbook.GetPaletteColor(i)))
else
AStream.WriteDWord(DWordToLE($FFFFFF));
begin
rgb := Math.IfThen(i < n, Workbook.GetPaletteColor(i), $FFFFFF);
AStream.WriteDWord(DWordToLE(rgb))
end;
end;
{@@
@ -2103,7 +2111,6 @@ end;
}
procedure TsSpreadBIFFWriter.WritePageSetup(AStream: TStream);
var
flags: Word;
dbl: Double;
begin
{ BIFF record header }
@ -2125,7 +2132,6 @@ begin
{ Fit worksheet height to this number of pages, 0 = use as many as needed }
AStream.WriteWord(WordToLE(0));
flags := 0;
AStream.WriteWord(WordToLE(0));
{ Print resolution in dpi }
@ -2265,8 +2271,7 @@ end;
procedure TsSpreadBIFFWriter.WriteRPNFormula(AStream: TStream;
const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell);
var
i: Integer;
RPNLength: Word;
RPNLength: Word = 0;
RecordSizePos, FinalPos: Int64;
begin
if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then

2
components/fpspreadsheet/xlsxooxml.pas
View File

@ -791,8 +791,6 @@ begin
end;
function TsSpreadOOXMLReader.ReadColor(ANode: TDOMNode): TsColor;
type
TRGBA = record r,g,b,a: Byte end;
var
s: String;
rgb: TsColorValue;