diff --git a/components/fpspreadsheet/examples/excel2demo/excel2read.lpi b/components/fpspreadsheet/examples/excel2demo/excel2read.lpi index a122edc85..2357a4b54 100644 --- a/components/fpspreadsheet/examples/excel2demo/excel2read.lpi +++ b/components/fpspreadsheet/examples/excel2demo/excel2read.lpi @@ -1,21 +1,23 @@ - + + - - <UseAppBundle Value="False"/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IgnoreBinaries Value="False"/> @@ -42,12 +44,17 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> <PathDelim Value="\"/> <SearchPaths> - <OtherUnitFiles Value="..\"/> - <SrcPath Value="..\"/> + <OtherUnitFiles Value=".."/> + <SrcPath Value=".."/> </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> <CompilerPath Value="$(CompPath)"/> </Other> diff --git a/components/fpspreadsheet/examples/excel2demo/excel2write.lpi b/components/fpspreadsheet/examples/excel2demo/excel2write.lpi index 09bc45b5a..920e71bdc 100644 --- a/components/fpspreadsheet/examples/excel2demo/excel2write.lpi +++ b/components/fpspreadsheet/examples/excel2demo/excel2write.lpi @@ -1,21 +1,23 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> + <Version Value="9"/> <PathDelim Value="\"/> - <Version Value="7"/> <General> <Flags> <LRSInOutputDirectory Value="False"/> </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> - <TargetFileExt Value=".exe"/> <Title Value="excel2write"/> <UseAppBundle Value="False"/> </General> <VersionInfo> - <ProjectVersion Value=""/> + <StringTable ProductVersion=""/> </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> <PublishOptions> <Version Value="2"/> <IgnoreBinaries Value="False"/> @@ -42,12 +44,17 @@ </Units> </ProjectOptions> <CompilerOptions> - <Version Value="8"/> + <Version Value="11"/> <PathDelim Value="\"/> <SearchPaths> - <OtherUnitFiles Value="..\"/> - <SrcPath Value="..\"/> + <OtherUnitFiles Value=".."/> + <SrcPath Value=".."/> </SearchPaths> + <Parsing> + <SyntaxOptions> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> <Other> <CompilerPath Value="$(CompPath)"/> </Other> diff --git a/components/fpspreadsheet/examples/excel2demo/excel2write.lpr b/components/fpspreadsheet/examples/excel2demo/excel2write.lpr index 09c279c48..01ac74202 100644 --- a/components/fpspreadsheet/examples/excel2demo/excel2write.lpr +++ b/components/fpspreadsheet/examples/excel2demo/excel2write.lpr @@ -58,6 +58,27 @@ begin // Write current date/time MyWorksheet.WriteDateTime(2, 0, now); + // Write cell with background color + MyWorksheet.WriteUTF8Text(3, 0, 'Text'); + MyWorksheet.WriteBackgroundColor(3, 0, scSilver); + + // Empty cell with background color + MyWorksheet.WriteBackgroundColor(3, 1, scGrey); + + // Cell2 with top and bottom borders + MyWorksheet.WriteUTF8Text(4, 0, 'Text'); + MyWorksheet.WriteBorders(4, 0, [cbNorth, cbSouth]); + MyWorksheet.WriteBorders(4, 1, [cbNorth, cbSouth]); + MyWorksheet.WriteBorders(4, 2, [cbNorth, cbSouth]); + + // Left, center, right aligned texts + MyWorksheet.WriteUTF8Text(5, 0, 'L'); + MyWorksheet.WriteUTF8Text(5, 1, 'C'); + MyWorksheet.WriteUTF8Text(5, 2, 'R'); + MyWorksheet.WriteHorAlignment(5, 0, haLeft); + MyWorksheet.WriteHorAlignment(5, 1, haCenter); + MyWorksheet.WriteHorAlignment(5, 2, haRight); + // Save the spreadsheet to a file MyWorkbook.WriteToFile(MyDir + 'test' + STR_EXCEL_EXTENSION, sfExcel2, true); MyWorkbook.Free; diff --git a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr index d3034e28d..2df9a3fd9 100644 --- a/components/fpspreadsheet/examples/excel8demo/excel8write.lpr +++ b/components/fpspreadsheet/examples/excel8demo/excel8write.lpr @@ -52,6 +52,12 @@ begin lCell^.BackgroundColor := scPURPLE; lCell^.UsedFormattingFields := [uffBackgroundColor]; + // E6 empty cell, only background color + MyWorksheet.WriteBackgroundColor(5, 4, scYellow); + + // E7 empty cell, only all borders + MyWorksheet.WriteBorders(5, 5, [cbNorth, cbEast, cbSouth, cbWest]); + // Word-wrapped long text in D7 MyWorksheet.WriteUTF8Text(6, 3, 'This is a very, very, very, very long text.'); MyWorksheet.WriteUsedFormatting(6, 3, [uffWordwrap]); @@ -65,6 +71,7 @@ begin MyWorksheet.WriteAnsiText(i, 3, ParamStr(0)); end; } + // Write the formula E1 = A1 + B1 SetLength(MyRPNFormula, 3); MyRPNFormula[0].ElementKind := fekCell; @@ -84,8 +91,6 @@ begin MyRPNFormula[1].ElementKind := fekABS; MyWorksheet.WriteRPNFormula(0, 5, MyRPNFormula); - //MyFormula.FormulaStr := ''; - // Write current date/time to cells B11:B16 MyWorksheet.WriteUTF8Text(10, 0, 'nfShortDate'); MyWorksheet.WriteDateTime(10, 1, now, nfShortDate); diff --git a/components/fpspreadsheet/examples/fpsgrid/mainform.pas b/components/fpspreadsheet/examples/fpsgrid/mainform.pas index 33f132eea..46a600663 100644 --- a/components/fpspreadsheet/examples/fpsgrid/mainform.pas +++ b/components/fpspreadsheet/examples/fpsgrid/mainform.pas @@ -58,7 +58,7 @@ var implementation uses - Grids; + Grids, fpcanvas; { TForm1 } @@ -95,7 +95,10 @@ begin if OpenDialog1.Execute then begin sWorksheetGrid1.LoadFromSpreadsheetFile(OpenDialog1.FileName); - Caption := Format('fpsGrid - %s', [OpenDialog1.Filename]); + Caption := Format('fpsGrid - %s (%s)', [ + OpenDialog1.Filename, + GetFileFormatName(sWorksheetGrid1.Workbook.FileFormat) + ]); // Create a tab in the pagecontrol for each worksheet contained in the workbook // This would be easer with a TTabControl. This has display issues, though. diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index 46261a56e..2faf48e03 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -90,10 +90,16 @@ type // Routines to write parts of those files function WriteStylesXMLAsString: string; { Record writing methods } - procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; const AFormula: TsFormula; ACell: PCell); override; - procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; const AValue: string; ACell: PCell); override; - procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); override; - procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); override; + procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; + ACell: PCell); override; + procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; + const AFormula: TsFormula; ACell: PCell); override; + procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; + const AValue: string; ACell: PCell); override; + procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; + const AValue: double; ACell: PCell); override; + procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; + const AValue: TDateTime; ACell: PCell); override; public constructor Create; override; { General writing methods } @@ -805,6 +811,17 @@ begin </table:table-cell>} end; +{ + Writes an empty cell + + Not clear whether this is needed for ods, but the inherited procedure is abstract. +} +procedure TsSpreadOpenDocWriter.WriteBlank(AStream: TStream; + const ARow, ACol: Cardinal; ACell: PCell); +begin + // no action at the moment... +end; + { Writes a cell with text content diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index f156a3516..6a1d71cea 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -296,6 +296,7 @@ type procedure WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring); procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double; AFormat: TsNumberFormat = nfGeneral; ADecimals: Word = 2); + procedure WriteBlank(ARow, ACol: Cardinal); procedure WriteDateTime(ARow, ACol: Cardinal; AValue: TDateTime; AFormat: TsNumberFormat = nfShortDateTime; AFormatStr: String = ''); procedure WriteFormula(ARow, ACol: Cardinal; AFormula: TsFormula); @@ -304,6 +305,7 @@ type procedure WriteTextRotation(ARow, ACol: Cardinal; ARotation: TsTextRotation); procedure WriteUsedFormatting(ARow, ACol: Cardinal; AUsedFormatting: TsUsedFormattingFields); procedure WriteBackgroundColor(ARow, ACol: Cardinal; AColor: TsColor); + procedure WriteBorders(ARow, ACol: Cardinal; ABorders: TsCellBorders); procedure WriteHorAlignment(ARow, ACol: Cardinal; AValue: TsHorAlignment); procedure WriteVertAlignment(ARow, ACol: Cardinal; AValue: TsVertAlignment); { Data manipulation methods - For Rows and Cols } @@ -328,6 +330,7 @@ type { Internal data } FWorksheets: TFPList; FEncoding: TsEncoding; + FFormat: TsSpreadsheetFormat; { Internal methods } procedure RemoveCallback(data, arg: pointer); public @@ -356,6 +359,7 @@ type {@@ This property is only used for formats which don't support unicode and support a single encoding for the whole document, like Excel 2 to 5 } property Encoding: TsEncoding read FEncoding write FEncoding; + property FileFormat: TsSpreadsheetFormat read FFormat; end; {@@ TsSpreadReader class reference type } @@ -369,6 +373,7 @@ type FWorkbook: TsWorkbook; FWorksheet: TsWorksheet; { Record reading methods } + procedure ReadBlank(AStream: TStream); virtual; abstract; procedure ReadFormula(AStream: TStream); virtual; abstract; procedure ReadLabel(AStream: TStream); virtual; abstract; procedure ReadNumber(AStream: TStream); virtual; abstract; @@ -401,6 +406,7 @@ type procedure WriteCellCallback(ACell: PCell; AStream: TStream); procedure WriteCellsToStream(AStream: TStream; ACells: TAVLTree); { Record writing methods } + procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); virtual; abstract; procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); virtual; abstract; procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; const AFormula: TsFormula; ACell: PCell); virtual; procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell); virtual; @@ -478,6 +484,7 @@ type function RPNFunc(AToken: TFEKind; ANext: PRPNItem): PRPNItem; overload; function RPNFunc(AToken: TFEKind; ANumParams: Byte; ANext: PRPNItem): PRPNItem; overload; + var GsSpreadFormats: array of TsSpreadFormatData; @@ -486,6 +493,8 @@ procedure RegisterSpreadFormat( AWriterClass: TsSpreadWriterClass; AFormat: TsSpreadsheetFormat); +function GetFileFormatName(AFormat: TsSpreadsheetFormat): String; + function SciFloat(AValue: Double; ADecimals: Word): String; function TimeIntervalToString(AValue: TDateTime): String; @@ -500,6 +509,8 @@ resourcestring lpUnsupportedReadFormat = 'Tried to read a spreadsheet using an unsupported format'; lpUnsupportedWriteFormat = 'Tried to write a spreadsheet using an unsupported format'; lpNoValidSpreadsheetFile = '"%s" is not a valid spreadsheet file.'; + lpUnknownSpreadsheetFormat = 'unknown format'; + {@@ Registers a new reader/writer pair for a format @@ -519,6 +530,27 @@ begin GsSpreadFormats[len].Format := AFormat; end; +{@@ + Returns the name of the given file format. +} +function GetFileFormatName(AFormat: TsSpreadsheetFormat): string; +begin + case AFormat of + sfExcel2 : Result := 'BIFF2'; + sfExcel3 : Result := 'BIFF3'; + sfExcel4 : Result := 'BIFF4'; + sfExcel5 : Result := 'BIFF5'; + sfExcel8 : Result := 'BIFF8'; + sfooxml : Result := 'OOXML'; + sfOpenDocument : Result := 'Open Document'; + sfCSV : Result := 'CSV'; + sfWikiTable_Pipes : Result := 'WikiTable Pipes'; + sfWikiTable_WikiMedia : Result := 'WikiTable WikiMedia'; + else Result := lpUnknownSpreadsheetFormat; + end; +end; + + {@@ Formats the number AValue in "scientific" format with the given number of decimals. "Scientific" is the same as "exponential", but with exponents rounded @@ -1056,6 +1088,22 @@ begin end; end; +{@@ + Writes as empty cell + + @param ARow The row of the cell + @param ACol The column of the cell + + Note: an empty cell is required for formatting. +} +procedure TsWorksheet.WriteBlank(ARow, ACol: Cardinal); +var + ACell: PCell; +begin + ACell := GetCell(ARow, ACol); + ACell^.ContentType := cctEmpty; +end; + {@@ Writes a date/time value to a determined cell @@ -1128,7 +1176,6 @@ var ACell: PCell; begin ACell := GetCell(ARow, ACol); - ACell^.ContentType := cctFormula; ACell^.FormulaValue := AFormula; end; @@ -1148,7 +1195,6 @@ var ACell: PCell; begin ACell := GetCell(ARow, ACol); - Include(ACell^.UsedFormattingFields, uffNumberFormat); ACell^.NumberFormat := ANumberFormat; end; @@ -1159,7 +1205,6 @@ var ACell: PCell; begin ACell := GetCell(ARow, ACol); - ACell^.ContentType := cctRPNFormula; ACell^.RPNFormulaValue := AFormula; end; @@ -1179,7 +1224,6 @@ var ACell: PCell; begin ACell := GetCell(ARow, ACol); - Include(ACell^.UsedFormattingFields, uffTextRotation); ACell^.TextRotation := ARotation; end; @@ -1190,7 +1234,6 @@ var ACell: PCell; begin ACell := GetCell(ARow, ACol); - ACell^.UsedFormattingFields := AUsedFormatting; end; @@ -1200,11 +1243,19 @@ var ACell: PCell; begin ACell := GetCell(ARow, ACol); - ACell^.UsedFormattingFields := ACell^.UsedFormattingFields + [uffBackgroundColor]; ACell^.BackgroundColor := AColor; end; +procedure TsWorksheet.WriteBorders(ARow, ACol: Cardinal; ABorders: TsCellBorders); +var + lCell: PCell; +begin + lCell := GetCell(ARow, ACol); + Include(lCell^.UsedFormattingFields, uffBorder); + lCell^.Border := ABorders; +end; + procedure TsWorksheet.WriteHorAlignment(ARow, ACol: Cardinal; AValue: TsHorAlignment); var lCell: PCell; @@ -1427,6 +1478,7 @@ begin try AReader.ReadFromFile(AFileName, Self); + FFormat := AFormat; finally AReader.Free; end; @@ -1893,6 +1945,7 @@ end; procedure TsCustomSpreadWriter.WriteCellCallback(ACell: PCell; AStream: TStream); begin case ACell.ContentType of + cctEmpty: WriteBlank(AStream, ACell^.Row, ACell^.Col, ACell); cctDateTime: WriteDateTime(AStream, ACell^.Row, ACell^.Col, ACell^.DateTimeValue, ACell); cctNumber: WriteNumber(AStream, ACell^.Row, ACell^.Col, ACell^.NumberValue, ACell); cctUTF8String: WriteLabel(AStream, ACell^.Row, ACell^.Col, ACell^.UTF8StringValue, ACell); diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index a68fb0570..3359ea3d6 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/components/fpspreadsheet/fpspreadsheetgrid.pas @@ -31,7 +31,7 @@ type protected { Protected declarations } procedure DoPrepareCanvas(ACol, ARow: Integer; AState: TGridDrawState); override; - procedure DrawCellGrid(aCol,aRow: Integer; aRect: TRect; aState: TGridDrawState); override; + procedure DrawAllRows; override; procedure DrawTextInCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); override; function GetCellText(ACol, ARow: Integer): String; procedure Loaded; override; @@ -156,7 +156,23 @@ procedure Register; implementation uses - fpsUtils; + fpCanvas, fpsUtils; + +var + FillPattern_BIFF2: TBitmap = nil; + +procedure Create_FillPattern_BIFF2(ABkColor: TColor); +begin + FreeAndNil(FillPattern_BIFF2); + FillPattern_BIFF2 := TBitmap.Create; + with FillPattern_BIFF2 do begin + SetSize(4, 4); + Canvas.Brush.Color := ABkColor; + Canvas.FillRect(0, 0, Width, Height); + Canvas.Pixels[0, 0] := clBlack; + Canvas.Pixels[2, 2] := clBlack; + end; +end; function FPSColorToColor(FPSColor: TsColor): TColor; begin @@ -180,8 +196,8 @@ begin // scGrey10pct: Result := TColor($00E6E6E6); scGrey20pct: Result := TColor($00CCCCCC); - scOrange : Result := TColor($0000A4FF); // FFA500 - scDarkBrown: Result := TColor($002D53A0); // A0522D + scOrange : Result := TColor($0000A5FF); // FFA500 + scDarkBrown: Result := TColor($002D52A0); // A0522D scBrown : Result := TColor($003F85CD); // CD853F scBeige : Result := TColor($00DCF5F5); // F5F5DC scWheat : Result := TColor($00B3DEF5); // F5DEB3 @@ -226,6 +242,8 @@ begin Result := round(AHeight / 25.4 * Screen.PixelsPerInch) + 4; end; +{ Adjusts the grid's canvas before painting a given cell. Considers, e.g. + background color, horizontal alignment, vertical alignment, etc. } procedure TsCustomWorksheetGrid.DoPrepareCanvas(ACol, ARow: Integer; AState: TGridDrawState); var @@ -233,6 +251,7 @@ var lCell: PCell; r, c: Integer; begin + Canvas.Brush.Bitmap := nil; ts := Canvas.TextStyle; if FDisplayFixedColRow then begin // Formatting of row and column headers @@ -274,8 +293,15 @@ begin end; // Background color if (uffBackgroundColor in lCell^.UsedFormattingFields) then begin - Canvas.Brush.Style := bsSolid; - Canvas.Brush.Color := FPSColorToColor(lCell^.BackgroundColor); + if FWorkbook.FileFormat = sfExcel2 then begin + if (FillPattern_BIFF2 = nil) and (ComponentState = []) then + Create_FillPattern_BIFF2(Color); + Canvas.Brush.Style := bsImage; + Canvas.Brush.Bitmap := FillPattern_BIFF2; + end else begin + Canvas.Brush.Style := bsSolid; + Canvas.Brush.Color := FPSColorToColor(lCell^.BackgroundColor); + end; end else begin Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := Color; @@ -287,42 +313,46 @@ begin inherited DoPrepareCanvas(ACol, ARow, AState); end; -procedure TsCustomWorksheetGrid.DrawCellGrid(ACol, ARow: Integer; ARect: TRect; - AState: TGridDrawState); +{ Paints the cell borders. This cannot be done in DrawCellGrid because the + lower border line is overwritten when painting the next row. } +procedure TsCustomWorksheetGrid.DrawAllRows; var - lCell: PCell; - r, c: Integer; + cell: PCell; + c, r: Integer; + rect: TRect; begin inherited; - if FWorksheet = nil then exit; - r := ARow - FixedRows; - c := ACol - FixedCols; - lCell := FWorksheet.FindCell(r, c); - if (lCell <> nil) and (uffBorder in lCell^.UsedFormattingFields) then begin - Canvas.Pen.Style := psSolid; - Canvas.Pen.Color := clBlack; - if (cbNorth in lCell^.Border) then - Canvas.Line(ARect.Left, ARect.Top, ARect.Right, ARect.Top) - else - if (cbWest in lCell^.Border) then - Canvas.Line(ARect.Left, ARect.Top, ARect.Left, ARect.Bottom) - else - if (cbEast in lCell^.Border) then - Canvas.Line(ARect.Right-1, ARect.Top, ARect.Right-1, ARect.Bottom) - else - if (cbSouth in lCell^.Border) then - Canvas.Line(ARect.Left, ARect.Bottom-1, ARect.Right, ARect.Bottom-1) + cell := FWorksheet.GetFirstCell; + while cell <> nil do begin + if (uffBorder in cell^.UsedFormattingFields) then begin + c := cell^.Col + FixedCols; + r := cell^.Row + FixedRows; + rect := CellRect(c, r); + Canvas.Pen.Style := psSolid; + Canvas.Pen.Color := clBlack; + if (cbNorth in cell^.Border) then + Canvas.Line(rect.Left, rect.Top-1, rect.Right, rect.Top-1); + if (cbWest in cell^.Border) then + Canvas.Line(rect.Left-1, rect.Top, rect.Left-1, rect.Bottom); + if (cbEast in cell^.Border) then + Canvas.Line(rect.Right-1, rect.Top, rect.Right-1, rect.Bottom); + if (cbSouth in cell^.Border) then + Canvas.Line(rect.Left, rect.Bottom-1, rect.Right, rect.Bottom-1); + end; + cell := FWorksheet.GetNextCell; end; end; +{ Draws the cell text. Calls "GetCellText" to determine the text in the cell. } procedure TsCustomWorksheetGrid.DrawTextInCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState); begin DrawCellText(aCol, aRow, aRect, aState, GetCellText(ACol,ARow)); end; +{ This function returns the text to be written in the cell } function TsCustomWorksheetGrid.GetCellText(ACol, ARow: Integer): String; var lCell: PCell; @@ -354,6 +384,8 @@ begin end; end; +{ Returns a list of worksheets contained in the file. Useful for assigning to + user controls like TabControl, Combobox etc. in order to select a sheet. } procedure TsCustomWorksheetGrid.GetSheets(const ASheets: TStrings); var i: Integer; @@ -488,4 +520,9 @@ begin LoadFromWorksheet(FWorkbook.GetWorksheetByIndex(AIndex)); end; +initialization + +finalization + FreeAndNil(FillPattern_BIFF2); + end. diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas index 5fbddf7b0..bd052b96e 100755 --- a/components/fpspreadsheet/xlsbiff2.pas +++ b/components/fpspreadsheet/xlsbiff2.pas @@ -47,7 +47,11 @@ type FWorksheet: TsWorksheet; procedure ReadRowInfo(AStream: TStream); protected + procedure ApplyCellFormatting(ARow, ACol: Word; XF, AFormat, AFont, AStyle: Byte); + procedure ReadRowColStyle(AStream: TStream; out ARow, ACol: Word; + out XF, AFormat, AFont, AStyle: byte); { Record writing methods } + procedure ReadBlank(AStream: TStream); override; procedure ReadFormula(AStream: TStream); override; procedure ReadLabel(AStream: TStream); override; procedure ReadNumber(AStream: TStream); override; @@ -63,6 +67,7 @@ type private procedure WriteCellFormatting(AStream: TStream; ACell: PCell); { Record writing methods } + procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); override; procedure WriteBOF(AStream: TStream); procedure WriteEOF(AStream: TStream); procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell); override; @@ -78,6 +83,7 @@ implementation const { Excel record IDs } + INT_EXCEL_ID_BLANK = $0001; INT_EXCEL_ID_INTEGER = $0002; INT_EXCEL_ID_NUMBER = $0003; INT_EXCEL_ID_LABEL = $0004; @@ -100,7 +106,7 @@ const procedure TsSpreadBIFF2Writer.WriteCellFormatting(AStream: TStream; ACell: PCell); var - BorderByte: Byte = 0; + b: Byte; begin if ACell^.UsedFormattingFields = [] then begin @@ -110,26 +116,36 @@ begin Exit; end; - AStream.WriteByte($0); + // 1st byte: + // Mask $3F: Index to XF record + // Mask $40: 1 = Cell is locked + // Mask $80: 1 = Formula is hidden AStream.WriteByte($0); - // The Border and Background + // 2nd byte: + // Mask $3F: Index to FORMAT record + // Mask $C0: Index to FONT record + AStream.WriteByte($0); - BorderByte := 0; - - if uffBorder in ACell^.UsedFormattingFields then - begin - if cbNorth in ACell^.Border then BorderByte := BorderByte or $20; - if cbWest in ACell^.Border then BorderByte := BorderByte or $08; - if cbEast in ACell^.Border then BorderByte := BorderByte or $10; - if cbSouth in ACell^.Border then BorderByte := BorderByte or $40; + // 3rd byte + // Mask $07: horizontal alignment + // Mask $08: Cell has left border + // Mask $10: Cell has right border + // Mask $20: Cell has top border + // Mask $40: Cell has bottom border + // Mask $80: Cell has shaded background + b := 0; + if uffHorAlign in ACell^.UsedFormattingFields then + b := ord (ACell^.HorAlignment); + if uffBorder in ACell^.UsedFormattingFields then begin + if cbNorth in ACell^.Border then b := b or $20; + if cbWest in ACell^.Border then b := b or $08; + if cbEast in ACell^.Border then b := b or $10; + if cbSouth in ACell^.Border then b := b or $40; end; - - // BIFF2 does not support a background color, just a "shaded" option if uffBackgroundColor in ACell^.UsedFormattingFields then - BorderByte := BorderByte or $80; - - AStream.WriteByte(BorderByte); + b := b or $80; + AStream.WriteByte(b); end; { @@ -329,6 +345,29 @@ begin AStream.position := FinalPos; end; +{******************************************************************* +* TsSpreadBIFF2Writer.WriteBlank () +* +* DESCRIPTION: Writes an Excel 2 record for an empty cell +* +* Required if this cell should contain formatting +* +*******************************************************************} +procedure TsSpreadBIFF2Writer.WriteBlank(AStream: TStream; + const ARow, ACol: Cardinal; ACell: PCell); +begin + { BIFF Record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_BLANK)); + AStream.WriteWord(WordToLE(7)); + + { BIFF Record data } + AStream.WriteWord(WordToLE(ARow)); + AStream.WriteWord(WordToLE(ACol)); + + { BIFF2 Attributes } + WriteCellFormatting(AStream, ACell); +end; + {******************************************************************* * TsSpreadBIFF2Writer.WriteLabel () * @@ -435,6 +474,48 @@ end; { TsSpreadBIFF2Reader } +procedure TsSpreadBIFF2Reader.ApplyCellFormatting(ARow, ACol: Word; + XF, AFormat, AFont, AStyle: Byte); +var + lCell: PCell; +begin + lCell := FWorksheet.GetCell(ARow, ACol); + + if Assigned(lCell) then begin + // Horizontal justification + if AStyle and $07 <> 0 then begin + Include(lCell^.UsedFormattingFields, uffHorAlign); + lCell^.HorAlignment := TsHorAlignment(AStyle and $07); + end; + + // Border + if AStyle and $78 <> 0 then begin + Include(lCell^.UsedFormattingFields, uffBorder); + lCell^.Border := []; + if AStyle and $08 <> 0 then Include(lCell^.Border, cbWest); + if AStyle and $10 <> 0 then Include(lCell^.Border, cbEast); + if AStyle and $20 <> 0 then Include(lCell^.Border, cbNorth); + if AStyle and $40 <> 0 then Include(lCell^.Border, cbSouth); + end else + Exclude(lCell^.UsedFormattingFields, uffBorder); + + // Background + if AStyle and $80 <> 0 then begin + Include(lCell^.UsedFormattingFields, uffBackgroundColor); + // Background color is ignored + end; + end; +end; + +procedure TsSpreadBIFF2Reader.ReadBlank(AStream: TStream); +var + ARow, ACol: Word; + XF, AFormat, AFont, AStyle: Byte; +begin + ReadRowColStyle(AStream, ARow, ACol, XF, AFormat, AFont, AStyle); + ApplyCellFormatting(ARow, ACol, XF, AFormat, AFont, AStyle); +end; + procedure TsSpreadBIFF2Reader.ReadFromStream(AStream: TStream; AData: TsWorkbook); var BIFF2EOF: Boolean; @@ -460,6 +541,7 @@ begin case RecordType of + INT_EXCEL_ID_BLANK: ReadBlank(AStream); INT_EXCEL_ID_INTEGER: ReadInteger(AStream); INT_EXCEL_ID_NUMBER: ReadNumber(AStream); INT_EXCEL_ID_LABEL: ReadLabel(AStream); @@ -488,17 +570,12 @@ procedure TsSpreadBIFF2Reader.ReadLabel(AStream: TStream); var L: Byte; ARow, ACol: Word; + XF, AFormat, AFont, AStyle: Byte; AValue: array[0..255] of Char; AStrValue: UTF8String; begin - { BIFF Record data } - ARow := WordLEToN(AStream.ReadWord); - ACol := WordLEToN(AStream.ReadWord); - - { BIFF2 Attributes } - AStream.ReadByte(); - AStream.ReadByte(); - AStream.ReadByte(); + { BIFF Record row/column/style } + ReadRowColStyle(AStream, ARow, ACol, XF, AFormat, AFont, AStyle); { String with 8-bit size } L := AStream.ReadByte(); @@ -518,48 +595,68 @@ begin AStrValue := CP1252ToUTF8(AValue); end; FWorksheet.WriteUTF8Text(ARow, ACol, AStrValue); + + { Apply formatting to cell } + ApplyCellFormatting(ARow, ACol, XF, AFormat, AFont, AStyle); end; procedure TsSpreadBIFF2Reader.ReadNumber(AStream: TStream); var ARow, ACol: Word; + XF, AFormat, AFont, AStyle: Byte; AValue: Double; begin - { BIFF Record data } - ARow := WordLEToN(AStream.ReadWord); - ACol := WordLEToN(AStream.ReadWord); - - { BIFF2 Attributes } - AStream.ReadByte(); - AStream.ReadByte(); - AStream.ReadByte(); + { BIFF Record row/column/style } + ReadRowColStyle(AStream, ARow, ACol, XF, AFormat, AFont, AStyle); { IEE 754 floating-point value } AStream.ReadBuffer(AValue, 8); { Save the data } FWorksheet.WriteNumber(ARow, ACol, AValue); + + { Apply formatting to cell } + ApplyCellFormatting(ARow, ACol, XF, AFormat, AFont, AStyle); end; procedure TsSpreadBIFF2Reader.ReadInteger(AStream: TStream); var ARow, ACol: Word; + XF, AFormat, AFont, AStyle: Byte; AWord : Word; begin - { BIFF Record data } - ARow := WordLEToN(AStream.ReadWord); - ACol := WordLEToN(AStream.ReadWord); - - { BIFF2 Attributes } - AStream.ReadByte(); - AStream.ReadByte(); - AStream.ReadByte(); + { BIFF Record row/column/style } + ReadRowColStyle(AStream, ARow, ACol, XF, AFormat, AFont, AStyle); { 16 bit unsigned integer } AStream.ReadBuffer(AWord, 2); { Save the data } FWorksheet.WriteNumber(ARow, ACol, AWord); + + { Apply formatting to cell } + ApplyCellFormatting(ARow, ACol, XF, AFormat, AFont, AStyle); +end; + +procedure TsSpreadBIFF2Reader.ReadRowColStyle(AStream: TStream; + out ARow, ACol: Word; out XF, AFormat, AFont, AStyle: byte); +type + TRowColStyleRecord = packed record + Row, Col: Word; + XFIndex: Byte; + Format_Font: Byte; + Style: Byte; + end; +var + rcs: TRowColStyleRecord; +begin + AStream.ReadBuffer(rcs, SizeOf(TRowColStyleRecord)); + ARow := WordLEToN(rcs.Row); + ACol := WordLEToN(rcs.Col); + XF := rcs.XFIndex; + AFormat := (rcs.Format_Font AND $3F); + AFont := (rcs.Format_Font AND $C0) shr 6; + AStyle := rcs.Style; end; procedure TsSpreadBIFF2Reader.ReadRowInfo(AStream: TStream); diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index 1c53a5ef3..2034fe91b 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -83,8 +83,10 @@ type FCurrentWorksheet: Integer; protected { Helpers } + procedure ApplyCellFormatting(ARow, ACol: Cardinal; XFIndex: Integer); function DecodeRKValue(const ARK: DWORD): Double; { Record writing methods } + procedure ReadBlank(AStream: TStream); override; procedure ReadFormula(AStream: TStream); override; procedure ReadFormulaExcel(AStream: TStream); procedure ReadLabel(AStream: TStream); override; @@ -109,17 +111,23 @@ type WorkBookEncoding: TsEncoding; protected { Record writing methods } + procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; + ACell: PCell); override; procedure WriteBOF(AStream: TStream; ADataType: Word); function WriteBoundsheet(AStream: TStream; ASheetName: string): Int64; //procedure WriteCodepage(AStream: TStream; AEncoding: TsEncoding); this is in xlscommon - procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); override; + procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; + const AValue: TDateTime; ACell: PCell); override; procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteEOF(AStream: TStream); procedure WriteFont(AStream: TStream; AFont: TFPCustomFont); - procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell); override; + procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal; + const AFormula: TsRPNFormula; ACell: PCell); override; procedure WriteIndex(AStream: TStream); - procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; const AValue: string; ACell: PCell); override; - procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); override; + procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; + const AValue: string; ACell: PCell); override; + procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; + const AValue: double; ACell: PCell); override; procedure WriteStyle(AStream: TStream); procedure WriteWindow1(AStream: TStream); procedure WriteWindow2(AStream: TStream; ASheetSelected: Boolean); @@ -135,6 +143,7 @@ implementation const { Excel record IDs } + INT_EXCEL_ID_BLANK = $0201; INT_EXCEL_ID_BOF = $0809; INT_EXCEL_ID_BOUNDSHEET = $0085; // Renamed to SHEET in the latest OpenOffice docs INT_EXCEL_ID_EOF = $000A; @@ -417,6 +426,27 @@ begin SetLength(Boundsheets, 0); end; +{******************************************************************* +* TsSpreadBIFF5Writer.WriteBlank +* +* DESCRIPTION: Writes the record for an empty cell +* +*******************************************************************} +procedure TsSpreadBIFF5Writer.WriteBlank(AStream: TStream; + const ARow, ACol: Cardinal; ACell: PCell); +begin + { BIFF Record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_BLANK)); + AStream.WriteWord(WordToLE(6)); + + { BIFF Record data } + AStream.WriteWord(WordToLE(ARow)); + AStream.WriteWord(WordToLE(ACol)); + + { Index to XF record } + AStream.WriteWord(WordToLE(15)); +end; + {******************************************************************* * TsSpreadBIFF5Writer.WriteBOF () * @@ -1023,7 +1053,7 @@ end; * *******************************************************************} procedure TsSpreadBIFF5Writer.WriteXF(AStream: TStream; AFontIndex: Word; - AXF_TYPE_PROT: Byte); + AXF_TYPE_PROT: Byte); var XFOptions: Word; XFAlignment, XFOrientationAttrib: Byte; @@ -1125,9 +1155,9 @@ begin case RecordType of + INT_EXCEL_ID_BLANK: ReadBlank(AStream); INT_EXCEL_ID_NUMBER: ReadNumber(AStream); INT_EXCEL_ID_LABEL: ReadLabel(AStream); -// INT_EXCEL_ID_FORMULA: ReadFormula(AStream); INT_EXCEL_ID_RSTRING: ReadRichString(AStream); //(RSTRING) This record stores a formatted text cell (Rich-Text). In BIFF8 it is usually replaced by the LABELSST record. Excel still uses this record, if it copies formatted text cells to the clipboard. INT_EXCEL_ID_RK: ReadRKValue(AStream); //(RK) This record represents a cell that contains an RK value (encoded integer or floating-point value). If a floating-point value cannot be encoded to an RK value, a NUMBER record will be written. This record replaces the record INTEGER written in BIFF2. INT_EXCEL_ID_MULRK: ReadMulRKValues(AStream); @@ -1230,6 +1260,9 @@ begin AStream.ReadByte; // First formatted character AStream.ReadByte; // Index to FONT record end; + + { Add attributes to cell } + ApplyCellFormatting(ARow, ACol, XF); end; procedure TsSpreadBIFF5Reader.ReadRKValue(AStream: TStream); @@ -1247,6 +1280,9 @@ begin Number:=DecodeRKValue(L); FWorksheet.WriteNumber(ARow,ACol,Number); + + { Add attributes to cell } + ApplyCellFormatting(ARow, ACol, XF); end; procedure TsSpreadBIFF5Reader.ReadMulRKValues(AStream: TStream); @@ -1296,6 +1332,9 @@ begin if SizeOf(Double)<>8 then Raise Exception.Create('Double is not 8 bytes'); Move(Data[0],ResultFormula,sizeof(Data)); FWorksheet.WriteNumber(ARow,ACol,ResultFormula); + + { Add attributes to cell } + ApplyCellFormatting(ARow, ACol, XF); end; function TsSpreadBIFF5Reader.DecodeRKValue(const ARK: DWORD): Double; @@ -1402,6 +1441,16 @@ begin FWorksheetNames.Free; end; +procedure TsSpreadBIFF5Reader.ReadBlank(AStream: TStream); +var + ARow, ACol, XF: Word; +begin + { Read row, column, and XF index from BIFF file } + ReadRowColXF(AStream, ARow, ACol, XF); + { Add attributes to cell} + ApplyCellFormatting(ARow, ACol, XF); +end; + procedure TsSpreadBIFF5Reader.ReadFormula(AStream: TStream); begin @@ -1424,6 +1473,9 @@ begin { Save the data } FWorksheet.WriteUTF8Text(ARow, ACol, ISO_8859_1ToUTF8(AStrValue)); + + { Add attributes } + ApplyCellFormatting(ARow, ACol, XF); end; procedure TsSpreadBIFF5Reader.ReadNumber(AStream: TStream); @@ -1438,8 +1490,18 @@ begin { Save the data } FWorksheet.WriteNumber(ARow, ACol, AValue); + + { Add attributes to cell } + ApplyCellFormatting(ARow, ACol, XF); end; +procedure TsSpreadBIFF5Reader.ApplyCellFormatting(ARow, ACol: Cardinal; + XFIndex: Integer); +begin + // to do... +end; + + initialization RegisterSpreadFormat(TsSpreadBIFF5Reader, TsSpreadBIFF5Writer, sfExcel5); diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index 634aeaef9..38303f54d 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -136,16 +136,17 @@ type procedure ReadFont(const AStream: TStream); // Read col info procedure ReadColInfo(const AStream: TStream); + { Record reading methods } + procedure ReadBlank(AStream: TStream); override; + procedure ReadFormula(AStream: TStream); override; + procedure ReadLabel(AStream: TStream); override; + procedure ReadNumber(AStream: TStream); override; public constructor Create; override; destructor Destroy; override; { General reading methods } procedure ReadFromFile(AFileName: string; AData: TsWorkbook); override; procedure ReadFromStream(AStream: TStream; AData: TsWorkbook); override; - { Record writing methods } - procedure ReadFormula(AStream: TStream); override; - procedure ReadLabel(AStream: TStream); override; - procedure ReadNumber(AStream: TStream); override; end; { TsSpreadBIFF8Writer } @@ -160,21 +161,28 @@ type protected procedure AddDefaultFormats(); override; { Record writing methods } + procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; + ACell: PCell); override; procedure WriteBOF(AStream: TStream; ADataType: Word); function WriteBoundsheet(AStream: TStream; ASheetName: string): Int64; // procedure WriteCodepage in xlscommon; Workbook Globals record procedure WriteColInfo(AStream: TStream; ASheet: TsWorksheet; ACol: PCol); - procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); override; + procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; + const AValue: TDateTime; ACell: PCell); override; // procedure WriteDateMode in xlscommon; Workbook Globals record procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteEOF(AStream: TStream); procedure WriteFont(AStream: TStream; AFont: TFPCustomFont); - procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; const AFormula: TsFormula; ACell: PCell); override; + procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; + const AFormula: TsFormula; ACell: PCell); override; procedure WriteIndex(AStream: TStream); - procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; const AValue: string; ACell: PCell); override; - procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); override; + procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; + const AValue: string; ACell: PCell); override; + procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; + const AValue: double; ACell: PCell); override; procedure WritePalette(AStream: TStream); - procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell); override; + procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal; + const AFormula: TsRPNFormula; ACell: PCell); override; procedure WriteStyle(AStream: TStream); procedure WriteWindow1(AStream: TStream); procedure WriteWindow2(AStream: TStream; ASheetSelected: Boolean); @@ -196,6 +204,7 @@ implementation const { Excel record IDs } + INT_EXCEL_ID_BLANK = $0201; INT_EXCEL_ID_BOF = $0809; INT_EXCEL_ID_BOUNDSHEET = $0085; // Renamed to SHEET in the latest OpenOffice docs INT_EXCEL_ID_COLINFO = $007D; @@ -725,6 +734,28 @@ begin SetLength(Boundsheets, 0); end; +{******************************************************************* +* TsSpreadBIFF8Writer.WriteBlank +* +* DESCRIPTION: Writes the record for an empty cell +* +*******************************************************************} +procedure TsSpreadBIFF8Writer.WriteBlank(AStream: TStream; + const ARow, ACol: Cardinal; ACell: PCell); +begin + { BIFF Record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_BLANK)); + AStream.WriteWord(WordToLE(6)); + + { BIFF Record data } + AStream.WriteWord(WordToLE(ARow)); + AStream.WriteWord(WordToLE(ACol)); + + { Index to XF record, according to formatting } + WriteXFIndex(AStream, ACell); +end; + + {******************************************************************* * TsSpreadBIFF8Writer.WriteBOF () * @@ -1955,6 +1986,7 @@ begin case RecordType of + INT_EXCEL_ID_BLANK: ReadBlank(AStream); INT_EXCEL_ID_NUMBER: ReadNumber(AStream); INT_EXCEL_ID_LABEL: ReadLabel(AStream); INT_EXCEL_ID_FORMULA: ReadFormula(AStream); @@ -2094,7 +2126,7 @@ var lCell: PCell; XFData: TXFRecordData; begin - lCell := FWorksheet.FindCell(ARow, ACol); + lCell := FWorksheet.GetCell(ARow, ACol); if Assigned(lCell) then begin XFData := TXFRecordData(FXFList.Items[XFIndex]); @@ -2212,6 +2244,16 @@ begin FWorksheetNames.Free; end; +procedure TsSpreadBIFF8Reader.ReadBlank(AStream: TStream); +var + ARow, ACol, XF: Word; +begin + { Read row, column, and XF index from BIFF file } + ReadRowColXF(AStream, ARow, ACol, XF); + { Add attributes to cell} + ApplyCellFormatting(ARow, ACol, XF); +end; + procedure TsSpreadBIFF8Reader.ReadFormula(AStream: TStream); var ARow, ACol, XF: WORD; diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index 30615df67..80b7dd4a6 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -283,7 +283,6 @@ type protected FCodepage: string; // in a format prepared for lconvencoding.ConvertEncoding FDateMode: TDateMode; - constructor Create; override; // converts an Excel color index to a color value. function ExcelPaletteToFPSColor(AIndex: Word): TsColor; // Here we can add reading of records which didn't change across BIFF2-8 versions @@ -293,6 +292,8 @@ type procedure ReadDateMode(AStream: TStream); // Read row info procedure ReadRowInfo(const AStream: TStream); virtual; + public + constructor Create; override; end; { TsSpreadBIFFWriter }