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

fpspreadsheet: Add mission routines of the cell record helper. Some cosmetics. Clean up commented lines from previous commit.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3895 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2015-01-24 00:36:10 +00:00
parent 133bf09eb4
commit d9343190a4
10 changed files with 1871 additions and 3767 deletions
Download Patch File Download Diff File Expand all files Collapse all files

117
components/fpspreadsheet/fpscell.pas
View File

@ -13,7 +13,7 @@ type
private
function GetBackgroundColor: TsColor;
function GetBorder: TsCellBorders;
function GetBorderStyle(ABorder: TsCellBorder): TsCellBorderStyle;
function GetBorderStyle(const ABorder: TsCellBorder): TsCellBorderStyle;
function GetCellFormat: TsCellFormat;
function GetFont: TsFont;
function GetFontIndex: integer;
@ -21,27 +21,48 @@ type
function GetNumberFormat: TsNumberFormat;
function GetNumberFormatStr: String;
function GetTextRotation: TsTextRotation;
function GetUsedFormattingFields: TsUsedFormattingFields;
function GetVertAlignment: TsVertAlignment;
function GetWordwrap: Boolean;
procedure SetBackgroundColor(AValue: TsColor);
procedure SetBorder(AValue: TsCellBorders);
procedure SetBorderStyle(ABorder: TsCellBorder; AValue: TsCellBorderStyle);
procedure SetFontIndex(AValue: Integer);
procedure SetBackgroundColor(const AValue: TsColor);
procedure SetBorder(const AValue: TsCellBorders);
procedure SetBorderStyle(const ABorder: TsCellBorder; const AValue: TsCellBorderStyle);
procedure SetCellFormat(const AValue: TsCellFormat);
procedure SetFontIndex(const AValue: Integer);
procedure SetHorAlignment(const AValue: TsHorAlignment);
procedure SetNumberFormat(const AValue: TsNumberFormat);
procedure SetNumberFormatStr(const AValue: String);
procedure SetTextRotation(const AValue: TsTextRotation);
procedure SetUsedFormattingFields(const AValue: TsUsedFormattingFields);
procedure SetVertAlignment(const AValue: TsVertAlignment);
procedure SetWordwrap(const AValue: Boolean);
protected
function GetWorkbook: TsWorkbook;
public
property BackgroundColor: TsColor read GetBackgroundColor write SetBackgroundColor;
property Border: TsCellBorders read GetBorder write SetBorder;
property CellFormat: TsCellFormat read GetCellFormat;
property BackgroundColor: TsColor
read GetBackgroundColor write SetBackgroundColor;
property Border: TsCellBorders
read GetBorder write SetBorder;
property CellFormat: TsCellFormat
read GetCellFormat write SetCellFormat;
property Font: TsFont read GetFont;
property FontIndex: Integer read GetFontIndex write SetFontIndex;
property HorAlignment: TsHorAlignment read GetHorAlignment;
property NumberFormat: TsNumberFormat read GetNumberFormat;
property NumberFormatStr: String read GetNumberFormatStr;
property TextRotation: TsTextRotation read GetTextRotation;
property VertAlignment: TsVertAlignment read GetVertAlignment;
property Wordwrap: Boolean read GetWordwrap;
property FontIndex: Integer
read GetFontIndex write SetFontIndex;
property HorAlignment: TsHorAlignment
read GetHorAlignment write SetHorAlignment;
property NumberFormat: TsNumberFormat
read GetNumberFormat write SetNumberFormat;
property NumberFormatStr: String
read GetNumberFormatStr write SetNumberFormatStr;
property TextRotation: TsTextRotation
read GetTextRotation write SetTextRotation;
property UsedFormattingFields: TsUsedFormattingFields
read GetUsedFormattingFields write SetUsedFormattingFields;
property VertAlignment: TsVertAlignment
read GetVertAlignment write SetVertAlignment;
property Wordwrap: Boolean
read GetWordwrap write SetWordwrap;
property Workbook: TsWorkbook read GetWorkbook;
end;
@ -57,7 +78,7 @@ begin
Result := Worksheet.ReadCellBorders(@self);
end;
function TCellHelper.GetBorderStyle(ABorder: TsCellBorder): TsCellBorderStyle;
function TCellHelper.GetBorderStyle(const ABorder: TsCellBorder): TsCellBorderStyle;
begin
Result := Worksheet.ReadCellBorderStyle(@self, ABorder);
end;
@ -106,6 +127,11 @@ begin
Result := Worksheet.ReadTextRotation(@Self);
end;
function TCellHelper.GetUsedFormattingFields: TsUsedFormattingFields;
begin
Result := Worksheet.ReadUsedFormatting(@Self);
end;
function TCellHelper.GetVertAlignment: TsVertAlignment;
begin
Result := Worksheet.ReadVertAlignment(@self);
@ -121,26 +147,75 @@ begin
Result := Worksheet.Workbook;
end;
procedure TCellHelper.SetBackgroundColor(AValue: TsColor);
procedure TCellHelper.SetBackgroundColor(const AValue: TsColor);
begin
Worksheet.WriteBackgroundColor(@self, AValue);
end;
procedure TCellHelper.SetBorder(AValue: TsCellBorders);
procedure TCellHelper.SetBorder(const AValue: TsCellBorders);
begin
Worksheet.WriteBorders(@self, AValue);
end;
procedure TCellHelper.SetBorderStyle(ABorder: TsCellBorder;
AValue: TsCellBorderStyle);
procedure TCellHelper.SetBorderStyle(const ABorder: TsCellBorder;
const AValue: TsCellBorderStyle);
begin
Worksheet.WriteBorderStyle(@self, ABorder, AValue);
end;
procedure TCellHelper.SetFontIndex(AValue: Integer);
procedure TCellHelper.SetCellFormat(const AValue: TsCellFormat);
begin
Worksheet.WriteCellFormat(@self, AValue);
end;
procedure TCellHelper.SetFontIndex(const AValue: Integer);
begin
Worksheet.WriteFont(@self, AValue);
end;
procedure TCellHelper.SetHorAlignment(const AValue: TsHorAlignment);
begin
Worksheet.WriteHorAlignment(@self, AValue);
end;
procedure TCellHelper.SetNumberFormat(const AValue: TsNumberFormat);
var
fmt: TsCellFormat;
begin
fmt := Workbook.GetCellFormat(FormatIndex);
fmt.NumberFormat := AValue;
Worksheet.WriteCellFormat(@self, fmt);
end;
procedure TCellHelper.SetNumberFormatStr(const AValue: String);
var
fmt: TsCellFormat;
begin
fmt := Workbook.GetCellFormat(FormatIndex);
fmt.NumberFormatStr := AValue;
Worksheet.WriteCellFormat(@self, fmt);
end;
procedure TCellHelper.SetTextRotation(const AValue: TsTextRotation);
begin
Worksheet.WriteTextRotation(@self, AValue);
end;
procedure TCellHelper.SetUsedFormattingFields(const AValue: TsUsedFormattingFields);
begin
Worksheet.WriteUsedFormatting(@self, AValue);
end;
procedure TCellHelper.SetVertAlignment(const AValue: TsVertAlignment);
begin
Worksheet.WriteVertAlignment(@self, AValue);
end;
procedure TCellHelper.SetWordwrap(const AValue: Boolean);
begin
Worksheet.WriteWordwrap(@self, AValue);
end;
end.

275
components/fpspreadsheet/fpsopendocument.pas
View File

