You've already forked lazarus-ccr
fpspreadsheet: Add reading and writing of font support to biff8, biff2, and fpspreadsheetgrid. Font colors in biff2 not yet working. No test cases yet.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2959 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -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;
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
|
@ -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;
|
||||
|
@ -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);
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
|
||||
|
Reference in New Issue
Block a user