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

fpspreadsheet: Add reading/writing of boolean cell values for BIFF formats.

Browse Source 
Add test case for boolean cell values for all formats (incl. CSV). 
Extend spready demo to be able to write sfExcel2 and sfExcel5 formats.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3656 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-10-14 21:44:00 +00:00
parent a4c5667dc9
commit 9f014b6875
12 changed files with 173 additions and 62 deletions
Download Patch File Download Diff File Expand all files Collapse all files

58
components/fpspreadsheet/examples/spready/mainform.lfm
View File

@ -4,7 +4,7 @@ object MainFrm: TMainFrm
Top = 258
Width = 884
Caption = 'spready'
ClientHeight = 614
ClientHeight = 619
ClientWidth = 884
Menu = MainMenu
OnActivate = FormActivate
@ -14,7 +14,7 @@ object MainFrm: TMainFrm
object Panel1: TPanel
Left = 0
Height = 82
Top = 532
Top = 537
Width = 884
Align = alBottom
BevelOuter = bvNone
@ -23,7 +23,7 @@ object MainFrm: TMainFrm
TabOrder = 6
object EdFrozenCols: TSpinEdit
Left = 429
Height = 28
Height = 23
Top = 8
Width = 52
OnChange = EdFrozenColsChange
@ -31,7 +31,7 @@ object MainFrm: TMainFrm
end
object EdFrozenRows: TSpinEdit
Left = 429
Height = 28
Height = 23
Top = 39
Width = 52
OnChange = EdFrozenRowsChange
@ -39,37 +39,37 @@ object MainFrm: TMainFrm
end
object Label1: TLabel
Left = 344
Height = 20
Height = 15
Top = 13
Width = 77
Width = 62
Caption = 'Frozen cols:'
FocusControl = EdFrozenCols
ParentColor = False
end
object Label2: TLabel
Left = 344
Height = 20
Height = 15
Top = 40
Width = 82
Width = 66
Caption = 'Frozen rows:'
FocusControl = EdFrozenRows
ParentColor = False
end
object CbReadFormulas: TCheckBox
Left = 8
Height = 24
Height = 19
Top = 8
Width = 120
Width = 96
Caption = 'Read formulas'
OnChange = CbReadFormulasChange
TabOrder = 0
end
object CbHeaderStyle: TComboBox
Left = 200
Height = 28
Height = 23
Top = 8
Width = 116
ItemHeight = 20
ItemHeight = 15
ItemIndex = 2
Items.Strings = (
'Lazarus'
@ -83,18 +83,18 @@ object MainFrm: TMainFrm
end
object CbAutoCalcFormulas: TCheckBox
Left = 8
Height = 24
Height = 19
Top = 32
Width = 158
Width = 128
Caption = 'Calculate on change'
OnChange = CbAutoCalcFormulasChange
TabOrder = 1
end
object CbTextOverflow: TCheckBox
Left = 8
Height = 24
Height = 19
Top = 56
Width = 114
Width = 91
Caption = 'Text overflow'
Checked = True
OnChange = CbTextOverflowChange
@ -206,19 +206,19 @@ object MainFrm: TMainFrm
end
object FontComboBox: TComboBox
Left = 52
Height = 28
Height = 23
Top = 2
Width = 127
ItemHeight = 20
ItemHeight = 15
OnSelect = FontComboBoxSelect
TabOrder = 0
end
object FontSizeComboBox: TComboBox
Left = 179
Height = 28
Height = 23
Top = 2
Width = 48
ItemHeight = 20
ItemHeight = 15
Items.Strings = (
'8'
'9'
@ -394,7 +394,7 @@ object MainFrm: TMainFrm
TabOrder = 2
object EdCellAddress: TEdit
Left = 0
Height = 28
Height = 23
Top = 0
Width = 170
Align = alTop
@ -406,7 +406,7 @@ object MainFrm: TMainFrm
end
object InspectorSplitter: TSplitter
Left = 648
Height = 446
Height = 451
Top = 86
Width = 5
Align = alRight
@ -414,7 +414,7 @@ object MainFrm: TMainFrm
end
object InspectorPageControl: TPageControl
Left = 653
Height = 446
Height = 451
Top = 86
Width = 231
ActivePage = PgCellValue
@ -424,11 +424,11 @@ object MainFrm: TMainFrm
OnChange = InspectorPageControlChange
object PgCellValue: TTabSheet
Caption = 'Cell value'
ClientHeight = 413
ClientHeight = 423
ClientWidth = 223
object CellInspector: TValueListEditor
Left = 0
Height = 413
Height = 423
Top = 0
Width = 223
Align = alClient
@ -472,7 +472,7 @@ object MainFrm: TMainFrm
end
object TabControl: TTabControl
Left = 0
Height = 446
Height = 451
Top = 86
Width = 648
OnChange = TabControlChange
@ -480,7 +480,7 @@ object MainFrm: TMainFrm
TabOrder = 3
object WorksheetGrid: TsWorksheetGrid
Left = 2
Height = 441
Height = 446
Top = 3
Width = 644
FrozenCols = 0
@ -498,7 +498,7 @@ object MainFrm: TMainFrm
OnHeaderClick = WorksheetGridHeaderClick
OnSelection = WorksheetGridSelection
ColWidths = (
56
42
64
64
64
@ -546,7 +546,7 @@ object MainFrm: TMainFrm
end
object SaveDialog: TSaveDialog
DefaultExt = '.xls'
Filter = 'Excel spreadsheet (*.xls)|*.xls|Excel XML spreadsheet (*.xlsx)|*.xlsx|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited file (*.csv)|*.csv|Wikitable (wikimedia) (.wikitable_wikimedia)|*.wikitable_wikimedia'
Filter = 'Excel 97-2003 spreadsheet (*.xls)|*.xls|Excel 5.0/95 spreadsheet (*.xls)|*.xls|Excel 2 spreadsheet (*.xls)|*.xls|Excel 2007+ XML spreadsheet (*.xlsx)|*.xlsx|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited file (*.csv)|*.csv|Wikitable (wikimedia) (*.wikitable_wikimedia)|*.wikitable_wikimedia'
Options = [ofOverwritePrompt, ofExtensionDifferent, ofEnableSizing, ofViewDetail]
left = 184
top = 264

13
components/fpspreadsheet/examples/spready/mainform.pas
View File

@ -326,6 +326,7 @@ type
end;
// Excel 97-2003 spreadsheet (*.xls)|*.xls|Excel 5.0 spreadsheet (*.xls)|*.xls|Excel 2.1 spreadsheet (*.xls)|*.xls|Excel XML spreadsheet (*.xlsx)|*.xlsx|LibreOffice/OpenOffice spreadsheet (*.ods)|*.ods|Comma-delimited file (*.csv)|*.csv|Wikitable (wikimedia) (.wikitable_wikimedia)|*.wikitable_wikimedia
var
MainFrm: TMainFrm;
@ -669,6 +670,7 @@ procedure TMainFrm.acSaveAsExecute(Sender: TObject);
// Saves sheet in grid to file, overwriting existing file
var
err: String = '';
fmt: TsSpreadsheetFormat;
begin
if WorksheetGrid.Workbook = nil then
exit;
@ -676,8 +678,17 @@ begin
if SaveDialog.Execute then
begin
Screen.Cursor := crHourglass;
case SaveDialog.FilterIndex of
1: fmt := sfExcel8;
2: fmt := sfExcel5;
3: fmt := sfExcel2;
4: fmt := sfOOXML;
5: fmt := sfOpenDocument;
6: fmt := sfCSV;
7: fmt := sfWikiTable_wikimedia;
end;
try
WorksheetGrid.SaveToSpreadsheetFile(SaveDialog.FileName);
WorksheetGrid.SaveToSpreadsheetFile(SaveDialog.FileName, fmt);
finally
Screen.Cursor := crDefault;
err := WorksheetGrid.Workbook.ErrorMsg;

8
components/fpspreadsheet/fpsopendocument.pas
View File

@ -178,6 +178,8 @@ type
ACell: PCell); override;
procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Boolean; ACell: PCell); override;
procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TsErrorValue; ACell: PCell); override;
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
@ -3406,6 +3408,12 @@ begin
);
end;
procedure TsSpreadOpenDocWriter.WriteError(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell);
begin
// ??
end;
function TsSpreadOpenDocWriter.WriteFontStyleXMLAsString(const AFormat: TCell): String;
var
fnt: TsFont;

