diff --git a/components/fpspreadsheet/fpscsv.pas b/components/fpspreadsheet/fpscsv.pas index d10159536..cc2fc6d0f 100644 --- a/components/fpspreadsheet/fpscsv.pas +++ b/components/fpspreadsheet/fpscsv.pas @@ -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 diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 430d92b08..867778534 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -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 ''); 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( + '' + + '%s' + + '', [ + 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? diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 217e8570b..3b8a6df77 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -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: diff --git a/components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas b/components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas index 01d8e1274..ad8e453d8 100644 --- a/components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas +++ b/components/fpspreadsheet/reference/BIFFExplorer/bebiffgrid.pas @@ -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; diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas index 8c6ebf4c6..d53015f3c 100755 --- a/components/fpspreadsheet/xlsbiff2.pas +++ b/components/fpspreadsheet/xlsbiff2.pas @@ -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 () diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index d51a435c2..c632ac695 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -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. } diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 0d2d6caac..f0c065b76 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -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 ''); 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( + '%s', [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);