paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Reading/writing of boolean cell values for all file formats (BIFF not complete, yet).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3655 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2014-10-14 15:56:08 +00:00
parent 1262d95889
commit a4c5667dc9
7 changed files with 496 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
components/fpspreadsheet/fpscsv.pas
View File

@ -12,6 +12,7 @@ type
TsCSVReader = class(TsCustomSpreadReader)
private
FWorksheetName: String;
function IsBool(AText: String; out AValue: Boolean): Boolean;
function IsDateTime(AText: String; out ADateTime: TDateTime): Boolean;
function IsNumber(AText: String; out ANumber: Double): Boolean;
function IsQuotedText(var AText: String): Boolean;
@ -34,6 +35,8 @@ type
protected
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Boolean; ACell: PCell); override;
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TDateTime; ACell: PCell); override;
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
@ -52,22 +55,30 @@ type
TsCSVLineEnding = (leSystem, leCRLF, leCR, leLF);
TsCSVParams = record
SheetIndex: Integer;
LineEnding: TsCSVLineEnding;
Delimiter: Char;
QuoteChar: Char;
NumberFormat: String;
FormatSettings: TFormatSettings;
TsCSVParams = record // W = writing, R = reading, RW = reading/writing
SheetIndex: Integer; // W: Index of the sheet to be written
LineEnding: TsCSVLineEnding; // W: Specification for line ending to be written
Delimiter: Char; // RW: Column delimiter
QuoteChar: Char; // RW: Character for quoting texts
NumberFormat: String; // W: if empty write numbers like in sheet, otherwise use this format
DateTimeAsText: Boolean; // R: if false tries to convert text to date/time values
BoolAsText: Boolean; // R: if false tries to convert text to boolean values
TrueText: String; // RW: String for boolean TRUE
FalseText: String; // RW: String for boolean FALSE
FormatSettings: TFormatSettings; // RW: add'l parameters for conversion
end;
var
CSVParams: TsCSVParams = (
SheetIndex: 0; // Store sheet #0 by default
LineEnding: leSystem; // Write system lineending, read any
Delimiter: ';'; // Column delimiter
QuoteChar: '"'; // for quoted strings
NumberFormat: ''; // if empty write numbers like in sheet, otherwise use this format
SheetIndex: 0;
LineEnding: leSystem;
Delimiter: ';';
QuoteChar: '"';
NumberFormat: '';
DateTimeAsText: false;
BoolAsText: false;
TrueText: 'TRUE';
FalseText: 'FALSE';
);
@ -174,6 +185,21 @@ begin
FWorksheetName := 'Sheet1'; // will be replaced by filename
end;
function TsCSVReader.IsBool(AText: String; out AValue: Boolean): Boolean;
begin
if SameText(AText, CSVParams.TrueText) then
begin
AValue := true;
Result := true;
end else
if SameText(AText, CSVParams.FalseText) then
begin
AValue := false;
Result := true;
end else
Result := false;
end;
function TsCSVReader.IsDateTime(AText: String; out ADateTime: TDateTime): Boolean;
begin
Result := TryStrToDateTime(AText, ADateTime, CSVParams.FormatSettings);
@ -204,8 +230,9 @@ end;
procedure TsCSVReader.ReadCellValue(ARow, ACol: Cardinal; AText: String);
var
dbl: Double;
dt: TDateTime;
dblValue: Double;
dtValue: TDateTime;
boolValue: Boolean;
begin
// Empty strings are blank cells -- nothing to do
if AText = '' then
@ -219,16 +246,23 @@ begin
end;
// Check for a NUMBER cell
if IsNumber(AText, dbl) then
if IsNumber(AText, dblValue) then
begin
FWorksheet.WriteNumber(ARow, ACol, dbl);
FWorksheet.WriteNumber(ARow, ACol, dblValue);
exit;
end;
// Check for a DATE/TIME cell
if IsDateTime(AText, dt) then
if not CSVParams.DateTimeAsText and IsDateTime(AText, dtValue) then
begin
FWorksheet.WriteDateTime(ARow, ACol, dt);
FWorksheet.WriteDateTime(ARow, ACol, dtValue);
exit;
end;
// Check for a BOOLEAN cell
if not CSVParams.BoolAsText and IsBool(AText, boolValue) then
begin
FWorksheet.WriteBoolValue(ARow, aCol, boolValue);
exit;
end;
@ -323,6 +357,7 @@ end;
{ -----------------------------------------------------------------------------}
{ TsCSVWriter }
{------------------------------------------------------------------------------}
constructor TsCSVWriter.Create(AWorkbook: TsWorkbook);
begin
inherited Create(AWorkbook);
@ -343,6 +378,16 @@ begin
// nothing to do
end;
procedure TsCSVWriter.WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Boolean; ACell: PCell);
begin
Unused(ARow, ACol, ACell);
if AValue then
AppendToStream(AStream, CSVParams.TrueText)
else
AppendToStream(AStream, CSVParams.FalseText);
end;
{ Write date/time values in the same way they are displayed in the sheet }
procedure TsCSVWriter.WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TDateTime; ACell: PCell);
@ -351,14 +396,24 @@ begin
AppendToStream(AStream, FWorksheet.ReadAsUTF8Text(ACell));
end;
{ CSV does not support formulas, but we have to write the formula results to
to stream. }
procedure TsCSVWriter.WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell);
begin
// no formulas in CSV
Unused(AStream);
Unused(ARow, ACol, AStream);
if ACell = nil then
exit;
case ACell^.ContentType of
cctBool : WriteBool(AStream, ARow, ACol, ACell^.BoolValue, ACell);
cctEmpty : ;
cctDateTime : WriteDateTime(AStream, ARow, ACol, ACell^.DateTimeValue, ACell);
cctNumber : WriteNumber(AStream, ARow, ACol, ACell^.NumberValue, ACell);
cctUTF8String: WriteLabel(AStream, ARow, ACol, ACell^.UTF8StringValue, ACell);
cctError : ;
end;
end;
{ Writes a LABEL cell to the stream. }
procedure TsCSVWriter.WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell);
var