@ -269,22 +269,6 @@ const
ROWHEIGHT_EPS = 1e-2; // for lines
type
(*
{ Cell style items relevant to FPSpreadsheet. Stored in the CellStyleList of the reader. }
TCellStyleData = class
public
Name: String;
FontIndex: Integer;
NumFormatIndex: Integer;
HorAlignment: TsHorAlignment;
VertAlignment: TsVertAlignment;
WordWrap: Boolean;
TextRotation: TsTextRotation;
Borders: TsCellBorders;
BorderStyles: TsCellBorderStyles;
BackgroundColor: TsColor;
end;
*)
{ Column style items stored in ColStyleList of the reader }
TColumnStyleData = class
@ -700,6 +684,7 @@ begin
end;
end;
{ TsSpreadOpenDocReader }
constructor TsSpreadOpenDocReader.Create(AWorkbook: TsWorkbook);
@ -737,10 +722,6 @@ begin
for j := FRowStyleList.Count-1 downto 0 do TObject(FRowStyleList[j]).Free;
FRowStyleList.Free;
{
for j := FCellStyleList.Count-1 downto 0 do TObject(FCellStyleList[j]).Free;
FCellStyleList.Free;
}
FVolatileNumFmtList.Free; // automatically destroys its items.
inherited Destroy;
@ -778,17 +759,6 @@ begin
end;
end;
end;
(*
{ Applies the style data referred to by the style name to the specified cell
The function result is false if a style with the given name could not be found }
function TsSpreadOpenDocReader.ApplyStyleToCell(ARow, ACol: Cardinal;
AStyleName: String): Boolean;
var
cell: PCell;
begin
cell := FWorksheet.GetCell(ARow, ACol);
Result := ApplyStyleToCell(cell, AStyleName)
end; *)
{ Applies the style data referred to by the style name to the specified cell
The function result is false if a style with the given name could not be found }
@ -818,74 +788,6 @@ begin
fmt := FCellFormatList.Items[styleIndex];
ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt^);
(*
styleData := FCellFormatList.Items[styleIndex]);
// Now copy all style parameters from the styleData to the cell.
// Font
if styleData.FontIndex = 1 then
Include(ACell^.UsedFormattingFields, uffBold)
else
if styleData.FontIndex > 1 then
Include(ACell^.UsedFormattingFields, uffFont);
ACell^.FontIndex := styleData.FontIndex;
// Word wrap
if styleData.WordWrap then
Include(ACell^.UsedFormattingFields, uffWordWrap)
else
Exclude(ACell^.UsedFormattingFields, uffWordWrap);
// Text rotation
if styleData.TextRotation > trHorizontal then
Include(ACell^.UsedFormattingFields, uffTextRotation)
else
Exclude(ACell^.UsedFormattingFields, uffTextRotation);
ACell^.TextRotation := styledata.TextRotation;
// Text alignment
if styleData.HorAlignment <> haDefault then
begin
Include(ACell^.UsedFormattingFields, uffHorAlign);
ACell^.HorAlignment := styleData.HorAlignment;
end else
Exclude(ACell^.UsedFormattingFields, uffHorAlign);
if styleData.VertAlignment <> vaDefault then
begin
Include(ACell^.UsedFormattingFields, uffVertAlign);
ACell^.VertAlignment := styleData.VertAlignment;
end else
Exclude(ACell^.UsedFormattingFields, uffVertAlign);
// Borders
ACell^.BorderStyles := styleData.BorderStyles;
if styleData.Borders <> [] then
begin
Include(ACell^.UsedFormattingFields, uffBorder);
ACell^.Border := styleData.Borders;
end else
Exclude(ACell^.UsedFormattingFields, uffBorder);
// Background color
if styleData.BackgroundColor <> scNotDefined then
begin
Include(ACell^.UsedFormattingFields, uffBackgroundColor);
ACell^.BackgroundColor := styleData.BackgroundColor;
end;
// Number format
if styleData.NumFormatIndex > -1 then
begin
numFmtData := NumFormatList[styleData.NumFormatIndex];
if numFmtData <> nil then
begin
Include(ACell^.UsedFormattingFields, uffNumberFormat);
ACell^.NumberFormat := numFmtData.NumFormat;
ACell^.NumberFormatStr := numFmtData.FormatString;
end;
end;
*)
Result := true;
end;
@ -1002,15 +904,7 @@ begin
end;
end;
end;
(*
function TsSpreadOpenDocReader.FindCellStyleByName(AStyleName: String): Integer;
begin
for Result:=0 to FCellStyleList.Count-1 do
if TCellStyleData(FCellStyleList[Result]).Name = AStyleName then
exit;
Result := -1;
end;
*)
function TsSpreadOpenDocReader.FindColumnByCol(AColIndex: Integer): Integer;
begin
for Result := 0 to FColumnList.Count-1 do
@ -1060,10 +954,6 @@ begin
FWorkSheet.WriteBlank(cell);
FWorksheet.CopyFormat(@lCell, cell);
{
styleName := GetAttrValue(ACellNode, 'table:style-name');
ApplyStyleToCell(cell, stylename);
}
if FIsVirtualMode then
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
@ -2255,15 +2145,6 @@ var
numFmtIndex: Integer;
numFmtData: TsNumFormatData;
clr: TsColorValue;
{
wrap: Boolean;
txtRot: TsTextRotation;
vertAlign: TsVertAlignment;
horAlign: TsHorAlignment;
borders: TsCellBorders;
borderStyles: TsCellBorderStyles;
fntIndex: Integer;
}
s: String;
procedure SetBorderStyle(ABorder: TsCellBorder; AStyleValue: String);
@ -2954,13 +2835,11 @@ var
nfs: String;
fmt: TsCellFormat;
begin
// for i := 0 to Length(FFormattingStyles) - 1 do
for i := 0 to FWorkbook.GetNumCellFormats - 1 do
begin
fmt := FWorkbook.GetCellFormat(i);
//nfidx := NumFormatList.Find(FFormattingStyles[i].NumberFormatStr);
nfidx := NumFormatList.Find(fmt.NumberFormatStr);
nfidx := NumFormatList.FindByFormatStr(fmt.NumberFormatStr);
if nfidx <> -1
then nfs := 'style:data-style-name="' + NumFormatList[nfidx].Name +'"'
else nfs := '';
@ -2971,24 +2850,15 @@ begin
'style:parent-style-name="Default" '+ nfs + '>');
// style:text-properties
//if uffBold in FFormattingStyles[i].UsedFormattingFields then
if (uffBold in fmt.UsedFormattingFields) then
AppendToStream(AStream,
'<style:text-properties fo:font-weight="bold" style:font-weight-asian="bold" style:font-weight-complex="bold"/>');
//s := WriteFontStyleXMLAsString(FFormattingStyles[i]);
s := WriteFontStyleXMLAsString(fmt);
if s <> '' then
AppendToStream(AStream,
'<style:text-properties '+ s + '/>');
// style:table-cell-properties
{
s := WriteBorderStyleXMLAsString(FFormattingStyles[i]) +
WriteBackgroundColorStyleXMLAsString(FFormattingStyles[i]) +
WriteWordwrapStyleXMLAsString(FFormattingStyles[i]) +
WriteTextRotationStyleXMLAsString(FFormattingStyles[i]) +
WriteVertAlignmentStyleXMLAsString(FFormattingStyles[i]);}
s := WriteBorderStyleXMLAsString(fmt) +
WriteBackgroundColorStyleXMLAsString(fmt) +
WriteWordwrapStyleXMLAsString(fmt) +
@ -2999,7 +2869,6 @@ begin
'<style:table-cell-properties ' + s + '/>');
// style:paragraph-properties
//s := WriteHorAlignmentStyleXMLAsString(FFormattingStyles[i]);
s := WriteHorAlignmentStyleXMLAsString(fmt);
if s <> '' then
AppendToStream(AStream,
@ -3363,9 +3232,9 @@ begin
inherited Destroy;
end;
{
{@@ ----------------------------------------------------------------------------
Writes a string to a file. Helper convenience method.
}
-------------------------------------------------------------------------------}
procedure TsSpreadOpenDocWriter.WriteStringToFile(AString, AFileName: string);
var
TheStream : TFileStream;
@ -3377,9 +3246,9 @@ begin
TheStream.Free;
end;
{
Writes an OOXML document to the disc.
}
{@@ ----------------------------------------------------------------------------
Writes an OOXML document to a file.
-------------------------------------------------------------------------------}
procedure TsSpreadOpenDocWriter.WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean);
var
@ -3475,20 +3344,11 @@ begin
else
AppendToStream(AStream,
'<table:table-cell ' + spannedStr + '/>');
{
if ACell^.UsedFormattingFields <> [] then
begin
lIndex := FindFormattingInList(ACell);
AppendToStream(AStream, Format(
'<table:table-cell table:style-name="ce%d" %s>', [lIndex, spannedStr]),
'</table:table-cell>');
end else
AppendToStream(AStream,
'<table:table-cell ' + spannedStr + '/>');
}
end;
{ Writes a boolean cell to the stream }
{@@ ----------------------------------------------------------------------------
Writes a boolean cell to the stream
-------------------------------------------------------------------------------}
procedure TsSpreadOpenDocWriter.WriteBool(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell);
var
@ -3509,15 +3369,6 @@ begin
else
lStyle := '';
{
if ACell^.UsedFormattingFields <> [] then
begin
lIndex := FindFormattingInList(ACell);
lStyle := ' table:style-name="ce' + IntToStr(lIndex) + '" ';
end else
lStyle := '';
}
// Merged?
if FWorksheet.IsMergeBase(ACell) then
begin
@ -3548,9 +3399,11 @@ begin
]));
end;
{ Creates an XML string for inclusion of the background color into the
{@@ ----------------------------------------------------------------------------
Creates an XML string for inclusion of the background color into the
written file from the backgroundcolor setting in the given format record.
Is called from WriteStyles (via WriteStylesXMLAsString). }
Is called from WriteStyles (via WriteStylesXMLAsString).
-------------------------------------------------------------------------------}
function TsSpreadOpenDocWriter.WriteBackgroundColorStyleXMLAsString(
const AFormat: TsCellFormat): String;
begin
@ -3564,9 +3417,11 @@ begin
]);
end;
{ Creates an XML string for inclusion of borders and border styles into the
{@@ ----------------------------------------------------------------------------
Creates an XML string for inclusion of borders and border styles into the
written file from the border settings in the given format record.
Is called from WriteStyles (via WriteStylesXMLAsString). }
Is called from WriteStyles (via WriteStylesXMLAsString).
-------------------------------------------------------------------------------}
function TsSpreadOpenDocWriter.WriteBorderStyleXMLAsString(
const AFormat: TsCellFormat): String;
begin
@ -3702,9 +3557,11 @@ begin
Result := Result + Format('fo:color="%s" ', [Workbook.GetPaletteColorAsHTMLStr(fnt.Color)]);
end;
{ Creates an XML string for inclusion of the horizontal alignment into the
{@@ ----------------------------------------------------------------------------
Creates an XML string for inclusion of the horizontal alignment into the
written file from the horizontal alignment setting in the format cell.
Is called from WriteStyles (via WriteStylesXMLAsString). }
Is called from WriteStyles (via WriteStylesXMLAsString).
-------------------------------------------------------------------------------}
function TsSpreadOpenDocWriter.WriteHorAlignmentStyleXMLAsString(
const AFormat: TsCellFormat): String;
begin
@ -3780,9 +3637,11 @@ begin
end;
end;
{ Creates an XML string for inclusion of the textrotation style option into the
{@@ ----------------------------------------------------------------------------
Creates an XML string for inclusion of the textrotation style option into the
written file from the textrotation setting in the format cell.
Is called from WriteStyles (via WriteStylesXMLAsString). }
Is called from WriteStyles (via WriteStylesXMLAsString).
-------------------------------------------------------------------------------}
function TsSpreadOpenDocWriter.WriteTextRotationStyleXMLAsString(
const AFormat: TsCellFormat): String;
begin
@ -3797,9 +3656,11 @@ begin
end;
end;
{ Creates an XML string for inclusion of the vertical alignment into the
{@@ ----------------------------------------------------------------------------
Creates an XML string for inclusion of the vertical alignment into the
written file from the vertical alignment setting in the given format record.
Is called from WriteStyles (via WriteStylesXMLAsString). }
Is called from WriteStyles (via WriteStylesXMLAsString).
-------------------------------------------------------------------------------}
function TsSpreadOpenDocWriter.WriteVertAlignmentStyleXMLAsString(
const AFormat: TsCellFormat): String;
begin
@ -3939,9 +3800,11 @@ begin
end;
end;
{ Creates an XML string for inclusion of the wordwrap option into the
{@@ ----------------------------------------------------------------------------
Creates an XML string for inclusion of the wordwrap option into the
written file from the wordwrap setting in the format cell.
Is called from WriteStyles (via WriteStylesXMLAsString). }
Is called from WriteStyles (via WriteStylesXMLAsString).
-------------------------------------------------------------------------------}
function TsSpreadOpenDocWriter.WriteWordwrapStyleXMLAsString(
const AFormat: TsCellFormat): String;
begin
@ -3951,7 +3814,9 @@ begin
Result := '';
end;
{ Writes a string formula }
{@@ ----------------------------------------------------------------------------
Writes a string formula
-------------------------------------------------------------------------------}
procedure TsSpreadOpenDocWriter.WriteFormula(AStream: TStream; const ARow,
ACol: Cardinal; ACell: PCell);
var
@ -3975,13 +3840,6 @@ begin
lStyle := ' table:style-name="ce' + IntToStr(ACell^.FormatIndex) + '" '
else
lStyle := '';
{
if ACell^.UsedFormattingFields <> [] then
begin
lIndex := FindFormattingInList(ACell);
lStyle := ' table:style-name="ce' + IntToStr(lIndex) + '" ';
end else
lStyle := ''; }
// Merged?
if FWorksheet.IsMergeBase(ACell) then
@ -4069,12 +3927,12 @@ begin
end;
{
{@@ ----------------------------------------------------------------------------
Writes a cell with text content
The UTF8 Text needs to be converted, because some chars are invalid in XML
See bug with patch 19422
}
-------------------------------------------------------------------------------}
procedure TsSpreadOpenDocWriter.WriteLabel(AStream: TStream; const ARow,
ACol: Cardinal; const AValue: string; ACell: PCell);
var
@ -4094,14 +3952,7 @@ begin
lStyle := ' table:style-name="ce' + IntToStr(ACell^.FormatIndex) + '" '
else
lStyle := '';
{
if ACell^.UsedFormattingFields <> [] then
begin
lIndex := FindFormattingInList(ACell);
lStyle := ' table:style-name="ce' + IntToStr(lIndex) + '" ';
end else
lStyle := '';
}
// Merged?
if FWorksheet.IsMergeBase(ACell) then
begin
@ -4156,18 +4007,7 @@ begin
valType := 'currency';
end else
lStyle := '';
{
if ACell^.UsedFormattingFields <> [] then
begin
lIndex := FindFormattingInList(ACell);
lStyle := ' table:style-name="ce' + IntToStr(lIndex) + '" ';
if pos('%', ACell^.NumberFormatStr) <> 0 then
valType := 'percentage'
else if IsCurrencyFormat(ACell^.NumberFormat) then
valType := 'currency';
end else
lStyle := '';
}
// Merged?
if FWorksheet.IsMergeBase(ACell) then
begin
@ -4197,13 +4037,9 @@ begin
]));
end;
{*******************************************************************
* TsSpreadOpenDocWriter.WriteDateTime ()
*
* DESCRIPTION: Writes a date/time value
*
*
*******************************************************************}
{@@ ----------------------------------------------------------------------------
Writes a date/time value
-------------------------------------------------------------------------------}
procedure TsSpreadOpenDocWriter.WriteDateTime(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell);
const
@ -4238,23 +4074,13 @@ begin
lStyle := ' table:style-name="ce' + IntToStr(ACell^.FormatIndex) + '" '
else
lStyle := '';
{
if ACell^.UsedFormattingFields <> [] then
begin
lIndex := FindFormattingInList(ACell);
lStyle := 'table:style-name="ce' + IntToStr(lIndex) + '" ';
end else
lStyle := '';
}
// nfTimeInterval is a special case - let's handle it first:
// if (ACell^.NumberFormat = nfTimeInterval) then
if (fmt.NumberFormat = nfTimeInterval) then
begin
strValue := FormatDateTime(ISO8601FormatHoursOverflow, AValue, [fdoInterval]);
displayStr := FormatDateTime(fmt.NumberFormatStr, AValue, [fdoInterval]);
// displayStr := FormatDateTime(ACell^.NumberFormatStr, AValue, [fdoInterval]);
AppendToStream(AStream, Format(
'<table:table-cell office:value-type="time" office:time-value="%s" %s %s>' +
'<text:p>%s</text:p>' +
@ -4268,11 +4094,6 @@ begin
isTimeOnly := IsTimeFormat(fmt.NumberFormat) or IsTimeFormat(fmt.NumberFormatStr);
strValue := FormatDateTime(DATE_FMT[isTimeOnly], AValue);
displayStr := FormatDateTime(fmt.NumberFormatStr, AValue);
{
isTimeOnly := IsTimeFormat(ACell^.NumberFormat) or IsTimeFormat(ACell^.NumberFormatStr);
strValue := FormatDateTime(FMT[isTimeOnly], AValue);
displayStr := FormatDateTime(ACell^.NumberFormatStr, AValue);
}
AppendToStream(AStream, Format(
'<table:table-cell office:value-type="%s" office:%s-value="%s" %s %s>' +
'<text:p>%s</text:p> ' +
@ -4283,11 +4104,11 @@ begin
end;
end;
{
Registers this reader / writer on fpSpreadsheet
}
initialization
{@@ ----------------------------------------------------------------------------
Registers this reader / writer on fpSpreadsheet
-------------------------------------------------------------------------------}
RegisterSpreadFormat(TsSpreadOpenDocReader, TsSpreadOpenDocWriter, sfOpenDocument);
end.

693
components/fpspreadsheet/fpspreadsheet.pas
View File

File diff suppressed because it is too large Load Diff

2
components/fpspreadsheet/tests/formattests.pas
View File

@ -18,7 +18,7 @@ uses
// Not using Lazarus package as the user may be working with multiple versions
// Instead, add .. to unit search path
Classes, SysUtils, fpcunit, testutils, testregistry, testsutility,
fpstypes, fpsallformats, fpspreadsheet, fpshelpers, xlsbiff8;
fpstypes, fpsallformats, fpspreadsheet, fpscell, xlsbiff8;
var
// Norm to test against - list of strings that should occur in spreadsheet

2
components/fpspreadsheet/tests/manualtests.pas
View File

@ -21,7 +21,7 @@ uses
// Not using lazarus package as the user may be working with multiple versions
// Instead, add .. to unit search path
Classes, SysUtils, testutils, testregistry, testdecorator, fpcunit,
fpsallformats, fpspreadsheet, fpshelpers,
fpsallformats, fpspreadsheet, fpscell,
xlsbiff8 {and a project requirement for lclbase for utf8 handling},
testsutility;

524
components/fpspreadsheet/xlsbiff2.pas
View File

@ -50,7 +50,7 @@ type
constructor Create(AWorkbook: TsWorkbook);
procedure ConvertBeforeWriting(var AFormatString: String;
var ANumFormat: TsNumberFormat); override;
function Find(ANumFormat: TsNumberFormat; ANumFormatStr: String): Integer; override; overload;
function Find(ANumFormat: TsNumberFormat; ANumFormatStr: String): Integer; override;
end;
{ TsSpreadBIFF2Reader }
@ -60,12 +60,7 @@ type
WorkBookEncoding: TsEncoding;
FFont: TsFont;
protected
// procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); override;
procedure CreateNumFormatList; override;
{
procedure ExtractNumberFormat(AXFIndex: WORD;
out ANumberFormat: TsNumberFormat; out ANumberFormatStr: String); override;
}
procedure ReadBlank(AStream: TStream); override;
procedure ReadBool(AStream: TStream); override;
procedure ReadColWidth(AStream: TStream);
@ -108,11 +103,6 @@ type
procedure WriteFonts(AStream: TStream);
procedure WriteFormatCount(AStream: TStream);
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);
protected
procedure CreateNumFormatList; override;
procedure ListAllNumFormats; override;
@ -264,10 +254,12 @@ begin
inherited Create(AWorkbook);
end;
{ Prepares the list of built-in number formats. They are created in the default
{@@ ----------------------------------------------------------------------------
Prepares the list of built-in number formats. They are created in the default
dialect for FPC, they have to be converted to Excel syntax before writing.
Note that Excel2 expects them to be localized. This is something which has to
be taken account of in ConverBeforeWriting.}
be taken account of in ConvertBeforeWriting.
-------------------------------------------------------------------------------}
procedure TsBIFF2NumFormatList.AddBuiltinFormats;
var
fs: TFormatSettings;
@ -360,43 +352,6 @@ begin
end;
end;
(*
function TsBIFF2NumFormatList.FindFormatOf(AFormatCell: PCell): Integer;
var
parser: TsNumFormatParser;
decs: Integer;
dt: string;
begin
Result := 0;
parser := TsNumFormatParser.Create(Workbook, AFormatCell^.NumberFormatStr);
try
decs := parser.Decimals;
dt := parser.GetDateTimeCode(0);
finally
parser.Free;
end;
case AFormatCell^.NumberFormat of
nfGeneral : exit;
nfFixed : Result := IfThen(decs = 0, 1, 2);
nfFixedTh : Result := IfThen(decs = 0, 3, 4);
nfCurrency : Result := IfThen(decs = 0, 5, 7);
nfCurrencyRed : Result := IfThen(decs = 0, 6, 8);
nfPercentage : Result := IfThen(decs = 0, 9, 10);
nfExp : Result := 11;
nfShortDate : Result := 12;
nfLongDate : Result := 13;
nfShortTimeAM : Result := 16;
nfLongTimeAM : Result := 17;
nfShortTime : Result := 18;
nfLongTime : Result := 19;
nfShortDateTime: Result := 20;
nfCustom : if dt = 'dm' then Result := 14 else
if dt = 'my' then Result := 15;
end;
end;
*)
{ TsSpreadBIFF2Reader }
@ -405,70 +360,17 @@ begin
inherited Create(AWorkbook);
FLimitations.MaxPaletteSize := BIFF2_MAX_PALETTE_SIZE;
end;
(*
procedure TsSpreadBIFF2Reader.ApplyCellFormatting(ACell: PCell; XFIndex: Word);
var
xfData: TXFListData;
begin
if Assigned(ACell) then begin
xfData := TXFListData(FXFList.items[XFIndex]);
// Font index, "bold" attribute
if xfData.FontIndex = 1 then
Include(ACell^.UsedFormattingFields, uffBold)
else
Include(ACell^.UsedFormattingFields, uffFont);
ACell^.FontIndex := xfData.FontIndex;
// Alignment
ACell^.HorAlignment := xfData.HorAlignment;
ACell^.VertAlignment := xfData.VertAlignment;
// Wordwrap not supported by BIFF2
Exclude(ACell^.UsedFormattingFields, uffWordwrap);
// Text rotation not supported by BIFF2
Exclude(ACell^.UsedFormattingFields, uffTextRotation);
// Border
if xfData.Borders <> [] then begin
Include(ACell^.UsedFormattingFields, uffBorder);
ACell^.Border := xfData.Borders;
end else
Exclude(ACell^.UsedFormattingFields, uffBorder);
// Background, only shaded, color is ignored
if xfData.BackgroundColor <> 0 then
Include(ACell^.UsedFormattingFields, uffBackgroundColor)
else
Exclude(ACell^.UsedFormattingFields, uffBackgroundColor);
end;
end;
*)
{ Creates the correct version of the number format list.
It is for BIFF2 and BIFF3 file formats. }
{@@ ----------------------------------------------------------------------------
Creates the correct version of the number format list.
It is for BIFF2 and BIFF3 file formats.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Reader.CreateNumFormatList;
begin
FreeAndNil(FNumFormatList);
FNumFormatList := TsBIFF2NumFormatList.Create(Workbook);
end;
(*
{ Extracts the number format data from an XF record indexed by AXFIndex.
Note that BIFF2 supports only 21 formats. }
procedure TsSpreadBIFF2Reader.ExtractNumberFormat(AXFIndex: WORD;
out ANumberFormat: TsNumberFormat; out ANumberFormatStr: String);
var
lNumFormatData: TsNumFormatData;
begin
lNumFormatData := FindNumFormatDataForCell(AXFIndex);
if lNumFormatData <> nil then begin
ANumberFormat := lNumFormatData.NumFormat;
ANumberFormatStr := lNumFormatData.FormatString;
end else begin
ANumberFormat := nfGeneral;
ANumberFormatStr := '';
end;
end;
*)
procedure TsSpreadBIFF2Reader.ReadBlank(AStream: TStream);
var
ARow, ACol: Cardinal;
@ -486,8 +388,10 @@ begin
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
{ The name of this method is misleading - it reads a BOOLEAN cell value,
but also an ERROR value; BIFF stores them in the same record. }
{@@ ----------------------------------------------------------------------------
The name of this method is misleading - it reads a BOOLEAN cell value,
but also an ERROR value; BIFF stores them in the same record.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Reader.ReadBool(AStream: TStream);
var
rec: TBIFF2_BoolErrRecord;
@ -588,7 +492,9 @@ begin
FFont.Color := WordLEToN(AStream.ReadWord);
end;
// Read the FORMAT record for formatting numerical data
{@@ ----------------------------------------------------------------------------
Reads the FORMAT record required for formatting numerical data
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Reader.ReadFormat(AStream: TStream);
begin
Unused(AStream);
@ -708,10 +614,8 @@ begin
3: // Empty cell
FWorksheet.WriteBlank(cell);
end
else begin
{if SizeOf(Double) <> 8 then
raise Exception.Create('Double is not 8 bytes');}
else
begin
// Result is a number or a date/time
Move(Data[0], formulaResult, SizeOf(Data));
@ -724,7 +628,8 @@ begin
end;
{ Formula token array }
if (boReadFormulas in FWorkbook.Options) then begin
if (boReadFormulas in FWorkbook.Options) then
begin
ok := ReadRPNTokenArray(AStream, cell);
if not ok then FWorksheet.WriteErrorValue(cell, errFormulaNotSupported);
end;
@ -843,7 +748,8 @@ begin
AWord := WordLEToN(rec.Value);
{ Create cell }
if FIsVirtualMode then begin
if FIsVirtualMode then
begin
InitCell(ARow, ACol, FVirtualCell);
cell := @FVirtualCell;
end else
@ -859,7 +765,9 @@ begin
Workbook.OnReadCellData(Workbook, ARow, ACol, cell);
end;
// Read the row, column and xf index
{@@ ----------------------------------------------------------------------------
Reads the row, column and xf index from the stream
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Reader.ReadRowColXF(AStream: TStream;
out ARow, ACol: Cardinal; out AXF: WORD);
begin
@ -870,7 +778,7 @@ begin
{ Index to XF record }
AXF := AStream.ReadByte;
{ Index to format and font record, Cell style - ignored because contained in XF
{ Index to format and font record, cell style - ignored because contained in XF
Must read to keep the record in sync. }
AStream.ReadWord;
end;
@ -891,7 +799,8 @@ begin
rowRec.RowIndex := 0; // to silence the compiler...
AStream.ReadBuffer(rowrec, SizeOf(TRowRecord));
h := WordLEToN(rowrec.Height);
if h and $8000 = 0 then begin // if this bit were set, rowheight would be default
if h and $8000 = 0 then // if this bit were set, rowheight would be default
begin
lRow := FWorksheet.GetRow(WordLEToN(rowrec.RowIndex));
// Row height is encoded into the 15 remaining bits in units "twips" (1/20 pt)
// We need it in "lines" units.
@ -903,8 +812,11 @@ begin
end;
end;
{ Reads the identifier for an RPN function with fixed argument count.
Valid for BIFF2-BIFF3. }
{@@ ----------------------------------------------------------------------------
Reads the identifier for an RPN function with fixed argument count from the
stream.
Valid for BIFF2-BIFF3.
-------------------------------------------------------------------------------}
function TsSpreadBIFF2Reader.ReadRPNFunc(AStream: TStream): Word;
var
b: Byte;
@ -913,11 +825,14 @@ begin
Result := b;
end;
{ Reads the cell coordiantes of the top/left cell of a range using a shared formula.
{@@ ----------------------------------------------------------------------------
Reads the cell coordiantes of the top/left cell of a range using a
shared formula.
This cell contains the rpn token sequence of the formula.
Is overridden because BIFF2 has 1 byte for column.
Code is not called for shared formulas (which are not supported by BIFF2), but
maybe for array formulas. }
maybe for array formulas.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Reader.ReadRPNSharedFormulaBase(AStream: TStream;
out ARow, ACol: Cardinal);
begin
@ -927,15 +842,18 @@ begin
ACol := AStream.ReadByte;
end;
{ Helper funtion for reading of the size of the token array of an RPN formula.
Is overridden because BIFF2 uses 1 byte only. }
{@@ ----------------------------------------------------------------------------
Helper funtion for reading of the size of the token array of an RPN formula.
Is overridden because BIFF2 uses 1 byte only.
-------------------------------------------------------------------------------}
function TsSpreadBIFF2Reader.ReadRPNTokenArraySize(AStream: TStream): Word;
begin
Result := AStream.ReadByte;
end;
{ Reads a STRING record which contains the result of string formula. }
{@@ ----------------------------------------------------------------------------
Reads a STRING record which contains the result of string formula.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Reader.ReadStringRecord(AStream: TStream);
var
len: Byte;
@ -943,10 +861,12 @@ var
begin
// The string is a byte-string with 8 bit length
len := AStream.ReadByte;
if len > 0 then begin
if len > 0 then
begin
SetLength(s, Len);
AStream.ReadBuffer(s[1], len);
if (FIncompleteCell <> nil) and (s <> '') then begin
if (FIncompleteCell <> nil) and (s <> '') then
begin
// The "IncompleteCell" has been identified in the sheet when reading
// the FORMULA record which precedes the String record.
FIncompleteCell^.UTF8StringValue := AnsiToUTF8(s);
@ -958,8 +878,10 @@ begin
FIncompleteCell := nil;
end;
{ Reads the WINDOW2 record containing information like "show grid lines",
"show sheet headers", "panes are frozen", etc. }
{@@ ----------------------------------------------------------------------------
Reads the WINDOW2 record containing information like "show grid lines",
"show sheet headers", "panes are frozen", etc.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Reader.ReadWindow2(AStream: TStream);
begin
// Show formulas, not results
@ -1000,32 +922,6 @@ begin
end;
procedure TsSpreadBIFF2Reader.ReadXF(AStream: TStream);
{ Offset Size Contents
0 1 Index to FONT record (➜5.45)
1 1 Not used
2 1 Number format and cell flags:
Bit Mask Contents
5-0 3FH Index to FORMAT record (➜5.49)
6 40H 1 = Cell is locked
7 80H 1 = Formula is hidden
3 1 Horizontal alignment, border style, and background:
Bit Mask Contents
2-0 07H XF_HOR_ALIGN – Horizontal alignment
0 General, 1 Left, 2 Center, 3 Right, 4 Filled
3 08H 1 = Cell has left black border
4 10H 1 = Cell has right black border
5 20H 1 = Cell has top black border
6 40H 1 = Cell has bottom black border
7 80H 1 = Cell has shaded background
type
TXFRecord = packed record
FontIndex: byte;
NotUsed: byte;
NumFormat_Flags: byte;
HorAlign_Border_BackGround: Byte;
end;
}
var
rec: TBIFF2_XFRecord;
fmt: TsCellFormat;
@ -1110,37 +1006,22 @@ begin
FLimitations.MaxPaletteSize := BIFF2_MAX_PALETTE_SIZE;
end;
{ Creates the correct version of the number format list.
It is for BIFF2 and BIFF3 file formats. }
{@@ ----------------------------------------------------------------------------
Creates the correct version of the number format list.
It is valid for BIFF2 and BIFF3 file formats.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.CreateNumFormatList;
begin
FreeAndNil(FNumFormatList);
FNumFormatList := TsBIFF2NumFormatList.Create(Workbook);
end;
(*
function TsSpreadBIFF2Writer.FindXFIndex(ACell: PCell): Word;
var
lIndex: Integer;
lCell: TCell;
begin
// First try the fast methods for default formats
if ACell^.UsedFormattingFields = [] then
Result := 15
else begin
// If not, then we need to search in the list of dynamic formats
lCell := ACell^;
lIndex := FindFormattingInList(@lCell);
// Carefully check the index
if (lIndex < 0) or (lIndex > Length(FFormattingStyles)) then
raise Exception.Create('[TsSpreadBIFF2Writer.FindXFIndex] Invalid index, this should not happen!');
Result := FFormattingStyles[lIndex].Row;
end;
end; *)
{ Determines the cell attributes needed for writing a cell content record, such
{@@ ----------------------------------------------------------------------------
Determines the cell attributes needed for writing a cell content record, such
as WriteLabel, WriteNumber, etc.
The cell attributes contain, in bit masks, xf record index, font index, borders, etc.}
The cell attributes contain, in bit masks, xf record index, font index,
borders, etc.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.GetCellAttributes(ACell: PCell; XFIndex: Word;
out Attrib1, Attrib2, Attrib3: Byte);
var
@ -1199,8 +1080,10 @@ begin
// Nothing to do here.
end;
{ Attaches cell formatting data for the given cell to the current record.
Is called from all writing methods of cell contents. }
{@@ ----------------------------------------------------------------------------
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);
type
@ -1225,14 +1108,12 @@ begin
// Mask $40: 1 = Cell is locked
// Mask $80: 1 = Formula is hidden
rec.XFIndex_Locked_Hidden := Min(XFIndex, $3F) and $3F;
// AStream.WriteByte(Min(XFIndex, $3F) and $3F);
// 2nd byte:
// Mask $3F: Index to FORMAT record
// Mask $C0: Index to FONT record
w := fmt^.FontIndex shr 6; // was shl --> MUST BE shr! // ??????????????????????
rec.Format_Font := Lo(w);
// AStream.WriteByte(b);
// 3rd byte
// Mask $07: horizontal alignment
@ -1244,10 +1125,14 @@ begin
if uffHorAlign in fmt^.UsedFormattingFields then
rec.Align_Border_BkGr := ord(fmt^.HorAlignment);
if uffBorder in fmt^.UsedFormattingFields then begin
if cbNorth in fmt^.Border then rec.Align_Border_BkGr := rec.Align_Border_BkGr or $20;
if cbWest in fmt^.Border then rec.Align_Border_BkGr := rec.Align_Border_BkGr or $08;
if cbEast in fmt^.Border then rec.Align_Border_BkGr := rec.Align_Border_BkGr or $10;
if cbSouth in fmt^.Border then rec.Align_Border_BkGr := rec.Align_Border_BkGr or $40;
if cbNorth in fmt^.Border then
rec.Align_Border_BkGr := rec.Align_Border_BkGr or $20;
if cbWest in fmt^.Border then
rec.Align_Border_BkGr := rec.Align_Border_BkGr or $08;
if cbEast in fmt^.Border then
rec.Align_Border_BkGr := rec.Align_Border_BkGr or $10;
if cbSouth in fmt^.Border then
rec.Align_Border_BkGr := rec.Align_Border_BkGr or $40;
end;
if uffBackgroundColor in fmt^.UsedFormattingFields then
rec.Align_Border_BkGr := rec.Align_Border_BkGr or $80;
@ -1255,9 +1140,9 @@ begin
AStream.WriteBuffer(rec, SizeOf(rec));
end;
{
{@@ ----------------------------------------------------------------------------
Writes an Excel 2 COLWIDTH record
}
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteColWidth(AStream: TStream; ACol: PCol);
type
TColRecord = packed record
@ -1290,9 +1175,9 @@ begin
end;
end;
{
{@@ ----------------------------------------------------------------------------
Write COLWIDTH records for all columns
}
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteColWidths(AStream: TStream);
var
j: Integer;
@ -1306,10 +1191,11 @@ begin
end;
end;
{
{@@ ----------------------------------------------------------------------------
Writes an Excel 2 DIMENSIONS record
}
procedure TsSpreadBIFF2Writer.WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet);
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteDimensions(AStream: TStream;
AWorksheet: TsWorksheet);
var
firstRow, lastRow, firstCol, lastCol: Cardinal;
rec: TBIFF2_DimensionsRecord;
@ -1332,10 +1218,10 @@ begin
AStream.WriteBuffer(rec, SizeOf(rec));
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 }
@ -1344,12 +1230,12 @@ begin
AStream.WriteWord(WordToLE(XFIndex));
end;
{
{@@ ----------------------------------------------------------------------------
Writes an Excel 2 file to a stream
Excel 2.x files support only one Worksheet per Workbook,
so only the first will be written.
}
so only the first one will be written.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteToStream(AStream: TStream);
var
pane: Byte;
@ -1381,9 +1267,9 @@ begin
WriteEOF(AStream);
end;
{
{@@ ----------------------------------------------------------------------------
Writes an Excel 2 WINDOW1 record
}
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteWindow1(AStream: TStream);
begin
{ BIFF Record header }
@ -1406,9 +1292,9 @@ begin
AStream.WriteByte(WordToLE(0));
end;
{
{@@ ----------------------------------------------------------------------------
Writes an Excel 2 WINDOW2 record
}
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteWindow2(AStream: TStream;
ASheet: TsWorksheet);
var
@ -1532,107 +1418,11 @@ begin
{ Write out }
AStream.WriteBuffer(rec, SizeOf(rec));
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 index 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, j: Integer;
lFontIndex: Word;
lFormatIndex: Word; //number format
lBorders: TsCellBorders;
lAddBackground: Boolean;
lHorAlign: TsHorAlignment;
begin
// The loop starts with the first style added manually.
// 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 begin
j := NumFormatList.FindFormatOf(@FFormattingStyles[i]);
if j > -1 then
lFormatIndex := NumFormatList[j].Index;
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);
begin
WriteXFRecord(AStream, 0, 0); // XF0
WriteXFRecord(AStream, 0, 0); // XF1
WriteXFRecord(AStream, 0, 0); // XF2
WriteXFRecord(AStream, 0, 0); // XF3
WriteXFRecord(AStream, 0, 0); // XF4
WriteXFRecord(AStream, 0, 0); // XF5
WriteXFRecord(AStream, 0, 0); // XF6
WriteXFRecord(AStream, 0, 0); // XF7
WriteXFRecord(AStream, 0, 0); // XF8
WriteXFRecord(AStream, 0, 0); // XF9
WriteXFRecord(AStream, 0, 0); // XF10
WriteXFRecord(AStream, 0, 0); // XF11
WriteXFRecord(AStream, 0, 0); // XF12
WriteXFRecord(AStream, 0, 0); // XF13
WriteXFRecord(AStream, 0, 0); // XF14
WriteXFRecord(AStream, 0, 0); // XF15 - Default, no formatting
// Add all further non-standard/built-in formatting styles
ListAllFormattingStyles;
WriteXFFieldsForFormattingStyles(AStream);
end;
*)
{
{@@ ----------------------------------------------------------------------------
Writes an Excel 2 BOF record
This must be the first record on an Excel 2 stream
}
This must be the first record in an Excel 2 stream
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteBOF(AStream: TStream);
begin
{ BIFF Record header }
@ -1646,11 +1436,10 @@ begin
AStream.WriteWord(WordToLE(INT_EXCEL_SHEET));
end;
{
{@@ ----------------------------------------------------------------------------
Writes an Excel 2 EOF record
This must be the last record on an Excel 2 stream
}
This must be the last record in an Excel 2 stream
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteEOF(AStream: TStream);
begin
{ BIFF Record header }
@ -1658,10 +1447,10 @@ begin
AStream.WriteWord($0000);
end;
{
{@@ ----------------------------------------------------------------------------
Writes an Excel 2 font record
The font data is passed as font index.
}
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteFont(AStream: TStream; AFontIndex: Integer);
var
Len: Byte;
@ -1710,6 +1499,10 @@ begin
AStream.WriteWord(WordToLE(word(FixColor(font.Color))));
end;
{@@ ----------------------------------------------------------------------------
Writes all font records to the stream
@see WriteFont
-------------------------------------------------------------------------------}
procedure TsSpreadBiff2Writer.WriteFonts(AStream: TStream);
var
i: Integer;
@ -1718,6 +1511,9 @@ begin
WriteFont(AStream, i);
end;
{@@ ----------------------------------------------------------------------------
Writes an Excel 2 FORMAT record which describes formatting of numerical data.
-------------------------------------------------------------------------------}
procedure TsSpreadBiff2Writer.WriteNumFormat(AStream: TStream;
ANumFormatData: TsNumFormatData; AListIndex: Integer);
type
@ -1756,6 +1552,10 @@ begin
SetLength(buf, 0);
end;
{@@ ----------------------------------------------------------------------------
Writes the number of FORMAT records contained in the file.
Excel 2 supports only 21 FORMAT records.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteFormatCount(AStream: TStream);
begin
AStream.WriteWord(WordToLE(INT_EXCEL_ID_FORMATCOUNT));
@ -1763,22 +1563,11 @@ begin
AStream.WriteWord(WordToLE(21)); // there are 21 built-in formats
end;
{
{@@ ----------------------------------------------------------------------------
Writes an Excel 2 FORMULA record
The formula needs to be converted from usual user-readable string
to an RPN array
// or, in RPN: A1, B1, +
SetLength(MyFormula, 3);
MyFormula[0].TokenID := INT_EXCEL_TOKEN_TREFV; A1
MyFormula[0].Col := 0;
MyFormula[0].Row := 0;
MyFormula[1].TokenID := INT_EXCEL_TOKEN_TREFV; B1
MyFormula[1].Col := 1;
MyFormula[1].Row := 0;
MyFormula[2].TokenID := INT_EXCEL_TOKEN_TADD; +
}
The formula is an RPN formula that was converted from usual user-readable
string to an RPN array by the calling method.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteRPNFormula(AStream: TStream;
const ARow, ACol: Cardinal; const AFormula: TsRPNFormula; ACell: PCell);
var
@ -1831,18 +1620,23 @@ begin
WriteStringRecord(AStream, ACell^.UTF8StringValue);
end;
{ Writes the identifier for an RPN function with fixed argument count and
returns the number of bytes written. }
function TsSpreadBIFF2Writer.WriteRPNFunc(AStream: TStream; AIdentifier: Word): Word;
{@@ ----------------------------------------------------------------------------
Writes the identifier for an RPN function with fixed argument count and
returns the number of bytes written.
-------------------------------------------------------------------------------}
function TsSpreadBIFF2Writer.WriteRPNFunc(AStream: TStream;
AIdentifier: Word): Word;
begin
AStream.WriteByte(Lo(AIdentifier));
Result := 1;
end;
{ This method is intended to write a link to the cell containing the shared
{@@ ----------------------------------------------------------------------------
This method is intended to write a link to the cell containing the shared
formula used by the cell. But since BIFF2 does not support shared formulas
the writer must copy the shared formula and adapt the relative
references. }
references.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteRPNSharedFormulaLink(AStream: TStream;
ACell: PCell; var RPNLength: Word);
var
@ -1862,8 +1656,10 @@ begin
SetLength(formula, 0);
end;
{ Writes the size of the RPN token array. Called from WriteRPNFormula.
Overrides xlscommon. }
{@@ ----------------------------------------------------------------------------
Writes the size of the RPN token array. Called from WriteRPNFormula.
Overrides xlscommon.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteRPNTokenArraySize(AStream: TStream;
ASize: Word);
begin
@ -1871,23 +1667,26 @@ begin
// AStream.WriteByte(Lo(ASize));
end;
{ Is intended to write the token array of a shared formula stored in ACell.
{@@ ----------------------------------------------------------------------------
Is intended to write the token array of a shared formula stored in ACell.
But since BIFF2 does not support shared formulas this method must not do
anything. }
anything.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteSharedFormula(AStream: TStream; ACell: PCell);
begin
Unused(AStream, ACell);
end;
{ Writes an Excel 2 STRING record which immediately follows a FORMULA record
when the formula result is a string. }
{@@ ----------------------------------------------------------------------------
Writes an Excel 2 STRING record which immediately follows a FORMULA record
when the formula result is a string.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteStringRecord(AStream: TStream;
AString: String);
var
s: ansistring;
len: Integer;
begin
// s := AString; // Why not call UTF8ToAnsi?
s := UTF8ToAnsi(AString);
len := Length(s);
@ -1901,7 +1700,9 @@ begin
AStream.WriteBuffer(s[1], len * SizeOf(Char));
end;
{ Writes a BOOLEAN cell record. }
{@@ ----------------------------------------------------------------------------
Writes a Excel 2 BOOLEAN cell record.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteBool(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: Boolean; ACell: PCell);
var
@ -1934,7 +1735,9 @@ begin
AStream.WriteBuffer(rec, SizeOf(rec));
end;
{ Writes an ERROR cell record. }
{@@ ----------------------------------------------------------------------------
Writes an Excel 2 ERROR cell record.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteError(AStream: TStream;
const ARow, ACol: Cardinal; const AValue: TsErrorValue; ACell: PCell);
var
@ -1967,15 +1770,10 @@ begin
AStream.WriteBuffer(rec, SizeOf(rec));
end;
{*******************************************************************
* TsSpreadBIFF2Writer.WriteBlank ()
*
* DESCRIPTION: Writes an Excel 2 record for an empty cell
*
* Required if this cell should contain formatting
*
*******************************************************************}
{@@ ----------------------------------------------------------------------------
Writes an Excel 2 record for an empty cell
Required if this cell should contain formatting, but no data.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteBlank(AStream: TStream;
const ARow, ACol: Cardinal; ACell: PCell);
type
@ -2013,17 +1811,11 @@ begin
AStream.WriteBuffer(rec, Sizeof(rec));
end;
{*******************************************************************
* TsSpreadBIFF2Writer.WriteLabel ()
*
* DESCRIPTION: Writes an Excel 2 LABEL record
*
* Writes a string to the sheet
* If the string length exceeds 255 bytes, the string
* will be truncated and an exception will be raised as
* a warning.
*
*******************************************************************}
{@@ ----------------------------------------------------------------------------
Writes an Excel 2 LABEL record
If the string length exceeds 255 bytes, the string will be truncated and an
error message will be logged.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteLabel(AStream: TStream; const ARow,
ACol: Cardinal; const AValue: string; ACell: PCell);
const
@ -2082,14 +1874,10 @@ begin
AStream.WriteBuffer(buf[0], SizeOf(Rec) + SizeOf(ansiChar)*L);
end;
{*******************************************************************
* TsSpreadBIFF2Writer.WriteNumber ()
*
* DESCRIPTION: Writes an Excel 2 NUMBER record
*
* Writes a number (64-bit IEE 754 floating point) to the sheet
*
*******************************************************************}
{@@ ----------------------------------------------------------------------------
Writes an Excel 2 NUMBER record
A "number" is a 64-bit IEE 754 floating point.
-------------------------------------------------------------------------------}
procedure TsSpreadBIFF2Writer.WriteNumber(AStream: TStream; const ARow,
ACol: Cardinal; const AValue: double; ACell: PCell);
var

1583
components/fpspreadsheet/xlsbiff5.pas
View File

File diff suppressed because it is too large Load Diff

1931
components/fpspreadsheet/xlsbiff8.pas
View File

File diff suppressed because it is too large Load Diff

228
components/fpspreadsheet/xlscommon.pas
View File

@ -203,21 +203,7 @@ type
// Converts an fps error value to the byte code needed in xls files
function ConvertToExcelError(AValue: TsErrorValue): byte;
type (*
{ Contents of the XF record to be stored in the XFList of the reader }
TXFListData = class
public
FontIndex: Integer;
FormatIndex: Integer;
HorAlignment: TsHorAlignment;
VertAlignment: TsVertAlignment;
WordWrap: Boolean;
TextRotation: TsTextRotation;
Borders: TsCellBorders;
BorderStyles: TsCellBorderStyles;
BackgroundColor: TsColor;
end; *)
type
{ TsBIFFNumFormatList }
TsBIFFNumFormatList = class(TsCustomNumFormatList)
protected
@ -234,9 +220,7 @@ type (*
FCodepage: string; // in a format prepared for lconvencoding.ConvertEncoding
FDateMode: TDateMode;
FPaletteFound: Boolean;
// FXFList: TFPList; // of TXFListData
FIncompleteCell: PCell;
// procedure ApplyCellFormatting(ARow, ACol: Cardinal; XFIndex: Word); overload;
procedure ApplyCellFormatting(ACell: PCell; XFIndex: Word); virtual; //overload;
procedure CreateNumFormatList; override;
// Extracts a number out of an RK value
@ -244,11 +228,6 @@ type (*
// Returns the numberformat for a given XF record
procedure ExtractNumberFormat(AXFIndex: WORD;
out ANumberFormat: TsNumberFormat; out ANumberFormatStr: String); virtual;
{
// Finds format record for XF record pointed to by cell
// Will not return info for built-in formats
function FindNumFormatDataForCell(const AXFIndex: Integer): TsNumFormatData;
}
// Tries to find if a number cell is actually a date/datetime/time cell and retrieves the value
function IsDateTime(Number: Double; ANumberFormat: TsNumberFormat;
ANumberFormatStr: String; out ADateTime: TDateTime): Boolean;
@ -310,9 +289,9 @@ type (*
public
constructor Create(AWorkbook: TsWorkbook); override;
// destructor Destroy; override;
end;
{ TsSpreadBIFFWriter }
TsSpreadBIFFWriter = class(TsCustomSpreadWriter)
@ -320,7 +299,6 @@ type (*
FDateMode: TDateMode;
FLastRow: Cardinal;
FLastCol: Cardinal;
// procedure AddDefaultFormats; override;
procedure CreateNumFormatList; override;
function FindXFIndex(ACell: PCell): Integer; virtual;
function FixColor(AColor: TsColor): TsColor; override;
@ -402,13 +380,10 @@ type (*
procedure WriteVirtualCells(AStream: TStream);
// Writes out a WINDOW1 record
procedure WriteWindow1(AStream: TStream); virtual;
// Writes the index of the XF record used in the given cell
//procedure WriteXFIndex(AStream: TStream; ACell: PCell);
// Writes an XF record
procedure WriteXF(AStream: TStream; ACellFormat: PsCellFormat;
XFType_Prot: Byte = 0); virtual;
// Writes all xF records
// Writes all XF records
procedure WriteXFRecords(AStream: TStream);
public
@ -563,6 +538,7 @@ begin
end;
end;
{ TsBIFFNumFormatList }
{ These are the built-in number formats as expected in the biff spreadsheet file.
@ -652,27 +628,6 @@ begin
FLimitations.MaxPaletteSize := 64;
end;
{
destructor TsSpreadBIFFReader.Destroy;
var
j: integer;
begin
for j := FXFList.Count-1 downto 0 do TObject(FXFList[j]).Free;
FXFList.Free;
inherited Destroy;
end;
}
(*
{ Applies the XF formatting referred to by XFIndex to the specified cell }
procedure TsSpreadBIFFReader.ApplyCellFormatting(ARow, ACol: Cardinal;
XFIndex: Word);
var
lCell: PCell;
begin
lCell := FWorksheet.GetCell(ARow, ACol);
ApplyCellFormatting(lCell, XFIndex);
end;
*)
{ Applies the XF formatting referred to by XFIndex to the specified cell }
procedure TsSpreadBIFFReader.ApplyCellFormatting(ACell: PCell; XFIndex: Word);
var
@ -687,57 +642,6 @@ begin
ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt^);
end else
ACell^.FormatIndex := 0;
(*
// Font
if XFData.FontIndex = 1 then
Include(ACell^.UsedFormattingFields, uffBold)
else
if XFData.FontIndex > 1 then
Include(ACell^.UsedFormattingFields, uffFont);
ACell^.FontIndex := XFData.FontIndex;
// Alignment
if XFData.HorAlignment <> haDefault then
Include(ACell^.UsedFormattingFields, uffHorAlign)
else
Exclude(ACell^.UsedFormattingFields, uffHorAlign);
ACell^.HorAlignment := XFData.HorAlignment;
if XFData.VertAlignment <> vaDefault then
Include(ACell^.UsedFormattingFields, uffVertAlign)
else
Exclude(ACell^.UsedFormattingFields, uffVertAlign);
ACell^.VertAlignment := XFData.VertAlignment;
// Word wrap
if XFData.WordWrap then
Include(ACell^.UsedFormattingFields, uffWordWrap)
else
Exclude(ACell^.UsedFormattingFields, uffWordWrap);
// Text rotation
if XFData.TextRotation > trHorizontal then
Include(ACell^.UsedFormattingFields, uffTextRotation)
else
Exclude(ACell^.UsedFormattingFields, uffTextRotation);
ACell^.TextRotation := XFData.TextRotation;
// Borders
ACell^.BorderStyles := XFData.BorderStyles;
if XFData.Borders <> [] then begin
Include(ACell^.UsedFormattingFields, uffBorder);
ACell^.Border := XFData.Borders;
end else
Exclude(ACell^.UsedFormattingFields, uffBorder);
// Background color
if XFData.BackgroundColor <> scTransparent then begin
Include(ACell^.UsedFormattingFields, uffBackgroundColor);
ACell^.BackgroundColor := XFData.BackgroundColor;
end else
Exclude(ACell^.UsedFormattingFields, uffBackgroundColor);
*)
end;
end;
@ -801,36 +705,7 @@ begin
ANumberFormatStr := '';
end;
end;
{
var
lNumFormatData: TsNumFormatData;
begin
lNumFormatData := FindNumFormatDataForCell(AXFIndex);
if lNumFormatData <> nil then begin
ANumberFormat := lNumFormatData.NumFormat;
ANumberFormatStr := lNumFormatData.FormatString;
end else begin
ANumberFormat := nfGeneral;
ANumberFormatStr := '';
end;
end; }
(*
{ Determines the format data (for numerical formatting) which belong to a given
XF record. }
function TsSpreadBIFFReader.FindNumFormatDataForCell(const AXFIndex: Integer
): TsNumFormatData;
var
fmt: TsCellFormat;
i: Integer;
begin
Result := nil;
fmt := FFormatList.FindByID(AXFIndex);
i := NumFormatList.FindByIndex(
lXFData := TXFListData(FXFList.Items[AXFIndex]);
i := NumFormatList.FindByIndex(lXFData.FormatIndex);
if i <> -1 then Result := NumFormatList[i];
end;
*)
{ Convert the number to a date/time and return that if it is }
function TsSpreadBIFFReader.IsDateTime(Number: Double;
ANumberFormat: TsNumberFormat; ANumberFormatStr: String;
@ -1115,11 +990,6 @@ begin
end
else
begin
{
if SizeOf(Double) <> 8 then
raise Exception.Create('Double is not 8 bytes');
}
// Result is a number or a date/time
Move(Data[0], ResultFormula, SizeOf(Data));
@ -1817,28 +1687,6 @@ destructor TsSpreadBIFFWriter.Destroy;
begin
inherited Destroy;
end;
(*
{ These are default style formats which are added as XF fields regardless of
being used in the document or not.
Currently, only one additional default format is supported ("bold").
Here are the changes to be made when extending this list:
- SetLength(FFormattingstyles, <number of predefined styles>)
}
procedure TsSpreadBIFFWriter.AddDefaultFormats();
begin
// XF0..XF14: Normal style, Row Outline level 1..7,
// Column Outline level 1..7.
// XF15 - Default cell format, no formatting (4.6.2)
SetLength(FFormattingStyles, 1);
FFormattingStyles[0].UsedFormattingFields := [];
FFormattingStyles[0].BorderStyles := DEFAULT_BORDERSTYLES;
FFormattingStyles[0].Row := 15;
NextXFIndex := 15 + Length(FFormattingStyles);
// "15" is the index of the last pre-defined xf record
end;
*)
{ Creates the correct version of the number format list. It is for BIFF file
formats.
@ -1854,30 +1702,7 @@ function TsSpreadBIFFWriter.FindXFIndex(ACell: PCell): Integer;
begin
Result := LAST_BUILTIN_XF + ACell^.FormatIndex;
end;
{
var
idx: Integer;
cell: TCell;
begin
// First try the fast methods for default formats
if ACell^.UsedFormattingFields = [] then begin
Result := 15; //XF15; see TsSpreadBIFF8Writer.AddDefaultFormats
Exit;
end;
// If not, then we need to search in the list of dynamic formats
// But we have to consider that the number formats of the cell is in fpc syntax,
// but the number format list of the writer is in Excel syntax.
cell := ACell^;
idx := FindFormattingInList(@cell);
// Carefully check the index
if (idx < 0) or (idx > Length(FFormattingStyles)) then
Result := -1
else
Result := FFormattingStyles[idx].Row;
end;
}
function TsSpreadBIFFWriter.FixColor(AColor: TsColor): TsColor;
var
rgb: TsColorValue;
@ -2108,7 +1933,6 @@ begin
AStream.WriteBuffer(rec, SizeOf(rec));
end;
{ Writes a BIFF number format record defined in AFormatData.
AListIndex the index of the numformatdata in the numformat list
(not the FormatIndex!).
@ -2728,14 +2552,6 @@ begin
then spacebelow := true;
end;
end;
{
if (cell <> nil) and (uffBorder in cell^.UsedFormattingFields) then begin
if (cbNorth in cell^.Border) and (cell^.BorderStyles[cbNorth].LineStyle = lsThick)
then spaceabove := true;
if (cbSouth in cell^.Border) and (cell^.BorderStyles[cbSouth].LineStyle = lsThick)
then spacebelow := true;
end;
}
if spaceabove and spacebelow then break;
inc(colindex);
end;
@ -3135,40 +2951,6 @@ begin
WriteXF(AStream, Workbook.GetPointerToCellFormat(i), 0);
end;
(*
{ Write the index of the XF record, according to formatting of the given cell
Valid for BIFF5 and BIFF8.
BIFF2 is handled differently. }
procedure TsSpreadBIFFWriter.WriteXFIndex(AStream: TStream; ACell: PCell);
begin
AStream.WriteWord(AStream, LAST_BUILTIN_XF + ACell^.FormatIndex);
{
var
lIndex: Integer;
lXFIndex: Word;
lCell: TCell;
begin
// First try the fast methods for default formats
if ACell^.UsedFormattingFields = [] then begin
AStream.WriteWord(WordToLE(15)); //XF15; see TsSpreadBIFF8Writer.AddDefaultFormats
Exit;
end;
// If not, then we need to search in the list of dynamic formats
// But we have to consider that the number formats of the cell is in fpc syntax,
// but the number format list of the writer is in Excel syntax.
lCell := ACell^;
lIndex := FindFormattingInList(@lCell);
// Carefully check the index
if (lIndex < 0) or (lIndex > Length(FFormattingStyles)) then
raise Exception.Create('[TsSpreadBIFFWriter.WriteXFIndex] Invalid Index, this should not happen!');
lXFIndex := FFormattingStyles[lIndex].Row;
AStream.WriteWord(WordToLE(lXFIndex));
}
end; *)
end.

269
components/fpspreadsheet/xlsxooxml.pas
View File

@ -107,19 +107,11 @@ type
FSharedStringsCount: Integer;
FFillList: array of PsCellFormat;
FBorderList: array of PsCellFormat;
{
FFillList: array of TsCell;
FBorderList: array of PCell;
}
protected
{ Helper routines }
// procedure AddDefaultFormats; override;
procedure CreateNumFormatList; override;
procedure CreateStreams;
procedure DestroyStreams;
{
function FindBorderInList(ACell: PCell): Integer;
function FindFillInList(ACell: PCell): Integer; }
function FindBorderInList(AFormat: PsCellFormat): Integer;
function FindFillInList(AFormat: PsCellFormat): Integer;
function GetStyleIndex(ACell: PCell): Cardinal;
@ -312,18 +304,7 @@ type
Borders: TsCellBorders;
BorderStyles: TsCellBorderStyles;
end;
(*
TXFListData = class
NumFmtIndex: Integer;
FontIndex: Integer;
FillIndex: Integer;
BorderIndex: Integer;
HorAlignment: TsHorAlignment;
VertAlignment: TsVertAlignment;
WordWrap: Boolean;
TextRotation: TsTextRotation;
end;
*)
{ TsOOXMLNumFormatList }
@ -441,86 +422,12 @@ procedure TsSpreadOOXMLReader.ApplyCellFormatting(ACell: PCell; XFIndex: Integer
var
i: Integer;
fmt: PsCellFormat;
{
xf: TXfListData;
numFmtData: TsNumFormatData;
fillData: TFillListData;
borderData: TBorderListData;
j: Integer;
}
begin
if Assigned(ACell) then begin
i := FCellFormatList.FindIndexOfID(XFIndex);
fmt := FCellFormatList.Items[i];
ACell^.FormatIndex := FWorkbook.AddCellFormat(fmt^);
end;
(*
if Assigned(ACell) then begin
xf := TXFListData(FXfList.Items[XfIndex]);
// Font
if FWrittenByFPS and (xf.FontIndex = 1) then
Include(ACell^.UsedFormattingFields, uffBold)
else
if xf.FontIndex > 0 then
Include(ACell^.UsedFormattingFields, uffFont);
ACell^.FontIndex := xf.FontIndex;
// Alignment
if xf.HorAlignment <> haDefault then
Include(ACell^.UsedFormattingFields, uffHorAlign)
else
Exclude(ACell^.UsedFormattingFields, uffHorAlign);
if xf.VertAlignment <> vaDefault then
Include(ACell^.UsedFormattingFields, uffVertAlign)
else
Exclude(ACell^.UsedformattingFields, uffVertAlign);
ACell^.HorAlignment := xf.HorAlignment;
ACell^.VertAlignment := xf.VertAlignment;
// Word wrap
if xf.WordWrap then
Include(ACell^.UsedFormattingFields, uffWordWrap)
else
Exclude(ACell^.UsedFormattingFields, uffWordWrap);
// Text rotation
if xf.TextRotation > trHorizontal then
Include(ACell^.UsedFormattingFields, uffTextRotation)
else
Exclude(ACell^.UsedFormattingFields, uffTextRotation);
ACell^.TextRotation := xf.TextRotation;
// Borders
borderData := FBorderList[xf.BorderIndex];
if (borderData <> nil) then begin
ACell^.BorderStyles := borderData.BorderStyles;
if borderData.Borders <> [] then begin
Include(ACell^.UsedFormattingFields, uffBorder);
ACell^.Border := borderData.Borders;
end else
Exclude(ACell^.UsedFormattingFields, uffBorder);
end;
// Background color
fillData := FFillList[xf.FillIndex];
if (fillData <> nil) and (fillData.PatternType <> 'none') then begin
Include(ACell^.UsedFormattingFields, uffBackgroundColor);
ACell^.BackgroundColor := fillData.FgColor;
end else
Exclude(ACell^.UsedFormattingFields, uffBackgroundColor);
if xf.NumFmtIndex > 0 then begin
j := NumFormatList.FindByIndex(xf.NumFmtIndex);
if j > -1 then begin
numFmtData := NumFormatList[j];
Include(ACell^.UsedFormattingFields, uffNumberFormat);
ACell^.NumberFormat := numFmtData.NumFormat;
ACell^.NumberFormatStr := numFmtData.FormatString;
end;
end;
end;
*)
end;
procedure TsSpreadOOXMLReader.CreateNumFormatList;
@ -1594,62 +1501,10 @@ end;
{ TsSpreadOOXMLWriter }
{ Adds built-in styles:
- Default style for cells having no specific formatting
- Bold styles for cells having UsedFormattingFileds = [uffBold]
All other styles will be added by "ListAllFormattingStyles".
}
(*
procedure TsSpreadOOXMLWriter.AddDefaultFormats();
// We store the index of the XF record that will be assigned to this style in
// the "row" of the style. Will be needed when writing the XF record.
// --- This is needed for BIFF. Not clear if it is important here as well...
begin
SetLength(FFormattingStyles, 2);
// Default style
InitCell(FFormattingStyles[0]);
FFormattingStyles[0].BorderStyles := DEFAULT_BORDERSTYLES;
FFormattingStyles[0].Row := 0;
// Bold style
InitCell(FFormattingStyles[1]);
FFormattingStyles[1].UsedFormattingFields := [uffBold];
FFormattingStyles[1].FontIndex := 1; // this is the "bold" font
FFormattingStyles[1].Row := 1;
NextXFIndex := 2;
end;
*)
(*
{ Looks for the combination of border attributes of the given cell in the
FBorderList and returns its index. }
function TsSpreadOOXMLWriter.FindBorderInList(ACell: PCell): Integer;
var
i: Integer;
styleCell: PCell;
begin
// No cell, or border-less --> index 0
if (ACell = nil) or not (uffBorder in ACell^.UsedFormattingFields) then begin
Result := 0;
exit;
end;
for i:=0 to High(FBorderList) do begin
styleCell := FBorderList[i];
if SameCellBorders(styleCell, ACell) then begin
Result := i;
exit;
end;
end;
// Not found --> return -1
Result := -1;
end;
*)
{ Looks for the combination of border attributes of the given format record in
the FBorderList and returns its index. }
{@@ ----------------------------------------------------------------------------
Looks for the combination of border attributes of the given format record in
the FBorderList and returns its index.
-------------------------------------------------------------------------------}
function TsSpreadOOXMLWriter.FindBorderInList(AFormat: PsCellFormat): Integer;
var
i: Integer;
@ -1672,37 +1527,11 @@ begin
// Not found --> return -1
Result := -1;
end;
(*
{ Looks for the combination of fill attributes of the given cell in the
FFillList and returns its index. }
function TsSpreadOOXMLWriter.FindFillInList(ACell: PCell): Integer;
var
i: Integer;
styleCell: PCell;
begin
if (ACell = nil) or not (uffBackgroundColor in ACell^.UsedFormattingFields)
then begin
Result := 0;
exit;
end;
// Index 0 is "no fill" which already has been handled.
for i:=2 to High(FFillList) do begin
styleCell := FFillList[i];
if (uffBackgroundColor in styleCell^.UsedFormattingFields) then
if (styleCell^.BackgroundColor = ACell^.BackgroundColor) then begin
Result := i;
exit;
end;
end;
// Not found --> return -1
Result := -1;
end;
*)
{ Looks for the combination of fill attributes of the given format record in the
FFillList and returns its index. }
{@@ ----------------------------------------------------------------------------
Looks for the combination of fill attributes of the given format record in the
FFillList and returns its index.
-------------------------------------------------------------------------------}
function TsSpreadOOXMLWriter.FindFillInList(AFormat: PsCellFormat): Integer;
var
i: Integer;
@ -1730,7 +1559,6 @@ begin
Result := -1;
end;
{ Determines the formatting index which a given cell has in list of
"FormattingStyles" which correspond to the section cellXfs of the styles.xml
file. }
@ -1738,15 +1566,6 @@ function TsSpreadOOXMLWriter.GetStyleIndex(ACell: PCell): Cardinal;
begin
Result := ACell^.FormatIndex;
end;
{
var
idx: Integer;
begin
idx := FindFormattingInList(ACell);
if idx = -1 then
idx := 0;
Result := idx;
end;
{ Creates a list of all border styles found in the workbook.
The list contains indexes into the array FFormattingStyles for each unique
@ -1773,15 +1592,6 @@ begin
inc(n);
end;
end;
{
for i := 0 to High(FFormattingStyles) do begin
styleCell := @FFormattingStyles[i];
if FindBorderInList(styleCell) = -1 then begin
SetLength(FBorderList, n+1);
FBorderList[n] := styleCell;
inc(n);
end;
end; }
end;
{ Creates a list of all fill styles found in the workbook.
@ -1791,7 +1601,6 @@ end;
To be used for styles.xml. }
procedure TsSpreadOOXMLWriter.ListAllFills;
var
//styleCell: PCell;
i, n: Integer;
fmt: PsCellFormat;
begin
@ -1811,16 +1620,6 @@ begin
inc(n);
end;
end;
{
for i := 0 to High(FFormattingStyles) do begin
styleCell := @FFormattingStyles[i];
if FindFillInList(styleCell) = -1 then begin
SetLength(FFillList, n+1);
FFillList[n] := styleCell;
inc(n);
end;
end;
}
end;
procedure TsSpreadOOXMLWriter.WriteBorderList(AStream: TStream);
@ -1828,8 +1627,6 @@ const
LINESTYLE_NAME: Array[TsLineStyle] of String = (
'thin', 'medium', 'dashed', 'dotted', 'thick', 'double', 'hair');
//procedure WriteBorderStyle(AStream: TStream; ACell: PCell; ABorder: TsCellBorder;
// ABorderName: String);
procedure WriteBorderStyle(AStream: TStream; AFormatRecord: PsCellFormat;
ABorder: TsCellBorder; ABorderName: String);
{ border names found in xlsx files for Excel selections:
@ -1840,11 +1637,9 @@ const
colorName: String;
rgb: TsColorValue;
begin
//if (ABorder in ACell^.Border) then begin
if (ABorder in AFormatRecord^.Border) then begin
// Line style
styleName := LINESTYLE_NAME[AFormatRecord^.BorderStyles[ABorder].LineStyle];
//styleName := LINESTYLE_NAME[ACell.BorderStyles[ABorder].LineStyle];
// Border color
rgb := Workbook.GetPaletteColor(AFormatRecord^.BorderStyles[ABorder].Color);
@ -1861,7 +1656,6 @@ const
var
i: Integer;
// styleCell: PCell;
diag: String;
begin
AppendToStream(AStream, Format(
@ -1874,7 +1668,6 @@ begin
'</border>');
for i:=1 to High(FBorderList) do begin
//styleCell := FBorderList[i];
diag := '';
if (cbDiagUp in FBorderList[i].Border) then diag := diag + ' diagonalUp="1"';
if (cbDiagDown in FBorderList[i].Border) then diag := diag + ' diagonalDown="1"';
@ -1887,15 +1680,6 @@ begin
// OOXML uses the same border style for both diagonals. In agreement with
// the biff implementation we select the style from the diagonal-up line.
WriteBorderStyle(AStream, FBorderList[i], cbDiagUp, 'diagonal');
{
WriteBorderStyle(AStream, styleCell, cbWest, 'left');
WriteBorderStyle(AStream, styleCell, cbEast, 'right');
WriteBorderStyle(AStream, styleCell, cbNorth, 'top');
WriteBorderStyle(AStream, styleCell, cbSouth, 'bottom');
// OOXML uses the same border style for both diagonals. In agreement with
// the biff implementation we select the style from the diagonal-up line.
WriteBorderStyle(AStream, styleCell, cbDiagUp, 'diagonal');
}
AppendToStream(AStream,
'</border>');
end;
@ -1931,7 +1715,6 @@ end;
procedure TsSpreadOOXMLWriter.WriteFillList(AStream: TStream);
var
i: Integer;
//styleCell: PCell;
rgb: TsColorValue;
begin
AppendToStream(AStream, Format(
@ -1951,8 +1734,6 @@ begin
// user-defined fills
for i:=2 to High(FFillList) do begin
//styleCell := FFillList[i];
//rgb := Workbook.GetPaletteColor(styleCell^.BackgroundColor);
rgb := Workbook.GetPaletteColor(FFillList[i]^.BackgroundColor);
AppendToStream(AStream,
'<fill>',
@ -2280,9 +2061,7 @@ var
begin
AppendToStream(AStream, Format(
'<%s count="%d">', [ANodeName, FWorkbook.GetNumCellFormats]));
// '<%s count="%d">', [ANodeName, Length(FFormattingStyles)]));
// for styleCell in FFormattingStyles do begin
for i:=0 to FWorkbook.GetNumCellFormats-1 do
begin
fmt := FWorkbook.GetPointerToCellFormat(i);
@ -2290,10 +2069,8 @@ begin
sAlign := '';
{ Number format }
// if (uffNumberFormat in styleCell.UsedFormattingFields) then
if (uffNumberFormat in fmt^.UsedFormattingFields) then
begin
// idx := NumFormatList.FindFormatOf(@styleCell);
idx := NumFormatList.Find(fmt^.NumberFormat, fmt^.NumberFormatStr);
if idx > -1 then begin
numFmtID := NumFormatList[idx].Index;
@ -2307,22 +2084,12 @@ begin
fontID := 1;
if (uffFont in fmt^.UsedFormattingFields) then
fontID := fmt^.FontIndex;
{
if (uffBold in styleCell.UsedFormattingFields) then
fontId := 1;
if (uffFont in styleCell.UsedFormattingFields) then
fontId := styleCell.FontIndex;
}
s := s + Format('fontId="%d" ', [fontId]);
if fontID > 0 then s := s + 'applyFont="1" ';
if ANodeName = 'cellXfs' then s := s + 'xfId="0" ';
{ Text rotation }
{
if (uffTextRotation in styleCell.UsedFormattingFields) and (styleCell.TextRotation <> trHorizontal)
then
case styleCell.TextRotation of}
if (uffTextRotation in fmt^.UsedFormattingFields) then
case fmt^.TextRotation of
trHorizontal : ;
@ -2332,10 +2099,6 @@ begin
end;
{ Text alignment }
{
if (uffHorAlign in styleCell.UsedFormattingFields) and (styleCell.HorAlignment <> haDefault)
then
case styleCell.HorAlignment of }
if (uffHorAlign in fmt^.UsedFormattingFields) and (fmt^.HorAlignment <> haDefault)
then
case fmt.HorAlignment of
@ -2344,11 +2107,6 @@ begin
haRight : sAlign := sAlign + 'horizontal="right" ';
end;
{
if (uffVertAlign in styleCell.UsedformattingFields) and (styleCell.VertAlignment <> vaDefault)
then
case styleCell.VertAlignment of
}
if (uffVertAlign in fmt^.UsedFormattingFields) and (fmt^.VertAlignment <> vaDefault)
then
case fmt.VertAlignment of
@ -2357,14 +2115,10 @@ begin
vaBottom: sAlign := sAlign + 'vertical="bottom" ';
end;
//if (uffWordWrap in styleCell.UsedFormattingFields) then
if (uffWordWrap in fmt^.UsedFormattingFields) then
sAlign := sAlign + 'wrapText="1" ';
{ Fill }
{
if (uffBackgroundColor in styleCell.UsedFormattingFields) then
fillID := FindFillInList(@styleCell); }
if (uffBackgroundColor in fmt.UsedFormattingFields) then
begin
fillID := FindFillInList(fmt);
@ -2373,9 +2127,6 @@ begin
end;
{ Border }
{
if (uffBorder in styleCell.UsedFormattingFields) then
borderID := FindBorderInList(@styleCell); }
if (uffBorder in fmt^.UsedFormattingFields) then
begin
borderID := FindBorderInList(fmt);
@ -2719,7 +2470,6 @@ var
begin
{ Analyze the workbook and collect all information needed }
ListAllNumFormats;
//ListAllFormattingStyles;
ListAllFills;
ListAllBorders;
@ -2929,7 +2679,6 @@ var
CellPosText: string;
lStyleIndex: Cardinal;
ResultingValue: string;
//S: string;
begin
// Office 2007-2010 (at least) support no more characters in a cell;
if Length(AValue) > MAXBYTES then