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

fpspreadsheet: Add reading and writing of font support to biff8, biff2, and fpspreadsheetgrid. Font colors in biff2 not yet working. No test cases yet.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2959 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-04-22 23:10:32 +00:00
parent f7f1b0f12a
commit c61e4418b7
7 changed files with 789 additions and 150 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -51,6 +51,7 @@ begin
// Write some string cells
MyWorksheet.WriteUTF8Text(1, 0, 'First');
MyWorksheet.WriteFont(1, 0, 'Arial', 12, [fssBold, fssItalic, fssUnderline], scRed);
MyWorksheet.WriteUTF8Text(1, 1, 'Second');
MyWorksheet.WriteUTF8Text(1, 2, 'Third');
MyWorksheet.WriteUTF8Text(1, 3, 'Fourth');
@ -79,6 +80,16 @@ begin
MyWorksheet.WriteHorAlignment(5, 1, haCenter);
MyWorksheet.WriteHorAlignment(5, 2, haRight);
// Red font, italic
MyWorksheet.WriteNumber(6, 0, 2014);
MyWorksheet.WriteFont(6, 0, 'Calibri', 15, [fssItalic], scRed);
MyWorksheet.WriteNumber(6, 1, 2015);
MyWorksheet.WriteFont(6, 1, 'Times New Roman', 9, [fssUnderline], scBlue);
MyWorksheet.WriteNumber(6, 2, 2016);
MyWorksheet.WriteFont(6, 2, 'Courier New', 8, [], scBlue);
MyWorksheet.WriteNumber(6, 3, 2017);
MyWorksheet.WriteFont(6, 3, 'Arial', 18, [fssBold], scBlue);
// Save the spreadsheet to a file
MyWorkbook.WriteToFile(MyDir + 'test' + STR_EXCEL_EXTENSION, sfExcel2, true);
MyWorkbook.Free;

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