110
components/fpspreadsheet/fpsopendocument.pas
View File

@ -85,6 +85,8 @@ type
// Applies a style to a cell
procedure ApplyStyleToCell(ARow, ACol: Cardinal; AStyleName: String); overload;
procedure ApplyStyleToCell(ACell: PCell; AStyleName: String); overload;
// Extracts a boolean value from the xml node
function ExtractBoolFromNode(ANode: TDOMNode): Boolean;
// Extracts the date/time value from the xml node
function ExtractDateTimeFromNode(ANode: TDOMNode;
ANumFormat: TsNumberFormat; const AFormatStr: String): TDateTime;
@ -110,6 +112,7 @@ type
procedure ReadStyles(AStylesNode: TDOMNode);
{ Record writing methods }
procedure ReadBlank(ARow, ACol: Word; ACellNode: TDOMNode); reintroduce;
procedure ReadBoolean(ARow, ACol: Word; ACellNode: TDOMNode);
procedure ReadDateTime(ARow, ACol: Word; ACellNode: TDOMNode);
procedure ReadFormula(ARow, ACol: Word; ACellNode: TDOMNode); reintroduce;
procedure ReadLabel(ARow, ACol: Word; ACellNode: TDOMNode); reintroduce;
@ -173,6 +176,8 @@ type
{ Record writing methods }
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Boolean; ACell: PCell); override;
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
@ -856,6 +861,19 @@ begin
FNumFormatList := TsSpreadOpenDocNumFormatList.Create(Workbook);
end;
{ Extracts a boolean value from a "boolean" cell node.
Is called from ReadBoolean }
function TsSpreadOpenDocReader.ExtractBoolFromNode(ANode: TDOMNode): Boolean;
var
value: String;
begin
value := GetAttrValue(ANode, 'office:boolean-value');
if (lowercase(value) = 'true') then
Result := true
else
Result := false;
end;
{ Extracts a date/time value from a "date-value" or "time-value" cell node.
Requires the number format and format strings to optimize agreement with
fpc date/time values.
@ -998,6 +1016,28 @@ begin
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
procedure TsSpreadOpenDocReader.ReadBoolean(ARow, ACol: Word; ACellNode: TDOMNode);
var
styleName: String;
cell: PCell;
boolValue: Boolean;
begin
if FIsVirtualMode then begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
cell := FWorksheet.GetCell(ARow, ACol);
boolValue := ExtractBoolFromNode(ACellNode);
FWorkSheet.WriteBoolValue(cell, boolValue);
styleName := GetAttrValue(ACellNode, 'table:style-name');
ApplyStyleToCell(cell, stylename);
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
{ Collection columns used in the given table. The columns contain links to
styles that must be used when cells in that columns are without styles. }
procedure TsSpreadOpenDocReader.ReadColumns(ATableNode: TDOMNode);
@ -1192,6 +1232,7 @@ var
formula: String;
stylename: String;
floatValue: Double;
boolValue: Boolean;
valueType: String;
valueStr: String;
node: TDOMNode;
@ -1272,6 +1313,11 @@ begin
FWorksheet.WriteUTF8Text(cell, valueStr);
end;
end else
// (d) boolean
if (valuetype = 'boolean') then begin
boolValue := ExtractBoolFromNode(ACellNode);
FWorksheet.WriteBoolValue(cell, boolValue);
end else
// (e) Text
FWorksheet.WriteUTF8Text(cell, valueStr);
@ -1868,6 +1914,8 @@ begin
ReadNumber(row, col, cellNode)
else if (paramValueType = 'date') or (paramValueType = 'time') then
ReadDateTime(row, col, cellNode)
else if (paramValueType = 'boolean') then
ReadBoolean(row, col, cellNode)
else if (paramValueType = '') and (tableStyleName <> '') then
ReadBlank(row, col, cellNode);
@ -3174,9 +3222,7 @@ begin
end;
end;
{
Writes an empty cell
}
{ Writes an empty cell to the stream }
procedure TsSpreadOpenDocWriter.WriteBlank(AStream: TStream;
const ARow, ACol: Cardinal; ACell: PCell);
var
@ -3186,7 +3232,6 @@ var
spannedStr: String;
r1,c1,r2,c2: Cardinal;
begin
Unused(AStream, ACell);
Unused(ARow, ACol);
// Merged?
@ -3208,6 +3253,58 @@ begin
'<table:table-cell ' + spannedStr + '/>');
end;
{ Writes a boolean cell to the stream }
procedure TsSpreadOpenDocWriter.WriteBool(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell);
var
valType: String;
lIndex: Integer;
lStyle: String;
r1,c1,r2,c2: Cardinal;
rowsSpannedStr, colsSpannedStr, spannedStr: String;
strValue: String;
displayStr: String;
begin
Unused(ARow, ACol);
valType := 'boolean';
if ACell^.UsedFormattingFields <> [] then
begin
lIndex := FindFormattingInList(ACell);
lStyle := ' table:style-name="ce' + IntToStr(lIndex) + '" ';
end else
lStyle := '';
// Merged?
if FWorksheet.IsMergeBase(ACell) then
begin
FWorksheet.FindMergedRange(ACell, r1, c1, r2, c2);
rowsSpannedStr := Format('table:number-rows-spanned="%d"', [r2 - r1 + 1]);
colsSpannedStr := Format('table:number-columns-spanned="%d"', [c2 - c1 + 1]);
spannedStr := colsSpannedStr + ' ' + rowsSpannedStr;
end else
spannedStr := '';
// Displayed value
if AValue then
begin
StrValue := 'true';
DisplayStr := rsTRUE;
end else
begin
strValue := 'false';
DisplayStr := rsFALSE;
end;
AppendToStream(AStream, Format(
'<table:table-cell office:value-type="%s" office:boolean-value="%s" %s %s >' +
'<text:p>%s</text:p>' +
'</table:table-cell>', [
valType, StrValue, lStyle, spannedStr,
DisplayStr
]));
end;
{ Creates an XML string for inclusion of the background color into the
written file from the backgroundcolor setting in the format cell.
Is called from WriteStyles (via WriteStylesXMLAsString). }
@ -3593,7 +3690,7 @@ var
spannedStr: String;
r1,c1,r2,c2: Cardinal;
begin
Unused(AStream, ARow, ACol);
Unused(ARow, ACol);
// Style
if ACell^.UsedFormattingFields <> [] then begin
@ -3703,7 +3800,6 @@ var
r1,c1,r2,c2: Cardinal;
str: ansistring;
begin
Unused(AStream, ACell);
Unused(ARow, ACol);
// Style
@ -3753,7 +3849,6 @@ var
spannedStr: String;
r1,c1,r2,c2: Cardinal;
begin
Unused(AStream, ACell);
Unused(ARow, ACol);
valType := 'float';
@ -3818,7 +3913,6 @@ var
spannedStr: String;
r1,c1,r2,c2: Cardinal;
begin
Unused(AStream, ACell);
Unused(ARow, ACol);
// Merged?

