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

fpspreadsheet: Add support for empty cells to all BIFF formats (needed for formatting of empty cells).

Browse Source 
Fix painting error of cell borders in fpspreadsheetgrid.
Add/complete reading/writing support for horizontal alignment, cell background and cell borders to BIFF2.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2958 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-04-21 21:43:43 +00:00
parent 4f85834153
commit f7f1b0f12a
12 changed files with 465 additions and 113 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
components/fpspreadsheet/examples/excel2demo/excel2read.lpi
View File

@ -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="excel2read"/>
<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>

21
components/fpspreadsheet/examples/excel2demo/excel2write.lpi
View File

@ -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>

21
components/fpspreadsheet/examples/excel2demo/excel2write.lpr
View File

@ -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;

9
components/fpspreadsheet/examples/excel8demo/excel8write.lpr
View File

@ -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);

7
components/fpspreadsheet/examples/fpsgrid/mainform.pas
View File

@ -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.

25
components/fpspreadsheet/fpsopendocument.pas
View File

@ -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

65
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -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);

93
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -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.

177
components/fpspreadsheet/xlsbiff2.pas
View File

@ -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);

74
components/fpspreadsheet/xlsbiff5.pas
View File

@ -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);

62
components/fpspreadsheet/xlsbiff8.pas
View File

@ -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;

3
components/fpspreadsheet/xlscommon.pas
View File

@ -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 }