@ -36,6 +36,8 @@ begin
// Create the spreadsheet
MyWorkbook := TsWorkbook.Create;
MyWorkbook.SetDefaultFont('Calibri', 9);
MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet1);
// Write some cells
@ -48,9 +50,10 @@ begin
// D6 number with background color
MyWorksheet.WriteNumber(5, 3, 10);
lCell := MyWorksheet.GetCell(5,3);
lCell^.BackgroundColor := scPURPLE;
lCell := MyWorksheet.GetCell(5, 3);
lCell^.BackgroundColor := scPurple;
lCell^.UsedFormattingFields := [uffBackgroundColor];
// or: MyWorksheet.WriteBackgroundColor(5, 3, scPurple);
// E6 empty cell, only background color
MyWorksheet.WriteBackgroundColor(5, 4, scYellow);
@ -60,7 +63,15 @@ begin
// Word-wrapped long text in D7
MyWorksheet.WriteUTF8Text(6, 3, 'This is a very, very, very, very long text.');
MyWorksheet.WriteUsedFormatting(6, 3, [uffWordwrap]);
// Cell with changed font in D8
MyWorksheet.WriteUTF8Text(7, 3, 'This is 16pt red bold & italic Times New Roman.');
Myworksheet.WriteFont(7, 3, 'Times New Roman', 16, [fssBold, fssItalic], scRed);
// Cell with changed font and background in D9
MyWorksheet.WriteUTF8Text(8, 3, 'Colors...');
MyWorksheet.WriteFont(8, 3, 'Courier New', 12, [fssUnderline], scBlue);
// MyWorksheet.WriteBackgroundColor(8, 3, scYellow);
{ Uncomment this to test large XLS files
for i := 2 to 20 do
@ -82,6 +93,7 @@ begin
MyRPNFormula[1].Row := 0;
MyRPNFormula[2].ElementKind := fekAdd;
MyWorksheet.WriteRPNFormula(0, 4, MyRPNFormula);
MyWorksheet.WriteFont(0, 4, 'Arial', 10, [fssUnderline], scBlack);
// Write the formula F1 = ABS(A1)
SetLength(MyRPNFormula, 2);

257
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -131,8 +131,10 @@ type
{@@ List of possible formatting fields }
TsUsedFormattingField = (uffTextRotation, uffBold, uffBorder, uffBackgroundColor,
uffNumberFormat, uffWordWrap, uffHorAlign, uffVertAlign);
TsUsedFormattingField = (uffTextRotation, uffFont, uffBold, uffBorder,
uffBackgroundColor, uffNumberFormat, uffWordWrap,
uffHorAlign, uffVertAlign
);
{@@ Describes which formatting fields are active }
@ -210,6 +212,20 @@ type
scRGBCOLOR // Defined via TFPColor
);
{@@ Font style (redefined to avoid usage of "Graphics" }
TsFontStyle = (fssBold, fssItalic, fssStrikeOut, fssUnderline);
TsFontStyles = set of TsFontStyle;
{@@ Font }
TsFont = class
FontName: String;
Size: Single; // in "points"
Style: TsFontStyles;
Color: TsColor;
end;
{@@ Cell structure for TsWorksheet
Never suppose that all *Value fields are valid,
@ -231,6 +247,7 @@ type
DateTimeValue: TDateTime;
{ Formatting fields }
UsedFormattingFields: TsUsedFormattingFields;
FontIndex: Integer;
TextRotation: TsTextRotation;
HorAlignment: TsHorAlignment;
VertAlignment: TsVertAlignment;
@ -262,11 +279,13 @@ type
TsCustomSpreadReader = class;
TsCustomSpreadWriter = class;
TsWorkbook = class;
{ TsWorksheet }
TsWorksheet = class
private
FWorkbook: TsWorkbook;
FCells: TAvlTree; // Items are TCell
FCurrentNode: TAVLTreeNode; // For GetFirstCell and GetNextCell
FRows, FCols: TIndexedAVLTree; // This lists contain only rows or cols with styles different from the standard
@ -302,6 +321,9 @@ type
procedure WriteFormula(ARow, ACol: Cardinal; AFormula: TsFormula);
procedure WriteNumberFormat(ARow, ACol: Cardinal; ANumberFormat: TsNumberFormat);
procedure WriteRPNFormula(ARow, ACol: Cardinal; AFormula: TsRPNFormula);
function WriteFont(ARow, ACol: Cardinal; const AFontName: String;
AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; overload;
procedure WriteFont(ARow, ACol: Cardinal; AFontIndex: Integer); overload;
procedure WriteTextRotation(ARow, ACol: Cardinal; ARotation: TsTextRotation);
procedure WriteUsedFormatting(ARow, ACol: Cardinal; AUsedFormatting: TsUsedFormattingFields);
procedure WriteBackgroundColor(ARow, ACol: Cardinal; AColor: TsColor);
@ -321,6 +343,7 @@ type
property Cells: TAVLTree read FCells;
property Cols: TIndexedAVLTree read FCols;
property Rows: TIndexedAVLTree read FRows;
property Workbook: TsWorkbook read FWorkbook;
end;
{ TsWorkbook }
@ -331,8 +354,10 @@ type
FWorksheets: TFPList;
FEncoding: TsEncoding;
FFormat: TsSpreadsheetFormat;
FFontList: TFPList;
FBuiltinFontCount: Integer;
{ Internal methods }
procedure RemoveCallback(data, arg: pointer);
procedure RemoveWorksheetsCallback(data, arg: pointer);
public
{ Base methods }
constructor Create;
@ -356,6 +381,18 @@ type
function GetWorksheetByName(AName: String): TsWorksheet;
function GetWorksheetCount: Cardinal;
procedure RemoveAllWorksheets;
{ Font handling }
function AddFont(const AFontName: String; ASize: Single;
AStyle: TsFontStyles; AColor: TsColor): Integer; overload;
function AddFont(const AFont: TsFont): Integer; overload;
procedure CopyFontList(ASource: TFPList);
function FindFont(const AFontName: String; ASize: Single;
AStyle: TsFontStyles; AColor: TsColor): Integer;
function GetFont(AIndex: Integer): TsFont;
function GetFontCount: Integer;
procedure InitFonts;
procedure RemoveAllFonts;
procedure SetDefaultFont(const AFontName: String; ASize: Single);
{@@ 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;
@ -383,6 +420,7 @@ type
procedure ReadFromFile(AFileName: string; AData: TsWorkbook); virtual;
procedure ReadFromStream(AStream: TStream; AData: TsWorkbook); virtual;
procedure ReadFromStrings(AStrings: TStrings; AData: TsWorkbook); virtual;
property Wordbook: TsWorkbook read FWorkbook;
end;
{@@ TsSpreadWriter class reference type }
@ -394,6 +432,7 @@ type
{ TsCustomSpreadWriter }
TsCustomSpreadWriter = class
private
protected
{ Helper routines }
procedure AddDefaultFormats(); virtual;
@ -508,8 +547,9 @@ uses
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.';
lpNoValidSpreadsheetFile = '"%s" is not a valid spreadsheet file';
lpUnknownSpreadsheetFormat = 'unknown format';
lpInvalidFontIndex = 'Invalid font index';
{@@
@ -1209,6 +1249,45 @@ begin
ACell^.RPNFormulaValue := AFormula;
end;
{@@
Adds font specification to the formatting of a cell
@param ARow The row of the cell
@param ACol The column of the cell
@param AFontName Name of the font
@param AFontSize Size of the font, in points
@param AFontStyle Set with font style attributes
(don't use those of unit "graphics" !)
@result Index of font in font list
}
function TsWorksheet.WriteFont(ARow, ACol: Cardinal; const AFontName: String;
AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer;
var
lCell: PCell;
begin
lCell := GetCell(ARow, ACol);
Include(lCell^.UsedFormattingFields, uffFont);
Result := FWorkbook.FindFont(AFontName, AFontSize, AFontStyle, AFontColor);
if Result = -1 then
result := FWorkbook.AddFont(AFontName, AFontSize, AFontStyle, AFontColor);
lCell^.FontIndex := Result;
end;
procedure TsWorksheet.WriteFont(ARow, ACol: Cardinal; AFontIndex: Integer);
var
lCell: PCell;
begin
if (AFontIndex >= 0) and (AFontIndex < Workbook.GetFontCount) and (AFontIndex <> 4)
// note: Font index 4 is not defined in BIFF
then begin
lCell := GetCell(ARow, ACol);
Include(lCell^.UsedFormattingFields, uffFont);
lCell^.FontIndex := AFontIndex;
end else
raise Exception.Create(lpInvalidFontIndex);
end;
{@@
Adds text rotation to the formatting of a cell
@ -1377,7 +1456,7 @@ end;
{@@
Helper method for clearing the spreadsheet list.
}
procedure TsWorkbook.RemoveCallback(data, arg: pointer);
procedure TsWorkbook.RemoveWorksheetsCallback(data, arg: pointer);
begin
TsWorksheet(data).Free;
end;
@ -1389,6 +1468,9 @@ constructor TsWorkbook.Create;
begin
inherited Create;
FWorksheets := TFPList.Create;
FFontList := TFPList.Create;
SetDefaultFont('Arial', 10.0);
InitFonts;
end;
{@@
@ -1397,8 +1479,10 @@ end;
destructor TsWorkbook.Destroy;
begin
RemoveAllWorksheets;
RemoveAllFonts;
FWorksheets.Free;
FFontList.Free;
inherited Destroy;
end;
@ -1438,7 +1522,7 @@ begin
if GsSpreadFormats[i].Format = AFormat then
begin
Result := GsSpreadFormats[i].ReaderClass.Create;
Result.FWorkbook := self;
Break;
end;
@ -1459,7 +1543,6 @@ begin
if GsSpreadFormats[i].Format = AFormat then
begin
Result := GsSpreadFormats[i].WriterClass.Create;
Break;
end;
@ -1629,6 +1712,7 @@ begin
Result := TsWorksheet.Create;
Result.Name := AName;
Result.FWorkbook := Self;
FWorksheets.Add(Pointer(Result));
end;
@ -1665,8 +1749,10 @@ end;
}
function TsWorkbook.GetWorksheetByIndex(AIndex: Cardinal): TsWorksheet;
begin
if (integer(AIndex) < FWorksheets.Count) and (integer(AIndex)>=0) then Result := TsWorksheet(FWorksheets.Items[AIndex])
else Result := nil;
if (integer(AIndex) < FWorksheets.Count) and (integer(AIndex)>=0) then
Result := TsWorksheet(FWorksheets.Items[AIndex])
else
Result := nil;
end;
{@@
@ -1711,7 +1797,155 @@ end;
}
procedure TsWorkbook.RemoveAllWorksheets;
begin
FWorksheets.ForEachCall(RemoveCallback, nil);
FWorksheets.ForEachCall(RemoveWorksheetsCallback, nil);
end;
{ Font handling }
{@@
Adds a font to the font list. Returns the index in the font list.
}
function TsWorkbook.AddFont(const AFontName: String; ASize: Single;
AStyle: TsFontStyles; AColor: TsColor): Integer;
var
fnt: TsFont;
begin
fnt := TsFont.Create;
fnt.FontName := AFontName;
fnt.Size := ASize;
fnt.Style := AStyle;
fnt.Color := AColor;
Result := AddFont(fnt);
end;
function TsWorkbook.AddFont(const AFont: TsFont): Integer;
begin
// Font index 4 does not exist in BIFF. Avoid that a real font gets this index.
if FFontList.Count = 4 then
FFontList.Add(nil);
result := FFontList.Add(AFont);
end;
{@@
Copies the font list "ASource" to the workbook's font list
}
procedure TsWorkbook.CopyFontList(ASource: TFPList);
var
fnt: TsFont;
i: Integer;
begin
RemoveAllFonts;
for i:=0 to ASource.Count-1 do begin
fnt := TsFont(ASource.Items[i]);
AddFont(fnt.FontName, fnt.Size, fnt.Style, fnt.Color);
end;
end;
{@@
Checks whether the font with the given specification is already contained in
the font list. Returns the index, or -1, if not found.
}
function TsWorkbook.FindFont(const AFontName: String; ASize: Single;
AStyle: TsFontStyles; AColor: TsColor): Integer;
var
fnt: TsFont;
begin
for Result := 0 to FFontList.Count-1 do begin
fnt := TsFont(FFontList.Items[Result]);
if (fnt <> nil) and
SameText(AFontName, fnt.FontName) and
(abs(ASize - fnt.Size) < 0.001) and // careful when comparing floating point numbers
(AStyle = fnt.Style) and
(AColor = fnt.Color)
then
exit;
end;
Result := -1;
end;
{@@
Initialized the font list. In case of BIFF format, adds 5 fonts
}
procedure TsWorkbook.InitFonts;
var
fntName: String;
fntSize: Single;
begin
// Memorize old default font
with TsFont(FFontList.Items[0]) do begin
fntName := FontName;
fntSize := Size;
end;
// Remove current font list
RemoveAllFonts;
// Build new font list
SetDefaultFont(fntName, fntSize); // Default font (FONT0)
AddFont(fntName, fntSize, [fssBold], scBlack); // FONT1 for uffBold
AddFont(fntName, fntSize, [fssItalic], scBlack); // FONT2 for uffItalic
AddFont(fntName, fntSize, [fssUnderline], scBlack); // FONT3 for uffUnderline
// FONT4 which does not exist in BIFF is added automatically with nil as place-holder
AddFont(fntName, fntSize, [fssBold, fssItalic], scBlack); // FONT5 for uffBoldItalic
FBuiltinFontCount := FFontList.Count;
end;
{@@
Clears the list of fonts and releases their memory.
}
procedure TsWorkbook.RemoveAllFonts;
var
i, n: Integer;
fnt: TsFont;
begin
for i:=FFontList.Count-1 downto 0 do begin
fnt := TsFont(FFontList.Items[i]);
fnt.Free;
FFontList.Delete(i);
end;
end;
{@@
Defines the default font. This is the font with index 0 in the FontList.
The next built-in fonts will have the same font name and size
}
procedure TsWorkbook.SetDefaultFont(const AFontName: String; ASize: Single);
var
i: Integer;
begin
if FFontList.Count = 0 then
AddFont(AFontName, ASize, [], scBlack)
else
for i:=0 to FBuiltinFontCount-1 do begin
if (i <> 4) and (i < FFontList.Count) then
with TsFont(FFontList[i]) do begin
FontName := AFontName;
Size := ASize;
end;
end;
end;
{@@
Returns the font with the given index.
}
function TsWorkbook.GetFont(AIndex: Integer): TsFont;
begin
if (AIndex >= 0) and (AIndex < FFontList.Count) then
Result := FFontList.Items[AIndex]
else
Result := nil;
end;
{@@
Returns the count of registered fonts
}
function TsWorkbook.GetFontCount: Integer;
begin
Result := FFontList.Count;
end;
{ TsCustomSpreadReader }
@ -1817,6 +2051,9 @@ begin
end;
end;
if uffFont in AFormat^.UsedFormattingFields then
if (FFormattingStyles[i].FontIndex <> AFormat^.FontIndex) then Continue;
// If we arrived here it means that the styles match
Exit(i);
end;

25
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -149,7 +149,7 @@ type
property OnContextPopup;
end;
function FPSColorToColor(FPSColor: TsColor): TColor;
function FPSColorToColor(FPSColor: TsColor; ADefault: TColor): TColor;
procedure Register;
@ -174,7 +174,7 @@ begin
end;
end;
function FPSColorToColor(FPSColor: TsColor): TColor;
function FPSColorToColor(FPSColor: TsColor; ADefault: TColor): TColor;
begin
case FPSColor of
scBlack : Result := clBlack;
@ -201,7 +201,7 @@ begin
scBrown : Result := TColor($003F85CD); // CD853F
scBeige : Result := TColor($00DCF5F5); // F5F5DC
scWheat : Result := TColor($00B3DEF5); // F5DEB3
else Result := clWhite;
else Result := ADefault;
end;
end;
@ -250,6 +250,8 @@ var
ts: TTextStyle;
lCell: PCell;
r, c: Integer;
fnt: TsFont;
style: TFontStyles;
begin
Canvas.Brush.Bitmap := nil;
ts := Canvas.TextStyle;
@ -300,12 +302,27 @@ begin
Canvas.Brush.Bitmap := FillPattern_BIFF2;
end else begin
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := FPSColorToColor(lCell^.BackgroundColor);
Canvas.Brush.Color := FPSColorToColor(lCell^.BackgroundColor, Color);
end;
end else begin
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := Color;
end;
// Font
if (uffFont in lCell^.UsedFormattingFields) then begin
fnt := FWorkbook.GetFont(lCell^.FontIndex);
if fnt <> nil then begin
Canvas.Font.Name := fnt.FontName;
Canvas.Font.Color := FPSColorToColor(fnt.Color, clBlack);
style := [];
if fssBold in fnt.Style then Include(style, fsBold);
if fssItalic in fnt.Style then Include(style, fsItalic);
if fssUnderline in fnt.Style then Include(style, fsUnderline);
if fssStrikeout in fnt.Style then Include(style, fsStrikeout);
Canvas.Font.Style := style;
Canvas.Font.Size := round(fnt.Size);
end;
end;
end;
end;
Canvas.TextStyle := ts;

367
components/fpspreadsheet/xlsbiff2.pas
View File

@ -52,6 +52,7 @@ type
out XF, AFormat, AFont, AStyle: byte);
{ Record writing methods }
procedure ReadBlank(AStream: TStream); override;
procedure ReadFont(AStream: TStream);
procedure ReadFormula(AStream: TStream); override;
procedure ReadLabel(AStream: TStream); override;
procedure ReadNumber(AStream: TStream); override;
@ -65,11 +66,22 @@ type
TsSpreadBIFF2Writer = class(TsSpreadBIFFWriter)
private
procedure WriteCellFormatting(AStream: TStream; ACell: PCell);
function FindXFIndex(ACell: PCell): Word;
{ Record writing methods }
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); override;
procedure WriteBOF(AStream: TStream);
procedure WriteCellFormatting(AStream: TStream; ACell: PCell; XFIndex: Word);
procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AData: TsWorkbook; AFontIndex: Integer);
procedure WriteFonts(AStream: TStream; AData: TsWorkbook);
procedure WriteIXFE(AStream: TStream; XFIndex: Word);
procedure WriteXF(AStream: TStream; AFontIndex, AFormatIndex: byte;
ABorders: TsCellBorders = []; AHorAlign: TsHorAlignment = haLeft;
AddBackground: Boolean = false);
procedure WriteXFFieldsForFormattingStyles(AStream: TStream);
procedure WriteXFRecords(AStream: TStream; AData: TsWorkbook);
protected
procedure AddDefaultFormats(); override;
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); override;
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; 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;
@ -91,6 +103,9 @@ const
INT_EXCEL_ID_ROWINFO = $0008;
INT_EXCEL_ID_BOF = $0009;
INT_EXCEL_ID_EOF = $000A;
INT_EXCEL_ID_XF = $0043;
INT_EXCEL_ID_IXFE = $0044;
INT_EXCEL_ID_FONTCOLOR = $0045;
{ Cell Addresses constants }
MASK_EXCEL_ROW = $3FFF;
@ -104,9 +119,46 @@ const
{ TsSpreadBIFF2Writer }
procedure TsSpreadBIFF2Writer.WriteCellFormatting(AStream: TStream; ACell: PCell);
procedure TsSpreadBIFF2Writer.AddDefaultFormats();
begin
NextXFIndex := 16; //21;
SetLength(FFormattingStyles, 1);
// XF0..XF14: Normal style, Row Outline level 1..7,
// Column Outline level 1..7.
// XF15 - Default cell format, no formatting (4.6.2)
FFormattingStyles[0].UsedFormattingFields := [];
FFormattingStyles[0].Row := 15;
end;
function TsSpreadBIFF2Writer.FindXFIndex(ACell: PCell): Word;
var
i: Integer;
begin
if ACell^.UsedFormattingFields = [] then
Result := 15
else begin
// If not, then we need to search in the list of dynamic formats
i := FindFormattingInList(ACell);
// Carefully check the index
if (i < 0) or (i > Length(FFormattingStyles)) then
raise Exception.Create('[TsSpreadBIFF2Writer.WriteXFIndex] Invalid Index, this should not happen!');
Result := FFormattingStyles[i].Row;
end;
end;
{
Attaches cell formatting data for the given cell to the current record.
Is called from all writing methods of cell contents.
}
procedure TsSpreadBIFF2Writer.WriteCellFormatting(AStream: TStream; ACell: PCell;
XFIndex: Word);
var
b: Byte;
xf: Word;
i: Integer;
begin
if ACell^.UsedFormattingFields = [] then
begin
@ -120,12 +172,13 @@ begin
// Mask $3F: Index to XF record
// Mask $40: 1 = Cell is locked
// Mask $80: 1 = Formula is hidden
AStream.WriteByte($0);
AStream.WriteByte(XFIndex and $3F);
// 2nd byte:
// Mask $3F: Index to FORMAT record
// Mask $C0: Index to FONT record
AStream.WriteByte($0);
b := ACell.FontIndex shl 6;
AStream.WriteByte(b);
// 3rd byte
// Mask $07: horizontal alignment
@ -148,6 +201,18 @@ begin
AStream.WriteByte(b);
end;
{
Writes an Excel 2 IXFE record
This record contains the "real" XF index if it is > 62.
}
procedure TsSpreadBIFF2Writer.WriteIXFE(AStream: TStream; XFIndex: Word);
begin
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_IXFE));
AStream.WriteWord(WordToLE(2));
AStream.WriteWord(WordToLE(XFIndex));
end;
{
Writes an Excel 2 file to a stream
@ -158,11 +223,165 @@ procedure TsSpreadBIFF2Writer.WriteToStream(AStream: TStream; AData: TsWorkbook)
begin
WriteBOF(AStream);
WriteFonts(AStream, AData);
WriteXFRecords(AStream, AData);
WriteCellsToStream(AStream, AData.GetFirstWorksheet.Cells);
WriteEOF(AStream);
end;
procedure TsSpreadBIFF2Writer.WriteXF(AStream: TStream;
AFontIndex, AFormatIndex: byte; ABorders: TsCellBorders = [];
AHorAlign: TsHorAlignment = haLeft; AddBackground: Boolean = false);
var
b: Byte;
begin
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_XF));
AStream.WriteWord(WordToLE(4));
{ Index to FONT record }
AStream.WriteByte(AFontIndex);
{ not used }
AStream.WriteByte(0);
{ number format and cell flags }
b := AFormatIndex and $3F;
AStream.WriteByte(b);
{ Horizontal alignment, border style, and background }
b := byte(AHorAlign);
if cbWest in ABorders then b := b or $08;
if cbEast in ABorders then b := b or $10;
if cbNorth in ABorders then b := b or $20;
if cbSouth in ABorders then b := b or $40;
if AddBackground then b := b or $80;
AStream.WriteByte(b);
end;
procedure TsSpreadBIFF2Writer.WriteXFFieldsForFormattingStyles(AStream: TStream);
var
i: Integer;
lFontIndex: Word;
lFormatIndex: Word; //number format
lBorders: TsCellBorders;
lAddBackground: Boolean;
lHorAlign: TsHorAlignment;
fmt: String;
begin
// The first style was already added (see AddDefaultFormats)
for i := 1 to Length(FFormattingStyles) - 1 do begin
// Default styles
lFontIndex := 0;
lFormatIndex := 0; //General format (one of the built-in number formats)
lBorders := [];
lHorAlign := FFormattingStyles[i].HorAlignment;
// Now apply the modifications.
(*
if uffNumberFormat in FFormattingStyles[i].UsedFormattingFields then
case FFormattingStyles[i].NumberFormat of
nfFixed:
case FFormattingStyles[i].NumberDecimals of
0: lFormatIndex := FORMAT_FIXED_0_DECIMALS;
2: lFormatIndex := FORMAT_FIXED_2_DECIMALS;
end;
nfFixedTh:
case FFormattingStyles[i].NumberDecimals of
0: lFormatIndex := FORMAT_FIXED_THOUSANDS_0_DECIMALS;
2: lFormatIndex := FORMAT_FIXED_THOUSANDS_2_DECIMALS;
end;
nfExp:
lFormatIndex := FORMAT_EXP_2_DECIMALS;
nfSci:
lFormatIndex := FORMAT_SCI_1_DECIMAL;
nfPercentage:
case FFormattingStyles[i].NumberDecimals of
0: lFormatIndex := FORMAT_PERCENT_0_DECIMALS;
2: lFormatIndex := FORMAT_PERCENT_2_DECIMALS;
end;
{
nfCurrency:
case FFormattingStyles[i].NumberDecimals of
0: lFormatIndex := FORMAT_CURRENCY_0_DECIMALS;
2: lFormatIndex := FORMAT_CURRENCY_2_DECIMALS;
end;
}
nfShortDate:
lFormatIndex := FORMAT_SHORT_DATE;
nfShortTime:
lFormatIndex := FORMAT_SHORT_TIME;
nfLongTime:
lFormatIndex := FORMAT_LONG_TIME;
nfShortTimeAM:
lFormatIndex := FORMAT_SHORT_TIME_AM;
nfLongTimeAM:
lFormatIndex := FORMAT_LONG_TIME_AM;
nfShortDateTime:
lFormatIndex := FORMAT_SHORT_DATETIME;
nfFmtDateTime:
begin
fmt := lowercase(FFormattingStyles[i].NumberFormatStr);
if (fmt = 'dm') or (fmt = 'd-mmm') or (fmt = 'd mmm') or (fmt = 'd. mmm') or (fmt = 'd/mmm') then
lFormatIndex := FORMAT_DATE_DM
else
if (fmt = 'my') or (fmt = 'mmm-yy') or (fmt = 'mmm yy') or (fmt = 'mmm/yy') then
lFormatIndex := FORMAT_DATE_MY
else
if (fmt = 'ms') or (fmt = 'nn:ss') or (fmt = 'mm:ss') then
lFormatIndex := FORMAT_TIME_MS
else
if (fmt = 'msz') or (fmt = 'nn:ss.zzz') or (fmt = 'mm:ss.zzz') or (fmt = 'mm:ss.0') or (fmt = 'mm:ss.z') or (fmt = 'nn:ss.z') then
lFormatIndex := FORMAT_TIME_MSZ
end;
nfTimeInterval:
lFormatIndex := FORMAT_TIME_INTERVAL;
end;
*)
if uffBorder in FFormattingStyles[i].UsedFormattingFields then
lBorders := FFormattingStyles[i].Border;
if uffBold in FFormattingStyles[i].UsedFormattingFields then
lFontIndex := 1; // must be before uffFont which overrides uffBold
if uffFont in FFormattingStyles[i].UsedFormattingFields then
lFontIndex := FFormattingStyles[i].FontIndex;
lAddBackground := (uffBackgroundColor in FFormattingStyles[i].UsedFormattingFields);
// And finally write the style
WriteXF(AStream, lFontIndex, lFormatIndex, lBorders, lHorAlign, lAddBackground);
end;
end;
procedure TsSpreadBIFF2Writer.WriteXFRecords(AStream: TStream; AData: TsWorkbook);
begin
WriteXF(AStream, 0, 0); // XF0
WriteXF(AStream, 0, 0); // XF1
WriteXF(AStream, 0, 0); // XF2
WriteXF(AStream, 0, 0); // XF3
WriteXF(AStream, 0, 0); // XF4
WriteXF(AStream, 0, 0); // XF5
WriteXF(AStream, 0, 0); // XF6
WriteXF(AStream, 0, 0); // XF7
WriteXF(AStream, 0, 0); // XF8
WriteXF(AStream, 0, 0); // XF9
WriteXF(AStream, 0, 0); // XF10
WriteXF(AStream, 0, 0); // XF11
WriteXF(AStream, 0, 0); // XF12
WriteXF(AStream, 0, 0); // XF13
WriteXF(AStream, 0, 0); // XF14
WriteXF(AStream, 0, 0); // XF15 - Default, no formatting
// Add all further non-standard/built-in formatting styles
ListAllFormattingStyles(AData);
WriteXFFieldsForFormattingStyles(AStream);
end;
{
Writes an Excel 2 BOF record
@ -193,6 +412,67 @@ begin
AStream.WriteWord($0000);
end;
{
Writes an Excel 2 font record
The font data is passed as font index.
}
procedure TsSpreadBIFF2Writer.WriteFont(AStream: TStream; AData: TsWorkbook;
AFontIndex: Integer);
var
Len: Byte;
lFontName: AnsiString;
optn: Word;
font: TsFont;
begin
font := AData.GetFont(AFontIndex);
if font = nil then // this happens for FONT4 in case of BIFF
exit;
if font.FontName = '' then
raise Exception.Create('Font name not specified.');
if font.Size <= 0.0 then
raise Exception.Create('Font size not specified.');
lFontName := font.FontName;
Len := Length(lFontName);
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_FONT));
AStream.WriteWord(WordToLE(4 + 1 + Len * Sizeof(AnsiChar)));
{ Height of the font in twips = 1/20 of a point }
AStream.WriteWord(WordToLE(round(font.Size*20)));
{ Option flags }
optn := 0;
if fssBold in font.Style then optn := optn or $0001;
if fssItalic in font.Style then optn := optn or $0002;
if fssUnderline in font.Style then optn := optn or $0004;
if fssStrikeout in font.Style then optn := optn or $0008;
AStream.WriteWord(WordToLE(optn));
{ Font name: Unicodestring, char count in 1 byte }
AStream.WriteByte(Len);
AStream.WriteBuffer(lFontName[1], Len * Sizeof(AnsiChar));
{ Font color: goes into next record! }
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_FONTCOLOR));
AStream.WriteWord(WordToLE(2));
{ Font color index, only first 8 palette entries allowed! }
AStream.WriteWord(WordToLE(word(font.Color)));
end;
procedure TsSpreadBiff2Writer.WriteFonts(AStream: TStream; AData: TsWorkbook);
var
i: Integer;
begin
for i:=0 to AData.GetFontCount-1 do
WriteFont(AStream, AData, i);
end;
{
Writes an Excel 2 FORMULA record
@ -220,23 +500,26 @@ var
r: Cardinal;
len: Integer;
s: ansistring;
xf: Word;
begin
RPNLength := 0;
FormulaResult := 0.0;
xf := FindXFIndex(ACell);
if xf >= 63 then
WriteIXFE(AStream, xf);
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_FORMULA));
RecordSizePos := AStream.Position;
AStream.WriteWord(WordToLE(17 + RPNLength));
{ BIFF Record data }
{ Row and column }
AStream.WriteWord(WordToLE(ARow));
AStream.WriteWord(WordToLE(ACol));
{ BIFF2 Attributes }
AStream.WriteByte($0);
AStream.WriteByte($0);
AStream.WriteByte($0);
WriteCellFormatting(AStream, ACell, xf);
{ Result of the formula in IEEE 754 floating-point value }
AStream.WriteBuffer(FormulaResult, 8);
@ -355,7 +638,13 @@ end;
*******************************************************************}
procedure TsSpreadBIFF2Writer.WriteBlank(AStream: TStream;
const ARow, ACol: Cardinal; ACell: PCell);
var
xf: Word;
begin
xf := FindXFIndex(ACell);
if xf >= 63 then
WriteIXFE(AStream, xf);
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_BLANK));
AStream.WriteWord(WordToLE(7));
@ -365,7 +654,7 @@ begin
AStream.WriteWord(WordToLE(ACol));
{ BIFF2 Attributes }
WriteCellFormatting(AStream, ACell);
WriteCellFormatting(AStream, ACell, xf);
end;
{*******************************************************************
@ -387,6 +676,8 @@ var
L: Byte;
AnsiText: ansistring;
TextTooLong: boolean=false;
var
xf: Word;
begin
if AValue = '' then Exit; // Writing an empty text doesn't work
@ -403,6 +694,10 @@ begin
end;
L := Length(AnsiText);
xf := FindXFIndex(ACell);
if xf >= 63 then
WriteIXFE(AStream, xf);
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_LABEL));
AStream.WriteWord(WordToLE(8 + L));
@ -412,7 +707,7 @@ begin
AStream.WriteWord(WordToLE(ACol));
{ BIFF2 Attributes }
WriteCellFormatting(AStream, ACell);
WriteCellFormatting(AStream, ACell, xf);
{ String with 8-bit size }
AStream.WriteByte(L);
@ -437,7 +732,13 @@ end;
*******************************************************************}
procedure TsSpreadBIFF2Writer.WriteNumber(AStream: TStream; const ARow,
ACol: Cardinal; const AValue: double; ACell: PCell);
var
xf: Word;
begin
xf := FindXFIndex(ACell);
if xf >= 63 then
WriteIXFE(AStream, xf);
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_NUMBER));
AStream.WriteWord(WordToLE(15));
@ -447,9 +748,7 @@ begin
AStream.WriteWord(WordToLE(ACol));
{ BIFF2 Attributes }
AStream.WriteByte($0);
AStream.WriteByte($0);
AStream.WriteByte($0);
WriteCellFormatting(AStream, ACell, xf);
{ IEE 754 floating-point value }
AStream.WriteBuffer(AValue, 8);
@ -482,6 +781,10 @@ begin
lCell := FWorksheet.GetCell(ARow, ACol);
if Assigned(lCell) then begin
// Font index
Include(lCell^.UsedFormattingFields, uffFont);
lCell^.FontIndex := AFont;
// Horizontal justification
if AStyle and $07 <> 0 then begin
Include(lCell^.UsedFormattingFields, uffHorAlign);
@ -516,12 +819,47 @@ begin
ApplyCellFormatting(ARow, ACol, XF, AFormat, AFont, AStyle);
end;
procedure TsSpreadBIFF2Reader.ReadFont(AStream: TStream);
var
lHeight: Word;
lOptions: Word;
Len: Byte;
lFontName: UTF8String;
font: TsFont;
begin
font := TsFont.Create;
{ Height of the font in twips = 1/20 of a point }
lHeight := WordLEToN(AStream.ReadWord); // WordToLE(200)
font.Size := lHeight/20;
{ Option flags }
lOptions := WordLEToN(AStream.ReadWord);
font.Style := [];
if lOptions and $0001 <> 0 then Include(font.Style, fssBold);
if lOptions and $0002 <> 0 then Include(font.Style, fssItalic);
if lOptions and $0004 <> 0 then Include(font.Style, fssUnderline);
if lOptions and $0008 <> 0 then Include(font.Style, fssStrikeout);
{ Font name: Unicodestring, char count in 1 byte }
Len := AStream.ReadByte();
SetLength(lFontName, Len);
AStream.ReadBuffer(lFontName[1], Len);
font.FontName := lFontName;
{ Add font to workbook's font list }
FWorkbook.AddFont(font);
end;
procedure TsSpreadBIFF2Reader.ReadFromStream(AStream: TStream; AData: TsWorkbook);
var
BIFF2EOF: Boolean;
RecordType: Word;
CurStreamPos: Int64;
begin
// Clear existing fonts. They will be replaced by those from the file.
FWorkbook.RemoveAllFonts;
{ Store some data about the workbook that other routines need }
WorkBookEncoding := AData.Encoding;
@ -542,6 +880,7 @@ begin
case RecordType of
INT_EXCEL_ID_BLANK: ReadBlank(AStream);
INT_EXCEL_ID_FONT: ReadFont(AStream);
INT_EXCEL_ID_INTEGER: ReadInteger(AStream);
INT_EXCEL_ID_NUMBER: ReadNumber(AStream);
INT_EXCEL_ID_LABEL: ReadLabel(AStream);

260
components/fpspreadsheet/xlsbiff8.pas
View File

@ -65,6 +65,7 @@ uses
type
TXFRecordData = class
public
FontIndex: Integer;
FormatIndex: Integer;
HorAlignment: TsHorAlignment;
VertAlignment: TsVertAlignment;
@ -172,15 +173,16 @@ type
// procedure WriteDateMode in xlscommon; Workbook Globals record
procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFont: TFPCustomFont);
procedure WriteFont(AStream: TStream; AFont: TsFont);
procedure WriteFonts(AStream: TStream; AData: TsWorkbook);
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 WritePalette(AStream: TStream);
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 WriteStyle(AStream: TStream);
@ -191,6 +193,7 @@ type
AHorAlignment: TsHorAlignment = haDefault; AVertAlignment: TsVertAlignment = vaDefault;
AWordWrap: Boolean = false; AddBackground: Boolean = false;
ABackgroundColor: TsColor = scSilver);
procedure WriteXFRecords(AStream: TStream; AData: TsWorkbook);
public
// constructor Create;
// destructor Destroy; override;
@ -211,7 +214,6 @@ const
INT_EXCEL_ID_COUNTRY = $008C;
INT_EXCEL_ID_EOF = $000A;
INT_EXCEL_ID_DIMENSIONS = $0200;
INT_EXCEL_ID_FONT = $0031;
INT_EXCEL_ID_FORMULA = $0006;
INT_EXCEL_ID_INDEX = $020B;
INT_EXCEL_ID_LABEL = $0204;
@ -399,12 +401,6 @@ begin
end;
}
if ACell^.UsedFormattingFields = [uffBold] then
begin
AStream.WriteWord(WordToLE(18)); //XF_18
Exit;
end;
// If not, then we need to search in the list of dynamic formats
lIndex := FindFormattingInList(ACell);
// Carefully check the index
@ -430,9 +426,8 @@ var
lWordWrap: Boolean;
fmt: String;
begin
// The first 4 styles were already added
for i := 4 to Length(FFormattingStyles) - 1 do
begin
// The first style was already added
for i := 1 to Length(FFormattingStyles) - 1 do begin
// Default styles
lFontIndex := 0;
lFormatIndex := 0; //General format (one of the built-in number formats)
@ -515,7 +510,10 @@ begin
end;
if uffBold in FFormattingStyles[i].UsedFormattingFields then
lFontIndex := 1;
lFontIndex := 1; // must be before uffFont which overrides uffBold
if uffFont in FFormattingStyles[i].UsedFormattingFields then
lFontIndex := FFormattingStyles[i].FontIndex;
lAddBackground := (uffBackgroundColor in FFormattingStyles[i].UsedFormattingFields);
lWordwrap := (uffWordwrap in FFormattingStyles[i].UsedFormattingFields);
@ -532,9 +530,9 @@ end;
}
procedure TsSpreadBIFF8Writer.AddDefaultFormats();
begin
NextXFIndex := 21;
NextXFIndex := 16;
SetLength(FFormattingStyles, 6);
SetLength(FFormattingStyles, 1);
// XF0..XF14: Normal style, Row Outline level 1..7,
// Column Outline level 1..7.
@ -542,20 +540,6 @@ begin
// XF15 - Default cell format, no formatting (4.6.2)
FFormattingStyles[0].UsedFormattingFields := [];
FFormattingStyles[0].Row := 15;
// XF16 - Rotated
FFormattingStyles[1].UsedFormattingFields := [uffTextRotation];
FFormattingStyles[1].Row := 16;
FFormattingStyles[1].TextRotation := rt90DegreeCounterClockwiseRotation;
// XF17 - Rotated
FFormattingStyles[2].UsedFormattingFields := [uffTextRotation];
FFormattingStyles[2].Row := 17;
FFormattingStyles[2].TextRotation := rt90DegreeClockwiseRotation;
// XF18 - Bold
FFormattingStyles[3].UsedFormattingFields := [uffBold];
FFormattingStyles[3].Row := 18;
end;
{*******************************************************************
@ -606,7 +590,6 @@ end;
*******************************************************************}
procedure TsSpreadBIFF8Writer.WriteToStream(AStream: TStream; AData: TsWorkbook);
var
FontData: TFPCustomFont;
MyData: TMemoryStream;
CurrentPos: Int64;
Boundsheets: array of Int64;
@ -620,72 +603,13 @@ begin
WriteWindow1(AStream);
FontData := TFPCustomFont.Create;
try
FontData.Name := 'Arial';
WriteFonts(AStream, AData);
// FONT0 - normal
WriteFont(AStream, FontData);
// FONT1 - bold
FontData.Bold := True;
WriteFont(AStream, FontData);
FontData.Bold := False;
// FONT2
WriteFont(AStream, FontData);
// FONT3
WriteFont(AStream, FontData);
// FONT5
WriteFont(AStream, FontData);
finally
FontData.Free;
end;
// PALETTE
WritePalette(AStream);
// XF0
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF1
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF2
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF3
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF4
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF5
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF6
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF7
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF8
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF9
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF10
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF11
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF12
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF13
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF14
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF15 - Default, no formatting
WriteXF(AStream, 0, 0, 0, XF_ROTATION_HORIZONTAL, []);
// XF16 - Rotated
WriteXF(AStream, 0, 0, 0, XF_ROTATION_90_DEGREE_COUNTERCLOCKWISE, []);
// XF17 - Rotated
WriteXF(AStream, 0, 0, 0, XF_ROTATION_90_DEGREE_CLOCKWISE, []);
// XF18 - Bold
WriteXF(AStream, 1, 0, 0, XF_ROTATION_HORIZONTAL, []);
// Add all further non-standard/built-in formatting styles
ListAllFormattingStyles(AData);
WriteXFFieldsForFormattingStyles(AStream);
// XF Records
WriteXFRecords(AStream, AData);
WriteStyle(AStream);
// A BOUNDSHEET for each worksheet
@ -937,15 +861,25 @@ end;
*
* DESCRIPTION: Writes an Excel 8 FONT record
*
* The font data is passed in an instance of TFPCustomFont
* The font data is passed in an instance of TsFont
*
*******************************************************************}
procedure TsSpreadBIFF8Writer.WriteFont(AStream: TStream; AFont: TFPCustomFont);
procedure TsSpreadBIFF8Writer.WriteFont(AStream: TStream; AFont: TsFont);
var
Len: Byte;
WideFontName: WideString;
optn: Word;
begin
WideFontName:=AFont.Name;
if AFont = nil then // this happens for FONT4 in case of BIFF
exit;
if AFont.FontName = '' then
raise Exception.Create('Font name not specified.');
if AFont.Size <= 0.0 then
raise Exception.Create('Font size not specified.');
WideFontName := AFont.FontName;
Len := Length(WideFontName);
{ BIFF Record header }
@ -953,24 +887,33 @@ begin
AStream.WriteWord(WordToLE(14 + 1 + 1 + Len * Sizeof(WideChar)));
{ Height of the font in twips = 1/20 of a point }
AStream.WriteWord(WordToLE(200));
AStream.WriteWord(WordToLE(round(AFont.Size*20)));
{ Option flags }
if AFont.Bold then AStream.WriteWord(WordToLE(1))
else AStream.WriteWord(WordToLE(0));
optn := 0;
if fssBold in AFont.Style then optn := optn or $0001;
if fssItalic in AFont.Style then optn := optn or $0002;
if fssUnderline in AFont.Style then optn := optn or $0004;
if fssStrikeout in AFont.Style then optn := optn or $0008;
AStream.WriteWord(WordToLE(optn));
{ Colour index }
AStream.WriteWord(WordToLE($7FFF));
AStream.WriteWord(WordToLE(8 + ord(AFont.Color))); //WordToLE($7FFF));
{ Font weight }
if AFont.Bold then AStream.WriteWord(WordToLE(INT_FONT_WEIGHT_BOLD))
else AStream.WriteWord(WordToLE(INT_FONT_WEIGHT_NORMAL));
if fssBold in AFont.Style then
AStream.WriteWord(WordToLE(INT_FONT_WEIGHT_BOLD))
else
AStream.WriteWord(WordToLE(INT_FONT_WEIGHT_NORMAL));
{ Escapement type }
AStream.WriteWord(WordToLE(0));
{ Underline type }
AStream.WriteByte(0);
if fssUnderline in AFont.Style then
AStream.WriteByte(1)
else
AStream.WriteByte(0);
{ Font family }
AStream.WriteByte(0);
@ -988,6 +931,20 @@ begin
AStream.WriteBuffer(WideStringToLE(WideFontName)[1], Len * Sizeof(WideChar));
end;
{*******************************************************************
* TsSpreadBIFF8Writer.WriteFonts ()
*
* DESCRIPTION: Writes the Excel 8 FONT records neede for the
* used fonts in the workbook.
*
*******************************************************************}
procedure TsSpreadBiff8Writer.WriteFonts(AStream: TStream; AData: TsWorkbook);
var
i: Integer;
begin
for i:=0 to AData.GetFontCount-1 do
WriteFont(AStream, AData.GetFont(i));
end;
{*******************************************************************
* TsSpreadBIFF8Writer.WriteFormula ()
@ -1364,6 +1321,14 @@ begin
AStream.WriteBuffer(AValue, 8);
end;
(*******************************************************************
* TsSpreadBIFF8Writer.WritePalette
*
* DESCRIPTION: Writes Excel PALETTE records
*
*******************************************************************)
procedure TsSpreadBIFF8Writer.WritePalette(AStream: TStream);
begin
{ BIFF Record header }
@ -1667,6 +1632,47 @@ begin
AStream.WriteWord(0);
end;
procedure TsSpreadBIFF8Writer.WriteXFRecords(AStream: TStream; AData: TsWorkbook);
begin
// XF0
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF1
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF2
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF3
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF4
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF5
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF6
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF7
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF8
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF9
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF10
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF11
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF12
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF13
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF14
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
// XF15 - Default, no formatting
WriteXF(AStream, 0, 0, 0, XF_ROTATION_HORIZONTAL, []);
// Add all further non-standard/built-in formatting styles
ListAllFormattingStyles(AData);
WriteXFFieldsForFormattingStyles(AStream);
end;
{ TsSpreadBIFF8Reader }
function TsSpreadBIFF8Reader.DecodeRKValue(const ARK: DWORD): Double;
@ -1933,6 +1939,9 @@ var
RecordType: Word;
CurStreamPos: Int64;
begin
// Clear existing fonts. They will be replaced by those from the file.
FWorkbook.RemoveAllFonts;
if Assigned(FSharedStringTable) then FreeAndNil(FSharedStringTable);
while (not SectionEOF) do
begin
@ -2130,6 +2139,10 @@ begin
if Assigned(lCell) then begin
XFData := TXFRecordData(FXFList.Items[XFIndex]);
// Font
Include(lCell^.UsedFormattingFields, uffFont);
lCell^.FontIndex := XFData.FontIndex;
// Alignment
lCell^.HorAlignment := XFData.HorAlignment;
lCell^.VertAlignment := XFData.VertAlignment;
@ -2305,17 +2318,7 @@ var
WideStrValue: WideString;
AnsiStrValue: AnsiString;
begin
(*
{ BIFF Record data }
ARow := WordLEToN(AStream.ReadWord);
ACol := WordLEToN(AStream.ReadWord);
{ Index to XF record, not used }
AStream.ReadWord();
*)
{ BIFF Record header }
{ BIFF Record data }
{ Index to XF Record }
{ BIFF Record data: Row, Column, XF Index }
ReadRowColXF(AStream,ARow,ACol,XF);
{ Byte String with 16-bit size }
@ -2491,6 +2494,9 @@ begin
lData := TXFRecordData.Create;
// Font index
lData.FontIndex := WordLEToN(xf.FontIndex);
// Format index
lData.FormatIndex := WordLEToN(xf.FormatIndex);
@ -2573,26 +2579,39 @@ var
lCodePage: Word;
lHeight: Word;
lOptions: Word;
lColor: Word;
lWeight: Word;
Len: Byte;
lFontName: UTF8String;
font: TsFont;
begin
font := TsFont.Create;
{ Height of the font in twips = 1/20 of a point }
lHeight := AStream.ReadWord(); // WordToLE(200)
lHeight := WordLEToN(AStream.ReadWord); // WordToLE(200)
font.Size := lHeight/20;
{ Option flags }
lOptions := AStream.ReadWord();
lOptions := WordLEToN(AStream.ReadWord);
font.Style := [];
if lOptions and $0001 <> 0 then Include(font.Style, fssBold);
if lOptions and $0002 <> 0 then Include(font.Style, fssItalic);
if lOptions and $0004 <> 0 then Include(font.Style, fssUnderline);
if lOptions and $0008 <> 0 then Include(font.Style, fssStrikeout);
{ Colour index }
AStream.ReadWord();
lColor := WordLEToN(AStream.ReadWord);
font.Color := TsColor(lColor - 8); // Palette colors have an offset 8
{ Font weight }
AStream.ReadWord();
lWeight := WordLEToN(AStream.ReadWord);
if lWeight = 700 then Include(font.Style, fssBold);
{ Escapement type }
AStream.ReadWord();
{ Underline type }
AStream.ReadByte();
if AStream.ReadByte > 0 then Include(font.Style, fssUnderline);
{ Font family }
AStream.ReadByte();
@ -2608,7 +2627,10 @@ begin
{ Font name: Unicodestring, char count in 1 byte }
Len := AStream.ReadByte();
lFontName := ReadString(AStream, Len);
font.FontName := ReadString(AStream, Len);
{ Add font to workbook's font list }
FWorkbook.AddFont(font);
end;
procedure TsSpreadBiff8Reader.ReadColInfo(const AStream: TStream);

1
components/fpspreadsheet/xlscommon.pas
View File

@ -16,6 +16,7 @@ uses
const
{ RECORD IDs which didn't change across versions 2-8 }
INT_EXCEL_ID_FONT = $0031;
INT_EXCEL_ID_CODEPAGE = $0042;
INT_EXCEL_ID_DATEMODE = $0022;