12
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -1111,8 +1111,12 @@ type
{ 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;
{@@ 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;
{@@ 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;
{@@ 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;
{@@ 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;
{@@ Abstract method for writing a string to a cell. Must be overridden by descendent classes. }
@ -7718,10 +7722,14 @@ begin
WriteFormula(AStream, ACell^.Row, ACell^.Col, ACell)
else
case ACell.ContentType of
cctEmpty:
WriteBlank(AStream, ACell^.Row, ACell^.Col, ACell);
cctBool:
WriteBool(AStream, ACell^.Row, ACell^.Col, ACell^.BoolValue, ACell);
cctDateTime:
WriteDateTime(AStream, ACell^.Row, ACell^.Col, ACell^.DateTimeValue, ACell);
cctEmpty:
WriteBlank(AStream, ACell^.Row, ACell^.Col, ACell);
cctError:
WriteError(AStream, ACell^.Row, ACell^.Col, ACell^.ErrorValue, ACell);
cctNumber:
WriteNumber(AStream, ACell^.Row, ACell^.Col, ACell^.NumberValue, ACell);
cctUTF8String:

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

@ -27,6 +27,7 @@ type
procedure ShowBlankCell;
procedure ShowBOF;
procedure ShowBookBool;
procedure ShowBoolCell;
procedure ShowBottomMargin;
procedure ShowCalcCount;
procedure ShowCalcMode;
@ -268,6 +269,8 @@ begin
ShowNumberCell;
$0004, $0204:
ShowLabelCell;
$0005, $0205:
ShowBoolCell;
$0006:
ShowFormula;
$0007, $0207:
@ -678,6 +681,99 @@ begin
'Specifies some properties assosciated with a workbook');
end;
procedure TBIFFGrid.ShowBoolCell;
var
numBytes: Integer;
w: Word;
b: Byte;
begin
RowCount := FixedRows + 5;
ShowRowColData(FBufferIndex);
if FFormat = sfExcel2 then begin
numBytes := 1;
b := FBuffer[FBufferIndex];
if Row = FCurrRow then begin
FDetails.Add('Cell protection and XF index:'#13);
FDetails.Add(Format('Bits 5-0 = %d: XF Index', [b and $3F]));
case b and $40 of
0: FDetails.Add('Bit 6 = 0: Cell is NOT locked.');
1: FDetails.Add('Bit 6 = 1: Cell is locked.');
end;
case b and $80 of
0: FDetails.Add('Bit 7 = 0: Formula is NOT hidden.');
1: FDetails.Add('Bit 7 = 1: Formula is hidden.');
end;
end;
ShowInRow(FCurrRow, FBufferIndex, numBytes, Format('%d ($%.2x)', [b,b]),
'Cell protection and XF index');
b := FBuffer[FBufferIndex];
if Row = FCurrRow then begin
FDetails.Add('Indexes to format and font records:'#13);
FDetails.Add(Format('Bits 5-0 = %d: Index to FORMAT record', [b and $3f]));
FDetails.Add(Format('Bits 7-6 = %d: Index to FONT record', [(b and $C0) shr 6]));
end;
ShowInRow(FCurrRow, FBufferIndex, numBytes, Format('%d ($%.2x)', [b,b]),
'Indexes of format and font records');
b := FBuffer[FBufferIndex];
if Row = FCurrRow then begin
FDetails.Add('Cell style:'#13);
case b and $07 of
0: FDetails.Add('Bits 2-0 = 0: Horizontal alignment is GENERAL');
1: FDetails.Add('Bits 2-0 = 1: Horizontal alignment is LEFT');
2: FDetails.Add('Bits 2-0 = 2: Horizontal alignment is CENTERED');
3: FDetails.Add('Bits 2-0 = 3: Horizontal alignment is RIGHT');
4: FDetails.Add('Bits 2-0 = 4: Horizontal alignment is FILLED');
end;
if b and $08 = 0
then FDetails.Add('Bit 3 = 0: Cell has NO left border')
else FDetails.Add('Bit 3 = 1: Cell has left black border');
if b and $10 = 0
then FDetails.Add('Bit 4 = 0: Cell has NO right border')
else FDetails.Add('Bit 4 = 1: Cell has right black border');
if b and $20 = 0
then FDetails.Add('Bit 5 = 0: Cell has NO top border')
else FDetails.Add('Bit 5 = 1: Cell has top black border');
if b and $40 = 0
then FDetails.Add('Bit 6 = 0: Cell has NO bottom border')
else FDetails.Add('Bit 6 = 1: Cell has bottom black border');
if b and $80 = 0
then FDetails.Add('Bit 7 = 0: Cell has NO shaded background')
else FDetails.Add('Bit 7 = 1: Cell has shaded background');
end;
ShowInRow(FCurrRow, FBufferIndex, numbytes, Format('%d ($%.2x)', [b,b]),
'Cell style');
end else
begin // BIFF3 - BIFF 8
numBytes := 2;
Move(FBuffer[FBufferIndex], w, numBytes);
w := WordLEToN(w);
ShowInRow(FCurrROw, FBufferIndex, numBytes, Format('%d ($%.4x)', [w, w]),
'Index of XF record');
end;
// boolean value
numBytes := 1;
b := FBuffer[FBufferIndex];
ShowInRow(FCurrRow, FBufferIndex, numbytes,
Format('%d (%s)', [b, Uppercase(BoolToStr(Boolean(b), true))]),
'Boolean value (0=FALSE, 1=TRUE)'
);
// bool/error flag
numBytes := 1;
b := FBuffer[FBufferIndex];
if b = 0 then
ShowInRow(FCurrRow, FBufferIndex, numbytes, '0 (boolean value)',
'Boolean/Error value flag (0=boolean, 1=error value)')
else
ShowInRow(FCurrRow, FBufferIndex, numbytes, '1 (error value)',
'Boolean/Error value flag (0=boolean, 1=error value)');
end;
procedure TBIFFGrid.ShowBottomMargin;
var
numBytes: Integer;

95
components/fpspreadsheet/xlsbiff2.pas
View File

@ -114,7 +114,12 @@ type
protected
procedure CreateNumFormatList; override;
procedure ListAllNumFormats; override;
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); override;
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
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);
procedure WriteFormat(AStream: TStream; AFormatData: TsNumFormatData;
AListIndex: Integer); override;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
@ -167,6 +172,7 @@ const
INT_EXCEL_ID_INTEGER = $0002;
INT_EXCEL_ID_NUMBER = $0003;
INT_EXCEL_ID_LABEL = $0004;
INT_EXCEL_ID_BOOLERROR = $0005;
INT_EXCEL_ID_ROW = $0008;
INT_EXCEL_ID_BOF = $0009;
{%H-}INT_EXCEL_ID_INDEX = $000B;
@ -185,6 +191,18 @@ const
{%H-}INT_EXCEL_MACRO_SHEET = $0040;
type
TBIFF2BoolErrRecord = packed record
RecordID: Word;
RecordSize: Word;
Row: Word;
Col: Word;
Attrib1: Byte;
Attrib2: Byte;
Attrib3: Byte;
BoolErrValue: Byte;
ValueType: Byte;
end;
TBIFF2DimensionsRecord = packed record
RecordID: Word;
RecordSize: Word;
@ -1688,6 +1706,81 @@ begin
AStream.WriteBuffer(s[1], len * SizeOf(Char));
end;
{ Writes a BOOLEAN cell record. }
procedure TsSpreadBIFF2Writer.WriteBool(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell);
var
rec: TBIFF2BoolErrRecord;
xf: Integer;
begin
if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
exit;
xf := FindXFIndex(ACell);
if xf >= 63 then
WriteIXFE(AStream, xf);
{ BIFF record header }
rec.RecordID := WordToLE(INT_EXCEL_ID_BOOLERROR);
rec.RecordSize := WordToLE(9);
{ Row and column index }
rec.Row := WordToLE(ARow);
rec.Col := WordToLE(ACol);
{ BIFF2 attributes }
GetCellAttributes(ACell, xf, rec.Attrib1, rec.Attrib2, rec.Attrib3);
{ Cell value }
rec.BoolErrValue := ord(AValue);
rec.ValueType := 1; // 0 = boolean value, 1 = error value
{ Write out }
AStream.WriteBuffer(rec, SizeOf(rec));
end;
{ Writes an ERROR cell record. }
procedure TsSpreadBIFF2Writer.WriteError(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell);
var
rec: TBIFF2BoolErrRecord;
xf: Integer;
begin
if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
exit;
xf := FindXFIndex(ACell);
if xf >= 63 then
WriteIXFE(AStream, xf);
{ BIFF record header }
rec.RecordID := WordToLE(INT_EXCEL_ID_BOOLERROR);
rec.RecordSize := WordToLE(9);
{ Row and column index }
rec.Row := WordToLE(ARow);
rec.Col := WordToLE(ACol);
{ BIFF2 attributes }
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.ValueType := 1; // 0 = boolean value, 1 = error value
{ Write out }
AStream.WriteBuffer(rec, SizeOf(rec));
end;
{*******************************************************************
* TsSpreadBIFF2Writer.WriteBlank ()

87
components/fpspreadsheet/xlscommon.pas
View File

@ -44,6 +44,7 @@ const
INT_EXCEL_ID_BLANK = $0201; // BIFF2: $0001
INT_EXCEL_ID_NUMBER = $0203; // BIFF2: $0003
INT_EXCEL_ID_LABEL = $0204; // BIFF2: $0004
INT_EXCEL_ID_BOOLERROR = $0205; // BIFF2: $0005
INT_EXCEL_ID_STRING = $0207; // BIFF2: $0007
INT_EXCEL_ID_ROW = $0208; // BIFF2: $0008
INT_EXCEL_ID_INDEX = $020B; // BIFF2: $000B
@ -326,7 +327,10 @@ type
// Write out BLANK cell record
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
// Write out used codepage for character encoding
// Write out BOOLEAN cell record
procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Boolean; ACell: PCell); override;
// Writes out used codepage for character encoding
procedure WriteCodepage(AStream: TStream; AEncoding: TsEncoding);
// Writes out column info(s)
procedure WriteColInfo(AStream: TStream; ACol: PCol);
@ -336,6 +340,9 @@ type
// Writes out a TIME/DATE/TIMETIME
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TDateTime; ACell: PCell); override;
// Writes out ERROR cell record
procedure WriteError(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TsErrorValue; ACell: PCell); override;
// Writes out a FORMAT record
procedure WriteFormat(AStream: TStream; AFormatData: TsNumFormatData;
AListIndex: Integer); virtual;
@ -447,6 +454,16 @@ type
XFIndex: Word;
end;
TBIFF38BoolErrRecord = packed record
RecordID: Word;
RecordSize: Word;
Row: Word;
Col: Word;
XFIndex: Word;
BoolErrValue: Byte;
ValueType: Byte;
end;
TBIFF58NumberRecord = packed record
RecordID: Word;
RecordSize: Word;
@ -1839,6 +1856,35 @@ begin
AStream.WriteBuffer(rec, SizeOf(rec));
end;
{ Writes a BOOLEAN cell record.
Valie for BIFF3-BIFF8. Override for BIFF2. }
procedure TsSpreadBIFFWriter.WriteBool(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell);
var
rec: TBIFF38BoolErrRecord;
begin
if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
exit;
{ BIFF record header }
rec.RecordID := WordToLE(INT_EXCEL_ID_BOOLERROR);
rec.RecordSize := WordToLE(8);
{ Row and column index }
rec.Row := WordToLE(ARow);
rec.Col := WordToLE(ACol);
{ Index to XF record, according to formatting }
rec.XFIndex := WordToLE(FindXFIndex(ACell));
{ Cell value }
rec.BoolErrValue := ord(AValue);
rec.ValueType := 0; // 0 = boolean value, 1 = error value
{ Write out }
AStream.WriteBuffer(rec, SizeOf(rec));
end;
procedure TsSpreadBIFFWriter.WriteCodepage(AStream: TStream;
AEncoding: TsEncoding);
var
@ -1948,6 +1994,45 @@ begin
WriteNumber(AStream, ARow, ACol, ExcelDateSerial, ACell);
end;
{ Writes an ERROR cell record.
Valie for BIFF3-BIFF8. Override for BIFF2. }
procedure TsSpreadBIFFWriter.WriteError(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell);
var
rec: TBIFF38BoolErrRecord;
begin
if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then
exit;
{ BIFF record header }
rec.RecordID := WordToLE(INT_EXCEL_ID_BOOLERROR);
rec.RecordSize := WordToLE(8);
{ Row and column index }
rec.Row := WordToLE(ARow);
rec.Col := WordToLE(ACol);
{ Index to XF record, according to formatting }
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.ValueType := 1; // 0 = boolean value, 1 = error value
{ Write out }
AStream.WriteBuffer(rec, SizeOf(rec));
end;
{ Writes a BIFF format record defined in AFormatData. AListIndex the index of
the formatdata in the format list (not the FormatIndex!).
Needs to be overridden by descendants. }

53
components/fpspreadsheet/xlsxooxml.pas
View File

@ -151,6 +151,8 @@ type
//todo: add WriteDate
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
procedure WriteBool(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: Boolean; ACell: PCell); override;
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
ACell: PCell); override;
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
@ -448,6 +450,14 @@ begin
ACell^.FontIndex := xf.FontIndex;
// Alignment
if xf.HorAlignment <> haDefault then
Include(ACell^.UsedFormattingFields, uffHorAlign)
else
Exclude(ACell^.UsedFormattingFields, uffHorAlign);
if xf.VertAlignment <> vaDefault then
Include(ACell^.UsedFormattingFields, uffVertAlign)
else
Exclude(ACell^.UsedformattingFields, uffVertAlign);
ACell^.HorAlignment := xf.HorAlignment;
ACell^.VertAlignment := xf.VertAlignment;
@ -469,7 +479,7 @@ begin
if (borderData <> nil) then begin
ACell^.BorderStyles := borderData.BorderStyles;
if borderData.Borders <> [] then begin
Include(Acell^.UsedFormattingFields, uffBorder);
Include(ACell^.UsedFormattingFields, uffBorder);
ACell^.Border := borderData.Borders;
end else
Exclude(ACell^.UsedFormattingFields, uffBorder);
@ -485,7 +495,7 @@ begin
if xf.NumFmtIndex > 0 then begin
j := NumFormatList.FindByIndex(xf.NumFmtIndex);
if j > -1then begin
if j > -1 then begin
numFmtData := NumFormatList[j];
Include(ACell^.UsedFormattingFields, uffNumberFormat);
ACell^.NumberFormat := numFmtData.NumFormat;
@ -511,12 +521,13 @@ procedure TsSpreadOOXMLReader.ReadBorders(ANode: TDOMNode);
nodeName: String;
begin
Result := false;
ABorderStyle.LineStyle := lsThin;
ABorderStyle.Color := scBlack;
s := GetAttrValue(ANode, 'style');
if s = '' then
exit;
ABorderStyle.LineStyle := lsThin;
if s = 'thin' then
ABorderStyle.LineStyle := lsThin
else if s = 'medium' then
@ -532,23 +543,11 @@ procedure TsSpreadOOXMLReader.ReadBorders(ANode: TDOMNode);
else if s = 'hair' then
ABorderStyle.LineStyle := lsHair;
ABorderStyle.Color := scBlack;
colorNode := ANode.FirstChild;
while Assigned(colorNode) do begin
nodeName := colorNode.NodeName;
if nodeName = 'color' then begin
if nodeName = 'color' then
ABorderStyle.Color := ReadColor(colorNode);
{
s := GetAttrValue(colorNode, 'rgb');
if s <> '' then
ABorderStyle.Color := FWorkbook.AddColorToPalette(HTMLColorStrToColor('#' + s))
else begin
s := GetAttrValue(colorNode, 'indexed');
if s <> '' then
ABorderStyle.Color := StrToInt(s);
end;
}
end;
colorNode := colorNode.NextSibling;
end;
Result := true;
@ -567,6 +566,7 @@ begin
if ANode = nil then
exit;
borderStyles := DEFAULT_BORDERSTYLES;
borderNode := ANode.FirstChild;
while Assigned(borderNode) do begin
nodeName := borderNode.NodeName;
@ -2548,6 +2548,21 @@ begin
'</c>');
end;
{ Writes a boolean value to the stream }
procedure TsSpreadOOXMLWriter.WriteBool(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell);
var
CellPosText: String;
CellValueText: String;
lStyleIndex: Integer;
begin
CellPosText := TsWorksheet.CellPosToText(ARow, ACol);
lStyleIndex := GetStyleIndex(ACell);
if AValue then CellValueText := '1' else CellValueText := '0';
AppendToStream(AStream, Format(
'<c r="%s" s="%d" t="b"><v>%s</v></c>', [CellPosText, lStyleIndex, CellValueText]));
end;
{ Writes a string formula to the given cell. }
procedure TsSpreadOOXMLWriter.WriteFormula(AStream: TStream;
const ARow, ACol: Cardinal; ACell: PCell);
@ -2684,9 +2699,6 @@ var
ResultingValue: string;
//S: string;
begin
Unused(AStream);
Unused(ARow, ACol, ACell);
// Office 2007-2010 (at least) support no more characters in a cell;
if Length(AValue) > MAXBYTES then
begin
@ -2700,7 +2712,7 @@ begin
if not ValidXMLText(ResultingValue) then
Workbook.AddErrorMsg(
'Invalid character(s) in cell %s.', [
rsInvalidCharacterInCell, [
GetCellString(ARow, ACol)
]);
@ -2727,7 +2739,6 @@ var
CellValueText: String;
lStyleIndex: Integer;
begin
Unused(AStream, ACell);
CellPosText := TsWorksheet.CellPosToText(ARow, ACol);
lStyleIndex := GetStyleIndex(ACell);
CellValueText := FloatToStr(AValue, FPointSeparatorSettings);