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

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

View File

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

View File

@ -326,6 +326,7 @@ type
end; 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 var
MainFrm: TMainFrm; MainFrm: TMainFrm;
@ -669,6 +670,7 @@ procedure TMainFrm.acSaveAsExecute(Sender: TObject);
// Saves sheet in grid to file, overwriting existing file // Saves sheet in grid to file, overwriting existing file
var var
err: String = ''; err: String = '';
fmt: TsSpreadsheetFormat;
begin begin
if WorksheetGrid.Workbook = nil then if WorksheetGrid.Workbook = nil then
exit; exit;
@ -676,8 +678,17 @@ begin
if SaveDialog.Execute then if SaveDialog.Execute then
begin begin
Screen.Cursor := crHourglass; 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 try
WorksheetGrid.SaveToSpreadsheetFile(SaveDialog.FileName); WorksheetGrid.SaveToSpreadsheetFile(SaveDialog.FileName, fmt);
finally finally
Screen.Cursor := crDefault; Screen.Cursor := crDefault;
err := WorksheetGrid.Workbook.ErrorMsg; err := WorksheetGrid.Workbook.ErrorMsg;

View File

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

View File

@ -1063,6 +1063,8 @@ type
{ Record reading methods } { Record reading methods }
{@@ Abstract method for reading a blank cell. Must be overridden by descendent classes. } {@@ Abstract method for reading a blank cell. Must be overridden by descendent classes. }
procedure ReadBlank(AStream: TStream); virtual; abstract; 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. } {@@ Abstract method for reading a formula cell. Must be overridden by descendent classes. }
procedure ReadFormula(AStream: TStream); virtual; abstract; procedure ReadFormula(AStream: TStream); virtual; abstract;
{@@ Abstract method for reading a text cell. Must be overridden by descendent classes. } {@@ Abstract method for reading a text cell. Must be overridden by descendent classes. }
@ -1110,19 +1112,26 @@ type
procedure WriteCellsToStream(AStream: TStream; ACells: TAVLTree); procedure WriteCellsToStream(AStream: TStream; ACells: TAVLTree);
{ Record writing methods } { Record writing methods }
{@@ Abstract method for writing a blank cell. Must be overridden by descendent classes. } {@@ 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. } {@@ 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. } {@@ 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. } {@@ 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. } {@@ 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. } {@@ 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. } {@@ 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 public
{@@ An array with cells which are models for the used styles {@@ An array with cells which are models for the used styles

View File

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

View File

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

View File

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

View File

@ -65,6 +65,7 @@ type
procedure ExtractNumberFormat(AXFIndex: WORD; procedure ExtractNumberFormat(AXFIndex: WORD;
out ANumberFormat: TsNumberFormat; out ANumberFormatStr: String); override; out ANumberFormat: TsNumberFormat; out ANumberFormatStr: String); override;
procedure ReadBlank(AStream: TStream); override; procedure ReadBlank(AStream: TStream); override;
procedure ReadBool(AStream: TStream); override;
procedure ReadColWidth(AStream: TStream); procedure ReadColWidth(AStream: TStream);
procedure ReadDefRowHeight(AStream: TStream); procedure ReadDefRowHeight(AStream: TStream);
procedure ReadFont(AStream: TStream); procedure ReadFont(AStream: TStream);
@ -438,6 +439,42 @@ begin
Workbook.OnReadCellData(Workbook, ARow, ACol, cell); Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end; 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); procedure TsSpreadBIFF2Reader.ReadColWidth(AStream: TStream);
var var
c, c1, c2: Cardinal; c, c1, c2: Cardinal;
@ -540,6 +577,7 @@ begin
case RecordType of case RecordType of
INT_EXCEL_ID_BLANK : ReadBlank(AStream); INT_EXCEL_ID_BLANK : ReadBlank(AStream);
INT_EXCEL_ID_BOOLERROR : ReadBool(AStream);
INT_EXCEL_ID_FONT : ReadFont(AStream); INT_EXCEL_ID_FONT : ReadFont(AStream);
INT_EXCEL_ID_FONTCOLOR : ReadFontColor(AStream); INT_EXCEL_ID_FONTCOLOR : ReadFontColor(AStream);
INT_EXCEL_ID_FORMAT : ReadFormat(AStream); INT_EXCEL_ID_FORMAT : ReadFormat(AStream);
@ -1733,7 +1771,7 @@ begin
{ Cell value } { Cell value }
rec.BoolErrValue := ord(AValue); rec.BoolErrValue := ord(AValue);
rec.ValueType := 1; // 0 = boolean value, 1 = error value rec.ValueType := 0; // 0 = boolean value, 1 = error value
{ Write out } { Write out }
AStream.WriteBuffer(rec, SizeOf(rec)); AStream.WriteBuffer(rec, SizeOf(rec));
@ -1765,16 +1803,7 @@ begin
GetCellAttributes(ACell, xf, rec.Attrib1, rec.Attrib2, rec.Attrib3); GetCellAttributes(ACell, xf, rec.Attrib1, rec.Attrib2, rec.Attrib3);
{ Cell value } { Cell value }
case AValue of rec.BoolErrValue := ConvertToExcelError(AValue);
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.ValueType := 1; // 0 = boolean value, 1 = error value rec.ValueType := 1; // 0 = boolean value, 1 = error value
{ Write out } { Write out }

View File

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

View File

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

View File

@ -248,6 +248,7 @@ type
// Here we can add reading of records which didn't change across BIFF5-8 versions // Here we can add reading of records which didn't change across BIFF5-8 versions
// Read a blank cell // Read a blank cell
procedure ReadBlank(AStream: TStream); override; procedure ReadBlank(AStream: TStream); override;
procedure ReadBool(AStream: TStream); override;
procedure ReadCodePage(AStream: TStream); procedure ReadCodePage(AStream: TStream);
// Read column info // Read column info
procedure ReadColInfo(const AStream: TStream); procedure ReadColInfo(const AStream: TStream);
@ -848,6 +849,43 @@ begin
Workbook.OnReadCellData(Workbook, ARow, ACol, cell); Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end; 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 // In BIFF8 it seams to always use the UTF-16 codepage
procedure TsSpreadBIFFReader.ReadCodePage(AStream: TStream); procedure TsSpreadBIFFReader.ReadCodePage(AStream: TStream);
var var
@ -2016,16 +2054,7 @@ begin
rec.XFIndex := WordToLE(FindXFIndex(ACell)); rec.XFIndex := WordToLE(FindXFIndex(ACell));
{ Cell value } { Cell value }
case AValue of rec.BoolErrValue := ConvertToExcelError(AValue);
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.ValueType := 1; // 0 = boolean value, 1 = error value rec.ValueType := 1; // 0 = boolean value, 1 = error value
{ Write out } { Write out }

View File

@ -153,6 +153,8 @@ type
ACell: PCell); override; ACell: PCell); override;
procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Boolean; ACell: PCell); override; 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; procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override; ACell: PCell); override;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; 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])); '<c r="%s" s="%d" t="b"><v>%s</v></c>', [CellPosText, lStyleIndex, CellValueText]));
end; 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. } { Writes a string formula to the given cell. }
procedure TsSpreadOOXMLWriter.WriteFormula(AStream: TStream; procedure TsSpreadOOXMLWriter.WriteFormula(AStream: TStream;
const ARow, ACol: Cardinal; ACell: PCell); const ARow, ACol: Cardinal; ACell: PCell);