23
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -1063,6 +1063,8 @@ type
{ Record reading methods }
{@@ Abstract method for reading a blank cell. Must be overridden by descendent classes. }
procedure ReadBlank(AStream: TStream); virtual; abstract;
{@@ Abstract method for reading a BOOLEAN cell. Must be overridden by descendent classes. }
procedure ReadBool(AStream: TSTream); virtual; abstract;
{@@ Abstract method for reading a formula cell. Must be overridden by descendent classes. }
procedure ReadFormula(AStream: TStream); virtual; abstract;
{@@ Abstract method for reading a text cell. Must be overridden by descendent classes. }
@ -1110,19 +1112,26 @@ type
procedure WriteCellsToStream(AStream: TStream; ACells: TAVLTree);
{ Record writing methods }
{@@ Abstract method for writing a blank cell. Must be overridden by descendent classes. }
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); virtual; abstract;
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); virtual; abstract;
{@@ Abstract method for writing a boolean cell. Must be overridden by descendent classes. }
procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell); virtual; abstract;
procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Boolean; ACell: PCell); virtual; abstract;
{@@ Abstract method for writing a date/time value to a cell. Must be overridden by descendent classes. }
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); virtual; abstract;
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TDateTime; ACell: PCell); virtual; abstract;
{@@ Abstract method for writing an Excel error value to a cell. Must be overridden by descendent classes. }
procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell); virtual; abstract;
procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TsErrorValue; ACell: PCell); virtual; abstract;
{@@ Abstract method for writing a formula to a cell. Must be overridden by descendent classes. }
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); virtual;
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); virtual;
{@@ Abstract method for writing a string to a cell. Must be overridden by descendent classes. }
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; const AValue: string; ACell: PCell); virtual; abstract;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); virtual; abstract;
{@@ Abstract method for writing a number value to a cell. Must be overridden by descendent classes. }
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); virtual; abstract;
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: double; ACell: PCell); virtual; abstract;
public
{@@ An array with cells which are models for the used styles

3
components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas
View File

@ -687,6 +687,9 @@ var
w: Word;
b: Byte;
begin
if FFormat = sfExcel2 then
RowCount := FixedRows + 7
else
RowCount := FixedRows + 5;
ShowRowColData(FBufferIndex);

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

@ -40,7 +40,7 @@
<PackageName Value="FCL"/>
</Item4>
</RequiredPackages>
<Units Count="18">
<Units Count="19">
<Unit0>
<Filename Value="spreadtestgui.lpr"/>
<IsPartOfProject Value="True"/>
@ -48,7 +48,6 @@
<Unit1>
<Filename Value="datetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="datetests"/>
</Unit1>
<Unit2>
<Filename Value="stringtests.pas"/>
@ -57,6 +56,7 @@
<Unit3>
<Filename Value="numberstests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="numberstests"/>
</Unit3>
<Unit4>
<Filename Value="manualtests.pas"/>
@ -76,14 +76,17 @@
<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"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fonttests"/>
</Unit9>
<Unit10>
<Filename Value="optiontests.pas"/>
@ -96,6 +99,7 @@
<Unit12>
<Filename Value="rpnformulaunit.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rpnFormulaUnit"/>
</Unit12>
<Unit13>
<Filename Value="formulatests.pas"/>
@ -105,6 +109,7 @@
<Unit14>
<Filename Value="emptycelltests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="emptycelltests"/>
</Unit14>
<Unit15>
<Filename Value="errortests.pas"/>
@ -120,6 +125,11 @@
<IsPartOfProject Value="True"/>
<UnitName Value="insertdeletetests"/>
</Unit17>
<Unit18>
<Filename Value="celltypetests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="celltypetests"/>
</Unit18>
</Units>
</ProjectOptions>
<CompilerOptions>

3
components/fpspreadsheet/tests/spreadtestgui.lpr
View File

@ -11,7 +11,8 @@ uses
Interfaces, Forms, GuiTestRunner, datetests, stringtests, numberstests,
manualtests, testsutility, internaltests, formattests, colortests, fonttests,
optiontests, numformatparsertests, formulatests, rpnFormulaUnit,
emptycelltests, errortests, virtualmodetests, insertdeletetests;
emptycelltests, errortests, virtualmodetests, insertdeletetests,
celltypetests;
begin
{$IFDEF HEAPTRC}

51
components/fpspreadsheet/xlsbiff2.pas
View File

@ -65,6 +65,7 @@ type
procedure ExtractNumberFormat(AXFIndex: WORD;
out ANumberFormat: TsNumberFormat; out ANumberFormatStr: String); override;
procedure ReadBlank(AStream: TStream); override;
procedure ReadBool(AStream: TStream); override;
procedure ReadColWidth(AStream: TStream);
procedure ReadDefRowHeight(AStream: TStream);
procedure ReadFont(AStream: TStream);
@ -438,6 +439,42 @@ begin
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
{ The name of this method is misleading - it reads a BOOLEAN cell value,
but also an ERROR value; BIFF stores them in the same record. }
procedure TsSpreadBIFF2Reader.ReadBool(AStream: TStream);
var
rec: TBIFF2BoolErrRecord;
r, c: Cardinal;
xf: Word;
cell: PCell;
begin
{ Read entire record, starting at Row }
rec.Row := 0; // to silence the compiler...
AStream.ReadBuffer(rec.Row, SizeOf(TBIFF2BoolErrRecord) - 2*SizeOf(Word));
r := WordLEToN(rec.Row);
c := WordLEToN(rec.Col);
xf := rec.Attrib1 and $3F;
{ Create cell }
if FIsVirtualMode then begin
InitCell(r, c, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(r, c);
{ Retrieve boolean or error value depending on the "ValueType" }
case rec.ValueType of
0: FWorksheet.WriteBoolValue(cell, boolean(rec.BoolErrValue));
1: FWorksheet.WriteErrorValue(cell, ConvertFromExcelError(rec.BoolErrValue));
end;
{ Apply formatting }
ApplyCellFormatting(cell, xf);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, r, c, cell);
end;
procedure TsSpreadBIFF2Reader.ReadColWidth(AStream: TStream);
var
c, c1, c2: Cardinal;
@ -540,6 +577,7 @@ begin
case RecordType of
INT_EXCEL_ID_BLANK : ReadBlank(AStream);
INT_EXCEL_ID_BOOLERROR : ReadBool(AStream);
INT_EXCEL_ID_FONT : ReadFont(AStream);
INT_EXCEL_ID_FONTCOLOR : ReadFontColor(AStream);
INT_EXCEL_ID_FORMAT : ReadFormat(AStream);
@ -1733,7 +1771,7 @@ begin
{ Cell value }
rec.BoolErrValue := ord(AValue);
rec.ValueType := 1; // 0 = boolean value, 1 = error value
rec.ValueType := 0; // 0 = boolean value, 1 = error value
{ Write out }
AStream.WriteBuffer(rec, SizeOf(rec));
@ -1765,16 +1803,7 @@ begin
GetCellAttributes(ACell, xf, rec.Attrib1, rec.Attrib2, rec.Attrib3);
{ Cell value }
case AValue of
errEmptyIntersection : rec.BoolErrValue := $00; // #NULL!
errDivideByZero : rec.BoolErrValue := $07; // #DIV/0!
errWrongType : rec.BoolErrValue := $0F; // #VALUE!
errIllegalRef : rec.BoolErrValue := $17; // #REF!
errWrongName : rec.BoolErrValue := $1D; // #NAME?
errOverflow : rec.BoolErrValue := $24; // #NUM!
errArgError : rec.BoolErrValue := $2A; // #N/A
else exit;
end;
rec.BoolErrValue := ConvertToExcelError(AValue);
rec.ValueType := 1; // 0 = boolean value, 1 = error value
{ Write out }

1
components/fpspreadsheet/xlsbiff5.pas
View File

@ -1142,6 +1142,7 @@ begin
case RecordType of
INT_EXCEL_ID_BLANK : ReadBlank(AStream);
INT_EXCEL_ID_BOOLERROR : ReadBool(AStream);
INT_EXCEL_ID_MULBLANK : ReadMulBlank(AStream);
INT_EXCEL_ID_NUMBER : ReadNumber(AStream);
INT_EXCEL_ID_LABEL : ReadLabel(AStream);

1
components/fpspreadsheet/xlsbiff8.pas
View File

@ -1440,6 +1440,7 @@ begin
case RecordType of
INT_EXCEL_ID_BLANK : ReadBlank(AStream);
INT_EXCEL_ID_BOOLERROR : ReadBool(AStream);
INT_EXCEL_ID_MULBLANK : ReadMulBlank(AStream);
INT_EXCEL_ID_NUMBER : ReadNumber(AStream);
INT_EXCEL_ID_LABEL : ReadLabel(AStream);

49
components/fpspreadsheet/xlscommon.pas
View File

@ -248,6 +248,7 @@ type
// Here we can add reading of records which didn't change across BIFF5-8 versions
// Read a blank cell
procedure ReadBlank(AStream: TStream); override;
procedure ReadBool(AStream: TStream); override;
procedure ReadCodePage(AStream: TStream);
// Read column info
procedure ReadColInfo(const AStream: TStream);
@ -848,6 +849,43 @@ begin
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
{ The name of this method is misleading - it reads a BOOLEAN cell value,
but also an ERROR value; BIFF stores them in the same record. }
procedure TsSpreadBIFFReader.ReadBool(AStream: TStream);
var
rec: TBIFF38BoolErrRecord;
r, c: Cardinal;
XF: Word;
cell: PCell;
begin
rec.Row := 0; // to silence the compiler
{ Read entire record into a buffer }
AStream.ReadBuffer(rec.Row, SizeOf(TBIFF38BoolErrRecord) - 2*SizeOf(Word));
r := WordLEToN(rec.Row);
c := WordLEToN(rec.Col);
XF := WordLEToN(rec.XFIndex);
if FIsVirtualMode then begin
InitCell(r, c, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(r, c);
{ Retrieve boolean or error value depending on the "ValueType" }
case rec.ValueType of
0: FWorksheet.WriteBoolValue(cell, boolean(rec.BoolErrValue));
1: FWorksheet.WriteErrorValue(cell, ConvertFromExcelError(rec.BoolErrValue));
end;
{ Add attributes to cell}
ApplyCellFormatting(cell, XF);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, r, c, cell);
end;
// In BIFF8 it seams to always use the UTF-16 codepage
procedure TsSpreadBIFFReader.ReadCodePage(AStream: TStream);
var
@ -2016,16 +2054,7 @@ begin
rec.XFIndex := WordToLE(FindXFIndex(ACell));
{ Cell value }
case AValue of
errEmptyIntersection : rec.BoolErrValue := $00; // #NULL!
errDivideByZero : rec.BoolErrValue := $07; // #DIV/0!
errWrongType : rec.BoolErrValue := $0F; // #VALUE!
errIllegalRef : rec.BoolErrValue := $17; // #REF!
errWrongName : rec.BoolErrValue := $1D; // #NAME?
errOverflow : rec.BoolErrValue := $24; // #NUM!
errArgError : rec.BoolErrValue := $2A; // #N/A
else exit;
end;
rec.BoolErrValue := ConvertToExcelError(AValue);
rec.ValueType := 1; // 0 = boolean value, 1 = error value
{ Write out }

9
components/fpspreadsheet/xlsxooxml.pas
View File

@ -153,6 +153,8 @@ type
ACell: PCell); override;
procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Boolean; ACell: PCell); override;
procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TsErrorValue; ACell: PCell); override;
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
@ -2563,6 +2565,13 @@ begin
'<c r="%s" s="%d" t="b"><v>%s</v></c>', [CellPosText, lStyleIndex, CellValueText]));
end;
{ Writes an error value to the specified cell. }
procedure TsSpreadOOXMLWriter.WriteError(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell);
begin
// ???
end;
{ Writes a string formula to the given cell. }
procedure TsSpreadOOXMLWriter.WriteFormula(AStream: TStream;
const ARow, ACol: Cardinal; ACell: PCell);