diff --git a/components/fpspreadsheet/examples/excel8demo/run_excel8write_format.bat b/components/fpspreadsheet/examples/excel8demo/run_excel8write_format.bat deleted file mode 100644 index f470b475e..000000000 --- a/components/fpspreadsheet/examples/excel8demo/run_excel8write_format.bat +++ /dev/null @@ -1,2 +0,0 @@ -excel8write_format.exe -pause \ No newline at end of file diff --git a/components/fpspreadsheet/examples/excel8demo/excel8write_format.lpi b/components/fpspreadsheet/examples/other/test_write_formatting.lpi similarity index 89% rename from components/fpspreadsheet/examples/excel8demo/excel8write_format.lpi rename to components/fpspreadsheet/examples/other/test_write_formatting.lpi index 2173ae5db..72184c16b 100644 --- a/components/fpspreadsheet/examples/excel8demo/excel8write_format.lpi +++ b/components/fpspreadsheet/examples/other/test_write_formatting.lpi @@ -10,6 +10,7 @@ + <ResourceType Value="res"/> <UseXPManifest Value="True"/> <Icon Value="0"/> @@ -40,9 +41,9 @@ </RequiredPackages> <Units Count="1"> <Unit0> - <Filename Value="excel8write_format.pas"/> + <Filename Value="test_write_formatting.pas"/> <IsPartOfProject Value="True"/> - <UnitName Value="excel8write_format"/> + <UnitName Value="test_write_formatting"/> </Unit0> </Units> </ProjectOptions> @@ -50,7 +51,7 @@ <Version Value="10"/> <PathDelim Value="\"/> <Target> - <Filename Value="excel8write_format"/> + <Filename Value="test_write_formatting"/> </Target> <SearchPaths> <IncludeFiles Value="$(ProjOutDir)"/> diff --git a/components/fpspreadsheet/examples/excel8demo/excel8write_format.pas b/components/fpspreadsheet/examples/other/test_write_formatting.pas similarity index 95% rename from components/fpspreadsheet/examples/excel8demo/excel8write_format.pas rename to components/fpspreadsheet/examples/other/test_write_formatting.pas index 125c2d6cc..95deca231 100644 --- a/components/fpspreadsheet/examples/excel8demo/excel8write_format.pas +++ b/components/fpspreadsheet/examples/other/test_write_formatting.pas @@ -1,5 +1,5 @@ { -excel8write.dpr +test_write_formatting.pas Demonstrates how to write an Excel 8+ file using the fpspreadsheet library @@ -7,12 +7,12 @@ Adds formatting to the file AUTHORS: Felipe Monteiro de Carvalho } -program excel8write_format; +program test_write_formatting; {$mode delphi}{$H+} uses - Classes, SysUtils, fpspreadsheet, xlsbiff8, + Classes, SysUtils, fpspreadsheet, xlsbiff8, fpsopendocument, laz_fpspreadsheet, fpsconvencoding; var @@ -170,7 +170,8 @@ begin WriteSecondWorksheet(); // Save the spreadsheet to a file - MyWorkbook.WriteToFile(MyDir + 'test3.xls', sfExcel8, False); + //MyWorkbook.WriteToFile(MyDir + 'test3.xls', sfExcel8, False); + MyWorkbook.WriteToFile(MyDir + 'test3.odt', sfOpenDocument, False); MyWorkbook.Free; end. diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 9dd16c1af..562e6ceef 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/components/fpspreadsheet/fpspreadsheet.pas @@ -272,7 +272,17 @@ type TsCustomSpreadWriter = class 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; + NextXFIndex: Integer; // Indicates which should be the next XF (Style) Index when filling the styles list { Helper routines } + function FindFormattingInList(AFormat: PCell): Integer; + procedure AddDefaultFormats(); virtual; + procedure ListAllFormattingStylesCallback(ACell: PCell; AStream: TStream); + procedure ListAllFormattingStyles(AData: TsWorkbook); function ExpandFormula(AFormula: TsFormula): TsExpandedFormula; { General writing methods } procedure WriteCellCallback(ACell: PCell; AStream: TStream); @@ -988,6 +998,71 @@ end; { TsCustomSpreadWriter } +{@@ + Checks if the style of a cell is in the list FFormattingStyles and returns the index + or -1 if it isn't +} +function TsCustomSpreadWriter.FindFormattingInList(AFormat: PCell): Integer; +var + i: Integer; +begin + Result := -1; + + for i := 0 to Length(FFormattingStyles) - 1 do + begin + if (FFormattingStyles[i].UsedFormattingFields <> AFormat^.UsedFormattingFields) then Continue; + + if uffTextRotation in AFormat^.UsedFormattingFields then + if (FFormattingStyles[i].TextRotation <> AFormat^.TextRotation) then Continue; + + if uffBorder in AFormat^.UsedFormattingFields then + if (FFormattingStyles[i].Border <> AFormat^.Border) then Continue; + + if uffBackgroundColor in AFormat^.UsedFormattingFields then + if (FFormattingStyles[i].BackgroundColor <> AFormat^.BackgroundColor) then Continue; + + // If we arrived here it means that the styles match + Exit(i); + end; +end; + +{ Each descendent should define it's own default formats, if any. + Always add the normal, unformatted style first to speed up. } +procedure TsCustomSpreadWriter.AddDefaultFormats(); +begin + SetLength(FFormattingStyles, 0); + NextXFIndex := 0; +end; + +procedure TsCustomSpreadWriter.ListAllFormattingStylesCallback(ACell: PCell; AStream: TStream); +var + Len: Integer; +begin + if ACell^.UsedFormattingFields = [] then Exit; + + if FindFormattingInList(ACell) <> -1 then Exit; + + Len := Length(FFormattingStyles); + SetLength(FFormattingStyles, Len+1); + FFormattingStyles[Len] := ACell^; + FFormattingStyles[Len].Row := NextXFIndex; + Inc(NextXFIndex); +end; + +procedure TsCustomSpreadWriter.ListAllFormattingStyles(AData: TsWorkbook); +var + i: Integer; +begin + SetLength(FFormattingStyles, 0); + + AddDefaultFormats(); + + for i := 0 to AData.GetWorksheetCount - 1 do + begin + IterateThroughCells(nil, AData.GetWorksheetByIndex(i).Cells, ListAllFormattingStylesCallback); + end; +end; + {@@ Expands a formula, separating it in it's constituent parts, so that it is already partially parsed and it is easier to diff --git a/components/fpspreadsheet/xlsbiffcommon.pas b/components/fpspreadsheet/xlsbiffcommon.pas index 8779ba367..306beb205 100644 --- a/components/fpspreadsheet/xlsbiffcommon.pas +++ b/components/fpspreadsheet/xlsbiffcommon.pas @@ -46,17 +46,7 @@ type TsSpreadBIFFWriter = class(TsCustomSpreadWriter) protected - { - 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; - NextXFIndex: Integer; // Indicates which should be the next XF Index when filling the styles list function FPSColorToEXCELPallete(AColor: TsColor): Word; - function FindFormattingInList(AFormat: PCell): Integer; - procedure AddDefaultFormats(); virtual; - procedure ListAllFormattingStylesCallback(ACell: PCell; AStream: TStream); - procedure ListAllFormattingStyles(AData: TsWorkbook); end; implementation @@ -86,70 +76,5 @@ begin end; end; -{ - Checks if the style of a cell is in the list FFormattingStyles and returns the index - or -1 if it isn't -} -function TsSpreadBIFFWriter.FindFormattingInList(AFormat: PCell): Integer; -var - i: Integer; -begin - Result := -1; - - for i := 0 to Length(FFormattingStyles) - 1 do - begin - if (FFormattingStyles[i].UsedFormattingFields <> AFormat^.UsedFormattingFields) then Continue; - - if uffTextRotation in AFormat^.UsedFormattingFields then - if (FFormattingStyles[i].TextRotation <> AFormat^.TextRotation) then Continue; - - if uffBorder in AFormat^.UsedFormattingFields then - if (FFormattingStyles[i].Border <> AFormat^.Border) then Continue; - - if uffBackgroundColor in AFormat^.UsedFormattingFields then - if (FFormattingStyles[i].BackgroundColor <> AFormat^.BackgroundColor) then Continue; - - // If we arrived here it means that the styles match - Exit(i); - end; -end; - -{ Each descendent should define it's own default formats, if any. - Always add the normal, unformatted style first to speed up. } -procedure TsSpreadBIFFWriter.AddDefaultFormats(); -begin - SetLength(FFormattingStyles, 0); - NextXFIndex := 0; -end; - -procedure TsSpreadBIFFWriter.ListAllFormattingStylesCallback(ACell: PCell; AStream: TStream); -var - Len: Integer; -begin - if ACell^.UsedFormattingFields = [] then Exit; - - if FindFormattingInList(ACell) <> -1 then Exit; - - Len := Length(FFormattingStyles); - SetLength(FFormattingStyles, Len+1); - FFormattingStyles[Len] := ACell^; - FFormattingStyles[Len].Row := NextXFIndex; - Inc(NextXFIndex); -end; - -procedure TsSpreadBIFFWriter.ListAllFormattingStyles(AData: TsWorkbook); -var - i: Integer; -begin - SetLength(FFormattingStyles, 0); - - AddDefaultFormats(); - - for i := 0 to AData.GetWorksheetCount - 1 do - begin - IterateThroughCells(nil, AData.GetWorksheetByIndex(i).Cells, ListAllFormattingStylesCallback); - end; -end; - end.