From d9343190a4520e051a548bba800ea0413b9b044e Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sat, 24 Jan 2015 00:36:10 +0000 Subject: [PATCH] fpspreadsheet: Add mission routines of the cell record helper. Some cosmetics. Clean up commented lines from previous commit. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3895 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/fpspreadsheet/fpscell.pas | 117 +- components/fpspreadsheet/fpsopendocument.pas | 275 +-- components/fpspreadsheet/fpspreadsheet.pas | 703 +----- .../fpspreadsheet/tests/formattests.pas | 2 +- .../fpspreadsheet/tests/manualtests.pas | 2 +- components/fpspreadsheet/xlsbiff2.pas | 524 ++--- components/fpspreadsheet/xlsbiff5.pas | 1585 ++++++-------- components/fpspreadsheet/xlsbiff8.pas | 1933 ++++++++--------- components/fpspreadsheet/xlscommon.pas | 228 +- components/fpspreadsheet/xlsxooxml.pas | 269 +-- 10 files changed, 1871 insertions(+), 3767 deletions(-) diff --git a/components/fpspreadsheet/fpscell.pas b/components/fpspreadsheet/fpscell.pas index 6555daba2..384bfa0c7 100644 --- a/components/fpspreadsheet/fpscell.pas +++ b/components/fpspreadsheet/fpscell.pas @@ -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. diff --git a/components/fpspreadsheet/fpsopendocument.pas b/components/fpspreadsheet/fpsopendocument.pas index da6cb6739..16e60ba42 100755 --- a/components/fpspreadsheet/fpsopendocument.pas +++ b/components/fpspreadsheet/fpsopendocument.pas @@ -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, ''); - //s := WriteFontStyleXMLAsString(FFormattingStyles[i]); s := WriteFontStyleXMLAsString(fmt); if s <> '' then AppendToStream(AStream, ''); - // 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: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, ''); - { - if ACell^.UsedFormattingFields <> [] then - begin - lIndex := FindFormattingInList(ACell); - AppendToStream(AStream, Format( - '', [lIndex, spannedStr]), - ''); - end else - AppendToStream(AStream, - ''); -} 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( '' + '%s' + @@ -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( '' + '%s ' + @@ -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. diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index ac142272f..033fe7d76 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -57,43 +57,13 @@ type DateTimeValue: TDateTime; BoolValue: Boolean; ErrorValue: TsErrorValue; - SharedFormulaBase: PCell; // Cell containing the shared formula - MergeBase: PCell; // Upper left cell if a merged range - //MergedNeighbors: TsCellBorders; - { Formatting fields } -(* - { When adding/deleting formatting fields don't forget to update CopyFormat! } - UsedFormattingFields: TsUsedFormattingFields; - FontIndex: Integer; - TextRotation: TsTextRotation; - HorAlignment: TsHorAlignment; - VertAlignment: TsVertAlignment; - Border: TsCellBorders; - BorderStyles: TsCellBorderStyles; - BackgroundColor: TsColor; - NumberFormat: TsNumberFormat; - NumberFormatStr: String; - RGBBackgroundColor: TFPColor; // only valid if BackgroundColor=scRGBCOLOR - *) + SharedFormulaBase: PCell; // Cell containing the shared formula + MergeBase: PCell; // Upper left cell if a merged range { Index of format record } FormatIndex: Integer; { Status flags } CalcState: TsCalcState; end; - { - TCell = record - Worksheet: TsWorksheet; - Col: LongInt; - Row: LongInt; - ContentType: TCellContentType; - NumberValue: Double; - StringValue: String; - FormulaValue: String; - SharedFormulaBase: PCell; - MergeBase: PCell; - StyleIndex: Integer; - CalcState: TsCalcState; - end; } {@@ The record TRow contains information about a spreadsheet row: @param Row The index of the row (beginning with 0) @@ -226,14 +196,11 @@ type function GetNumberFormatAttributes(ACell: PCell; out ADecimals: Byte; out ACurrencySymbol: String): Boolean; -// function ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields; overload; function ReadUsedFormatting(ACell: PCell): TsUsedFormattingFields; -// function ReadBackgroundColor(ARow, ACol: Cardinal): TsColor; overload; - function ReadBackgroundColor(ACell: PCell): TsColor; //overload; + function ReadBackgroundColor(ACell: PCell): TsColor; function ReadCellBorders(ACell: PCell): TsCellBorders; function ReadCellBorderStyle(ACell: PCell; ABorder: TsCellBorder): TsCellBorderStyle; -// function ReadCellFont(ARow, ACol: Cardinal): TsFont; overload; - function ReadCellFont(ACell: PCell): TsFont; //overload; + function ReadCellFont(ACell: PCell): TsFont; function ReadCellFormat(ACell: PCell): TsCellFormat; function ReadHorAlignment(ACell: PCell): TsHorAlignment; procedure ReadNumFormat(ACell: PCell; out ANumFormat: TsNumberFormat; @@ -338,6 +305,8 @@ type function WriteBorderStyles(ARow, ACol: Cardinal; const AStyles: TsCellBorderStyles): PCell; overload; procedure WriteBorderStyles(ACell: PCell; const AStyles: TsCellBorderStyles); overload; + procedure WriteCellFormat(ACell: PCell; const ACellFormat: TsCellFormat); + function WriteDateTimeFormat(ARow, ACol: Cardinal; ANumFormat: TsNumberFormat; const ANumFormatString: String = ''): PCell; overload; procedure WriteDateTimeFormat(ACell: PCell; ANumFormat: TsNumberFormat; @@ -568,8 +537,7 @@ type {@@ Event procedure called when a worksheet is removed } TsRemoveWorksheetEvent = procedure (Sender: TObject; ASheetIndex: Integer) of object; - {@@ - The workbook contains the worksheets and provides methods for reading from + {@@ The workbook contains the worksheets and provides methods for reading from and writing to file. } TsWorkbook = class @@ -786,7 +754,6 @@ type public constructor Create(AWorkbook: TsWorkbook); destructor Destroy; override; -// function AddFormat(AFormatCell: PCell): Integer; overload; function AddFormat(AFormatIndex: Integer; AFormatName: String; ANumFormat: TsNumberFormat; AFormatString: String): Integer; overload; function AddFormat(AFormatIndex: Integer; ANumFormat: TsNumberFormat; @@ -801,13 +768,11 @@ type procedure ConvertBeforeWriting(var AFormatString: String; var ANumFormat: TsNumberFormat); virtual; procedure Delete(AIndex: Integer); - function Find(ANumFormat: TsNumberFormat; AFormatString: String): Integer; virtual; overload; - function Find(AFormatString: String): Integer; overload; + function Find(ANumFormat: TsNumberFormat; AFormatString: String): Integer; virtual; + function FindByFormatStr(AFormatString: String): Integer; function FindByIndex(AFormatIndex: Integer): Integer; function FindByName(AFormatName: String): Integer; -// function FindFormatOf(AFormatCell: PCell): integer; virtual; function FormatStringForWriting(AIndex: Integer): String; virtual; -// function IndexOfFormatRecord(AFormatRecord: PsCellFormat): Integer; virtual; procedure Sort; {@@ Workbook from which the number formats are collected in the list. It is @@ -909,17 +874,11 @@ type TsCustomSpreadWriter = class(TsCustomSpreadReaderWriter) protected { Helper routines } -// procedure AddDefaultFormats(); virtual; procedure CheckLimitations; -// function FindFormattingInList(AFormat: PCell): Integer; -// procedure FixCellColors(ACell: PCell); function FixColor(AColor: TsColor): TsColor; virtual; procedure FixFormat(ACell: PCell); virtual; procedure GetSheetDimensions(AWorksheet: TsWorksheet; out AFirstRow, ALastRow, AFirstCol, ALastCol: Cardinal); virtual; -// procedure ListAllFormattingStylesCallback(ACell: PCell; AStream: TStream); -// procedure ListAllFormattingStyles; virtual; -// procedure ListAllNumFormatsCallback(ACell: PCell; AStream: TStream); procedure ListAllNumFormats; virtual; { Helpers for writing } procedure WriteCellCallback(ACell: PCell; AStream: TStream); @@ -946,14 +905,6 @@ type {@@ Abstract method for writing a number value to a cell. Must be overridden by descendent classes. } procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); virtual; abstract; - (* - public - {@@ An array with cells which are models for the used styles - In this array the Row property holds the index to the corresponding XF field } - FFormattingStyles: array of TCell; - {@@ Indicates which should be the next XF (style) index when filling the FFormattingStyles array } - NextXFIndex: Integer; - *) public constructor Create(AWorkbook: TsWorkbook); override; { General writing methods } @@ -1163,18 +1114,6 @@ begin Assert(AFromCell <> nil); Assert(AToCell <> nil); AToCell^.FormatIndex := AFromCell^.FormatIndex; - { - AToCell^.UsedFormattingFields := AFromCell^.UsedFormattingFields; - AToCell^.BackgroundColor := AFromCell^.BackgroundColor; - AToCell^.Border := AFromCell^.Border; - AToCell^.BorderStyles := AFromCell^.BorderStyles; - AToCell^.FontIndex := AFromCell^.FontIndex; - AToCell^.HorAlignment := AFromCell^.HorAlignment; - AToCell^.VertAlignment := AFromCell^.VertAlignment; - AToCell^.TextRotation := AFromCell^.TextRotation; - AToCell^.NumberFormat := AFromCell^.NumberFormat; - AToCell^.NumberFormatStr := AFromCell^.NumberFormatStr; - } end; {@@ ---------------------------------------------------------------------------- @@ -1197,46 +1136,6 @@ begin AToCell^.UTF8StringValue := AFromCell^.UTF8StringValue; AToCell^.FormulaValue := ''; // This is confirmed with Excel end; - (* -{@@ ---------------------------------------------------------------------------- - Checks whether two cells have same border attributes - - @param ACell1 Pointer to the first one of the two cells to be compared - @param ACell2 Pointer to the second one of the two cells to be compared --------------------------------------------------------------------------------} -function SameCellBorders(ACell1, ACell2: PCell): Boolean; - - function NoBorder(ACell: PCell): Boolean; - begin - Result := (ACell = nil) or - not (uffBorder in ACell^.UsedFormattingFields) or - (ACell^.Border = []); - end; - -var - nobrdr1, nobrdr2: Boolean; - cb: TsCellBorder; -begin - nobrdr1 := NoBorder(ACell1); - nobrdr2 := NoBorder(ACell2); - if (nobrdr1 and nobrdr2) then - Result := true - else - if (nobrdr1 and (not nobrdr2) ) or ( (not nobrdr1) and nobrdr2) then - Result := false - else begin - Result := false; - if ACell1^.Border <> ACell2^.Border then - exit; - for cb in TsCellBorder do begin - if ACell1^.BorderStyles[cb].LineStyle <> ACell2^.BorderStyles[cb].LineStyle then - exit; - if ACell1^.BorderStyles[cb].Color <> ACell2^.BorderStyles[cb].Color then - exit; - end; - Result := true; - end; -end; *) {@@ ---------------------------------------------------------------------------- Checks whether two format records have same border attributes @@ -2168,7 +2067,6 @@ begin end; end; - {@@ ---------------------------------------------------------------------------- Determines some number format attributes (decimal places, currency symbol) of a cell @@ -2294,7 +2192,7 @@ begin Result := Math.Min(Result, PCell(AVLNode.Data)^.Col); AVLNode := FCells.FindSuccessor(AVLNode); end; - // In addition, there may be column records defining the column width even + // In addition, there may be column records defining the column width even // without content for i:=0 to FCols.Count-1 do if FCols[i] <> nil then @@ -2847,23 +2745,6 @@ begin end; end; -(* -{@@ ---------------------------------------------------------------------------- - Reads the set of used formatting fields of a cell. - - Each cell contains a set of "used formatting fields". Formatting is applied - only if the corresponding element is contained in the set. - - @param ARow Row index of the considered cell - @param ACol Column index of the considered cell - @return Set of elements used in formatting the cell --------------------------------------------------------------------------------} -function TsWorksheet.ReadUsedFormatting(ARow, ACol: Cardinal): TsUsedFormattingFields; -begin - Result := ReadUsedFormatting(FindCell(ARow, ACol)); -end; -*) - {@@ ---------------------------------------------------------------------------- Reads the set of used formatting fields of a cell. @@ -2886,19 +2767,6 @@ begin Result := fmt^.UsedFormattingFields; end; -(* -{@@ ---------------------------------------------------------------------------- - Returns the background color of a cell as index into the workbook's color palette. - - @param ARow Row index of the cell - @param ACol Column index of the cell - @return Index of the cell background color into the workbook's color palette --------------------------------------------------------------------------------} -function TsWorksheet.ReadBackgroundColor(ARow, ACol: Cardinal): TsColor; -begin - Result := ReadBackgroundColor(FindCell(ARow, ACol)); -end; *) - {@@ ---------------------------------------------------------------------------- Returns the background color of a cell as index into the workbook's color palette. @@ -2951,17 +2819,7 @@ begin Result := fmt^.BorderStyles[ABorder]; end; end; - (* -{@@ ---------------------------------------------------------------------------- - Determines the font used by a specified cell. Returns the workbook's default - font if the cell does not exist. Considers the uffBold and uffFont formatting - fields of the cell --------------------------------------------------------------------------------} -function TsWorksheet.ReadCellFont(ARow, ACol: Cardinal): TsFont; -begin - Result := ReadCellFont(FindCell(ARow, ACol)); -end; - *) + {@@ ---------------------------------------------------------------------------- Determines the font used by a specified cell. Returns the workbook's default font if the cell does not exist. Considers the uffBold and uffFont formatting @@ -3141,7 +2999,6 @@ begin cell := FindCell(r, c); if cell <> nil then cell^.MergeBase := nil; -// cell^.MergedNeighbors := []; end; ChangedCell(ARow, ACol); end; @@ -3395,14 +3252,6 @@ end; procedure TsWorksheet.RemoveCallback(data, arg: pointer); begin Unused(arg); - (* - { The strings and dyn arrays must be reset to nil content manually, because - FreeMem only frees the record mem, without checking its content } - PCell(data).UTF8StringValue := ''; - PCell(data).NumberFormatStr := ''; - SetLength(PCell(data).RPNFormulaValue, 0); -// FreeMem(data); -*) Dispose(PCell(data)); end; @@ -3564,13 +3413,6 @@ begin if (ACell1^.ContentType = cctEmpty) and (ACell2^.ContentType = cctEmpty) then Result := 0 else - { - if (ACell1^.ContentType = cctEmpty) or (ACell2^.ContentType = cctEmpty) then - begin - Result := +1; // Empty cells go to the end - exit; // Avoid SortOrder to bring the empty cell back to the top - end else - } if (ACell1^.ContentType = cctUTF8String) and (ACell2^.ContentType = cctUTF8String) then begin if ssoCaseInsensitive in ASortOptions then @@ -3735,12 +3577,10 @@ end; -------------------------------------------------------------------------------} procedure TsWorksheet.SelectCell(ARow, ACol: Cardinal); begin - //if (ARow <> FActiveCellRow) or (ACol <> FActiveCellCol) then - //begin - FActiveCellRow := ARow; - FActiveCellCol := ACol; - if Assigned(FOnSelectCell) then FOnSelectCell(Self, ARow, ACol); - //end; + FActiveCellRow := ARow; + FActiveCellCol := ACol; + if Assigned(FOnSelectCell) then + FOnSelectCell(Self, ARow, ACol); end; {@@ ---------------------------------------------------------------------------- @@ -3987,19 +3827,6 @@ begin if ACell <> nil then begin ACell^.ContentType := cctNumber; ACell^.NumberValue := ANumber; - (* - // old - ACell^.NumberFormat := ANumFormat; - if ANumFormat <> nfGeneral then begin - Include(ACell^.UsedFormattingFields, uffNumberFormat); - ACell^.NumberFormatStr := BuildNumberFormatString(ACell^.NumberFormat, - Workbook.FormatSettings, ADecimals); - end else begin - Exclude(ACell^.UsedFormattingFields, uffNumberFormat); - ACell^.NumberFormatStr := ''; - end; - - // new *) fmt := Workbook.GetCellFormat(ACell^.FormatIndex); fmt.NumberFormat := ANumFormat; @@ -4071,18 +3898,7 @@ begin ACell^.ContentType := cctNumber; ACell^.NumberValue := ANumber; - (* - // old - ACell^.NumberFormat := ANumFormat; - if ANumFormat <> nfGeneral then begin - Include(ACell^.UsedFormattingFields, uffNumberFormat); - ACell^.NumberFormatStr := ANumFormatString; - end else begin - Exclude(ACell^.UsedFormattingFields, uffNumberFormat); - ACell^.NumberFormatStr := ''; - end; - // new*) fmt := Workbook.GetCellFormat(ACell^.FormatIndex); fmt.NumberFormat := ANumFormat; if ANumFormat <> nfGeneral then begin @@ -4381,13 +4197,7 @@ begin if (ACell <> nil) and IsCurrencyFormat(ANumFormat) then begin ACell^.ContentType := cctNumber; ACell^.NumberValue := AValue; - (* - // old - Include(ACell^.UsedFormattingFields, uffNumberFormat); - ACell^.NumberFormat := ANumFormat; - ACell^.NumberFormatStr := ANumFormatString; - // new *) fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex); Include(fmt.UsedFormattingFields, uffNumberFormat); fmt.NumberFormat := ANumFormat; @@ -4477,11 +4287,7 @@ begin parser.Free; end; end; - (* - Include(ACell^.UsedFormattingFields, uffNumberFormat); - ACell^.NumberFormat := ANumFormat; - ACell^.NumberFormatStr := ANumFormatStr; - *) + fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex); Include(fmt.UsedFormattingFields, uffNumberFormat); fmt.NumberFormat := ANumFormat; @@ -4570,24 +4376,7 @@ begin if not ((ANumFormat in [nfGeneral, nfCustom]) or IsDateTimeFormat(ANumFormat)) then raise Exception.Create('WriteDateTimeFormat can only be called with date/time formats.'); - (* - // old - ACell^.NumberFormat := ANumFormat; - if (ANumFormat <> nfGeneral) then - begin - Include(ACell^.UsedFormattingFields, uffNumberFormat); - if (ANumFormatString = '') then - ACell^.NumberFormatStr := BuildDateTimeFormatString(ANumFormat, Workbook.FormatSettings) - else - ACell^.NumberFormatStr := ANumFormatString; - end - else - begin - Exclude(ACell^.UsedFormattingFields, uffNumberFormat); - ACell^.NumberFormatStr := ''; - end; - // new *) fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex); fmt.NumberFormat := ANumFormat; if (ANumFormat <> nfGeneral) then @@ -4639,7 +4428,6 @@ begin if (ACell = nil) then exit; - // new fmt := FWorkbook.GetCellFormat(ACell^.FormatIndex); if (uffNumberFormat in fmt.UsedFormattingFields) or (fmt.NumberFormat = nfGeneral) then @@ -4657,24 +4445,6 @@ begin ACell^.FormatIndex := Workbook.AddCellFormat(fmt); ChangedCell(ACell^.Row, ACell^.Col); end; - (* - // old --> remove - if (uffNumberFormat in ACell^.UsedFormattingFields) or (ACell^.NumberFormat = nfGeneral) - then - WriteNumberFormat(ACell, nfFixed, ADecimals) - else - if (ACell^.NumberFormat <> nfCustom) then - begin - parser := TsNumFormatParser.Create(Workbook, ACell^.NumberFormatStr); - try - parser.Decimals := ADecimals; - ACell^.NumberFormatStr := parser.FormatString[nfdDefault]; - finally - parser.Free; - end; - ChangedCell(ACell^.Row, ACell^.Col); - end; - *) end; {@@ ---------------------------------------------------------------------------- @@ -4810,26 +4580,7 @@ var begin if ACell = nil then exit; - (* - // old - ACell^.NumberFormat := ANumFormat; - if ANumFormat <> nfGeneral then begin - Include(ACell^.UsedFormattingFields, uffNumberFormat); - if ANumFormat in [nfCurrency, nfCurrencyRed] then - begin - ACell^.NumberFormatStr := BuildCurrencyFormatString(nfdDefault, ANumFormat, - Workbook.FormatSettings, ADecimals, - APosCurrFormat, ANegCurrFormat, ACurrencySymbol); - RegisterCurrency(ACurrencySymbol); - end else - ACell^.NumberFormatStr := BuildNumberFormatString(ANumFormat, - Workbook.FormatSettings, ADecimals); - end else begin - Exclude(ACell^.UsedFormattingFields, uffNumberFormat); - ACell^.NumberFormatStr := ''; - end; - // new - *) + fmt := Workbook.GetCellFormat(ACell^.FormatIndex); fmt.NumberFormat := ANumFormat; if ANumFormat <> nfGeneral then begin @@ -4888,21 +4639,7 @@ var begin if ACell = nil then exit; - (* - // old - ACell^.NumberFormat := ANumFormat; - if ANumFormat <> nfGeneral then begin - Include(ACell^.UsedFormattingFields, uffNumberFormat); - if (ANumFormatString = '') then - ACell^.NumberFormatStr := BuildNumberFormatString(ANumFormat, Workbook.FormatSettings) - else - ACell^.NumberFormatStr := ANumFormatString; - end else begin - Exclude(ACell^.UsedFormattingFields, uffNumberFormat); - ACell^.NumberFormatStr := ''; - end; - // new - *) + fmt := Workbook.GetCellFormat(ACell^.FormatIndex); fmt.NumberFormat := ANumFormat; if ANumFormat <> nfGeneral then begin @@ -5061,12 +4798,7 @@ begin Result := FWorkbook.FindFont(AFontName, AFontSize, AFontStyle, AFontColor); if Result = -1 then result := FWorkbook.AddFont(AFontName, AFontSize, AFontStyle, AFontColor); - (* - // old - Include(ACell^.UsedFormattingFields, uffFont); - ACell^.FontIndex := Result; - // new - *) + fmt := Workbook.GetCellFormat(ACell^.FormatIndex); Include(fmt.UsedFormattingFields, uffFont); fmt.FontIndex := Result; @@ -5107,13 +4839,7 @@ begin if (AFontIndex < 0) or (AFontIndex >= Workbook.GetFontCount) or (AFontIndex = 4) then // note: Font index 4 is not defined in BIFF raise Exception.Create(rsInvalidFontIndex); - (* - // old - Include(ACell^.UsedFormattingFields, uffFont); - ACell^.FontIndex := AFontIndex; - // new - *) fmt := Workbook.GetCellFormat(ACell^.FormatIndex); Include(fmt.UsedFormattingFields, uffFont); fmt.FontIndex := AFontIndex; @@ -5308,16 +5034,12 @@ var begin if ACell = nil then exit; - (* - // old - Include(ACell^.UsedFormattingFields, uffTextRotation); - ACell^.TextRotation := ARotation; - // new - *) + fmt := Workbook.GetCellFormat(ACell^.FormatIndex); Include(fmt.UsedFormattingFields, uffTextRotation); fmt.TextRotation := ARotation; ACell^.FormatIndex := Workbook.AddCellFormat(fmt); + ChangedFont(ACell^.Row, ACell^.Col); end; @@ -5393,7 +5115,6 @@ var fmt: TsCellFormat; begin if ACell <> nil then begin - // new fmt := Workbook.GetCellFormat(ACell^.FormatIndex); if AColor = scTransparent then Exclude(fmt.UsedFormattingFields, uffBackgroundColor) @@ -5403,16 +5124,6 @@ begin fmt.BackgroundColor := AColor; end; ACell^.FormatIndex := Workbook.AddCellFormat(fmt); - (* - // old - if AColor = scTransparent then - Exclude(ACell^.UsedFormattingFields, uffBackgroundColor) - else - begin - Include(ACell^.UsedFormattingFields, uffBackgroundColor); - ACell^.BackgroundColor := AColor; - end; - *) ChangedCell(ACell^.Row, ACell^.Col); end; end; @@ -5452,11 +5163,6 @@ var fmt: TsCellFormat; begin if ACell <> nil then begin - (* - // old - ACell^.BorderStyles[ABorder].Color := AColor; - // new - *) fmt := Workbook.GetCellFormat(ACell^.FormatIndex); fmt.BorderStyles[ABorder].Color := AColor; ACell^.FormatIndex := Workbook.AddCellFormat(fmt); @@ -5501,11 +5207,6 @@ var fmt: TsCellFormat; begin if ACell <> nil then begin - (* - // old - ACell^.BorderStyles[ABorder].LineStyle := ALineStyle; - // new - *) fmt := Workbook.GetCellFormat(ACell^.FormatIndex); fmt.BorderStyles[ABorder].LineStyle := ALineStyle; ACell^.FormatIndex := Workbook.AddCellFormat(fmt); @@ -5546,15 +5247,6 @@ var fmt: TsCellFormat; begin if ACell <> nil then begin - (* - // old - if ABorders = [] then - Exclude(ACell^.UsedFormattingFields, uffBorder) - else - Include(ACell^.UsedFormattingFields, uffBorder); - ACell^.Border := ABorders; - // new - *) fmt := Workbook.GetCellFormat(ACell^.FormatIndex); if ABorders = [] then Exclude(fmt.UsedFormattingFields, uffBorder) @@ -5599,11 +5291,6 @@ var fmt: TsCellFormat; begin if ACell <> nil then begin - (* - // old - ACell^.BorderStyles[ABorder] := AStyle; - // new - *) fmt := Workbook.GetCellFormat(ACell^.FormatIndex); fmt.BorderStyles[ABorder] := AStyle; ACell^.FormatIndex := Workbook.AddCellFormat(fmt); @@ -5648,12 +5335,6 @@ var fmt: TsCellFormat; begin if ACell <> nil then begin - (* - // old - ACell^.BorderStyles[ABorder].LineStyle := ALineStyle; - ACell^.BorderStyles[ABorder].Color := AColor; - // new - *) fmt := Workbook.GetCellFormat(ACell^.FormatIndex); fmt.BorderStyles[ABorder].LineStyle := ALineStyle; fmt.BorderStyles[ABorder].Color := AColor; @@ -5697,11 +5378,6 @@ var fmt: TsCellFormat; begin if Assigned(ACell) then begin - (* - // old - for b in TsCellBorder do ACell^.BorderStyles[b] := AStyles[b]; - // new - *) fmt := Workbook.GetCellFormat(ACell^.FormatIndex); for b in TsCellBorder do fmt.BorderStyles[b] := AStyles[b]; ACell^.FormatIndex := Workbook.AddCellFormat(fmt); @@ -5709,6 +5385,23 @@ begin end; end; +{@@ ---------------------------------------------------------------------------- + Assigns a complete cell format record to a cell + + @param ACell Pointer to the cell to be modified + @param ACellFormat Cell format record to be used by the cell + + @see TsCellFormat +-------------------------------------------------------------------------------} +procedure TsWorksheet.WriteCellFormat(ACell: PCell; + const ACellFormat: TsCellFormat); +begin + if Assigned(ACell) then begin + ACell^.FormatIndex := Workbook.AddCellFormat(ACellFormat); + ChangedCell(ACell^.Row, ACell^.Col); + end; +end; + {@@ ---------------------------------------------------------------------------- Defines the horizontal alignment of text in a cell. @@ -5741,15 +5434,6 @@ var begin if ACell = nil then exit; - (* - // old - if AValue = haDefault then - Exclude(ACell^.UsedFormattingFields, uffHorAlign) - else - Include(ACell^.UsedFormattingFields, uffHorAlign); - ACell^.HorAlignment := AValue; - // new - *) fmt := Workbook.GetCellFormat(ACell^.FormatIndex); if AValue = haDefault then Exclude(fmt.UsedFormattingFields, uffHorAlign) @@ -5791,15 +5475,6 @@ var begin if ACell = nil then exit; - (* - // old - if AValue = vaDefault then - Exclude(ACell^.UsedFormattingFields, uffVertAlign) - else - Include(ACell^.UsedFormattingFields, uffVertAlign); - ACell^.VertAlignment := AValue; - // new - *) fmt := Workbook.GetCellFormat(ACell^.FormatIndex); if AValue = vaDefault then Exclude(fmt.UsedFormattingFields, uffVertAlign) @@ -5836,14 +5511,6 @@ var begin if ACell = nil then exit; - (* - // old - if AValue then - Include(ACell^.UsedFormattingFields, uffWordwrap) - else - Exclude(ACell^.UsedFormattingFields, uffWordwrap); - // new - *) fmt := Workbook.GetCellFormat(ACell^.FormatIndex); if AValue then Include(fmt.UsedFormattingFields, uffWordwrap) @@ -7379,29 +7046,6 @@ begin Result := true; end; - (* -{@@ - Sets the selected flag for the sheet with the given index. - Excel requires one sheet to be selected, otherwise strange things happen when - the file is loaded into Excel (cannot print, hanging instance of Excel - see - bug 0026386). - - @param AIndex Index of the worksheet to be selected -} -procedure TsWorkbook.SelectWorksheet(AIndex: Integer); -var - i: Integer; - sheet: TsWorksheet; -begin - for i:=0 to FWorksheets.Count-1 do begin - sheet := TsWorksheet(FWorksheets.Items[i]); - if i = AIndex then - sheet.Options := sheet.Options + [soSelected] - else - sheet.Options := sheet.Options - [soSelected]; - end; -end; - *) { String-to-cell/range conversion } @@ -7582,6 +7226,7 @@ begin Result := FCellFormatList.Items[AIndex]; end; + { Font handling } {@@ ---------------------------------------------------------------------------- @@ -8212,6 +7857,7 @@ begin Result := false; end; + {******************************************************************************* * TsCustomNumFormatList * *******************************************************************************} @@ -8315,29 +7961,7 @@ function TsCustomNumFormatList.AddFormat(ANumFormat: TsNumberFormat; begin Result := AddFormat('', ANumFormat, AFormatString); end; - (* -{@@ ---------------------------------------------------------------------------- - Adds the number format used by a given cell to the list. - @param AFormatCell Pointer to a cell providing the format to be stored - in the list --------------------------------------------------------------------------------} -function TsCustomNumFormatList.AddFormat(AFormatCell: PCell): Integer; -begin - if AFormatCell = nil then - raise Exception.Create('TsCustomNumFormat.Add: No nil pointers please'); - - if Count = 0 then - raise Exception.Create('TsCustomNumFormatList: Error in program logics: You must provide built-in formats first.'); - - Result := AddFormat(FNextNumFormatIndex, - AFormatCell^.NumberFormatStr, - AFormatCell^.NumberFormat - ); - - inc(FNextNumFormatIndex); -end; - *) {@@ ---------------------------------------------------------------------------- Adds the builtin format items to the list. The formats must be specified in a way that is compatible with fpc syntax. @@ -8503,7 +8127,7 @@ end; @param AFormatString string of formatting codes to be searched in the list. @return Index of the format item in the format list, or -1 if not found. -------------------------------------------------------------------------------} -function TsCustomNumFormatList.Find(AFormatString: String): integer; +function TsCustomNumFormatList.FindByFormatStr(AFormatString: String): integer; var item: TsNumFormatData; begin @@ -8561,22 +8185,6 @@ begin end; Result := -1; end; - (* -{@@ ---------------------------------------------------------------------------- - Determines whether the format attributed to the given cell is already - contained in the list and returns its list index, or -1 if not found - - @param AFormatCell Pointer to a spreadsheet cell having the number format - that is looked for. - @return Index of the format item in the list, or -1 if not found. --------------------------------------------------------------------------------} -function TsCustomNumFormatList.FindFormatOf(AFormatCell: PCell): integer; -begin - if AFormatCell = nil then - Result := -1 - else - Result := Find(AFormatCell^.NumberFormat, AFormatCell^.NumberFormatStr); -end; *) {@@ ---------------------------------------------------------------------------- Determines the format string to be written into the spreadsheet file. Calls @@ -8605,23 +8213,6 @@ function TsCustomNumFormatList.GetItem(AIndex: Integer): TsNumFormatData; begin Result := TsNumFormatData(inherited Items[AIndex]); end; - (* -{@@ ---------------------------------------------------------------------------- - Determines whether the format specified by the given format record is already - contained in the list and returns its list index, or -1 if not found - - @param AFormatRecord Pointer to a format record item having the number format - that is looked for. - @return Index of the format item in the list, or -1 if not found. --------------------------------------------------------------------------------} -function TsCustomNumFormatList.IndexOfFormatRecord(AFormatRecord: PsCellFormat): integer; -begin - if AFormatRecord = nil then - Result := -1 - else - Result := Find(AFormatRecord^.NumberFormat, AFormatRecord^.NumberFormatStr); -end; - *) {@@ ---------------------------------------------------------------------------- Deletes the memory occupied by the formatting data, but keeps an empty item in @@ -8887,104 +8478,6 @@ begin inherited Create(AWorkbook); end; - (* -{@@ ---------------------------------------------------------------------------- - Each descendent should define its own default formats, if any. - Always add the normal, unformatted style first to speed things up. - - To be overridden by descendants. --------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.AddDefaultFormats(); -begin - SetLength(FFormattingStyles, 0); - NextXFIndex := 0; -end; - -{@@ ---------------------------------------------------------------------------- - Checks if the formatting style of a cell is in the list of manually added - FFormattingStyles and returns its index, or -1 if it isn't - - @param AFormat Cell containing the formatting styles which are seeked in the - FFormattingStyles array. --------------------------------------------------------------------------------} -function TsCustomSpreadWriter.FindFormattingInList(AFormat: PCell): Integer; -var - i, n: Integer; - b: TsCellBorder; - equ: Boolean; -begin - Result := -1; - - n := Length(FFormattingStyles); - for i := n - 1 downto 0 do - begin - if (FFormattingStyles[i].UsedFormattingFields <> AFormat^.UsedFormattingFields) then Continue; - - if uffHorAlign in AFormat^.UsedFormattingFields then - if (FFormattingStyles[i].HorAlignment <> AFormat^.HorAlignment) then Continue; - - if uffVertAlign in AFormat^.UsedFormattingFields then - if (FFormattingStyles[i].VertAlignment <> AFormat^.VertAlignment) then Continue; - - if uffTextRotation in AFormat^.UsedFormattingFields then - if (FFormattingStyles[i].TextRotation <> AFormat^.TextRotation) then Continue; - - if uffBorder in AFormat^.UsedFormattingFields then begin - if (FFormattingStyles[i].Border <> AFormat^.Border) then Continue; - equ := true; - for b in TsCellBorder do - begin - if FFormattingStyles[i].BorderStyles[b].LineStyle <> AFormat^.BorderStyles[b].LineStyle - then begin - equ := false; - Break; - end; - if FFormattingStyles[i].BorderStyles[b].Color <> FixColor(AFormat^.BorderStyles[b].Color) - then begin - equ := false; - Break; - end; - end; - if not equ then Continue; - end; - - if uffBackgroundColor in AFormat^.UsedFormattingFields then - if (FFormattingStyles[i].BackgroundColor <> FixColor(AFormat^.BackgroundColor)) then Continue; - - if uffNumberFormat in AFormat^.UsedFormattingFields then - begin - if (FFormattingStyles[i].NumberFormat <> AFormat^.NumberFormat) then Continue; - if (FFormattingStyles[i].NumberFormatStr <> AFormat^.NumberFormatStr) then Continue; - 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; -end; - -{@@ ---------------------------------------------------------------------------- - Makes sure that all colors used in a given cell belong to the workbook's - color palette. --------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.FixCellColors(ACell: PCell); -var - b: TsCellBorder; -begin - if ACell = nil then - exit; - - ACell^.BackgroundColor := FixColor(ACell^.BackgroundColor); - - for b in TsCellBorders do - ACell^.BorderStyles[b].Color := FixColor(ACell^.BorderStyles[b].Color); - - // Font color is not corrected here because this would affect other writers. - // Font color is handled immediately before writing. -end; - *) {@@ ---------------------------------------------------------------------------- If a color index is greater then the maximum palette color count this color is replaced by the closest palette color. @@ -9086,82 +8579,7 @@ begin break; end; end; - (* -{@@ ---------------------------------------------------------------------------- - Callback function for collecting all formatting styles found in the worksheet. - @param ACell Pointer to the worksheet cell being tested whether its format - already has been found in the array FFormattingStyles. - @param AStream Stream to which the workbook is written --------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.ListAllFormattingStylesCallback(ACell: PCell; - AStream: TStream); -var - Len: Integer; -begin - Unused(AStream); - - FixFormat(ACell); - - if ACell^.UsedFormattingFields = [] then Exit; - if FindFormattingInList(ACell) <> -1 then Exit; - - Len := Length(FFormattingStyles); - SetLength(FFormattingStyles, Len+1); - FFormattingStyles[Len] := ACell^; - - // Make sure that all colors of the formatting style cell are used in the workbook's - // palette. - FixCellColors(@FFormattingStyles[Len]); - - // 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. - FFormattingStyles[Len].Row := NextXFIndex; - Inc(NextXFIndex); -end; - -{@@ ---------------------------------------------------------------------------- - This method collects all formatting styles found in the worksheet and - stores unique prototypes in the array FFormattingStyles. --------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.ListAllFormattingStyles; -var - i: Integer; -begin - SetLength(FFormattingStyles, 0); - - // Add default styles which are required to be there by the destination file - AddDefaultFormats(); - - // Iterate through all cells and collect the individual styles - for i := 0 to Workbook.GetWorksheetCount - 1 do - IterateThroughCells(nil, Workbook.GetWorksheetByIndex(i).Cells, ListAllFormattingStylesCallback); -end; - -{@@ ---------------------------------------------------------------------------- - Adds the number format of the given cell to the NumFormatList, but only if - it does not yet exist in the list. --------------------------------------------------------------------------------} -procedure TsCustomSpreadWriter.ListAllNumFormatsCallback(ACell: PCell; AStream: TStream); -var - fmt: string; - nf: TsNumberFormat; -begin - Unused(AStream); - - if ACell^.NumberFormat = nfGeneral then - exit; - - // The builtin format list is in fpc dialect. - fmt := ACell^.NumberFormatStr; - nf := ACell^.NumberFormat; - - // Seek the format string in the current number format list. - // If not found add the format to the list. - if FNumFormatList.Find(nf, fmt) = -1 then - FNumFormatList.AddFormat(fmt, nf); -end; -*) {@@ ---------------------------------------------------------------------------- Iterates through all cells and collects the number formats in FNumFormatList (without duplicates). @@ -9181,17 +8599,6 @@ begin end; end; - -(* -procedure TsCustomSpreadWriter.ListAllNumFormats; -var - i: Integer; -begin - for i:=0 to Workbook.GetWorksheetCount-1 do - IterateThroughCells(nil, Workbook.GetWorksheetByIndex(i).Cells, ListAllNumFormatsCallback); - NumFormatList.Sort; -end; -*) {@@ ---------------------------------------------------------------------------- Helper function for the spreadsheet writers. Writes the cell value to the stream. Calls the WriteNumber method of the worksheet for writing a number, @@ -9352,31 +8759,3 @@ finalization end. -{ Strategy for handling of number formats: - -Problem: -For number formats, fpspreadsheet uses a syntax which is slightly different from -the syntax that Excel uses in the xls files. Moreover, the file syntax can be -different from file type to file type (biff2, for example, allows only a few -predefined formats, while the number of allowed formats is unlimited (?) for -biff8. - -Number format handling in fpspreadsheet is implemented with the following -concept in mind: - -- Formats written into TsWorksheet cells always follow the fpspreadsheet syntax. - -- For writing, the writer creates a TsNumFormatList which stores all formats - in file syntax. - - The built-in formats of the file types are coded in the fpc syntax. - - The method "ConvertBeforeWriting" converts the cell formats from the - fpspreadsheet to the file syntax. - -- For reading, the reader creates another TsNumFormatList. - - The built-in formats of the file types are coded again in fpc syntax. - - After reading, the formats are converted to fpc syntax by means of - "ConvertAfterReading". - -- Format conversion is done internally by means of the TsNumFormatParser. -} - diff --git a/components/fpspreadsheet/tests/formattests.pas b/components/fpspreadsheet/tests/formattests.pas index 5a962da67..0dc0d7ce6 100644 --- a/components/fpspreadsheet/tests/formattests.pas +++ b/components/fpspreadsheet/tests/formattests.pas @@ -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 diff --git a/components/fpspreadsheet/tests/manualtests.pas b/components/fpspreadsheet/tests/manualtests.pas index 0cc7dd64d..83a1104c6 100644 --- a/components/fpspreadsheet/tests/manualtests.pas +++ b/components/fpspreadsheet/tests/manualtests.pas @@ -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; diff --git a/components/fpspreadsheet/xlsbiff2.pas b/components/fpspreadsheet/xlsbiff2.pas index c630f303b..881976ea0 100755 --- a/components/fpspreadsheet/xlsbiff2.pas +++ b/components/fpspreadsheet/xlsbiff2.pas @@ -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 diff --git a/components/fpspreadsheet/xlsbiff5.pas b/components/fpspreadsheet/xlsbiff5.pas index 287dc44a0..f21bcc34e 100755 --- a/components/fpspreadsheet/xlsbiff5.pas +++ b/components/fpspreadsheet/xlsbiff5.pas @@ -105,10 +105,6 @@ type WorkBookEncoding: TsEncoding; protected { Record writing methods } - { - procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; - ACell: PCell); override; - } procedure WriteBOF(AStream: TStream; ADataType: Word); function WriteBoundsheet(AStream: TStream; ASheetName: string): Int64; procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet); @@ -123,14 +119,6 @@ type procedure WriteStringRecord(AStream: TStream; AString: String); override; procedure WriteStyle(AStream: TStream); procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet); - { - procedure WriteXF(AStream: TStream; AFontIndex: Word; - AFormatIndex: Word; AXF_TYPE_PROT, ATextRotation: Byte; ABorders: TsCellBorders; - const ABorderStyles: TsCellBorderStyles; AHorAlignment: TsHorAlignment = haDefault; - AVertAlignment: TsVertAlignment = vaDefault; AWordWrap: Boolean = false; - AddBackground: Boolean = false; ABackgroundColor: TsColor = scSilver); - procedure WriteXFFieldsForFormattingStyles(AStream: TStream); - } procedure WriteXF(AStream: TStream; AFormatRecord: PsCellFormat; XFType_Prot: Byte = 0); override; public @@ -340,914 +328,6 @@ type end; -{ TsSpreadBIFF5Writer } - -{******************************************************************* -* TsSpreadBIFF5Writer.WriteToFile () -* -* DESCRIPTION: Writes an Excel BIFF5 file to the disc -* -* The BIFF 5 writer overrides this method because -* BIFF 5 is written as an OLE document, and our -* current OLE document writing method involves: -* -* 1 - Writing the BIFF data to a memory stream -* -* 2 - Write the memory stream data to disk using -* COM functions -* -*******************************************************************} -procedure TsSpreadBIFF5Writer.WriteToFile(const AFileName: string; - const AOverwriteExisting: Boolean); -var - Stream: TStream; - OutputStorage: TOLEStorage; - OLEDocument: TOLEDocument; -begin - if (boBufStream in Workbook.Options) then begin - Stream := TBufStream.Create - end else - Stream := TMemoryStream.Create; - - OutputStorage := TOLEStorage.Create; - try - WriteToStream(Stream); - - // Only one stream is necessary for any number of worksheets - OLEDocument.Stream := Stream; - - OutputStorage.WriteOLEFile(AFileName, OLEDocument, AOverwriteExisting); - finally - Stream.Free; - OutputStorage.Free; - end; -end; - -{******************************************************************* -* TsSpreadBIFF5Writer.WriteToStream () -* -* DESCRIPTION: Writes an Excel BIFF5 record structure -* -* Be careful as this method doesn't write the OLE -* part of the document, just the BIFF records -* -*******************************************************************} -procedure TsSpreadBIFF5Writer.WriteToStream(AStream: TStream); -var - CurrentPos: Int64; - Boundsheets: array of Int64; - i, len: Integer; - pane: Byte; -begin - { Store some data about the workbook that other routines need } - WorkBookEncoding := Workbook.Encoding; - - { Write workbook globals } - - WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS); - - WriteCodepage(AStream, WorkBookEncoding); - WriteWindow1(AStream); - WriteFonts(AStream); - WriteNumFormats(AStream); - WritePalette(AStream); - WriteXFRecords(AStream); - WriteStyle(AStream); - - // A BOUNDSHEET for each worksheet - SetLength(Boundsheets, 0); - for i := 0 to Workbook.GetWorksheetCount - 1 do - begin - len := Length(Boundsheets); - SetLength(Boundsheets, len + 1); - Boundsheets[len] := WriteBoundsheet(AStream, Workbook.GetWorksheetByIndex(i).Name); - end; - - WriteEOF(AStream); - - { Write each worksheet } - - for i := 0 to Workbook.GetWorksheetCount - 1 do - begin - FWorksheet := Workbook.GetWorksheetByIndex(i); - - { First goes back and writes the position of the BOF of the - sheet on the respective BOUNDSHEET record } - CurrentPos := AStream.Position; - AStream.Position := Boundsheets[i]; - AStream.WriteDWord(CurrentPos); - AStream.Position := CurrentPos; - - WriteBOF(AStream, INT_BOF_SHEET); - - WriteIndex(AStream); -// WritePageSetup(AStream); - WriteColInfos(AStream, FWorksheet); - WriteDimensions(AStream, FWorksheet); - WriteWindow2(AStream, FWorksheet); - WritePane(AStream, FWorksheet, true, pane); // true for "is BIFF5 or BIFF8" - WriteSelection(AStream, FWorksheet, pane); - //WriteRows(AStream, sheet); - - if (boVirtualMode in Workbook.Options) then - WriteVirtualCells(AStream) - else begin - WriteRows(AStream, FWorksheet); - WriteCellsToStream(AStream, FWorksheet.Cells); - end; - - WriteEOF(AStream); - end; - - { Cleanup } - - SetLength(Boundsheets, 0); -end; - -{******************************************************************* -* TsSpreadBIFF5Writer.WriteBOF () -* -* DESCRIPTION: Writes an Excel 5 BOF record -* -* This must be the first record on an Excel 5 stream -* -*******************************************************************} -procedure TsSpreadBIFF5Writer.WriteBOF(AStream: TStream; ADataType: Word); -begin - { BIFF Record header } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_BOF)); - AStream.WriteWord(WordToLE(8)); - - { BIFF version. Should only be used if this BOF is for the workbook globals } - if ADataType = INT_BOF_WORKBOOK_GLOBALS then - AStream.WriteWord(WordToLE(INT_BOF_BIFF5_VER)) - else AStream.WriteWord(0); - - { Data type } - AStream.WriteWord(WordToLE(ADataType)); - - { Build identifier, must not be 0 } - AStream.WriteWord(WordToLE(INT_BOF_BUILD_ID)); - - { Build year, must not be 0 } - AStream.WriteWord(WordToLE(INT_BOF_BUILD_YEAR)); -end; - -{******************************************************************* -* TsSpreadBIFF5Writer.WriteBoundsheet () -* -* DESCRIPTION: Writes an Excel 5 BOUNDSHEET record -* -* Always located on the workbook globals substream. -* -* One BOUNDSHEET is written for each worksheet. -* -* RETURNS: The stream position where the absolute stream position -* of the BOF of this sheet should be written (4 bytes size). -* -*******************************************************************} -function TsSpreadBIFF5Writer.WriteBoundsheet(AStream: TStream; ASheetName: string): Int64; -var - Len: Byte; - LatinSheetName: string; -begin - LatinSheetName := UTF8ToISO_8859_1(ASheetName); - Len := Length(LatinSheetName); - - { BIFF Record header } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_BOUNDSHEET)); - AStream.WriteWord(WordToLE(6 + 1 + Len)); - - { Absolute stream position of the BOF record of the sheet represented - by this record } - Result := AStream.Position; - AStream.WriteDWord(WordToLE(0)); - - { Visibility } - AStream.WriteByte(0); - - { Sheet type } - AStream.WriteByte(0); - - { Sheet name: Byte string, 8-bit length } - AStream.WriteByte(Len); - AStream.WriteBuffer(LatinSheetName[1], Len); -end; - -{ - Writes an Excel 5 DIMENSIONS record - - nm = (rl - rf - 1) / 32 + 1 (using integer division) - - Excel, OpenOffice and FPSpreadsheet ignore the dimensions written in this record, - but some other applications really use them, so they need to be correct. - - See bug 18886: excel5 files are truncated when imported -} -procedure TsSpreadBIFF5Writer.WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet); -var - rec: TBIFF5_DimensionsRecord; - firstCol, lastCol, firstRow, lastRow: Cardinal; -begin - { Determine sheet size } - GetSheetDimensions(AWorksheet, firstRow, lastRow, firstCol, lastCol); - - { Setup BIFF record } - rec.RecordID := WordToLE(INT_EXCEL_ID_DIMENSIONS); - rec.RecordSize := WordToLE(10); - rec.FirstRow := WordToLE(firstRow); - if lastRow < $FFFF then // avoid WORD overflow - rec.LastRowPlus1 := WordToLE(lastRow + 1) - else - rec.LastRowPlus1 := $FFFF; - rec.FirstCol := WordToLe(firstCol); - rec.LastColPlus1 := WordToLE(lastCol+1); - rec.NotUsed := 0; - - { Write BIFF record } - AStream.WriteBuffer(rec, SizeOf(rec)); -end; - -{******************************************************************* -* TsSpreadBIFF5Writer.WriteEOF () -* -* DESCRIPTION: Writes an Excel 5 EOF record -* -* This must be the last record on an Excel 5 stream -* -*******************************************************************} -procedure TsSpreadBIFF5Writer.WriteEOF(AStream: TStream); -begin - { BIFF Record header } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_EOF)); - AStream.WriteWord($0000); -end; - -{******************************************************************* -* TsSpreadBIFF5Writer.WriteFont () -* -* DESCRIPTION: Writes an Excel 5 FONT record -* -* The font data is passed in an instance of TFPCustomFont -* -*******************************************************************} -procedure TsSpreadBIFF5Writer.WriteFont(AStream: TStream; AFont: TsFont); -var - Len: Byte; - optn: Word; -begin - 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.'); - - Len := Length(AFont.FontName); - - { BIFF Record header } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_FONT)); - AStream.WriteWord(WordToLE(14 + 1 + Len)); - - { Height of the font in twips = 1/20 of a point } - AStream.WriteWord(WordToLE(round(AFont.Size*20))); - - { Option flags } - 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(ord(FixColor(AFont.Color)))); - - { Font weight } - 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(0); - - { Underline type } - if fssUnderline in AFont.Style then - AStream.WriteByte(1) - else - AStream.WriteByte(0); - - { Font family } - AStream.WriteByte(0); - - { Character set } - AStream.WriteByte(0); - - { Not used } - AStream.WriteByte(0); - - { Font name: Byte string, 8-bit length } - AStream.WriteByte(Len); - AStream.WriteBuffer(AFont.FontName[1], Len); -end; - -{******************************************************************* -* TsSpreadBIFF5Writer.WriteFonts () -* -* DESCRIPTION: Writes the Excel 5 FONT records neede for the -* used fonts in the workbook. -* -*******************************************************************} -procedure TsSpreadBiff5Writer.WriteFonts(AStream: TStream); -var - i: Integer; -begin - for i:=0 to Workbook.GetFontCount-1 do - WriteFont(AStream, Workbook.GetFont(i)); -end; - -{******************************************************************* -* TsSpreadBIFF5Writer.WriteFormat -* -* DESCRIPTION: Writes an Excel 5 FORMAT record -* -*******************************************************************} -procedure TsSpreadBiff5Writer.WriteNumFormat(AStream: TStream; - ANumFormatData: TsNumFormatData; AListIndex: Integer); -type - TNumFormatRecord = packed record - RecordID: Word; - RecordSize: Word; - FormatIndex: Word; - FormatStringLen: Byte; - end; -var - len: Integer; - s: ansistring; - rec: TNumFormatRecord; - buf: array of byte; -begin - if (ANumFormatData = nil) or (ANumFormatData.FormatString = '') then - exit; - - s := UTF8ToAnsi(NumFormatList.FormatStringForWriting(AListIndex)); - len := Length(s); - - { BIFF record header } - rec.RecordID := WordToLE(INT_EXCEL_ID_FORMAT); - rec.RecordSize := WordToLE(2 + 1 + len * SizeOf(AnsiChar)); - - { Format index } - rec.FormatIndex := WordToLE(ANumFormatData.Index); - - { Format string } - { Length in 1 byte } - rec.FormatStringLen := len; - { Copy the format string characters into a buffer immediately after rec } - SetLength(buf, SizeOf(rec) + SizeOf(ansiChar)*len); - Move(rec, buf[0], SizeOf(rec)); - Move(s[1], buf[SizeOf(rec)], len*SizeOf(ansiChar)); - - { Write out } - AStream.WriteBuffer(buf[0], SizeOf(Rec) + SizeOf(ansiChar)*len); - - { Clean up } - SetLength(buf, 0); -end; - -{******************************************************************* -* TsSpreadBIFF5Writer.WriteIndex () -* -* DESCRIPTION: Writes an Excel 5 INDEX record -* -* nm = (rl - rf - 1) / 32 + 1 (using integer division) -* -*******************************************************************} -procedure TsSpreadBIFF5Writer.WriteIndex(AStream: TStream); -begin - { BIFF Record header } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_INDEX)); - AStream.WriteWord(WordToLE(12)); - - { Not used } - AStream.WriteDWord(0); - - { Index to first used row, rf, 0 based } - AStream.WriteWord(0); - - { Index to first row of unused tail of sheet, rl, last used row + 1, 0 based } - AStream.WriteWord(33); - - { Absolute stream position of the DEFCOLWIDTH record of the current sheet. - If it doesn't exist, the offset points to where it would occur. } - AStream.WriteDWord($00); - - { Array of nm absolute stream positions of the DBCELL record of each Row Block } - - { OBS: It seams to be no problem just ignoring this part of the record } -end; - -{******************************************************************* -* TsSpreadBIFF5Writer.WriteLabel () -* -* DESCRIPTION: Writes an Excel 5 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. -* -*******************************************************************} -procedure TsSpreadBIFF5Writer.WriteLabel(AStream: TStream; const ARow, - ACol: Cardinal; const AValue: string; ACell: PCell); -const - MAXBYTES = 255; //limit for this format -var - L: Word; - AnsiValue: ansistring; - rec: TBIFF5_LabelRecord; - buf: array of byte; -begin - if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then - exit; - - case WorkBookEncoding of - seLatin2: AnsiValue := UTF8ToCP1250(AValue); - seCyrillic: AnsiValue := UTF8ToCP1251(AValue); - seGreek: AnsiValue := UTF8ToCP1253(AValue); - seTurkish: AnsiValue := UTF8ToCP1254(AValue); - seHebrew: AnsiValue := UTF8ToCP1255(AValue); - seArabic: AnsiValue := UTF8ToCP1256(AValue); - else - // Latin 1 is the default - AnsiValue := UTF8ToCP1252(AValue); - end; - - if AnsiValue = '' then begin - // Bad formatted UTF8String (maybe ANSI?) - if Length(AValue) <> 0 then begin - //It was an ANSI string written as UTF8 quite sure, so raise exception. - Raise Exception.CreateFmt(rsUTF8TextExpectedButANSIFoundInCell, [ - GetCellString(ARow, ACol) - ]); - end; - Exit; - end; - - if Length(AnsiValue) > MAXBYTES then begin - // Rather than lose data when reading it, let the application programmer deal - // with the problem or purposefully ignore it. - AnsiValue := Copy(AnsiValue, 1, MAXBYTES); - Workbook.AddErrorMsg(rsTruncateTooLongCellText, [ - MAXBYTES, GetCellString(ARow, ACol) - ]); - end; - L := Length(AnsiValue); - - { BIFF record header } - rec.RecordID := WordToLE(INT_EXCEL_ID_LABEL); - rec.RecordSize := WordToLE(8 + L); - - { BIFF record data } - rec.Row := WordToLE(ARow); - rec.Col := WordToLE(ACol); - - { Index to XF record } - rec.XFIndex := WordToLE(FindXFIndex(ACell)); - - { String length, 16 bit } - rec.TextLen := WordToLE(L); - - { Copy the text characters into a buffer immediately after rec } - SetLength(buf, SizeOf(rec) + SizeOf(ansiChar)*L); - Move(rec, buf[0], SizeOf(rec)); - Move(AnsiValue[1], buf[SizeOf(rec)], L*SizeOf(ansiChar)); - - { Write out } - AStream.WriteBuffer(buf[0], SizeOf(Rec) + SizeOf(ansiChar)*L); - - { Clean up } - SetLength(buf, 0); -end; - -{ Writes an Excel 5 STRING record which immediately follows a FORMULA record - when the formula result is a string. - BIFF5 writes a byte-string, but uses a 16-bit length here! } -procedure TsSpreadBIFF5Writer.WriteStringRecord(AStream: TStream; - AString: String); -var - s: ansistring; - len: Integer; -begin - s := UTF8ToAnsi(AString); - len := Length(s); - - { BIFF Record header } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_STRING)); - AStream.WriteWord(WordToLE(2 + len*SizeOf(Char))); - - { Write string length } - AStream.WriteWord(WordToLE(len)); - { Write characters } - AStream.WriteBuffer(s[1], len * SizeOf(Char)); -end; - -{******************************************************************* -* TsSpreadBIFF5Writer.WriteStyle () -* -* DESCRIPTION: Writes an Excel 5 STYLE record -* -* Registers the name of a user-defined style or -* specific options for a built-in cell style. -* -*******************************************************************} -procedure TsSpreadBIFF5Writer.WriteStyle(AStream: TStream); -begin - { BIFF Record header } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_STYLE)); - AStream.WriteWord(WordToLE(4)); - - { Index to style XF and defines if it's a built-in or used defined style } - AStream.WriteWord(WordToLE(MASK_STYLE_BUILT_IN)); - - { Built-in cell style identifier } - AStream.WriteByte($00); - - { Level if the identifier for a built-in style is RowLevel or ColLevel, $FF otherwise } - AStream.WriteByte(WordToLE($FF)); -end; - -{******************************************************************* -* TsSpreadBIFF5Writer.WriteWindow2 () -* -* DESCRIPTION: Writes an Excel 5 WINDOW2 record -* -*******************************************************************} -procedure TsSpreadBIFF5Writer.WriteWindow2(AStream: TStream; - ASheet: TsWorksheet); -var - Options: Word; -begin - { BIFF Record header } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_WINDOW2)); - AStream.WriteWord(WordToLE(10)); - - { Options flags } - Options := - MASK_WINDOW2_OPTION_SHOW_ZERO_VALUES or - MASK_WINDOW2_OPTION_AUTO_GRIDLINE_COLOR or - MASK_WINDOW2_OPTION_SHOW_OUTLINE_SYMBOLS or - MASK_WINDOW2_OPTION_SHEET_SELECTED or - MASK_WINDOW2_OPTION_SHEET_ACTIVE; - { Bug 0026386 -> every sheet must be selected/active, otherwise Excel cannot print } - - if (soShowGridLines in ASheet.Options) then - Options := Options or MASK_WINDOW2_OPTION_SHOW_GRID_LINES; - if (soShowHeaders in ASheet.Options) then - Options := Options or MASK_WINDOW2_OPTION_SHOW_SHEET_HEADERS; - if (soHasFrozenPanes in ASheet.Options) and ((ASheet.LeftPaneWidth > 0) or (ASheet.TopPaneHeight > 0)) then - Options := Options or MASK_WINDOW2_OPTION_PANES_ARE_FROZEN; - - AStream.WriteWord(WordToLE(Options)); - - { Index to first visible row } - AStream.WriteWord(WordToLE(0)); - - { Index to first visible column } - AStream.WriteWord(WordToLE(0)); - - { Grid line RGB colour } - AStream.WriteDWord(DWordToLE(0)); -end; - (* -{******************************************************************* -* TsSpreadBIFF5Writer.WriteXF () -* -* DESCRIPTION: Writes an Excel 5 XF record -* -*******************************************************************} -procedure TsSpreadBIFF5Writer.WriteXF(AStream: TStream; AFontIndex: Word; - AFormatIndex: Word; AXF_TYPE_PROT, ATextRotation: Byte; ABorders: TsCellBorders; - const ABorderStyles: TsCellBorderStyles; AHorAlignment: TsHorAlignment = haDefault; - AVertAlignment: TsVertAlignment = vaDefault; AWordWrap: Boolean = false; - AddBackground: Boolean = false; ABackgroundColor: TsColor = scSilver); -const - FILL_PATTERN = 1; // solid fill -var - optns: Word; - b: Byte; - dw1, dw2: DWord; -begin - { BIFF Record header } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_XF)); - AStream.WriteWord(WordToLE(16)); - - { Index to FONT record } - AStream.WriteWord(WordToLE(AFontIndex)); - - { Index to FORMAT record } - AStream.WriteWord(WordToLE(AFormatIndex)); - - { XF type, cell protection and parent style XF } - optns := AXF_TYPE_PROT and MASK_XF_TYPE_PROT; - if AXF_TYPE_PROT and MASK_XF_TYPE_PROT_STYLE_XF <> 0 then - optns := optns or MASK_XF_TYPE_PROT_PARENT; - AStream.WriteWord(WordToLE(optns)); - - { Alignment and text break } - b := 0; - case AHorAlignment of - haLeft : b := b or MASK_XF_HOR_ALIGN_LEFT; - haCenter : b := b or MASK_XF_HOR_ALIGN_CENTER; - haRight : b := b or MASK_XF_HOR_ALIGN_RIGHT; - end; - case AVertAlignment of - vaTop : b := b or MASK_XF_VERT_ALIGN_TOP; - vaCenter : b := b or MASK_XF_VERT_ALIGN_CENTER; - vaBottom : b := b or MASK_XF_VERT_ALIGN_BOTTOM; - else b := b or MASK_XF_VERT_ALIGN_BOTTOM; - end; - if AWordWrap then - b := b or MASK_XF_TEXTWRAP; - AStream.WriteByte(b); - - { Text rotation } - AStream.WriteByte(ATextRotation); // 0 is horizontal / normal - - { Cell border lines and background area } - - dw1 := 0; - dw2 := 0; - // Background color - if AddBackground then begin - dw1 := dw1 or (ABackgroundColor and $0000007F); - dw1 := dw1 or (FILL_PATTERN shl 16); - end; - // Border lines - if cbSouth in ABorders then - dw1 := dw1 or ((DWord(ABorderStyles[cbSouth].LineStyle)+1) shl 22); - dw1 := dw1 or (ABorderStyles[cbSouth].Color shl 25); // Bottom line color - dw2 := (ABorderStyles[cbNorth].Color shl 9) or // Top line color - (ABorderStyles[cbWest].Color shl 16) or // Left line color - (ABorderStyles[cbEast].Color shl 23); // Right line color - if cbNorth in ABorders then dw2 := dw2 or (DWord(ABorderStyles[cbNorth].LineStyle)+1); - if cbWest in ABorders then dw2 := dw2 or ((DWord(ABorderStyles[cbWest].LineStyle)+1) shl 3); - if cbEast in ABorders then dw2 := dw2 or ((DWord(ABorderStyles[cbEast].LineStyle)+1) shl 6); - AStream.WriteDWord(DWordToLE(dw1)); - AStream.WriteDWord(DWordToLE(dw2)); -end; *) - -procedure TsSpreadBIFF5Writer.WriteXF(AStream: TStream; - AFormatRecord: PsCellFormat; XFType_Prot: Byte = 0); -var - rec: TBIFF5_XFRecord; - j: Integer; - b: Byte; - dw1, dw2: DWord; -begin - { BIFF record header } - rec.RecordID := WordToLE(INT_EXCEL_ID_XF); - rec.RecordSize := WordToLE(SizeOf(TBIFF5_XFRecord) - 2*SizeOf(Word)); - - { Index to font record } - rec.FontIndex := 0; - if (AFormatRecord <> nil) then begin - if (uffBold in AFormatRecord^.UsedFormattingFields) then - rec.FontIndex := 1 - else - if (uffFont in AFormatRecord^.UsedFormattingFields) then - rec.FontIndex := AFormatRecord^.FontIndex; - end; - rec.FontIndex := WordToLE(rec.FontIndex); - - { Index to number format } - rec.NumFormatIndex := 0; - if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields) - then begin - // The number formats in the FormatList are still in fpc dialect - // They will be converted to Excel syntax immediately before writing. - j := NumFormatList.Find(AFormatRecord^.NumberFormat, AFormatRecord^.NumberFormatStr); - if j > -1 then - rec.NumFormatIndex := NumFormatList[j].Index; - end; - rec.NumFormatIndex := WordToLE(rec.NumFormatIndex); - - { XF type, cell protection and parent style XF } - rec.XFType_Prot_ParentXF := XFType_Prot and MASK_XF_TYPE_PROT; - if XFType_Prot and MASK_XF_TYPE_PROT_STYLE_XF <> 0 then - rec.XFType_Prot_ParentXF := rec.XFType_Prot_ParentXF or MASK_XF_TYPE_PROT_PARENT; - - { Text alignment and text break } - if AFormatRecord = nil then - b := MASK_XF_VERT_ALIGN_BOTTOM - else - begin - b := 0; - if (uffHorAlign in AFormatRecord^.UsedFormattingFields) then - case AFormatRecord^.HorAlignment of - haLeft : b := b or MASK_XF_HOR_ALIGN_LEFT; - haCenter : b := b or MASK_XF_HOR_ALIGN_CENTER; - haRight : b := b or MASK_XF_HOR_ALIGN_RIGHT; - haDefault: ; - end; - // Since the default vertical alignment is vaDefault but "0" corresponds - // to vaTop, we alwys have to write the vertical alignment. - case AFormatRecord^.VertAlignment of - vaTop : b := b or MASK_XF_VERT_ALIGN_TOP; - vaCenter : b := b or MASK_XF_VERT_ALIGN_CENTER; - vaBottom : b := b or MASK_XF_VERT_ALIGN_BOTTOM; - else b := b or MASK_XF_VERT_ALIGN_BOTTOM; - end; - if (uffWordWrap in AFormatRecord^.UsedFormattingFields) then - b := b or MASK_XF_TEXTWRAP; - end; - rec.Align_TextBreak := b; - - { Text rotation } - rec.TextOrient_UnusedAttrib := 0; - if (AFormatRecord <> nil) and (uffTextRotation in AFormatRecord^.UsedFormattingFields) - then rec.TextOrient_UnusedAttrib := TEXT_ROTATIONS[AFormatRecord^.TextRotation]; - - { Cell border lines and background area } - dw1 := 0; - dw2 := 0; - if (AFormatRecord <> nil) then - begin - if (uffBackgroundColor in AFormatRecord^.UsedFormattingFields) then - begin - // Background color - dw1 := dw1 or (FixColor(AFormatRecord^.BackgroundColor) and $0000007F); - dw1 := dw1 or (MASK_XF_FILL_PATT_SOLID shl 16); - end; - // Border lines - if (uffBorder in AFormatRecord^.UsedFormattingFields) then - begin - dw1 := dw1 or (AFormatRecord^.BorderStyles[cbSouth].Color shl 25); // Bottom line color - dw2 := (FixColor(AFormatRecord^.BorderStyles[cbNorth].Color) shl 9) or // Top line color - (FixColor(AFormatRecord^.BorderStyles[cbWest].Color) shl 16) or // Left line color - (FixColor(AFormatRecord^.BorderStyles[cbEast].Color) shl 23); // Right line color - if cbSouth in AFormatRecord^.Border then - dw1 := dw1 or ((DWord(AFormatRecord^.BorderStyles[cbSouth].LineStyle)+1) shl 22); - if cbNorth in AFormatRecord^.Border then - dw2 := dw2 or (DWord(AFormatRecord^.BorderStyles[cbNorth].LineStyle)+1); - if cbWest in AFormatRecord^.Border then - dw2 := dw2 or ((DWord(AFormatRecord^.BorderStyles[cbWest].LineStyle)+1) shl 3); - if cbEast in AFormatRecord^.Border then - dw2 := dw2 or ((DWord(AFormatRecord^.BorderStyles[cbEast].LineStyle)+1) shl 6); - end; - end; - rec.Border_BkGr1 := dw1; - rec.Border_BkGr2 := dw2; - - { Write out } - AStream.WriteBuffer(rec, SizeOf(rec)); -end; - (* -procedure TsSpreadBIFF5Writer.WriteXFFieldsForFormattingStyles(AStream: TStream); -var - i, j: Integer; - lFontIndex: Word; - lFormatIndex: Word; //number format - lTextRotation: Byte; - lBorders: TsCellBorders; - lBorderStyles: TsCellBorderStyles; - lAddBackground: Boolean; - lBackgroundColor: TsColor; - lHorAlign: TsHorAlignment; - lVertAlign: TsVertAlignment; - lWordWrap: Boolean; -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) - lTextRotation := XF_ROTATION_HORIZONTAL; - lBorders := []; - lBorderStyles := FFormattingStyles[i].BorderStyles; - lHorAlign := FFormattingStyles[i].HorAlignment; - lVertAlign := FFormattingStyles[i].VertAlignment; - lBackgroundColor := FFormattingStyles[i].BackgroundColor; - - // 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 uffTextRotation in FFormattingStyles[i].UsedFormattingFields then - lTextRotation := TEXT_ROTATIONS[FFormattingStyles[i].TextRotation]; - - if uffBold in FFormattingStyles[i].UsedFormattingFields then - lFontIndex := 1; // must be before uffFont which overrides uffBold - // the "1" was defined in TsWorkbook.InitFont (FONT1) - - if uffFont in FFormattingStyles[i].UsedFormattingFields then - lFontIndex := FFormattingStyles[i].FontIndex; - - lAddBackground := (uffBackgroundColor in FFormattingStyles[i].UsedFormattingFields); - lWordwrap := (uffWordwrap in FFormattingStyles[i].UsedFormattingFields); - - // And finally write the style - WriteXF(AStream, lFontIndex, lFormatIndex, 0, lTextRotation, lBorders, - lBorderStyles, lHorAlign, lVertAlign, lWordwrap, lAddBackground, - lBackgroundColor); - end; -end; - -procedure TsSpreadBIFF5Writer.WriteXFRecords(AStream: TStream); -var - i: Integer; - fmt: TsCellFormat; -begin - // XF0 - WriteXFRecord(AStream, MASK_XF_TYPE_PROT_STYLE_XF, nil); - // XF1 - WriteXFRecord(AStream, MASK_XF_TYPE_PROT_STYLE_XF, nil); - // XF2 - WriteXFRecord(AStream, MASK_XF_TYPE_PROT_STYLE_XF, nil); - // XF3 - WriteXFRecord(AStream, MASK_XF_TYPE_PROT_STYLE_XF, nil); - // XF4 - WriteXFRecord(AStream, MASK_XF_TYPE_PROT_STYLE_XF, nil); - // XF5 - WriteXFRecord(AStream, MASK_XF_TYPE_PROT_STYLE_XF, nil); - // XF6 - WriteXFRecord(AStream, MASK_XF_TYPE_PROT_STYLE_XF, nil); - // XF7 - WriteXFRecord(AStream, MASK_XF_TYPE_PROT_STYLE_XF, nil); - // XF8 - WriteXFRecord(AStream, MASK_XF_TYPE_PROT_STYLE_XF, nil); - // XF9 - WriteXFRecord(AStream, MASK_XF_TYPE_PROT_STYLE_XF, nil); - // XF10 - WriteXFRecord(AStream, MASK_XF_TYPE_PROT_STYLE_XF, nil); - // XF11 - WriteXFRecord(AStream, MASK_XF_TYPE_PROT_STYLE_XF, nil); - // XF12 - WriteXFRecord(AStream, MASK_XF_TYPE_PROT_STYLE_XF, nil); - // XF13 - WriteXFRecord(AStream, MASK_XF_TYPE_PROT_STYLE_XF, nil); - // XF14 - WriteXFRecord(AStream, MASK_XF_TYPE_PROT_STYLE_XF, nil); - - // XF15 - Default, no formatting - WriteXFRecord(AStream, 0, nil); - - // Add all further non-standard format records - // The first style was already added --> begin loop with 1 - for i:=1 to FWorkbook.GetNumFormatRecords-1 do begin - fmt := FWorkbook.GetFormatRecord(i); - WriteXFRecord(AStream, 0, @fmt); - end; - -{ - // XF0 - WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES); - // XF1 - WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES); - // XF2 - WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES); - // XF3 - WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES); - // XF4 - WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES); - // XF5 - WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES); - // XF6 - WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES); - // XF7 - WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES); - // XF8 - WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES); - // XF9 - WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES); - // XF10 - WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES); - // XF11 - WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES); - // XF12 - WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES); - // XF13 - WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES); - // XF14 - WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES); - // XF15 - Default, no formatting - WriteXF(AStream, 0, 0, 0, XF_ROTATION_HORIZONTAL, [], DEFAULT_BORDERSTYLES); - - // Add all further non-standard/built-in formatting styles - ListAllFormattingStyles; - WriteXFFieldsForFormattingStyles(AStream); - } -end; - *) - { TsSpreadBIFF5Reader } procedure TsSpreadBIFF5Reader.ReadWorkbookGlobals(AStream: TStream; @@ -1431,7 +511,7 @@ begin { Save the data } FWorksheet.WriteUTF8Text(cell, ISO_8859_1ToUTF8(AStrValue)); //Read formatting runs (not supported) - B:=AStream.ReadByte; + B := AStream.ReadByte; for L := 0 to B-1 do begin AStream.ReadByte; // First formatted character AStream.ReadByte; // Index to FONT record @@ -1508,25 +588,12 @@ begin end; procedure TsSpreadBIFF5Reader.ReadXF(AStream: TStream); -{ -type - TXFRecord = packed record // see p. 224 - FontIndex: Word; // Offset 0, Size 2 - FormatIndex: Word; // Offset 2, Size 2 - XFType_CellProt_ParentStyleXF: Word; // Offset 4, Size 2 - Align_TextBreak: Byte; // Offset 6, Size 1 - XFRotation: Byte; // Offset 7, Size 1 - Border_Background_1: DWord; // Offset 8, Size 4 - Border_Background_2: DWord; // Offset 12, Size 4 - end; } var rec: TBIFF5_XFRecord; fmt: TsCellFormat; nfidx: Integer; i: Integer; nfdata: TsNumFormatData; - //lData: TXFListData; - //xf: TXFRecord; b: Byte; dw: DWord; fill: Word; @@ -1816,6 +883,656 @@ begin end; +{ TsSpreadBIFF5Writer } + +{@@ ---------------------------------------------------------------------------- + Writes an Excel BIFF5 file to the disc + + The BIFF 5 writer overrides this method because BIFF 5 is written as + an OLE document, and our current OLE document writing method involves: + + 1 - Writing the BIFF data to a memory stream + 2 - Write the memory stream data to disk using COM functions +-------------------------------------------------------------------------------} +procedure TsSpreadBIFF5Writer.WriteToFile(const AFileName: string; + const AOverwriteExisting: Boolean); +var + Stream: TStream; + OutputStorage: TOLEStorage; + OLEDocument: TOLEDocument; +begin + if (boBufStream in Workbook.Options) then begin + Stream := TBufStream.Create + end else + Stream := TMemoryStream.Create; + + OutputStorage := TOLEStorage.Create; + try + WriteToStream(Stream); + + // Only one stream is necessary for any number of worksheets + OLEDocument.Stream := Stream; + + OutputStorage.WriteOLEFile(AFileName, OLEDocument, AOverwriteExisting); + finally + Stream.Free; + OutputStorage.Free; + end; +end; + +{@@ ---------------------------------------------------------------------------- + Writes an Excel BIFF5 record structure + + Be careful as this method doesn't write the OLE part of the document, + just the BIFF records +-------------------------------------------------------------------------------} +procedure TsSpreadBIFF5Writer.WriteToStream(AStream: TStream); +var + CurrentPos: Int64; + Boundsheets: array of Int64; + i, len: Integer; + pane: Byte; +begin + { Store some data about the workbook that other routines need } + WorkBookEncoding := Workbook.Encoding; + + { Write workbook globals } + + WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS); + + WriteCodepage(AStream, WorkBookEncoding); + WriteWindow1(AStream); + WriteFonts(AStream); + WriteNumFormats(AStream); + WritePalette(AStream); + WriteXFRecords(AStream); + WriteStyle(AStream); + + // A BOUNDSHEET for each worksheet + SetLength(Boundsheets, 0); + for i := 0 to Workbook.GetWorksheetCount - 1 do + begin + len := Length(Boundsheets); + SetLength(Boundsheets, len + 1); + Boundsheets[len] := WriteBoundsheet(AStream, Workbook.GetWorksheetByIndex(i).Name); + end; + + WriteEOF(AStream); + + { Write each worksheet } + + for i := 0 to Workbook.GetWorksheetCount - 1 do + begin + FWorksheet := Workbook.GetWorksheetByIndex(i); + + { First goes back and writes the position of the BOF of the + sheet on the respective BOUNDSHEET record } + CurrentPos := AStream.Position; + AStream.Position := Boundsheets[i]; + AStream.WriteDWord(CurrentPos); + AStream.Position := CurrentPos; + + WriteBOF(AStream, INT_BOF_SHEET); + + WriteIndex(AStream); +// WritePageSetup(AStream); + WriteColInfos(AStream, FWorksheet); + WriteDimensions(AStream, FWorksheet); + WriteWindow2(AStream, FWorksheet); + WritePane(AStream, FWorksheet, true, pane); // true for "is BIFF5 or BIFF8" + WriteSelection(AStream, FWorksheet, pane); + //WriteRows(AStream, sheet); + + if (boVirtualMode in Workbook.Options) then + WriteVirtualCells(AStream) + else begin + WriteRows(AStream, FWorksheet); + WriteCellsToStream(AStream, FWorksheet.Cells); + end; + + WriteEOF(AStream); + end; + + { Cleanup } + + SetLength(Boundsheets, 0); +end; + +{@@ ---------------------------------------------------------------------------- + Writes an Excel 5 BOF record + + This must be the first record of an Excel 5 stream +-------------------------------------------------------------------------------} +procedure TsSpreadBIFF5Writer.WriteBOF(AStream: TStream; ADataType: Word); +begin + { BIFF Record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_BOF)); + AStream.WriteWord(WordToLE(8)); + + { BIFF version. Should only be used if this BOF is for the workbook globals } + if ADataType = INT_BOF_WORKBOOK_GLOBALS then + AStream.WriteWord(WordToLE(INT_BOF_BIFF5_VER)) + else AStream.WriteWord(0); + + { Data type } + AStream.WriteWord(WordToLE(ADataType)); + + { Build identifier, must not be 0 } + AStream.WriteWord(WordToLE(INT_BOF_BUILD_ID)); + + { Build year, must not be 0 } + AStream.WriteWord(WordToLE(INT_BOF_BUILD_YEAR)); +end; + +{@@ ---------------------------------------------------------------------------- + Writes an Excel 5 BOUNDSHEET record + + Always located on the workbook globals substream. + One BOUNDSHEET is written for each worksheet. + + @return The stream position where the absolute stream position + of the BOF of this sheet should be written (4 bytes size). +-------------------------------------------------------------------------------} +function TsSpreadBIFF5Writer.WriteBoundsheet(AStream: TStream; ASheetName: string): Int64; +var + Len: Byte; + LatinSheetName: string; +begin + LatinSheetName := UTF8ToISO_8859_1(ASheetName); + Len := Length(LatinSheetName); + + { BIFF Record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_BOUNDSHEET)); + AStream.WriteWord(WordToLE(6 + 1 + Len)); + + { Absolute stream position of the BOF record of the sheet represented + by this record } + Result := AStream.Position; + AStream.WriteDWord(WordToLE(0)); + + { Visibility } + AStream.WriteByte(0); + + { Sheet type } + AStream.WriteByte(0); + + { Sheet name: Byte string, 8-bit length } + AStream.WriteByte(Len); + AStream.WriteBuffer(LatinSheetName[1], Len); +end; + +{@@ ---------------------------------------------------------------------------- + Writes an Excel 5 DIMENSIONS record + + nm = (rl - rf - 1) / 32 + 1 (using integer division) + + Excel, OpenOffice and FPSpreadsheet ignore the dimensions written in this + record, but some other applications really use them, so they need to be correct. + + See bug 18886: excel5 files are truncated when imported +--------------------------------------------------------------------------------} +procedure TsSpreadBIFF5Writer.WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet); +var + rec: TBIFF5_DimensionsRecord; + firstCol, lastCol, firstRow, lastRow: Cardinal; +begin + { Determine sheet size } + GetSheetDimensions(AWorksheet, firstRow, lastRow, firstCol, lastCol); + + { Setup BIFF record } + rec.RecordID := WordToLE(INT_EXCEL_ID_DIMENSIONS); + rec.RecordSize := WordToLE(10); + rec.FirstRow := WordToLE(firstRow); + if lastRow < $FFFF then // avoid WORD overflow + rec.LastRowPlus1 := WordToLE(lastRow + 1) + else + rec.LastRowPlus1 := $FFFF; + rec.FirstCol := WordToLe(firstCol); + rec.LastColPlus1 := WordToLE(lastCol+1); + rec.NotUsed := 0; + + { Write BIFF record } + AStream.WriteBuffer(rec, SizeOf(rec)); +end; + +{@@ ---------------------------------------------------------------------------- + Writes an Excel 5 EOF record + This must be the last record of an Excel 5 stream +-------------------------------------------------------------------------------} +procedure TsSpreadBIFF5Writer.WriteEOF(AStream: TStream); +begin + { BIFF Record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_EOF)); + AStream.WriteWord($0000); +end; + +{@@ ---------------------------------------------------------------------------- + Writes an Excel 5 FONT record + The font data is passed as an instance of TsFont. +-------------------------------------------------------------------------------} +procedure TsSpreadBIFF5Writer.WriteFont(AStream: TStream; AFont: TsFont); +var + Len: Byte; + optn: Word; +begin + 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.'); + + Len := Length(AFont.FontName); + + { BIFF Record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_FONT)); + AStream.WriteWord(WordToLE(14 + 1 + Len)); + + { Height of the font in twips = 1/20 of a point } + AStream.WriteWord(WordToLE(round(AFont.Size*20))); + + { Option flags } + 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(ord(FixColor(AFont.Color)))); + + { Font weight } + 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(0); + + { Underline type } + if fssUnderline in AFont.Style then + AStream.WriteByte(1) + else + AStream.WriteByte(0); + + { Font family } + AStream.WriteByte(0); + + { Character set } + AStream.WriteByte(0); + + { Not used } + AStream.WriteByte(0); + + { Font name: Byte string, 8-bit length } + AStream.WriteByte(Len); + AStream.WriteBuffer(AFont.FontName[1], Len); +end; + +{@@ ---------------------------------------------------------------------------- + Writes the Excel 5 FONT records needed for the used fonts in the workbook. +-------------------------------------------------------------------------------} +procedure TsSpreadBiff5Writer.WriteFonts(AStream: TStream); +var + i: Integer; +begin + for i:=0 to Workbook.GetFontCount-1 do + WriteFont(AStream, Workbook.GetFont(i)); +end; + +{@@ ---------------------------------------------------------------------------- + Writes an Excel 5 FORMAT record which is needed for formatting of numerical + data. +-------------------------------------------------------------------------------} +procedure TsSpreadBiff5Writer.WriteNumFormat(AStream: TStream; + ANumFormatData: TsNumFormatData; AListIndex: Integer); +type + TNumFormatRecord = packed record + RecordID: Word; + RecordSize: Word; + FormatIndex: Word; + FormatStringLen: Byte; + end; +var + len: Integer; + s: ansistring; + rec: TNumFormatRecord; + buf: array of byte; +begin + if (ANumFormatData = nil) or (ANumFormatData.FormatString = '') then + exit; + + s := UTF8ToAnsi(NumFormatList.FormatStringForWriting(AListIndex)); + len := Length(s); + + { BIFF record header } + rec.RecordID := WordToLE(INT_EXCEL_ID_FORMAT); + rec.RecordSize := WordToLE(2 + 1 + len * SizeOf(AnsiChar)); + + { Format index } + rec.FormatIndex := WordToLE(ANumFormatData.Index); + + { Format string } + { Length in 1 byte } + rec.FormatStringLen := len; + { Copy the format string characters into a buffer immediately after rec } + SetLength(buf, SizeOf(rec) + SizeOf(ansiChar)*len); + Move(rec, buf[0], SizeOf(rec)); + Move(s[1], buf[SizeOf(rec)], len*SizeOf(ansiChar)); + + { Write out } + AStream.WriteBuffer(buf[0], SizeOf(Rec) + SizeOf(ansiChar)*len); + + { Clean up } + SetLength(buf, 0); +end; + +{@@ ---------------------------------------------------------------------------- + Writes an Excel 5 INDEX record + + nm = (rl - rf - 1) / 32 + 1 (using integer division) +-------------------------------------------------------------------------------} +procedure TsSpreadBIFF5Writer.WriteIndex(AStream: TStream); +begin + { BIFF Record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_INDEX)); + AStream.WriteWord(WordToLE(12)); + + { Not used } + AStream.WriteDWord(0); + + { Index to first used row, rf, 0 based } + AStream.WriteWord(0); + + { Index to first row of unused tail of sheet, rl, last used row + 1, 0 based } + AStream.WriteWord(33); + + { Absolute stream position of the DEFCOLWIDTH record of the current sheet. + If it doesn't exist, the offset points to where it would occur. } + AStream.WriteDWord($00); + + { Array of nm absolute stream positions of the DBCELL record of each Row Block } + + { OBS: It seams to be no problem just ignoring this part of the record } +end; + +{@@ ---------------------------------------------------------------------------- + Writes an Excel 5 LABEL record + + If the string length exceeds 255 bytes, the string will be truncated and + an error message will be logged as a warning. +-------------------------------------------------------------------------------} +procedure TsSpreadBIFF5Writer.WriteLabel(AStream: TStream; const ARow, + ACol: Cardinal; const AValue: string; ACell: PCell); +const + MAXBYTES = 255; //limit for this format +var + L: Word; + AnsiValue: ansistring; + rec: TBIFF5_LabelRecord; + buf: array of byte; +begin + if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then + exit; + + case WorkBookEncoding of + seLatin2: AnsiValue := UTF8ToCP1250(AValue); + seCyrillic: AnsiValue := UTF8ToCP1251(AValue); + seGreek: AnsiValue := UTF8ToCP1253(AValue); + seTurkish: AnsiValue := UTF8ToCP1254(AValue); + seHebrew: AnsiValue := UTF8ToCP1255(AValue); + seArabic: AnsiValue := UTF8ToCP1256(AValue); + else + // Latin 1 is the default + AnsiValue := UTF8ToCP1252(AValue); + end; + + if AnsiValue = '' then begin + // Bad formatted UTF8String (maybe ANSI?) + if Length(AValue) <> 0 then begin + //It was an ANSI string written as UTF8 quite sure, so raise exception. + Raise Exception.CreateFmt(rsUTF8TextExpectedButANSIFoundInCell, [ + GetCellString(ARow, ACol) + ]); + end; + Exit; + end; + + if Length(AnsiValue) > MAXBYTES then begin + // Rather than lose data when reading it, let the application programmer deal + // with the problem or purposefully ignore it. + AnsiValue := Copy(AnsiValue, 1, MAXBYTES); + Workbook.AddErrorMsg(rsTruncateTooLongCellText, [ + MAXBYTES, GetCellString(ARow, ACol) + ]); + end; + L := Length(AnsiValue); + + { BIFF record header } + rec.RecordID := WordToLE(INT_EXCEL_ID_LABEL); + rec.RecordSize := WordToLE(8 + L); + + { BIFF record data } + rec.Row := WordToLE(ARow); + rec.Col := WordToLE(ACol); + + { Index to XF record } + rec.XFIndex := WordToLE(FindXFIndex(ACell)); + + { String length, 16 bit } + rec.TextLen := WordToLE(L); + + { Copy the text characters into a buffer immediately after rec } + SetLength(buf, SizeOf(rec) + SizeOf(ansiChar)*L); + Move(rec, buf[0], SizeOf(rec)); + Move(AnsiValue[1], buf[SizeOf(rec)], L*SizeOf(ansiChar)); + + { Write out } + AStream.WriteBuffer(buf[0], SizeOf(Rec) + SizeOf(ansiChar)*L); + + { Clean up } + SetLength(buf, 0); +end; + +{@@ ---------------------------------------------------------------------------- + Writes an Excel 5 STRING record which immediately follows a FORMULA record + when the formula result is a string. + BIFF5 writes a byte-string, but uses a 16-bit length here! +-------------------------------------------------------------------------------} +procedure TsSpreadBIFF5Writer.WriteStringRecord(AStream: TStream; + AString: String); +var + s: ansistring; + len: Integer; +begin + s := UTF8ToAnsi(AString); + len := Length(s); + + { BIFF Record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_STRING)); + AStream.WriteWord(WordToLE(2 + len*SizeOf(Char))); + + { Write string length } + AStream.WriteWord(WordToLE(len)); + { Write characters } + AStream.WriteBuffer(s[1], len * SizeOf(Char)); +end; + +{@@ ---------------------------------------------------------------------------- + Writes an Excel 5 STYLE record + + Registers the name of a user-defined style or specific options for + a built-in cell style. +-------------------------------------------------------------------------------} +procedure TsSpreadBIFF5Writer.WriteStyle(AStream: TStream); +begin + { BIFF Record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_STYLE)); + AStream.WriteWord(WordToLE(4)); + + { Index to style XF and defines if it's a built-in or used defined style } + AStream.WriteWord(WordToLE(MASK_STYLE_BUILT_IN)); + + { Built-in cell style identifier } + AStream.WriteByte($00); + + { Level if the identifier for a built-in style is RowLevel or ColLevel, $FF otherwise } + AStream.WriteByte(WordToLE($FF)); +end; + +{@@ ---------------------------------------------------------------------------- + Writes an Excel 5 WINDOW2 record +-------------------------------------------------------------------------------} +procedure TsSpreadBIFF5Writer.WriteWindow2(AStream: TStream; + ASheet: TsWorksheet); +var + Options: Word; +begin + { BIFF Record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_WINDOW2)); + AStream.WriteWord(WordToLE(10)); + + { Options flags } + Options := + MASK_WINDOW2_OPTION_SHOW_ZERO_VALUES or + MASK_WINDOW2_OPTION_AUTO_GRIDLINE_COLOR or + MASK_WINDOW2_OPTION_SHOW_OUTLINE_SYMBOLS or + MASK_WINDOW2_OPTION_SHEET_SELECTED or + MASK_WINDOW2_OPTION_SHEET_ACTIVE; + { Bug 0026386 -> every sheet must be selected/active, otherwise Excel cannot print } + + if (soShowGridLines in ASheet.Options) then + Options := Options or MASK_WINDOW2_OPTION_SHOW_GRID_LINES; + if (soShowHeaders in ASheet.Options) then + Options := Options or MASK_WINDOW2_OPTION_SHOW_SHEET_HEADERS; + if (soHasFrozenPanes in ASheet.Options) and ((ASheet.LeftPaneWidth > 0) or (ASheet.TopPaneHeight > 0)) then + Options := Options or MASK_WINDOW2_OPTION_PANES_ARE_FROZEN; + + AStream.WriteWord(WordToLE(Options)); + + { Index to first visible row } + AStream.WriteWord(WordToLE(0)); + + { Index to first visible column } + AStream.WriteWord(WordToLE(0)); + + { Grid line RGB colour } + AStream.WriteDWord(DWordToLE(0)); +end; + +{@@ ---------------------------------------------------------------------------- + Writes an Excel 5 XF record +-------------------------------------------------------------------------------} +procedure TsSpreadBIFF5Writer.WriteXF(AStream: TStream; + AFormatRecord: PsCellFormat; XFType_Prot: Byte = 0); +var + rec: TBIFF5_XFRecord; + j: Integer; + b: Byte; + dw1, dw2: DWord; +begin + { BIFF record header } + rec.RecordID := WordToLE(INT_EXCEL_ID_XF); + rec.RecordSize := WordToLE(SizeOf(TBIFF5_XFRecord) - 2*SizeOf(Word)); + + { Index to font record } + rec.FontIndex := 0; + if (AFormatRecord <> nil) then begin + if (uffBold in AFormatRecord^.UsedFormattingFields) then + rec.FontIndex := 1 + else + if (uffFont in AFormatRecord^.UsedFormattingFields) then + rec.FontIndex := AFormatRecord^.FontIndex; + end; + rec.FontIndex := WordToLE(rec.FontIndex); + + { Index to number format } + rec.NumFormatIndex := 0; + if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields) + then begin + // The number formats in the FormatList are still in fpc dialect + // They will be converted to Excel syntax immediately before writing. + j := NumFormatList.Find(AFormatRecord^.NumberFormat, AFormatRecord^.NumberFormatStr); + if j > -1 then + rec.NumFormatIndex := NumFormatList[j].Index; + end; + rec.NumFormatIndex := WordToLE(rec.NumFormatIndex); + + { XF type, cell protection and parent style XF } + rec.XFType_Prot_ParentXF := XFType_Prot and MASK_XF_TYPE_PROT; + if XFType_Prot and MASK_XF_TYPE_PROT_STYLE_XF <> 0 then + rec.XFType_Prot_ParentXF := rec.XFType_Prot_ParentXF or MASK_XF_TYPE_PROT_PARENT; + + { Text alignment and text break } + if AFormatRecord = nil then + b := MASK_XF_VERT_ALIGN_BOTTOM + else + begin + b := 0; + if (uffHorAlign in AFormatRecord^.UsedFormattingFields) then + case AFormatRecord^.HorAlignment of + haLeft : b := b or MASK_XF_HOR_ALIGN_LEFT; + haCenter : b := b or MASK_XF_HOR_ALIGN_CENTER; + haRight : b := b or MASK_XF_HOR_ALIGN_RIGHT; + haDefault: ; + end; + // Since the default vertical alignment is vaDefault but "0" corresponds + // to vaTop, we alwys have to write the vertical alignment. + case AFormatRecord^.VertAlignment of + vaTop : b := b or MASK_XF_VERT_ALIGN_TOP; + vaCenter : b := b or MASK_XF_VERT_ALIGN_CENTER; + vaBottom : b := b or MASK_XF_VERT_ALIGN_BOTTOM; + else b := b or MASK_XF_VERT_ALIGN_BOTTOM; + end; + if (uffWordWrap in AFormatRecord^.UsedFormattingFields) then + b := b or MASK_XF_TEXTWRAP; + end; + rec.Align_TextBreak := b; + + { Text rotation } + rec.TextOrient_UnusedAttrib := 0; + if (AFormatRecord <> nil) and (uffTextRotation in AFormatRecord^.UsedFormattingFields) + then rec.TextOrient_UnusedAttrib := TEXT_ROTATIONS[AFormatRecord^.TextRotation]; + + { Cell border lines and background area } + dw1 := 0; + dw2 := 0; + if (AFormatRecord <> nil) then + begin + if (uffBackgroundColor in AFormatRecord^.UsedFormattingFields) then + begin + // Background color + dw1 := dw1 or (FixColor(AFormatRecord^.BackgroundColor) and $0000007F); + dw1 := dw1 or (MASK_XF_FILL_PATT_SOLID shl 16); + end; + // Border lines + if (uffBorder in AFormatRecord^.UsedFormattingFields) then + begin + dw1 := dw1 or (AFormatRecord^.BorderStyles[cbSouth].Color shl 25); // Bottom line color + dw2 := (FixColor(AFormatRecord^.BorderStyles[cbNorth].Color) shl 9) or // Top line color + (FixColor(AFormatRecord^.BorderStyles[cbWest].Color) shl 16) or // Left line color + (FixColor(AFormatRecord^.BorderStyles[cbEast].Color) shl 23); // Right line color + if cbSouth in AFormatRecord^.Border then + dw1 := dw1 or ((DWord(AFormatRecord^.BorderStyles[cbSouth].LineStyle)+1) shl 22); + if cbNorth in AFormatRecord^.Border then + dw2 := dw2 or (DWord(AFormatRecord^.BorderStyles[cbNorth].LineStyle)+1); + if cbWest in AFormatRecord^.Border then + dw2 := dw2 or ((DWord(AFormatRecord^.BorderStyles[cbWest].LineStyle)+1) shl 3); + if cbEast in AFormatRecord^.Border then + dw2 := dw2 or ((DWord(AFormatRecord^.BorderStyles[cbEast].LineStyle)+1) shl 6); + end; + end; + rec.Border_BkGr1 := dw1; + rec.Border_BkGr2 := dw2; + + { Write out } + AStream.WriteBuffer(rec, SizeOf(rec)); +end; + + initialization RegisterSpreadFormat(TsSpreadBIFF5Reader, TsSpreadBIFF5Writer, sfExcel5); diff --git a/components/fpspreadsheet/xlsbiff8.pas b/components/fpspreadsheet/xlsbiff8.pas index 4f9f964fe..59b3064b5 100755 --- a/components/fpspreadsheet/xlsbiff8.pas +++ b/components/fpspreadsheet/xlsbiff8.pas @@ -109,9 +109,6 @@ type { TsSpreadBIFF8Writer } TsSpreadBIFF8Writer = class(TsSpreadBIFFWriter) - private - // Writes index to XF record according to cell's formatting - //procedure WriteXFFieldsForFormattingStyles(AStream: TStream); protected { Record writing methods } procedure WriteBOF(AStream: TStream; ADataType: Word); @@ -136,13 +133,6 @@ type procedure WriteStringRecord(AStream: TStream; AString: string); override; procedure WriteStyle(AStream: TStream); procedure WriteWindow2(AStream: TStream; ASheet: TsWorksheet); - (* - procedure WriteXF(AStream: TStream; AFontIndex: Word; - AFormatIndex: Word; AXF_TYPE_PROT, ATextRotation: Byte; ABorders: TsCellBorders; - const ABorderStyles: TsCellBorderStyles; AHorAlignment: TsHorAlignment = haDefault; - AVertAlignment: TsVertAlignment = vaDefault; AWordWrap: Boolean = false; - AddBackground: Boolean = false; ABackgroundColor: TsColor = scSilver); - *) procedure WriteXF(AStream: TStream; AFormatRecord: PsCellFormat; XFType_Prot: Byte = 0); override; public @@ -338,1050 +328,6 @@ type end; -{ TsSpreadBIFF8Writer } - -constructor TsSpreadBIFF8Writer.Create(AWorkbook: TsWorkbook); -begin - inherited Create(AWorkbook); -end; -(* -procedure TsSpreadBIFF8Writer.WriteXFFieldsForFormattingStyles(AStream: TStream); -var - i, j: Integer; - lFontIndex: Word; - lFormatIndex: Word; //number format - lTextRotation: Byte; - lBorders: TsCellBorders; - lBorderStyles: TsCellBorderStyles; - lAddBackground: Boolean; - lBackgroundColor: TsColor; - lHorAlign: TsHorAlignment; - lVertAlign: TsVertAlignment; - lWordWrap: Boolean; -begin - // The first style was already added --> begin loop with 1 - for i := 1 to Length(FFormattingStyles) - 1 do begin - // Default styles - lFontIndex := 0; - lFormatIndex := 0; //General format (one of the built-in number formats) - lTextRotation := XF_ROTATION_HORIZONTAL; - lBorders := []; - lBorderStyles := FFormattingStyles[i].BorderStyles; - lHorAlign := FFormattingStyles[i].HorAlignment; - lVertAlign := FFormattingStyles[i].VertAlignment; - lBackgroundColor := FFormattingStyles[i].BackgroundColor; - - // Now apply the modifications. - if uffNumberFormat in FFormattingStyles[i].UsedFormattingFields then begin - // The number formats in the FormattingStyles are still in fpc dialect - // They will be converted to Excel syntax immediately before writing. - 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 uffTextRotation in FFormattingStyles[i].UsedFormattingFields then - lTextRotation := TEXT_ROTATIONS[FFormattingStyles[i].TextRotation]; - - 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); - lWordwrap := (uffWordwrap in FFormattingStyles[i].UsedFormattingFields); - - // And finally write the style - WriteXF(AStream, lFontIndex, lFormatIndex, 0, lTextRotation, lBorders, - lBorderStyles, lHorAlign, lVertAlign, lWordwrap, lAddBackground, - lBackgroundColor); - end; -end; - *) -{******************************************************************* -* TsSpreadBIFF8Writer.WriteToFile () -* -* DESCRIPTION: Writes an Excel BIFF8 file to the disc -* -* The BIFF 8 writer overrides this method because -* BIFF 8 is written as an OLE document, and our -* current OLE document writing method involves: -* -* 1 - Writing the BIFF data to a memory stream -* -* 2 - Write the memory stream data to disk using -* COM functions -* -*******************************************************************} -procedure TsSpreadBIFF8Writer.WriteToFile(const AFileName: string; - const AOverwriteExisting: Boolean); -var - Stream: TStream; - OutputStorage: TOLEStorage; - OLEDocument: TOLEDocument; -begin - if (boBufStream in Workbook.Options) then begin - Stream := TBufStream.Create - end else - Stream := TMemoryStream.Create; - - OutputStorage := TOLEStorage.Create; - try - WriteToStream(Stream); - - // Only one stream is necessary for any number of worksheets - OLEDocument.Stream := Stream; - - OutputStorage.WriteOLEFile(AFileName, OLEDocument, AOverwriteExisting, 'Workbook'); - finally - Stream.Free; - OutputStorage.Free; - end; -end; - -{******************************************************************* -* TsSpreadBIFF8Writer.WriteToStream () -* -* DESCRIPTION: Writes an Excel BIFF8 record structure -* -* Be careful as this method doesn't write the OLE -* part of the document, just the BIFF records -* -*******************************************************************} -procedure TsSpreadBIFF8Writer.WriteToStream(AStream: TStream); -const - isBIFF8 = true; -var - CurrentPos: Int64; - Boundsheets: array of Int64; - i, len: Integer; - pane: Byte; -begin - { Write workbook globals } - - WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS); - - WriteWindow1(AStream); - WriteFonts(AStream); - WriteNumFormats(AStream); - WritePalette(AStream); - WriteXFRecords(AStream); - WriteStyle(AStream); - - // A BOUNDSHEET for each worksheet - SetLength(Boundsheets, 0); - for i := 0 to Workbook.GetWorksheetCount - 1 do - begin - len := Length(Boundsheets); - SetLength(Boundsheets, len + 1); - Boundsheets[len] := WriteBoundsheet(AStream, Workbook.GetWorksheetByIndex(i).Name); - end; - - WriteEOF(AStream); - - { Write each worksheet } - - for i := 0 to Workbook.GetWorksheetCount - 1 do - begin - FWorksheet := Workbook.GetWorksheetByIndex(i); - - { First goes back and writes the position of the BOF of the - sheet on the respective BOUNDSHEET record } - CurrentPos := AStream.Position; - AStream.Position := Boundsheets[i]; - AStream.WriteDWord(DWordToLE(DWORD(CurrentPos))); - AStream.Position := CurrentPos; - - WriteBOF(AStream, INT_BOF_SHEET); - WriteIndex(AStream); - //WriteSheetPR(AStream); -// WritePageSetup(AStream); - WriteColInfos(AStream, FWorksheet); - WriteDimensions(AStream, FWorksheet); - //WriteRowAndCellBlock(AStream, sheet); - - if (boVirtualMode in Workbook.Options) then - WriteVirtualCells(AStream) - else begin - WriteRows(AStream, FWorksheet); - WriteCellsToStream(AStream, FWorksheet.Cells); - end; - - // View settings block - WriteWindow2(AStream, FWorksheet); - WritePane(AStream, FWorksheet, isBIFF8, pane); - WriteSelection(AStream, FWorksheet, pane); - - WriteMergedCells(AStream, FWorksheet); - - WriteEOF(AStream); - end; - - { Cleanup } - SetLength(Boundsheets, 0); -end; - - -{******************************************************************* -* TsSpreadBIFF8Writer.WriteBOF () -* -* DESCRIPTION: Writes an Excel 8 BOF record -* -* This must be the first record on an Excel 8 stream -* -*******************************************************************} -procedure TsSpreadBIFF8Writer.WriteBOF(AStream: TStream; ADataType: Word); -begin - { BIFF Record header } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_BOF)); - AStream.WriteWord(WordToLE(16)); //total record size - - { BIFF version. Should only be used if this BOF is for the workbook globals } - { OpenOffice rejects to correctly read xls files if this field is - omitted as docs. says, or even if it is being written to zero value, - Not tested with Excel, but MSExcel reader opens it as expected } - AStream.WriteWord(WordToLE(INT_BOF_BIFF8_VER)); - - { Data type } - AStream.WriteWord(WordToLE(ADataType)); - - { Build identifier, must not be 0 } - AStream.WriteWord(WordToLE(INT_BOF_BUILD_ID)); - - { Build year, must not be 0 } - AStream.WriteWord(WordToLE(INT_BOF_BUILD_YEAR)); - - { File history flags } - AStream.WriteDWord(DWordToLE(0)); - - { Lowest Excel version that can read all records in this file 5?} - AStream.WriteDWord(DWordToLE(0)); //????????? -end; - -{******************************************************************* -* TsSpreadBIFF8Writer.WriteBoundsheet () -* -* DESCRIPTION: Writes an Excel 8 BOUNDSHEET record -* -* Always located on the workbook globals substream. -* -* One BOUNDSHEET is written for each worksheet. -* -* RETURNS: The stream position where the absolute stream position -* of the BOF of this sheet should be written (4 bytes size). -* -*******************************************************************} -function TsSpreadBIFF8Writer.WriteBoundsheet(AStream: TStream; ASheetName: string): Int64; -var - Len: Byte; - WideSheetName: WideString; -begin - WideSheetName:=UTF8Decode(ASheetName); - Len := Length(WideSheetName); - - { BIFF Record header } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_BOUNDSHEET)); - AStream.WriteWord(WordToLE(6 + 1 + 1 + Len * Sizeof(WideChar))); - - { Absolute stream position of the BOF record of the sheet represented - by this record } - Result := AStream.Position; - AStream.WriteDWord(DWordToLE(0)); - - { Visibility } - AStream.WriteByte(0); - - { Sheet type } - AStream.WriteByte(0); - - { Sheet name: Unicode string char count 1 byte } - AStream.WriteByte(Len); - {String flags} - AStream.WriteByte(1); - AStream.WriteBuffer(WideStringToLE(WideSheetName)[1], Len * Sizeof(WideChar)); -end; - - -{ - Writes an Excel 8 DIMENSIONS record - - nm = (rl - rf - 1) / 32 + 1 (using integer division) - - Excel, OpenOffice and FPSpreadsheet ignore the dimensions written in this record, - but some other applications really use them, so they need to be correct. - - See bug 18886: excel5 files are truncated when imported -} -procedure TsSpreadBIFF8Writer.WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet); -var - firstRow, lastRow, firstCol, lastCol: Cardinal; - rec: TBIFF8_DimensionsRecord; -begin - { Determine sheet size } - GetSheetDimensions(AWorksheet, firstRow, lastRow, firstCol, lastCol); - - { Populate BIFF record } - rec.RecordID := WordToLE(INT_EXCEL_ID_DIMENSIONS); - rec.RecordSize := WordToLE(14); - rec.FirstRow := DWordToLE(firstRow); - rec.LastRowPlus1 := DWordToLE(lastRow+1); - rec.FirstCol := WordToLE(firstCol); - rec.LastColPlus1 := WordToLE(lastCol+1); - rec.NotUsed := 0; - - { Write BIFF record to stream } - AStream.WriteBuffer(rec, SizeOf(rec)); -end; - -{******************************************************************* -* TsSpreadBIFF8Writer.WriteEOF () -* -* DESCRIPTION: Writes an Excel 8 EOF record -* -* This must be the last record on an Excel 8 stream -* -*******************************************************************} -procedure TsSpreadBIFF8Writer.WriteEOF(AStream: TStream); -begin - { BIFF Record header } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_EOF)); - AStream.WriteWord(WordToLE($0000)); -end; - -{******************************************************************* -* TsSpreadBIFF8Writer.WriteFont () -* -* DESCRIPTION: Writes an Excel 8 FONT record -* -* The font data is passed in an instance of TsFont -* -*******************************************************************} - -procedure TsSpreadBIFF8Writer.WriteFont(AStream: TStream; AFont: TsFont); -var - Len: Byte; - WideFontName: WideString; - optn: Word; -begin - 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 } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_FONT)); - AStream.WriteWord(WordToLE(14 + 1 + 1 + Len * Sizeof(WideChar))); - - { Height of the font in twips = 1/20 of a point } - AStream.WriteWord(WordToLE(round(AFont.Size*20))); - - { Option flags } - 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(ord(FixColor(AFont.Color)))); - - { Font weight } - 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 } - if fssUnderline in AFont.Style then - AStream.WriteByte(1) - else - AStream.WriteByte(0); - - { Font family } - AStream.WriteByte(0); - - { Character set } - AStream.WriteByte(0); - - { Not used } - AStream.WriteByte(0); - - { Font name: Unicodestring, char count in 1 byte } - AStream.WriteByte(Len); - { Widestring flags, 1=regular unicode LE string } - AStream.WriteByte(1); - AStream.WriteBuffer(WideStringToLE(WideFontName)[1], Len * Sizeof(WideChar)); -end; - -{******************************************************************* -* TsSpreadBIFF8Writer.WriteFonts () -* -* DESCRIPTION: Writes the Excel 8 FONT records needed for the -* used fonts in the workbook. -* -*******************************************************************} -procedure TsSpreadBiff8Writer.WriteFonts(AStream: TStream); -var - i: Integer; -begin - for i:=0 to Workbook.GetFontCount-1 do - WriteFont(AStream, Workbook.GetFont(i)); -end; - -procedure TsSpreadBiff8Writer.WriteNumFormat(AStream: TStream; - AFormatData: TsNumFormatData; AListIndex: Integer); -type - TNumFormatRecord = packed record - RecordID: Word; - RecordSize: Word; - FormatIndex: Word; - FormatStringLen: Word; - FormatStringFlags: Byte; - end; -var - len: Integer; - s: String; - ws: widestring; - rec: TNumFormatRecord; - buf: array of byte; -begin - if (AFormatData = nil) or (AFormatData.FormatString = '') then - exit; - - s := NumFormatList.FormatStringForWriting(AListIndex); - ws := UTF8Decode(s); - len := Length(ws); - - { BIFF record header } - rec.RecordID := WordToLE(INT_EXCEL_ID_FORMAT); - rec.RecordSize := WordToLE(2 + 2 + 1 + len * SizeOf(WideChar)); - - { Format index } - rec.FormatIndex := WordToLE(AFormatData.Index); - - { Format string } - { - length of string = 16 bits } - rec.FormatStringLen := WordToLE(len); - { - Widestring flags, 1 = regular unicode LE string } - rec.FormatStringFlags := 1; - { - Copy the text characters into a buffer immediately after rec } - SetLength(buf, SizeOf(rec) + SizeOf(WideChar)*len); - Move(rec, buf[0], SizeOf(rec)); - Move(ws[1], buf[SizeOf(rec)], len*SizeOf(WideChar)); - - { Write out } - AStream.WriteBuffer(buf[0], SizeOf(rec) + SizeOf(WideChar)*len); - - { Clean up } - SetLength(buf, 0); -end; - -{ Writes the address of a cell as used in an RPN formula and returns the - number of bytes written. } -function TsSpreadBIFF8Writer.WriteRPNCellAddress(AStream: TStream; - ARow, ACol: Cardinal; AFlags: TsRelFlags): Word; -var - c: Cardinal; // column index with encoded relative/absolute address info -begin - AStream.WriteWord(WordToLE(ARow)); - c := ACol and MASK_EXCEL_COL_BITS_BIFF8; - if (rfRelRow in AFlags) then c := c or MASK_EXCEL_RELATIVE_ROW_BIFF8; - if (rfRelCol in AFlags) then c := c or MASK_EXCEL_RELATIVE_COL_BIFF8; - AStream.WriteWord(WordToLE(c)); - Result := 4; -end; - -{ Writes row and column offset (unsigned integers!) - Valid for BIFF2-BIFF5. } -function TsSpreadBIFF8Writer.WriteRPNCellOffset(AStream: TStream; - ARowOffset, AColOffset: Integer; AFlags: TsRelFlags): Word; -var - c: Word; - r: SmallInt; -begin - // row address - r := SmallInt(ARowOffset); - AStream.WriteWord(WordToLE(Word(r))); - - // Encoded column address - c := word(AColOffset) and MASK_EXCEL_COL_BITS_BIFF8; - if (rfRelRow in AFlags) then c := c or MASK_EXCEL_RELATIVE_ROW_BIFF8; - if (rfRelCol in AFlags) then c := c or MASK_EXCEL_RELATIVE_COL_BIFF8; - AStream.WriteWord(WordToLE(c)); - - Result := 4; -end; - -{ Writes the address of a cell range as used in an RPN formula and returns the - count of bytes written. } -function TsSpreadBIFF8Writer.WriteRPNCellRangeAddress(AStream: TStream; - ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: TsRelFlags): Word; -var - c: Cardinal; // column index with encoded relative/absolute address info -begin - AStream.WriteWord(WordToLE(ARow1)); - AStream.WriteWord(WordToLE(ARow2)); - - c := ACol1; - if (rfRelCol in AFlags) then c := c or MASK_EXCEL_RELATIVE_COL; - if (rfRelRow in AFlags) then c := c or MASK_EXCEL_RELATIVE_ROW; - AStream.WriteWord(WordToLE(c)); - - c := ACol2; - if (rfRelCol2 in AFlags) then c := c or MASK_EXCEL_RELATIVE_COL; - if (rfRelRow2 in AFlags) then c := c or MASK_EXCEL_RELATIVE_ROW; - AStream.WriteWord(WordToLE(c)); - - Result := 8; -end; - -{ Helper function for writing a string with 8-bit length. Overridden version - for BIFF8. Called for writing rpn formula string tokens. - Returns the count of bytes written} -function TsSpreadBIFF8Writer.WriteString_8BitLen(AStream: TStream; - AString: String): Integer; -var - len: Integer; - wideStr: WideString; -begin - // string constant is stored as widestring in BIFF8 - wideStr := UTF8Decode(AString); - len := Length(wideStr); - AStream.WriteByte(len); // char count in 1 byte - AStream.WriteByte(1); // Widestring flags, 1=regular unicode LE string - AStream.WriteBuffer(WideStringToLE(wideStr)[1], len * Sizeof(WideChar)); - Result := 1 + 1 + len * SizeOf(WideChar); -end; - -procedure TsSpreadBIFF8Writer.WriteStringRecord(AStream: TStream; - AString: String); -var - wideStr: widestring; - len: Integer; -begin - wideStr := UTF8Decode(AString); - len := Length(wideStr); - - { BIFF Record header } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_STRING)); - AStream.WriteWord(WordToLE(3 + len*SizeOf(widechar))); - - { Write widestring length } - AStream.WriteWord(WordToLE(len)); - { Widestring flags, 1=regular unicode LE string } - AStream.WriteByte(1); - { Write characters } - AStream.WriteBuffer(WideStringToLE(wideStr)[1], len * SizeOf(WideChar)); -end; - -{******************************************************************* -* TsSpreadBIFF8Writer.WriteIndex () -* -* DESCRIPTION: Writes an Excel 8 INDEX record -* -* nm = (rl - rf - 1) / 32 + 1 (using integer division) -* -*******************************************************************} -procedure TsSpreadBIFF8Writer.WriteIndex(AStream: TStream); -begin - { BIFF Record header } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_INDEX)); - AStream.WriteWord(WordToLE(16)); - - { Not used } - AStream.WriteDWord(DWordToLE(0)); - - { Index to first used row, rf, 0 based } - AStream.WriteDWord(DWordToLE(0)); - - { Index to first row of unused tail of sheet, rl, last used row + 1, 0 based } - AStream.WriteDWord(DWordToLE(0)); - - { Absolute stream position of the DEFCOLWIDTH record of the current sheet. - If it doesn't exist, the offset points to where it would occur. } - AStream.WriteDWord(DWordToLE($00)); - - { Array of nm absolute stream positions of the DBCELL record of each Row Block } - - { OBS: It seems to be no problem just ignoring this part of the record } -end; - -{******************************************************************* -* TsSpreadBIFF8Writer.WriteLabel () -* -* DESCRIPTION: Writes an Excel 8 LABEL record -* -* Writes a string to the sheet -* If the string length exceeds 32758 bytes, the string -* will be silently truncated. -* -*******************************************************************} -procedure TsSpreadBIFF8Writer.WriteLabel(AStream: TStream; const ARow, - ACol: Cardinal; const AValue: string; ACell: PCell); -const - //limit for this format: 32767 bytes - header (see reclen below): - //37267-8-1=32758 - MAXBYTES = 32758; -var - L: Word; - WideValue: WideString; - rec: TBIFF8_LabelRecord; - buf: array of byte; -begin - if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then - exit; - - WideValue := UTF8Decode(AValue); //to UTF16 - if WideValue = '' then begin - // Badly formatted UTF8String (maybe ANSI?) - if Length(AValue)<>0 then begin - //Quite sure it was an ANSI string written as UTF8, so raise exception. - raise Exception.CreateFmt(rsUTF8TextExpectedButANSIFoundInCell, [GetCellString(ARow,ACol)]); - end; - Exit; - end; - - if Length(WideValue) > MAXBYTES then begin - // Rather than lose data when reading it, let the application programmer deal - // with the problem or purposefully ignore it. - SetLength(WideValue, MAXBYTES); //may corrupt the string (e.g. in surrogate pairs), but... too bad. - Workbook.AddErrorMsg(rsTruncateTooLongCellText, [ - MAXBYTES, GetCellString(ARow, ACol) - ]); - end; - L := Length(WideValue); - - { BIFF record header } - rec.RecordID := WordToLE(INT_EXCEL_ID_LABEL); - rec.RecordSize := 8 + 1 + L * SizeOf(WideChar); - - { BIFF record data } - rec.Row := WordToLE(ARow); - rec.Col := WordToLE(ACol); - - { Index to XF record, according to formatting } - rec.XFIndex := WordToLE(FindXFIndex(ACell)); - - { Byte String with 16-bit length } - rec.TextLen := WordToLE(L); - - { Byte flags, 1 means regular unicode LE encoding } - rec.TextFlags := 1; - - { Copy the text characters into a buffer immediately after rec } - SetLength(buf, SizeOf(rec) + L*SizeOf(WideChar)); - Move(rec, buf[0], SizeOf(Rec)); - Move(WideStringToLE(WideValue)[1], buf[SizeOf(Rec)], L*SizeOf(WideChar)); - - { Write out } - AStream.WriteBuffer(buf[0], SizeOf(rec) + L*SizeOf(WideChar)); - - { Clean up } - SetLength(buf, 0); -end; - -procedure TsSpreadBIFF8Writer.WriteMergedCells(AStream: TStream; - AWorksheet: TsWorksheet); -const - MAX_PER_RECORD = 1026; -var - i, n0, n: Integer; - rngList: TsCellRangeArray; -begin - AWorksheet.GetMergedCellRanges(rngList); - n0 := Length(rngList); - i := 0; - - while n0 > 0 do begin - n := Min(n0, MAX_PER_RECORD); - // at most 1026 merged ranges per BIFF record, the rest goes into a new record - - { BIFF record header } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_MERGEDCELLS)); - AStream.WriteWord(WordToLE(2 + n*8)); - - // Count of cell ranges in this record - AStream.WriteWord(WordToLE(n)); - - // Loop writing the merged cell ranges - while (n > 0) and (i < Length(rngList)) do begin - AStream.WriteWord(WordToLE(rngList[i].Row1)); - AStream.WriteWord(WordToLE(rngList[i].Row2)); - AStream.WriteWord(WordToLE(rngList[i].Col1)); - AStream.WriteWord(WordToLE(rngList[i].Col2)); - (* - AStream.WriteWord(WordToLE({%H-}Lo(rngList[i].Row1))); - AStream.WriteWord(WordToLE({%H-}Lo(rngList[i].Row2))); - AStream.WriteWord(WordToLE({%H-}Lo(rngList[i].Col1))); - AStream.WriteWord(WordToLE({%H-}Lo(rngList[i].Col2))); - *) - inc(i); - dec(n); - end; - - dec(n0, MAX_PER_RECORD); - end; -end; - -{******************************************************************* -* TsSpreadBIFF8Writer.WriteStyle () -* -* DESCRIPTION: Writes an Excel 8 STYLE record -* -* Registers the name of a user-defined style or -* specific options for a built-in cell style. -* -*******************************************************************} -procedure TsSpreadBIFF8Writer.WriteStyle(AStream: TStream); -begin - { BIFF record header } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_STYLE)); - AStream.WriteWord(WordToLE(4)); - - { Index to style XF and defines if it's a built-in or used defined style } - AStream.WriteWord(WordToLE(MASK_STYLE_BUILT_IN)); - - { Built-in cell style identifier } - AStream.WriteByte($00); - - { Level if the identifier for a built-in style is RowLevel or ColLevel, $FF otherwise } - AStream.WriteByte($FF); -end; - -{******************************************************************* -* TsSpreadBIFF8Writer.WriteWindow2 () -* -* DESCRIPTION: Writes an Excel 8 WINDOW2 record -* -* This record contains aditional settings for the -* document window (BIFF2-BIFF4) or for a specific -* worksheet (BIFF5-BIFF8). -* -* The values written here are reasonable defaults, -* which should work for most sheets. -* -*******************************************************************} -procedure TsSpreadBIFF8Writer.WriteWindow2(AStream: TStream; - ASheet: TsWorksheet); -var - Options: Word; -begin - { BIFF Record header } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_WINDOW2)); - AStream.WriteWord(WordToLE(18)); - - { Options flags } - Options := - MASK_WINDOW2_OPTION_SHOW_ZERO_VALUES or - MASK_WINDOW2_OPTION_AUTO_GRIDLINE_COLOR or - MASK_WINDOW2_OPTION_SHOW_OUTLINE_SYMBOLS or - MASK_WINDOW2_OPTION_SHEET_SELECTED or - MASK_WINDOW2_OPTION_SHEET_ACTIVE; - { Bug 0026386 -> every sheet must be selected/active, otherwise Excel cannot print } - - if (soShowGridLines in ASheet.Options) then - Options := Options or MASK_WINDOW2_OPTION_SHOW_GRID_LINES; - if (soShowHeaders in ASheet.Options) then - Options := Options or MASK_WINDOW2_OPTION_SHOW_SHEET_HEADERS; - if (soHasFrozenPanes in ASheet.Options) and ((ASheet.LeftPaneWidth > 0) or (ASheet.TopPaneHeight > 0)) then - Options := Options or MASK_WINDOW2_OPTION_PANES_ARE_FROZEN; - AStream.WriteWord(WordToLE(Options)); - - { Index to first visible row } - AStream.WriteWord(WordToLE(0)); - - { Index to first visible column } - AStream.WriteWord(WordToLE(0)); - - { Grid line index colour } - AStream.WriteWord(WordToLE(0)); - - { Not used } - AStream.WriteWord(WordToLE(0)); - - { Cached magnification factor in page break preview (in percent); 0 = Default (60%) } - AStream.WriteWord(WordToLE(0)); - - { Cached magnification factor in normal view (in percent); 0 = Default (100%) } - AStream.WriteWord(WordToLE(0)); - - { Not used } - AStream.WriteDWord(DWordToLE(0)); -end; - -{******************************************************************* -* TsSpreadBIFF8Writer.WriteXF () -* -* DESCRIPTION: Writes an Excel 8 XF record -* -* -* -*******************************************************************} -procedure TsSpreadBIFF8Writer.WriteXF(AStream: TStream; - AFormatRecord: PsCellFormat; XFType_Prot: Byte = 0); -var - rec: TBIFF8_XFRecord; - j: Integer; - b: Byte; - dw1, dw2: DWord; -begin - { BIFF record header } - rec.RecordID := WordToLE(INT_EXCEL_ID_XF); - rec.RecordSize := WordToLE(SizeOf(TBIFF8_XFRecord) - 2*SizeOf(Word)); - - { Index to font record } - rec.FontIndex := 0; - if (AFormatRecord <> nil) then begin - if (uffBold in AFormatRecord^.UsedFormattingFields) then - rec.FontIndex := 1 - else - if (uffFont in AFormatRecord^.UsedFormattingFields) then - rec.FontIndex := AFormatRecord^.FontIndex; - end; - rec.FontIndex := WordToLE(rec.FontIndex); - - { Index to number format } - rec.NumFormatIndex := 0; - if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields) - then begin - // The number formats in the FormatList are still in fpc dialect - // They will be converted to Excel syntax immediately before writing. - j := NumFormatList.Find(AFormatRecord^.NumberFormat, AFormatRecord^.NumberFormatStr); - if j > -1 then - rec.NumFormatIndex := NumFormatList[j].Index; - end; - rec.NumFormatIndex := WordToLE(rec.NumFormatIndex); - - { XF type, cell protection and parent style XF } - rec.XFType_Prot_ParentXF := XFType_Prot and MASK_XF_TYPE_PROT; - if XFType_Prot and MASK_XF_TYPE_PROT_STYLE_XF <> 0 then - rec.XFType_Prot_ParentXF := rec.XFType_Prot_ParentXF or MASK_XF_TYPE_PROT_PARENT; - - { Text alignment and text break } - if AFormatRecord = nil then - b := MASK_XF_VERT_ALIGN_BOTTOM - else - begin - b := 0; - if (uffHorAlign in AFormatRecord^.UsedFormattingFields) then - case AFormatRecord^.HorAlignment of - haDefault: ; - haLeft : b := b or MASK_XF_HOR_ALIGN_LEFT; - haCenter : b := b or MASK_XF_HOR_ALIGN_CENTER; - haRight : b := b or MASK_XF_HOR_ALIGN_RIGHT; - end; - // Since the default vertical alignment is vaDefault but "0" corresponds - // to vaTop, we alwys have to write the vertical alignment. - case AFormatRecord^.VertAlignment of - vaTop : b := b or MASK_XF_VERT_ALIGN_TOP; - vaCenter : b := b or MASK_XF_VERT_ALIGN_CENTER; - vaBottom : b := b or MASK_XF_VERT_ALIGN_BOTTOM; - else b := b or MASK_XF_VERT_ALIGN_BOTTOM; - end; - if (uffWordWrap in AFormatRecord^.UsedFormattingFields) then - b := b or MASK_XF_TEXTWRAP; - end; - rec.Align_TextBreak := b; - - { Text rotation } - rec.TextRotation := 0; - if (AFormatRecord <> nil) and (uffTextRotation in AFormatRecord^.UsedFormattingFields) - then rec.TextRotation := TEXT_ROTATIONS[AFormatRecord^.TextRotation]; - - { Indentation, shrink, merge and text direction: - see "Excel97-2007BinaryFileFormat(xls)Specification.pdf", p281 ff - Bits 0-3: Indent value - Bit 4: Shrink to fit - Bit 5: MergeCell - Bits 6-7: Reading direction } - rec.Indent_Shrink_TextDir := 0; - - { Used attributes } - rec.UsedAttrib := - MASK_XF_USED_ATTRIB_NUMBER_FORMAT or - MASK_XF_USED_ATTRIB_FONT or - MASK_XF_USED_ATTRIB_TEXT or - MASK_XF_USED_ATTRIB_BORDER_LINES or - MASK_XF_USED_ATTRIB_BACKGROUND or - MASK_XF_USED_ATTRIB_CELL_PROTECTION; - - { Cell border lines and background area } - - dw1 := 0; - dw2 := 0; - rec.BkGr3 := 0; - if (AFormatRecord <> nil) and (uffBorder in AFormatRecord^.UsedFormattingFields) then - begin - // Left and right line colors - dw1 := AFormatRecord^.BorderStyles[cbWest].Color shl 16 + - AFormatRecord^.BorderStyles[cbEast].Color shl 23; - // Border line styles - if cbWest in AFormatRecord^.Border then - dw1 := dw1 or (DWord(AFormatRecord^.BorderStyles[cbWest].LineStyle)+1); - if cbEast in AFormatRecord^.Border then - dw1 := dw1 or ((DWord(AFormatRecord^.BorderStyles[cbEast].LineStyle)+1) shl 4); - if cbNorth in AFormatRecord^.Border then - dw1 := dw1 or ((DWord(AFormatRecord^.BorderStyles[cbNorth].LineStyle)+1) shl 8); - if cbSouth in AFormatRecord^.Border then - dw1 := dw1 or ((DWord(AFormatRecord^.BorderStyles[cbSouth].LineStyle)+1) shl 12); - if cbDiagDown in AFormatRecord^.Border then - dw1 := dw1 or $40000000; - if cbDiagUp in AFormatRecord^.Border then - dw1 := dw1 or $80000000; - - // Top, bottom and diagonal line colors - dw2 := FixColor(AFormatRecord^.BorderStyles[cbNorth].Color) + - FixColor(AFormatRecord^.BorderStyles[cbSouth].Color) shl 7 + - FixColor(AFormatRecord^.BorderStyles[cbDiagUp].Color) shl 14; - // In BIFF8 both diagonals have the same color - we use the color of the up-diagonal. - - // Diagonal line style - if (AFormatRecord^.Border * [cbDiagUp, cbDiagDown] <> []) then - dw2 := dw2 or ((DWord(AFormatRecord^.BorderStyles[cbDiagUp].LineStyle)+1) shl 21); - // In BIFF8 both diagonals have the same line style - we use the color of the up-diagonal. - end; - - if (AFormatRecord <> nil) and (uffBackgroundColor in AFormatRecord^.UsedFormattingFields) then - begin - dw2 := dw2 or DWORD(MASK_XF_FILL_PATT_SOLID shl 26); - rec.BkGr3 := FixColor(AFormatRecord^.BackgroundColor); - end; - - rec.Border_BkGr1 := DWordToLE(dw1); - rec.Border_BkGr2 := DWordToLE(dw2); - rec.BkGr3 := WordToLE(rec.BkGr3); - - { Write out } - AStream.WriteBuffer(rec, SizeOf(rec)); -end; - - (* -procedure TsSpreadBIFF8Writer.WriteXF(AStream: TStream; AFontIndex: Word; - AFormatIndex: Word; AXF_TYPE_PROT, ATextRotation: Byte; ABorders: TsCellBorders; - const ABorderStyles: TsCellBorderStyles; AHorAlignment: TsHorAlignment = haDefault; - AVertAlignment: TsVertAlignment = vaDefault; AWordWrap: Boolean = false; - AddBackground: Boolean = false; ABackgroundColor: TsColor = scSilver); -var - XFOptions: Word; - XFAlignment, XFIndentShrinkMerge, XFOrientationAttrib: Byte; - XFBorderDWord1, XFBorderDWord2: DWord; -begin - { BIFF Record header } - AStream.WriteWord(WordToLE(INT_EXCEL_ID_XF)); - AStream.WriteWord(WordToLE(20)); - - { Index to FONT record } - AStream.WriteWord(WordToLE(AFontIndex)); // Offset 4 - - { Index to FORMAT record } - AStream.WriteWord(WordToLE(AFormatIndex)); // Offset 6 - - { XF type, cell protection and parent style XF } - XFOptions := AXF_TYPE_PROT and MASK_XF_TYPE_PROT; - - if AXF_TYPE_PROT and MASK_XF_TYPE_PROT_STYLE_XF <> 0 then - XFOptions := XFOptions or MASK_XF_TYPE_PROT_PARENT; - - AStream.WriteWord(WordToLE(XFOptions)); // Offset 8 - - { Alignment and text break } - XFAlignment := 0; - case AHorAlignment of - haLeft : XFAlignment := XFAlignment or MASK_XF_HOR_ALIGN_LEFT; - haCenter : XFAlignment := XFAlignment or MASK_XF_HOR_ALIGN_CENTER; - haRight : XFAlignment := XFAlignment or MASK_XF_HOR_ALIGN_RIGHT; - end; - case AVertAlignment of - vaTop : XFAlignment := XFAlignment or MASK_XF_VERT_ALIGN_TOP; - vaCenter : XFAlignment := XFAlignment or MASK_XF_VERT_ALIGN_CENTER; - vaBottom : XFAlignment := XFAlignment or MASK_XF_VERT_ALIGN_BOTTOM; - else XFAlignment := XFAlignment or MASK_XF_VERT_ALIGN_BOTTOM; - end; - if AWordWrap then - XFAlignment := XFAlignment or MASK_XF_TEXTWRAP; - - AStream.WriteByte(XFAlignment); // Offset 10 - - { Text rotation } - AStream.WriteByte(ATextRotation); // 0 is horizontal / normal // Offset 11 - - { Indentation, shrink, merge and text direction: - see "Excel97-2007BinaryFileFormat(xls)Specification.pdf", p281 ff - Bits 0-3: Indent value - Bit 4: Shrink to fit - Bit 5: MergeCell - Bits 6-7: Reading direction } - XFIndentShrinkMerge := 0; - AStream.WriteByte(XFIndentShrinkMerge); // Offset 12 - - { Used attributes } - XFOrientationAttrib := - MASK_XF_USED_ATTRIB_NUMBER_FORMAT or - MASK_XF_USED_ATTRIB_FONT or - MASK_XF_USED_ATTRIB_TEXT or - MASK_XF_USED_ATTRIB_BORDER_LINES or - MASK_XF_USED_ATTRIB_BACKGROUND or - MASK_XF_USED_ATTRIB_CELL_PROTECTION; - - AStream.WriteByte(XFOrientationAttrib); - - { Cell border lines and background area } - - // Left and Right line colors - XFBorderDWord1 := ABorderStyles[cbWest].Color shl 16 + - ABorderStyles[cbEast].Color shl 23; - - // Border line styles - if cbWest in ABorders then - XFBorderDWord1 := XFBorderDWord1 or (DWord(ABorderStyles[cbWest].LineStyle)+1); - if cbEast in ABorders then - XFBorderDWord1 := XFBorderDWord1 or ((DWord(ABorderStyles[cbEast].LineStyle)+1) shl 4); - if cbNorth in ABorders then - XFBorderDWord1 := XFBorderDWord1 or ((DWord(ABorderStyles[cbNorth].LineStyle)+1) shl 8); - if cbSouth in ABorders then - XFBorderDWord1 := XFBorderDWord1 or ((DWord(ABorderStyles[cbSouth].LineStyle)+1) shl 12); - if cbDiagDown in ABorders then - XFBorderDWord1 := XFBorderDWord1 or $40000000; - if cbDiagUp in ABorders then - XFBorderDWord1 := XFBorderDWord1 or $80000000; - AStream.WriteDWord(DWordToLE(XFBorderDWord1)); - - // Top, bottom and diagonal line colors - XFBorderDWord2 := ABorderStyles[cbNorth].Color + ABorderStyles[cbSouth].Color shl 7 + - ABorderStyles[cbDiagUp].Color shl 14; - // In BIFF8 both diagonals have the same color - we use the color of the up-diagonal. - - // Diagonal line style - if (ABorders + [cbDiagUp, cbDiagDown] <> []) then - XFBorderDWord2 := XFBorderDWord2 or ((DWord(ABorderStyles[cbDiagUp].LineStyle)+1) shl 21); - // In BIFF8 both diagonals have the same color - we use the color of the up-diagonal. - - // Add a background, if desired - if AddBackground then XFBorderDWord2 := XFBorderDWord2 or $4000000; - AStream.WriteDWord(DWordToLE(XFBorderDWord2)); - - // Background Pattern Color, always zeroed - if AddBackground then - AStream.WriteWord(WordToLE(ABackgroundColor)) - else - AStream.WriteWord(0); -end;*) - - { TsSpreadBIFF8Reader } destructor TsSpreadBIFF8Reader.Destroy; @@ -1782,7 +728,7 @@ begin { Save the data } FWorksheet.WriteUTF8Text(cell, AStrValue); //Read formatting runs (not supported) - B:=WordLEtoN(AStream.ReadWord); + B := WordLEtoN(AStream.ReadWord); for L := 0 to B-1 do begin AStream.ReadWord; // First formatted character AStream.ReadWord; // Index to FONT record @@ -2039,21 +985,6 @@ procedure TsSpreadBIFF8Reader.ReadXF(const AStream: TStream); else Result := lsDashed; end; end; - (* -type - TXFRecord = packed record // see p. 224 - FontIndex: Word; // Offset 0, Size 2 - FormatIndex: Word; // Offset 2, Size 2 - XFType_CellProt_ParentStyleXF: Word; // Offset 4, Size 2 - Align_TextBreak: Byte; // Offset 6, Size 1 - XFRotation: Byte; // Offset 7, Size 1 - Indent_Shrink_TextDir: Byte; // Offset 8, Size 1 - UnusedAttrib: Byte; // Offset 9, Size 1 - Border_Background_1: DWord; // Offset 10, Size 4 - Border_Background_2: DWord; // Offset 14, Size 4 - Border_Background_3: DWord; // Offset 18, Size 2 - end; - *) var rec: TBIFF8_XFRecord; fmt: TsCellFormat; @@ -2276,6 +1207,868 @@ begin end; +{ TsSpreadBIFF8Writer } + +constructor TsSpreadBIFF8Writer.Create(AWorkbook: TsWorkbook); +begin + inherited Create(AWorkbook); +end; + +{@@ ---------------------------------------------------------------------------- + Writes an Excel BIFF8 file to the disc + + The BIFF 8 writer overrides this method because BIFF 8 is written + as an OLE document, and our current OLE document writing method involves: + + 1 - Writing the BIFF data to a memory stream + 2 - Write the memory stream data to disk using COM functions +-------------------------------------------------------------------------------} +procedure TsSpreadBIFF8Writer.WriteToFile(const AFileName: string; + const AOverwriteExisting: Boolean); +var + Stream: TStream; + OutputStorage: TOLEStorage; + OLEDocument: TOLEDocument; +begin + if (boBufStream in Workbook.Options) then begin + Stream := TBufStream.Create + end else + Stream := TMemoryStream.Create; + + OutputStorage := TOLEStorage.Create; + try + WriteToStream(Stream); + + // Only one stream is necessary for any number of worksheets + OLEDocument.Stream := Stream; + + OutputStorage.WriteOLEFile(AFileName, OLEDocument, AOverwriteExisting, 'Workbook'); + finally + Stream.Free; + OutputStorage.Free; + end; +end; + +{******************************************************************* +* TsSpreadBIFF8Writer.WriteToStream () +* +* DESCRIPTION: Writes an Excel BIFF8 record structure +* +* Be careful as this method doesn't write the OLE +* part of the document, just the BIFF records +* +*******************************************************************} +procedure TsSpreadBIFF8Writer.WriteToStream(AStream: TStream); +const + isBIFF8 = true; +var + CurrentPos: Int64; + Boundsheets: array of Int64; + i, len: Integer; + pane: Byte; +begin + { Write workbook globals } + + WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS); + + WriteWindow1(AStream); + WriteFonts(AStream); + WriteNumFormats(AStream); + WritePalette(AStream); + WriteXFRecords(AStream); + WriteStyle(AStream); + + // A BOUNDSHEET for each worksheet + SetLength(Boundsheets, 0); + for i := 0 to Workbook.GetWorksheetCount - 1 do + begin + len := Length(Boundsheets); + SetLength(Boundsheets, len + 1); + Boundsheets[len] := WriteBoundsheet(AStream, Workbook.GetWorksheetByIndex(i).Name); + end; + + WriteEOF(AStream); + + { Write each worksheet } + + for i := 0 to Workbook.GetWorksheetCount - 1 do + begin + FWorksheet := Workbook.GetWorksheetByIndex(i); + + { First goes back and writes the position of the BOF of the + sheet on the respective BOUNDSHEET record } + CurrentPos := AStream.Position; + AStream.Position := Boundsheets[i]; + AStream.WriteDWord(DWordToLE(DWORD(CurrentPos))); + AStream.Position := CurrentPos; + + WriteBOF(AStream, INT_BOF_SHEET); + WriteIndex(AStream); + //WriteSheetPR(AStream); +// WritePageSetup(AStream); + WriteColInfos(AStream, FWorksheet); + WriteDimensions(AStream, FWorksheet); + //WriteRowAndCellBlock(AStream, sheet); + + if (boVirtualMode in Workbook.Options) then + WriteVirtualCells(AStream) + else begin + WriteRows(AStream, FWorksheet); + WriteCellsToStream(AStream, FWorksheet.Cells); + end; + + // View settings block + WriteWindow2(AStream, FWorksheet); + WritePane(AStream, FWorksheet, isBIFF8, pane); + WriteSelection(AStream, FWorksheet, pane); + + WriteMergedCells(AStream, FWorksheet); + + WriteEOF(AStream); + end; + + { Cleanup } + SetLength(Boundsheets, 0); +end; + + +{******************************************************************* +* TsSpreadBIFF8Writer.WriteBOF () +* +* DESCRIPTION: Writes an Excel 8 BOF record +* +* This must be the first record on an Excel 8 stream +* +*******************************************************************} +procedure TsSpreadBIFF8Writer.WriteBOF(AStream: TStream; ADataType: Word); +begin + { BIFF Record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_BOF)); + AStream.WriteWord(WordToLE(16)); //total record size + + { BIFF version. Should only be used if this BOF is for the workbook globals } + { OpenOffice rejects to correctly read xls files if this field is + omitted as docs. says, or even if it is being written to zero value, + Not tested with Excel, but MSExcel reader opens it as expected } + AStream.WriteWord(WordToLE(INT_BOF_BIFF8_VER)); + + { Data type } + AStream.WriteWord(WordToLE(ADataType)); + + { Build identifier, must not be 0 } + AStream.WriteWord(WordToLE(INT_BOF_BUILD_ID)); + + { Build year, must not be 0 } + AStream.WriteWord(WordToLE(INT_BOF_BUILD_YEAR)); + + { File history flags } + AStream.WriteDWord(DWordToLE(0)); + + { Lowest Excel version that can read all records in this file 5?} + AStream.WriteDWord(DWordToLE(0)); //????????? +end; + +{******************************************************************* +* TsSpreadBIFF8Writer.WriteBoundsheet () +* +* DESCRIPTION: Writes an Excel 8 BOUNDSHEET record +* +* Always located on the workbook globals substream. +* +* One BOUNDSHEET is written for each worksheet. +* +* RETURNS: The stream position where the absolute stream position +* of the BOF of this sheet should be written (4 bytes size). +* +*******************************************************************} +function TsSpreadBIFF8Writer.WriteBoundsheet(AStream: TStream; ASheetName: string): Int64; +var + Len: Byte; + WideSheetName: WideString; +begin + WideSheetName:=UTF8Decode(ASheetName); + Len := Length(WideSheetName); + + { BIFF Record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_BOUNDSHEET)); + AStream.WriteWord(WordToLE(6 + 1 + 1 + Len * Sizeof(WideChar))); + + { Absolute stream position of the BOF record of the sheet represented + by this record } + Result := AStream.Position; + AStream.WriteDWord(DWordToLE(0)); + + { Visibility } + AStream.WriteByte(0); + + { Sheet type } + AStream.WriteByte(0); + + { Sheet name: Unicode string char count 1 byte } + AStream.WriteByte(Len); + {String flags} + AStream.WriteByte(1); + AStream.WriteBuffer(WideStringToLE(WideSheetName)[1], Len * Sizeof(WideChar)); +end; + + +{@@ ---------------------------------------------------------------------------- + Writes an Excel 8 DIMENSIONS record + + nm = (rl - rf - 1) / 32 + 1 (using integer division) + + Excel, OpenOffice and FPSpreadsheet ignore the dimensions written in this + record, but some other applications really use them, so they need to be correct. + + See bug 18886: excel5 files are truncated when imported +-------------------------------------------------------------------------------} +procedure TsSpreadBIFF8Writer.WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet); +var + firstRow, lastRow, firstCol, lastCol: Cardinal; + rec: TBIFF8_DimensionsRecord; +begin + { Determine sheet size } + GetSheetDimensions(AWorksheet, firstRow, lastRow, firstCol, lastCol); + + { Populate BIFF record } + rec.RecordID := WordToLE(INT_EXCEL_ID_DIMENSIONS); + rec.RecordSize := WordToLE(14); + rec.FirstRow := DWordToLE(firstRow); + rec.LastRowPlus1 := DWordToLE(lastRow+1); + rec.FirstCol := WordToLE(firstCol); + rec.LastColPlus1 := WordToLE(lastCol+1); + rec.NotUsed := 0; + + { Write BIFF record to stream } + AStream.WriteBuffer(rec, SizeOf(rec)); +end; + +{******************************************************************* +* TsSpreadBIFF8Writer.WriteEOF () +* +* DESCRIPTION: Writes an Excel 8 EOF record +* +* This must be the last record on an Excel 8 stream +* +*******************************************************************} +procedure TsSpreadBIFF8Writer.WriteEOF(AStream: TStream); +begin + { BIFF Record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_EOF)); + AStream.WriteWord(WordToLE($0000)); +end; + +{******************************************************************* +* TsSpreadBIFF8Writer.WriteFont () +* +* DESCRIPTION: Writes an Excel 8 FONT record +* +* The font data is passed in an instance of TsFont +* +*******************************************************************} +procedure TsSpreadBIFF8Writer.WriteFont(AStream: TStream; AFont: TsFont); +var + Len: Byte; + WideFontName: WideString; + optn: Word; +begin + 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 } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_FONT)); + AStream.WriteWord(WordToLE(14 + 1 + 1 + Len * Sizeof(WideChar))); + + { Height of the font in twips = 1/20 of a point } + AStream.WriteWord(WordToLE(round(AFont.Size*20))); + + { Option flags } + 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(ord(FixColor(AFont.Color)))); + + { Font weight } + 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 } + if fssUnderline in AFont.Style then + AStream.WriteByte(1) + else + AStream.WriteByte(0); + + { Font family } + AStream.WriteByte(0); + + { Character set } + AStream.WriteByte(0); + + { Not used } + AStream.WriteByte(0); + + { Font name: Unicodestring, char count in 1 byte } + AStream.WriteByte(Len); + { Widestring flags, 1=regular unicode LE string } + AStream.WriteByte(1); + AStream.WriteBuffer(WideStringToLE(WideFontName)[1], Len * Sizeof(WideChar)); +end; + +{******************************************************************* +* TsSpreadBIFF8Writer.WriteFonts () +* +* DESCRIPTION: Writes the Excel 8 FONT records needed for the +* used fonts in the workbook. +* +*******************************************************************} +procedure TsSpreadBiff8Writer.WriteFonts(AStream: TStream); +var + i: Integer; +begin + for i:=0 to Workbook.GetFontCount-1 do + WriteFont(AStream, Workbook.GetFont(i)); +end; + +procedure TsSpreadBiff8Writer.WriteNumFormat(AStream: TStream; + AFormatData: TsNumFormatData; AListIndex: Integer); +type + TNumFormatRecord = packed record + RecordID: Word; + RecordSize: Word; + FormatIndex: Word; + FormatStringLen: Word; + FormatStringFlags: Byte; + end; +var + len: Integer; + s: String; + ws: widestring; + rec: TNumFormatRecord; + buf: array of byte; +begin + if (AFormatData = nil) or (AFormatData.FormatString = '') then + exit; + + s := NumFormatList.FormatStringForWriting(AListIndex); + ws := UTF8Decode(s); + len := Length(ws); + + { BIFF record header } + rec.RecordID := WordToLE(INT_EXCEL_ID_FORMAT); + rec.RecordSize := WordToLE(2 + 2 + 1 + len * SizeOf(WideChar)); + + { Format index } + rec.FormatIndex := WordToLE(AFormatData.Index); + + { Format string } + { - length of string = 16 bits } + rec.FormatStringLen := WordToLE(len); + { - Widestring flags, 1 = regular unicode LE string } + rec.FormatStringFlags := 1; + { - Copy the text characters into a buffer immediately after rec } + SetLength(buf, SizeOf(rec) + SizeOf(WideChar)*len); + Move(rec, buf[0], SizeOf(rec)); + Move(ws[1], buf[SizeOf(rec)], len*SizeOf(WideChar)); + + { Write out } + AStream.WriteBuffer(buf[0], SizeOf(rec) + SizeOf(WideChar)*len); + + { Clean up } + SetLength(buf, 0); +end; + +{ Writes the address of a cell as used in an RPN formula and returns the + number of bytes written. } +function TsSpreadBIFF8Writer.WriteRPNCellAddress(AStream: TStream; + ARow, ACol: Cardinal; AFlags: TsRelFlags): Word; +var + c: Cardinal; // column index with encoded relative/absolute address info +begin + AStream.WriteWord(WordToLE(ARow)); + c := ACol and MASK_EXCEL_COL_BITS_BIFF8; + if (rfRelRow in AFlags) then c := c or MASK_EXCEL_RELATIVE_ROW_BIFF8; + if (rfRelCol in AFlags) then c := c or MASK_EXCEL_RELATIVE_COL_BIFF8; + AStream.WriteWord(WordToLE(c)); + Result := 4; +end; + +{ Writes row and column offset (unsigned integers!) + Valid for BIFF2-BIFF5. } +function TsSpreadBIFF8Writer.WriteRPNCellOffset(AStream: TStream; + ARowOffset, AColOffset: Integer; AFlags: TsRelFlags): Word; +var + c: Word; + r: SmallInt; +begin + // row address + r := SmallInt(ARowOffset); + AStream.WriteWord(WordToLE(Word(r))); + + // Encoded column address + c := word(AColOffset) and MASK_EXCEL_COL_BITS_BIFF8; + if (rfRelRow in AFlags) then c := c or MASK_EXCEL_RELATIVE_ROW_BIFF8; + if (rfRelCol in AFlags) then c := c or MASK_EXCEL_RELATIVE_COL_BIFF8; + AStream.WriteWord(WordToLE(c)); + + Result := 4; +end; + +{ Writes the address of a cell range as used in an RPN formula and returns the + count of bytes written. } +function TsSpreadBIFF8Writer.WriteRPNCellRangeAddress(AStream: TStream; + ARow1, ACol1, ARow2, ACol2: Cardinal; AFlags: TsRelFlags): Word; +var + c: Cardinal; // column index with encoded relative/absolute address info +begin + AStream.WriteWord(WordToLE(ARow1)); + AStream.WriteWord(WordToLE(ARow2)); + + c := ACol1; + if (rfRelCol in AFlags) then c := c or MASK_EXCEL_RELATIVE_COL; + if (rfRelRow in AFlags) then c := c or MASK_EXCEL_RELATIVE_ROW; + AStream.WriteWord(WordToLE(c)); + + c := ACol2; + if (rfRelCol2 in AFlags) then c := c or MASK_EXCEL_RELATIVE_COL; + if (rfRelRow2 in AFlags) then c := c or MASK_EXCEL_RELATIVE_ROW; + AStream.WriteWord(WordToLE(c)); + + Result := 8; +end; + +{ Helper function for writing a string with 8-bit length. Overridden version + for BIFF8. Called for writing rpn formula string tokens. + Returns the count of bytes written} +function TsSpreadBIFF8Writer.WriteString_8BitLen(AStream: TStream; + AString: String): Integer; +var + len: Integer; + wideStr: WideString; +begin + // string constant is stored as widestring in BIFF8 + wideStr := UTF8Decode(AString); + len := Length(wideStr); + AStream.WriteByte(len); // char count in 1 byte + AStream.WriteByte(1); // Widestring flags, 1=regular unicode LE string + AStream.WriteBuffer(WideStringToLE(wideStr)[1], len * Sizeof(WideChar)); + Result := 1 + 1 + len * SizeOf(WideChar); +end; + +procedure TsSpreadBIFF8Writer.WriteStringRecord(AStream: TStream; + AString: String); +var + wideStr: widestring; + len: Integer; +begin + wideStr := UTF8Decode(AString); + len := Length(wideStr); + + { BIFF Record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_STRING)); + AStream.WriteWord(WordToLE(3 + len*SizeOf(widechar))); + + { Write widestring length } + AStream.WriteWord(WordToLE(len)); + { Widestring flags, 1=regular unicode LE string } + AStream.WriteByte(1); + { Write characters } + AStream.WriteBuffer(WideStringToLE(wideStr)[1], len * SizeOf(WideChar)); +end; + +{******************************************************************* +* TsSpreadBIFF8Writer.WriteIndex () +* +* DESCRIPTION: Writes an Excel 8 INDEX record +* +* nm = (rl - rf - 1) / 32 + 1 (using integer division) +* +*******************************************************************} +procedure TsSpreadBIFF8Writer.WriteIndex(AStream: TStream); +begin + { BIFF Record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_INDEX)); + AStream.WriteWord(WordToLE(16)); + + { Not used } + AStream.WriteDWord(DWordToLE(0)); + + { Index to first used row, rf, 0 based } + AStream.WriteDWord(DWordToLE(0)); + + { Index to first row of unused tail of sheet, rl, last used row + 1, 0 based } + AStream.WriteDWord(DWordToLE(0)); + + { Absolute stream position of the DEFCOLWIDTH record of the current sheet. + If it doesn't exist, the offset points to where it would occur. } + AStream.WriteDWord(DWordToLE($00)); + + { Array of nm absolute stream positions of the DBCELL record of each Row Block } + + { OBS: It seems to be no problem just ignoring this part of the record } +end; + +{******************************************************************* +* TsSpreadBIFF8Writer.WriteLabel () +* +* DESCRIPTION: Writes an Excel 8 LABEL record +* +* Writes a string to the sheet +* If the string length exceeds 32758 bytes, the string +* will be silently truncated. +* +*******************************************************************} +procedure TsSpreadBIFF8Writer.WriteLabel(AStream: TStream; const ARow, + ACol: Cardinal; const AValue: string; ACell: PCell); +const + //limit for this format: 32767 bytes - header (see reclen below): + //37267-8-1=32758 + MAXBYTES = 32758; +var + L: Word; + WideValue: WideString; + rec: TBIFF8_LabelRecord; + buf: array of byte; +begin + if (ARow >= FLimitations.MaxRowCount) or (ACol >= FLimitations.MaxColCount) then + exit; + + WideValue := UTF8Decode(AValue); //to UTF16 + if WideValue = '' then begin + // Badly formatted UTF8String (maybe ANSI?) + if Length(AValue)<>0 then begin + //Quite sure it was an ANSI string written as UTF8, so raise exception. + raise Exception.CreateFmt(rsUTF8TextExpectedButANSIFoundInCell, [GetCellString(ARow,ACol)]); + end; + Exit; + end; + + if Length(WideValue) > MAXBYTES then begin + // Rather than lose data when reading it, let the application programmer deal + // with the problem or purposefully ignore it. + SetLength(WideValue, MAXBYTES); //may corrupt the string (e.g. in surrogate pairs), but... too bad. + Workbook.AddErrorMsg(rsTruncateTooLongCellText, [ + MAXBYTES, GetCellString(ARow, ACol) + ]); + end; + L := Length(WideValue); + + { BIFF record header } + rec.RecordID := WordToLE(INT_EXCEL_ID_LABEL); + rec.RecordSize := 8 + 1 + L * SizeOf(WideChar); + + { BIFF record data } + rec.Row := WordToLE(ARow); + rec.Col := WordToLE(ACol); + + { Index to XF record, according to formatting } + rec.XFIndex := WordToLE(FindXFIndex(ACell)); + + { Byte String with 16-bit length } + rec.TextLen := WordToLE(L); + + { Byte flags, 1 means regular unicode LE encoding } + rec.TextFlags := 1; + + { Copy the text characters into a buffer immediately after rec } + SetLength(buf, SizeOf(rec) + L*SizeOf(WideChar)); + Move(rec, buf[0], SizeOf(Rec)); + Move(WideStringToLE(WideValue)[1], buf[SizeOf(Rec)], L*SizeOf(WideChar)); + + { Write out } + AStream.WriteBuffer(buf[0], SizeOf(rec) + L*SizeOf(WideChar)); + + { Clean up } + SetLength(buf, 0); +end; + +procedure TsSpreadBIFF8Writer.WriteMergedCells(AStream: TStream; + AWorksheet: TsWorksheet); +const + MAX_PER_RECORD = 1026; +var + i, n0, n: Integer; + rngList: TsCellRangeArray; +begin + AWorksheet.GetMergedCellRanges(rngList); + n0 := Length(rngList); + i := 0; + + while n0 > 0 do begin + n := Min(n0, MAX_PER_RECORD); + // at most 1026 merged ranges per BIFF record, the rest goes into a new record + + { BIFF record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_MERGEDCELLS)); + AStream.WriteWord(WordToLE(2 + n*8)); + + // Count of cell ranges in this record + AStream.WriteWord(WordToLE(n)); + + // Loop writing the merged cell ranges + while (n > 0) and (i < Length(rngList)) do begin + AStream.WriteWord(WordToLE(rngList[i].Row1)); + AStream.WriteWord(WordToLE(rngList[i].Row2)); + AStream.WriteWord(WordToLE(rngList[i].Col1)); + AStream.WriteWord(WordToLE(rngList[i].Col2)); + inc(i); + dec(n); + end; + + dec(n0, MAX_PER_RECORD); + end; +end; + +{******************************************************************* +* TsSpreadBIFF8Writer.WriteStyle () +* +* DESCRIPTION: Writes an Excel 8 STYLE record +* +* Registers the name of a user-defined style or +* specific options for a built-in cell style. +* +*******************************************************************} +procedure TsSpreadBIFF8Writer.WriteStyle(AStream: TStream); +begin + { BIFF record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_STYLE)); + AStream.WriteWord(WordToLE(4)); + + { Index to style XF and defines if it's a built-in or used defined style } + AStream.WriteWord(WordToLE(MASK_STYLE_BUILT_IN)); + + { Built-in cell style identifier } + AStream.WriteByte($00); + + { Level if the identifier for a built-in style is RowLevel or ColLevel, $FF otherwise } + AStream.WriteByte($FF); +end; + +{******************************************************************* +* TsSpreadBIFF8Writer.WriteWindow2 () +* +* DESCRIPTION: Writes an Excel 8 WINDOW2 record +* +* This record contains aditional settings for the +* document window (BIFF2-BIFF4) or for a specific +* worksheet (BIFF5-BIFF8). +* +* The values written here are reasonable defaults, +* which should work for most sheets. +* +*******************************************************************} +procedure TsSpreadBIFF8Writer.WriteWindow2(AStream: TStream; + ASheet: TsWorksheet); +var + Options: Word; +begin + { BIFF Record header } + AStream.WriteWord(WordToLE(INT_EXCEL_ID_WINDOW2)); + AStream.WriteWord(WordToLE(18)); + + { Options flags } + Options := + MASK_WINDOW2_OPTION_SHOW_ZERO_VALUES or + MASK_WINDOW2_OPTION_AUTO_GRIDLINE_COLOR or + MASK_WINDOW2_OPTION_SHOW_OUTLINE_SYMBOLS or + MASK_WINDOW2_OPTION_SHEET_SELECTED or + MASK_WINDOW2_OPTION_SHEET_ACTIVE; + { Bug 0026386 -> every sheet must be selected/active, otherwise Excel cannot print } + + if (soShowGridLines in ASheet.Options) then + Options := Options or MASK_WINDOW2_OPTION_SHOW_GRID_LINES; + if (soShowHeaders in ASheet.Options) then + Options := Options or MASK_WINDOW2_OPTION_SHOW_SHEET_HEADERS; + if (soHasFrozenPanes in ASheet.Options) and ((ASheet.LeftPaneWidth > 0) or (ASheet.TopPaneHeight > 0)) then + Options := Options or MASK_WINDOW2_OPTION_PANES_ARE_FROZEN; + AStream.WriteWord(WordToLE(Options)); + + { Index to first visible row } + AStream.WriteWord(WordToLE(0)); + + { Index to first visible column } + AStream.WriteWord(WordToLE(0)); + + { Grid line index colour } + AStream.WriteWord(WordToLE(0)); + + { Not used } + AStream.WriteWord(WordToLE(0)); + + { Cached magnification factor in page break preview (in percent); 0 = Default (60%) } + AStream.WriteWord(WordToLE(0)); + + { Cached magnification factor in normal view (in percent); 0 = Default (100%) } + AStream.WriteWord(WordToLE(0)); + + { Not used } + AStream.WriteDWord(DWordToLE(0)); +end; + +{******************************************************************* +* TsSpreadBIFF8Writer.WriteXF () +* +* DESCRIPTION: Writes an Excel 8 XF record +* +* +* +*******************************************************************} +procedure TsSpreadBIFF8Writer.WriteXF(AStream: TStream; + AFormatRecord: PsCellFormat; XFType_Prot: Byte = 0); +var + rec: TBIFF8_XFRecord; + j: Integer; + b: Byte; + dw1, dw2: DWord; +begin + { BIFF record header } + rec.RecordID := WordToLE(INT_EXCEL_ID_XF); + rec.RecordSize := WordToLE(SizeOf(TBIFF8_XFRecord) - 2*SizeOf(Word)); + + { Index to font record } + rec.FontIndex := 0; + if (AFormatRecord <> nil) then begin + if (uffBold in AFormatRecord^.UsedFormattingFields) then + rec.FontIndex := 1 + else + if (uffFont in AFormatRecord^.UsedFormattingFields) then + rec.FontIndex := AFormatRecord^.FontIndex; + end; + rec.FontIndex := WordToLE(rec.FontIndex); + + { Index to number format } + rec.NumFormatIndex := 0; + if (AFormatRecord <> nil) and (uffNumberFormat in AFormatRecord^.UsedFormattingFields) + then begin + // The number formats in the FormatList are still in fpc dialect + // They will be converted to Excel syntax immediately before writing. + j := NumFormatList.Find(AFormatRecord^.NumberFormat, AFormatRecord^.NumberFormatStr); + if j > -1 then + rec.NumFormatIndex := NumFormatList[j].Index; + end; + rec.NumFormatIndex := WordToLE(rec.NumFormatIndex); + + { XF type, cell protection and parent style XF } + rec.XFType_Prot_ParentXF := XFType_Prot and MASK_XF_TYPE_PROT; + if XFType_Prot and MASK_XF_TYPE_PROT_STYLE_XF <> 0 then + rec.XFType_Prot_ParentXF := rec.XFType_Prot_ParentXF or MASK_XF_TYPE_PROT_PARENT; + + { Text alignment and text break } + if AFormatRecord = nil then + b := MASK_XF_VERT_ALIGN_BOTTOM + else + begin + b := 0; + if (uffHorAlign in AFormatRecord^.UsedFormattingFields) then + case AFormatRecord^.HorAlignment of + haDefault: ; + haLeft : b := b or MASK_XF_HOR_ALIGN_LEFT; + haCenter : b := b or MASK_XF_HOR_ALIGN_CENTER; + haRight : b := b or MASK_XF_HOR_ALIGN_RIGHT; + end; + // Since the default vertical alignment is vaDefault but "0" corresponds + // to vaTop, we alwys have to write the vertical alignment. + case AFormatRecord^.VertAlignment of + vaTop : b := b or MASK_XF_VERT_ALIGN_TOP; + vaCenter : b := b or MASK_XF_VERT_ALIGN_CENTER; + vaBottom : b := b or MASK_XF_VERT_ALIGN_BOTTOM; + else b := b or MASK_XF_VERT_ALIGN_BOTTOM; + end; + if (uffWordWrap in AFormatRecord^.UsedFormattingFields) then + b := b or MASK_XF_TEXTWRAP; + end; + rec.Align_TextBreak := b; + + { Text rotation } + rec.TextRotation := 0; + if (AFormatRecord <> nil) and (uffTextRotation in AFormatRecord^.UsedFormattingFields) + then rec.TextRotation := TEXT_ROTATIONS[AFormatRecord^.TextRotation]; + + { Indentation, shrink, merge and text direction: + see "Excel97-2007BinaryFileFormat(xls)Specification.pdf", p281 ff + Bits 0-3: Indent value + Bit 4: Shrink to fit + Bit 5: MergeCell + Bits 6-7: Reading direction } + rec.Indent_Shrink_TextDir := 0; + + { Used attributes } + rec.UsedAttrib := + MASK_XF_USED_ATTRIB_NUMBER_FORMAT or + MASK_XF_USED_ATTRIB_FONT or + MASK_XF_USED_ATTRIB_TEXT or + MASK_XF_USED_ATTRIB_BORDER_LINES or + MASK_XF_USED_ATTRIB_BACKGROUND or + MASK_XF_USED_ATTRIB_CELL_PROTECTION; + + { Cell border lines and background area } + + dw1 := 0; + dw2 := 0; + rec.BkGr3 := 0; + if (AFormatRecord <> nil) and (uffBorder in AFormatRecord^.UsedFormattingFields) then + begin + // Left and right line colors + dw1 := AFormatRecord^.BorderStyles[cbWest].Color shl 16 + + AFormatRecord^.BorderStyles[cbEast].Color shl 23; + // Border line styles + if cbWest in AFormatRecord^.Border then + dw1 := dw1 or (DWord(AFormatRecord^.BorderStyles[cbWest].LineStyle)+1); + if cbEast in AFormatRecord^.Border then + dw1 := dw1 or ((DWord(AFormatRecord^.BorderStyles[cbEast].LineStyle)+1) shl 4); + if cbNorth in AFormatRecord^.Border then + dw1 := dw1 or ((DWord(AFormatRecord^.BorderStyles[cbNorth].LineStyle)+1) shl 8); + if cbSouth in AFormatRecord^.Border then + dw1 := dw1 or ((DWord(AFormatRecord^.BorderStyles[cbSouth].LineStyle)+1) shl 12); + if cbDiagDown in AFormatRecord^.Border then + dw1 := dw1 or $40000000; + if cbDiagUp in AFormatRecord^.Border then + dw1 := dw1 or $80000000; + + // Top, bottom and diagonal line colors + dw2 := FixColor(AFormatRecord^.BorderStyles[cbNorth].Color) + + FixColor(AFormatRecord^.BorderStyles[cbSouth].Color) shl 7 + + FixColor(AFormatRecord^.BorderStyles[cbDiagUp].Color) shl 14; + // In BIFF8 both diagonals have the same color - we use the color of the up-diagonal. + + // Diagonal line style + if (AFormatRecord^.Border * [cbDiagUp, cbDiagDown] <> []) then + dw2 := dw2 or ((DWord(AFormatRecord^.BorderStyles[cbDiagUp].LineStyle)+1) shl 21); + // In BIFF8 both diagonals have the same line style - we use the color of the up-diagonal. + end; + + if (AFormatRecord <> nil) and (uffBackgroundColor in AFormatRecord^.UsedFormattingFields) then + begin + dw2 := dw2 or DWORD(MASK_XF_FILL_PATT_SOLID shl 26); + rec.BkGr3 := FixColor(AFormatRecord^.BackgroundColor); + end; + + rec.Border_BkGr1 := DWordToLE(dw1); + rec.Border_BkGr2 := DWordToLE(dw2); + rec.BkGr3 := WordToLE(rec.BkGr3); + + { Write out } + AStream.WriteBuffer(rec, SizeOf(rec)); +end; + + {******************************************************************* * Initialization section * diff --git a/components/fpspreadsheet/xlscommon.pas b/components/fpspreadsheet/xlscommon.pas index a2eb4bfca..430a64dee 100644 --- a/components/fpspreadsheet/xlscommon.pas +++ b/components/fpspreadsheet/xlscommon.pas @@ -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, ) -} -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. diff --git a/components/fpspreadsheet/xlsxooxml.pas b/components/fpspreadsheet/xlsxooxml.pas index 9804509fe..c851efaf1 100755 --- a/components/fpspreadsheet/xlsxooxml.pas +++ b/components/fpspreadsheet/xlsxooxml.pas @@ -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 ''); 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, ''); 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, '', @@ -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