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

fpspreadsheet: Add/complete color support for biff2 and biff8, reading and writing. Display colors in fpspreadsheetgrid.

Browse Source 
Remove parameter AData in several methods of the readers/writers and replace it by FWorkbook passed at creation.
Add unit tests for font and color support. No issues.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2960 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-04-23 22:29:32 +00:00
parent c61e4418b7
commit f69a47c902
20 changed files with 1395 additions and 580 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
components/fpspreadsheet/examples/excel8demo/excel8write.lpi
View File

@ -55,6 +55,11 @@
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<DebugInfoType Value="dsStabs"/>
</Debugging>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>

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

@ -37,6 +37,7 @@ begin
// Create the spreadsheet
MyWorkbook := TsWorkbook.Create;
MyWorkbook.SetDefaultFont('Calibri', 9);
MyWorkbook.UsePalette(@PALETTE_BIFF8, 64, true);
MyWorksheet := MyWorkbook.AddWorksheet(Str_Worksheet1);
@ -54,6 +55,9 @@ begin
lCell^.BackgroundColor := scPurple;
lCell^.UsedFormattingFields := [uffBackgroundColor];
// or: MyWorksheet.WriteBackgroundColor(5, 3, scPurple);
MyWorksheet.WriteFontColor(5, 3, scWhite);
MyWorksheet.WriteFontSize(5, 3, 12);
// or: MyWorksheet.WriteFont(5, 3, 'Arial', 12, [], scWhite);
// E6 empty cell, only background color
MyWorksheet.WriteBackgroundColor(5, 4, scYellow);
@ -62,7 +66,8 @@ begin
MyWorksheet.WriteBorders(5, 5, [cbNorth, cbEast, cbSouth, cbWest]);
// Word-wrapped long text in D7
MyWorksheet.WriteUTF8Text(6, 3, 'This is a very, very, very, very long text.');
MyWorksheet.WriteUTF8Text(6, 3, 'This is a very, very, very, very long wrapped text.');
MyWorksheet.WriteUsedFormatting(6, 3, [uffWordwrap]);
// Cell with changed font in D8
MyWorksheet.WriteUTF8Text(7, 3, 'This is 16pt red bold & italic Times New Roman.');
@ -71,7 +76,7 @@ begin
// Cell with changed font and background in D9
MyWorksheet.WriteUTF8Text(8, 3, 'Colors...');
MyWorksheet.WriteFont(8, 3, 'Courier New', 12, [fssUnderline], scBlue);
// MyWorksheet.WriteBackgroundColor(8, 3, scYellow);
MyWorksheet.WriteBackgroundColor(8, 3, scYellow);
{ Uncomment this to test large XLS files
for i := 2 to 20 do

352
components/fpspreadsheet/examples/fpsgrid/fpsgrid.lpi
View File

@ -15,8 +15,79 @@
<CharSet Value=""/>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<BuildModes Count="3" Active="Debug">
<Item1 Name="default" Default="True"/>
<Item2 Name="Debug">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
</CodeGeneration>
<Linking>
<Debugging>
<DebugInfoType Value="dsStabs"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</Item2>
<Item3 Name="Release">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</Item3>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
@ -37,7 +108,7 @@
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="24">
<Units Count="27">
<Unit0>
<Filename Value="fpsgrid.lpr"/>
<IsPartOfProject Value="True"/>
@ -46,7 +117,7 @@
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="11"/>
<UsageCount Value="95"/>
<UsageCount Value="119"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
@ -58,9 +129,9 @@
<UnitName Value="mainform"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="8" Y="1"/>
<UsageCount Value="95"/>
<TopLine Value="47"/>
<CursorPos X="51" Y="49"/>
<UsageCount Value="119"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
@ -69,19 +140,22 @@
<UnitName Value="fpspreadsheet"/>
<EditorIndex Value="5"/>
<WindowIndex Value="0"/>
<TopLine Value="1810"/>
<CursorPos X="11" Y="1941"/>
<UsageCount Value="45"/>
<TopLine Value="1916"/>
<CursorPos X="1" Y="1940"/>
<UsageCount Value="58"/>
<Bookmarks Count="1">
<Item0 X="1" Y="1292" ID="1"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<UnitName Value="fpspreadsheetgrid"/>
<EditorIndex Value="2"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/>
<TopLine Value="133"/>
<CursorPos X="3" Y="159"/>
<UsageCount Value="46"/>
<TopLine Value="12"/>
<CursorPos X="15" Y="33"/>
<UsageCount Value="59"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
@ -90,7 +164,7 @@
<WindowIndex Value="0"/>
<TopLine Value="25"/>
<CursorPos X="4" Y="44"/>
<UsageCount Value="5"/>
<UsageCount Value="3"/>
</Unit4>
<Unit5>
<Filename Value="c:\lazarus27\fpc\2.2.4\source\packages\winunits-base\src\activex.pp"/>
@ -98,7 +172,7 @@
<WindowIndex Value="0"/>
<TopLine Value="49"/>
<CursorPos X="10" Y="24"/>
<UsageCount Value="5"/>
<UsageCount Value="3"/>
</Unit5>
<Unit6>
<Filename Value="c:\lazarus27\fpc\2.2.4\source\packages\fcl-base\src\avl_tree.pp"/>
@ -106,7 +180,7 @@
<WindowIndex Value="0"/>
<TopLine Value="37"/>
<CursorPos X="14" Y="83"/>
<UsageCount Value="5"/>
<UsageCount Value="3"/>
</Unit6>
<Unit7>
<Filename Value="c:\Lazarus\lcl\grids.pas"/>
@ -114,14 +188,14 @@
<WindowIndex Value="0"/>
<TopLine Value="1516"/>
<CursorPos X="28" Y="1534"/>
<UsageCount Value="5"/>
<UsageCount Value="3"/>
</Unit7>
<Unit8>
<Filename Value="c:\Lazarus\lcl\include\customform.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="2021"/>
<CursorPos X="1" Y="2041"/>
<UsageCount Value="5"/>
<UsageCount Value="3"/>
</Unit8>
<Unit9>
<Filename Value="..\..\fpsallformats.pas"/>
@ -129,7 +203,7 @@
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="62" Y="13"/>
<UsageCount Value="15"/>
<UsageCount Value="13"/>
</Unit9>
<Unit10>
<Filename Value="..\..\wikitable.pas"/>
@ -137,32 +211,34 @@
<WindowIndex Value="0"/>
<TopLine Value="48"/>
<CursorPos X="41" Y="60"/>
<UsageCount Value="21"/>
<UsageCount Value="19"/>
</Unit10>
<Unit11>
<Filename Value="..\..\fpsopendocument.pas"/>
<UnitName Value="fpsopendocument"/>
<EditorIndex Value="6"/>
<WindowIndex Value="0"/>
<TopLine Value="280"/>
<CursorPos X="41" Y="285"/>
<UsageCount Value="15"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="1"/>
<UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit11>
<Unit12>
<Filename Value="d:\lazarus-svn\lcl\grids.pas"/>
<UnitName Value="Grids"/>
<WindowIndex Value="0"/>
<TopLine Value="4124"/>
<CursorPos X="3" Y="4129"/>
<UsageCount Value="21"/>
<TopLine Value="3963"/>
<CursorPos X="2" Y="3981"/>
<UsageCount Value="24"/>
</Unit12>
<Unit13>
<Filename Value="..\..\fpsutils.pas"/>
<UnitName Value="fpsutils"/>
<EditorIndex Value="4"/>
<EditorIndex Value="3"/>
<WindowIndex Value="0"/>
<TopLine Value="310"/>
<CursorPos X="25" Y="59"/>
<UsageCount Value="21"/>
<TopLine Value="35"/>
<CursorPos X="1" Y="62"/>
<UsageCount Value="34"/>
<Loaded Value="True"/>
</Unit13>
<Unit14>
@ -170,37 +246,35 @@
<WindowIndex Value="0"/>
<TopLine Value="1212"/>
<CursorPos X="3" Y="1218"/>
<UsageCount Value="13"/>
<UsageCount Value="11"/>
</Unit14>
<Unit15>
<Filename Value="d:\lazarus-svn\lcl\graphics.pp"/>
<UnitName Value="Graphics"/>
<EditorIndex Value="3"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/>
<TopLine Value="259"/>
<CursorPos X="3" Y="278"/>
<UsageCount Value="13"/>
<TopLine Value="34"/>
<CursorPos X="1" Y="64"/>
<UsageCount Value="26"/>
<Loaded Value="True"/>
</Unit15>
<Unit16>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\rtl\objpas\classes\classesh.inc"/>
<EditorIndex Value="7"/>
<WindowIndex Value="0"/>
<TopLine Value="76"/>
<CursorPos X="28" Y="88"/>
<UsageCount Value="13"/>
<TopLine Value="248"/>
<CursorPos X="22" Y="263"/>
<UsageCount Value="18"/>
<Loaded Value="True"/>
</Unit16>
<Unit17>
<Filename Value="..\..\xlsbiff8.pas"/>
<UnitName Value="xlsbiff8"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="6"/>
<EditorIndex Value="10"/>
<WindowIndex Value="0"/>
<TopLine Value="158"/>
<CursorPos X="1" Y="178"/>
<UsageCount Value="20"/>
<Bookmarks Count="1">
<Item0 X="86" Y="2488" ID="1"/>
</Bookmarks>
<TopLine Value="2065"/>
<CursorPos X="1" Y="2100"/>
<UsageCount Value="33"/>
<Loaded Value="True"/>
</Unit17>
<Unit18>
@ -209,40 +283,43 @@
<WindowIndex Value="0"/>
<TopLine Value="537"/>
<CursorPos X="23" Y="567"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit18>
<Unit19>
<Filename Value="d:\lazarus-svn\lcl\include\wincontrol.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="7344"/>
<CursorPos X="30" Y="7349"/>
<UsageCount Value="15"/>
<UsageCount Value="13"/>
</Unit19>
<Unit20>
<Filename Value="..\..\xlscommon.pas"/>
<UnitName Value="xlscommon"/>
<EditorIndex Value="7"/>
<EditorIndex Value="9"/>
<WindowIndex Value="0"/>
<TopLine Value="286"/>
<CursorPos X="14" Y="305"/>
<UsageCount Value="16"/>
<TopLine Value="494"/>
<CursorPos X="1" Y="501"/>
<UsageCount Value="29"/>
<Loaded Value="True"/>
</Unit20>
<Unit21>
<Filename Value="..\..\xlsbiff5.pas"/>
<UnitName Value="xlsbiff5"/>
<WindowIndex Value="0"/>
<TopLine Value="1110"/>
<TopLine Value="1113"/>
<CursorPos X="1" Y="1134"/>
<UsageCount Value="11"/>
<UsageCount Value="16"/>
</Unit21>
<Unit22>
<Filename Value="..\..\xlsbiff2.pas"/>
<UnitName Value="xlsbiff2"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="11"/>
<WindowIndex Value="0"/>
<TopLine Value="93"/>
<CursorPos X="35" Y="83"/>
<UsageCount Value="11"/>
<TopLine Value="944"/>
<CursorPos X="37" Y="959"/>
<UsageCount Value="17"/>
<Loaded Value="True"/>
</Unit22>
<Unit23>
<Filename Value="d:\lazarus-svn\lcl\lclproc.pas"/>
@ -250,129 +327,154 @@
<WindowIndex Value="0"/>
<TopLine Value="841"/>
<CursorPos X="19" Y="852"/>
<UsageCount Value="10"/>
<UsageCount Value="8"/>
</Unit23>
<Unit24>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\packages\fcl-image\src\fpcanvas.pp"/>
<UnitName Value="FPCanvas"/>
<WindowIndex Value="0"/>
<TopLine Value="64"/>
<CursorPos X="3" Y="83"/>
<UsageCount Value="14"/>
</Unit24>
<Unit25>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\packages\fcl-image\src\fpimage.pp"/>
<UnitName Value="FPimage"/>
<WindowIndex Value="0"/>
<TopLine Value="74"/>
<CursorPos X="3" Y="93"/>
<UsageCount Value="9"/>
</Unit25>
<Unit26>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\rtl\objpas\classes\lists.inc"/>
<EditorIndex Value="8"/>
<WindowIndex Value="0"/>
<TopLine Value="141"/>
<CursorPos X="3" Y="143"/>
<UsageCount Value="16"/>
<Loaded Value="True"/>
</Unit26>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="647" Column="50" TopLine="615"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="965" Column="1" TopLine="957"/>
</Position1>
<Position2>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="650" Column="24" TopLine="618"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="964" Column="48" TopLine="957"/>
</Position2>
<Position3>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="652" Column="51" TopLine="620"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="972" Column="32" TopLine="957"/>
</Position3>
<Position4>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="966" Column="72" TopLine="934"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="968" Column="1" TopLine="957"/>
</Position4>
<Position5>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="978" Column="35" TopLine="946"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="971" Column="1" TopLine="957"/>
</Position5>
<Position6>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1195" Column="43" TopLine="1163"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="974" Column="1" TopLine="957"/>
</Position6>
<Position7>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1196" Column="18" TopLine="1164"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="792" Column="1" TopLine="771"/>
</Position7>
<Position8>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1202" Column="83" TopLine="1170"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="794" Column="1" TopLine="771"/>
</Position8>
<Position9>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1203" Column="35" TopLine="1171"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="796" Column="1" TopLine="774"/>
</Position9>
<Position10>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1752" Column="26" TopLine="1720"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="797" Column="26" TopLine="783"/>
</Position10>
<Position11>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1753" Column="75" TopLine="1721"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="806" Column="1" TopLine="783"/>
</Position11>
<Position12>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1852" Column="87" TopLine="1833"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="814" Column="1" TopLine="783"/>
</Position12>
<Position13>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1856" Column="14" TopLine="1833"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="968" Column="1" TopLine="947"/>
</Position13>
<Position14>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="151" Column="15" TopLine="124"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="965" Column="1" TopLine="947"/>
</Position14>
<Position15>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="254" Column="39" TopLine="223"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1008" Column="1" TopLine="987"/>
</Position15>
<Position16>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="168" Column="31" TopLine="144"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1009" Column="1" TopLine="987"/>
</Position16>
<Position17>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="165" Column="24" TopLine="146"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1010" Column="1" TopLine="987"/>
</Position17>
<Position18>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1852" Column="63" TopLine="1850"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1011" Column="1" TopLine="987"/>
</Position18>
<Position19>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="2426" Column="13" TopLine="2411"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1012" Column="1" TopLine="987"/>
</Position19>
<Position20>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="2097" Column="3" TopLine="2090"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1013" Column="1" TopLine="987"/>
</Position20>
<Position21>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="2099" Column="1" TopLine="2090"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1014" Column="1" TopLine="987"/>
</Position21>
<Position22>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="2102" Column="1" TopLine="2090"/>
<Caret Line="104" Column="15" TopLine="86"/>
</Position22>
<Position23>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="2103" Column="1" TopLine="2090"/>
<Caret Line="1712" Column="38" TopLine="1676"/>
</Position23>
<Position24>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="2106" Column="1" TopLine="2090"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1005" Column="16" TopLine="996"/>
</Position24>
<Position25>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="2109" Column="1" TopLine="2090"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="817" Column="3" TopLine="811"/>
</Position25>
<Position26>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="2112" Column="1" TopLine="2090"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="815" Column="18" TopLine="794"/>
</Position26>
<Position27>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="2116" Column="1" TopLine="2090"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="139" Column="10" TopLine="102"/>
</Position27>
<Position28>
<Filename Value="..\..\xlsbiff8.pas"/>
<Caret Line="2119" Column="1" TopLine="2090"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="824" Column="31" TopLine="803"/>
</Position28>
<Position29>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="170" Column="39" TopLine="151"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1088" Column="17" TopLine="1055"/>
</Position29>
<Position30>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="171" Column="30" TopLine="151"/>
<Filename Value="..\..\xlsbiff2.pas"/>
<Caret Line="1082" Column="16" TopLine="1061"/>
</Position30>
</JumpHistory>
</ProjectOptions>
@ -388,6 +490,9 @@
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<DebugInfoType Value="dsStabs"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
@ -399,12 +504,15 @@
</Other>
</CompilerOptions>
<Debugging>
<Watches Count="1">
<Watches Count="2">
<Item1>
<Expression Value="ldata.borders"/>
<Expression Value="lcell^.fontindex"/>
</Item1>
<Item2>
<Expression Value="arow"/>
</Item2>
</Watches>
<Exceptions Count="3">
<Exceptions Count="5">
<Item1>
<Name Value="EAbort"/>
</Item1>
@ -414,6 +522,12 @@
<Item3>
<Name Value="EFOpenError"/>
</Item3>
<Item4>
<Name Value="Exception"/>
</Item4>
<Item5>
<Name Value="EStreamError"/>
</Item5>
</Exceptions>
</Debugging>
<EditorMacros Count="0"/>

32
components/fpspreadsheet/fpsopendocument.pas
View File

@ -85,7 +85,7 @@ type
procedure WriteMeta;
procedure WriteSettings;
procedure WriteStyles;
procedure WriteContent(AData: TsWorkbook);
procedure WriteContent;
procedure WriteWorksheet(CurSheet: TsWorksheet);
// Routines to write parts of those files
function WriteStylesXMLAsString: string;
@ -101,12 +101,12 @@ type
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: TDateTime; ACell: PCell); override;
public
constructor Create; override;
constructor Create(AWorkbook: TsWorkbook); override;
{ General writing methods }
procedure WriteStringToFile(AString, AFileName: string);
procedure WriteToFile(const AFileName: string; AData: TsWorkbook;
procedure WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean = False); override;
procedure WriteToStream(AStream: TStream; AData: TsWorkbook); override;
procedure WriteToStream(AStream: TStream); override;
end;
implementation
@ -544,14 +544,14 @@ begin
'</office:document-styles>';
end;
procedure TsSpreadOpenDocWriter.WriteContent(AData: TsWorkbook);
procedure TsSpreadOpenDocWriter.WriteContent;
var
i: Integer;
lStylesCode: string;
begin
ListAllFormattingStyles(AData);
ListAllFormattingStyles;
lStylesCode := WriteStylesXMLAsString();
lStylesCode := WriteStylesXMLAsString;
FContent :=
XML_HEADER + LineEnding +
@ -602,10 +602,8 @@ begin
' <office:spreadsheet>' + LineEnding;
// Write all worksheets
for i := 0 to AData.GetWorksheetCount - 1 do
begin
WriteWorksheet(Adata.GetWorksheetByIndex(i));
end;
for i := 0 to Workbook.GetWorksheetCount - 1 do
WriteWorksheet(Workbook.GetWorksheetByIndex(i));
FContent := FContent +
' </office:spreadsheet>' + LineEnding +
@ -701,7 +699,7 @@ begin
if (uffBackgroundColor in FFormattingStyles[i].UsedFormattingFields) then
begin
Result := Result + 'fo:background-color="#'
+ FPSColorToHexString(FFormattingStyles[i].BackgroundColor, FFormattingStyles[i].RGBBackgroundColor) +'" ';
+ Workbook.FPSColorToHexString(FFormattingStyles[i].BackgroundColor, FFormattingStyles[i].RGBBackgroundColor) +'" ';
end;
if (uffWordWrap in FFormattingStyles[i].UsedFormattingFields) then
@ -718,9 +716,9 @@ begin
end;
end;
constructor TsSpreadOpenDocWriter.Create;
constructor TsSpreadOpenDocWriter.Create(AWorkbook: TsWorkbook);
begin
inherited Create;
inherited Create(AWorkbook);
FPointSeparatorSettings := SysUtils.DefaultFormatSettings;
FPointSeparatorSettings.DecimalSeparator:='.';
@ -744,7 +742,7 @@ end;
Writes an OOXML document to the disc.
}
procedure TsSpreadOpenDocWriter.WriteToFile(const AFileName: string;
AData: TsWorkbook; const AOverwriteExisting: Boolean);
const AOverwriteExisting: Boolean);
var
FZip: TZipper;
begin
@ -755,7 +753,7 @@ begin
WriteMeta();
WriteSettings();
WriteStyles();
WriteContent(AData);
WriteContent;
{ Write the data to streams }
@ -792,7 +790,7 @@ begin
end;
procedure TsSpreadOpenDocWriter.WriteToStream(AStream: TStream; AData: TsWorkbook);
procedure TsSpreadOpenDocWriter.WriteToStream(AStream: TStream);
begin
// Not supported at the moment
raise Exception.Create('TsSpreadOpenDocWriter.WriteToStream not supported');

273
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -179,12 +179,63 @@ type
TsHorAlignment = (haDefault, haLeft, haCenter, haRight);
TsVertAlignment = (vaDefault, vaTop, vaCenter, vaBottom);
{@@
Colors in fpspreadsheet are given as indices into a palette.
Use the workbook's GetPaletteColor to determine the color rgb value (with
"r" being the low-value byte, in agreement with TColor).
}
TsColor = Word;
{@@
These are some constants for color indices into the default palette.
Note, however, that if a different palette is used there may be more colors,
and the names of the color constants may no longer be correct.
}
const
scBlack = $00;
scWhite = $01;
scRed = $02;
scGreen = $03;
scBlue = $04;
scYellow = $05;
scMagenta = $06;
scCyan = $07;
scEGABlack = $08;
scEGAWhite = $09;
scEGARed = $0A;
scEGAGreen = $0B;
scEGABlue = $0C;
scEGAYellow = $0D;
scEGAMagenta = $0E;
scEGACyan = $0F;
scDarkRed = $10;
scDarkGreen = $11;
scDarkBlue = $12;
scOLIVE = $13;
scPURPLE = $14;
scTEAL = $15;
scSilver = $16;
scGrey = $17;
scOrange = $18;
scRGBColor = $FFFF;
{
//
scGrey10pct,// E6E6E6H
scGrey20pct,// CCCCCCH
scOrange, // ffa500H
scDarkBrown,// a0522dH
scBrown, // cd853fH
scBeige, // f5f5dcH
scWheat, // f5deb3H
}
{@@ Colors in FPSpreadsheet as given by a palette to be compatible with Excel.
However, please note that they are physically written to XLS file as
ABGR (where A is 0) }
(*
TsColor = ( // R G B color value:
scBlack , // 000000H
scBlack, // 000000H
scWhite, // FFFFFFH
scRed, // FF0000H
scGREEN, // 00FF00H
@ -211,14 +262,18 @@ type
//
scRGBCOLOR // Defined via TFPColor
);
*)
type
{@@ Palette of color values }
TsPalette = array[0..0] of DWord;
PsPalette = ^TsPalette;
{@@ Font style (redefined to avoid usage of "Graphics" }
TsFontStyle = (fssBold, fssItalic, fssStrikeOut, fssUnderline);
TsFontStyles = set of TsFontStyle;
{@@ Font }
TsFont = class
FontName: String;
Size: Single; // in "points"
@ -269,7 +324,7 @@ type
PRow = ^TRow;
TCol = record
Col: Byte;
Col: Cardinal;
Width: Single; // in "characters". Excel uses the with of char "0" in 1st font
end;
@ -324,6 +379,8 @@ type
function WriteFont(ARow, ACol: Cardinal; const AFontName: String;
AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; overload;
procedure WriteFont(ARow, ACol: Cardinal; AFontIndex: Integer); overload;
function WriteFontColor(ARow, ACol: Cardinal; AFontColor: TsColor): Integer;
function WriteFontSize(ARow, ACol: Cardinal; ASize: Integer): Integer;
procedure WriteTextRotation(ARow, ACol: Cardinal; ARotation: TsTextRotation);
procedure WriteUsedFormatting(ARow, ACol: Cardinal; AUsedFormatting: TsUsedFormattingFields);
procedure WriteBackgroundColor(ARow, ACol: Cardinal; AColor: TsColor);
@ -356,6 +413,7 @@ type
FFormat: TsSpreadsheetFormat;
FFontList: TFPList;
FBuiltinFontCount: Integer;
FPalette: array of DWord;
{ Internal methods }
procedure RemoveWorksheetsCallback(data, arg: pointer);
public
@ -393,6 +451,11 @@ type
procedure InitFonts;
procedure RemoveAllFonts;
procedure SetDefaultFont(const AFontName: String; ASize: Single);
{ Color handling }
function FPSColorToHexString(AColor: TsColor; ARGBColor: TFPColor): String;
function GetPaletteColor(AColorIndex: TsColor): DWord;
function GetPaletteSize: Integer;
procedure UsePalette(APalette: PsPalette; APaletteCount: Word; AFlipBytes: Boolean);
{@@ This property is only used for formats which don't support unicode
and support a single encoding for the whole document, like Excel 2 to 5 }
property Encoding: TsEncoding read FEncoding write FEncoding;
@ -415,12 +478,12 @@ type
procedure ReadLabel(AStream: TStream); virtual; abstract;
procedure ReadNumber(AStream: TStream); virtual; abstract;
public
constructor Create; virtual; // To allow descendents to override it
constructor Create(AWorkbook: TsWorkbook); virtual; // To allow descendents to override it
{ General writing methods }
procedure ReadFromFile(AFileName: string; AData: TsWorkbook); virtual;
procedure ReadFromStream(AStream: TStream; AData: TsWorkbook); virtual;
procedure ReadFromStrings(AStrings: TStrings; AData: TsWorkbook); virtual;
property Wordbook: TsWorkbook read FWorkbook;
property Workbook: TsWorkbook read FWorkbook;
end;
{@@ TsSpreadWriter class reference type }
@ -433,14 +496,14 @@ type
TsCustomSpreadWriter = class
private
FWorkbook: TsWorkbook;
protected
{ Helper routines }
procedure AddDefaultFormats(); virtual;
function ExpandFormula(AFormula: TsFormula): TsExpandedFormula;
function FindFormattingInList(AFormat: PCell): Integer;
function FPSColorToHexString(AColor: TsColor; ARGBColor: TFPColor): string;
procedure ListAllFormattingStylesCallback(ACell: PCell; AStream: TStream);
procedure ListAllFormattingStyles(AData: TsWorkbook);
procedure ListAllFormattingStyles;
{ Helpers for writing }
procedure WriteCellCallback(ACell: PCell; AStream: TStream);
procedure WriteCellsToStream(AStream: TStream; ACells: TAVLTree);
@ -458,13 +521,13 @@ type
}
FFormattingStyles: array of TCell;
NextXFIndex: Integer; // Indicates which should be the next XF (Style) Index when filling the styles list
constructor Create; virtual; // To allow descendents to override it
constructor Create(AWorkbook: TsWorkbook); virtual; // To allow descendents to override it
{ General writing methods }
procedure IterateThroughCells(AStream: TStream; ACells: TAVLTree; ACallback: TCellsCallback);
procedure WriteToFile(const AFileName: string; AData: TsWorkbook;
const AOverwriteExisting: Boolean = False); virtual;
procedure WriteToStream(AStream: TStream; AData: TsWorkbook); virtual;
procedure WriteToStrings(AStrings: TStrings; AData: TsWorkbook); virtual;
procedure WriteToFile(const AFileName: string; const AOverwriteExisting: Boolean = False); virtual;
procedure WriteToStream(AStream: TStream); virtual;
procedure WriteToStrings(AStrings: TStrings); virtual;
property Workbook: TsWorkbook read FWorkbook;
end;
{@@ List of registered formats }
@ -537,7 +600,6 @@ function GetFileFormatName(AFormat: TsSpreadsheetFormat): String;
function SciFloat(AValue: Double; ADecimals: Word): String;
function TimeIntervalToString(AValue: TDateTime): String;
implementation
uses
@ -551,6 +613,38 @@ resourcestring
lpUnknownSpreadsheetFormat = 'unknown format';
lpInvalidFontIndex = 'Invalid font index';
const
{@@
Colors in RGB (red at left). Needs to be inverted to get TColor.
The indices into this palette are named as scXXXX color constants.
}
DEFAULT_PALETTE: array[$0..$18] of DWord = (
$000000, // $00: black
$FFFFFF, // $01: white
$FF0000, // $02: red
$00FF00, // $03: green
$0000FF, // $04: blue
$FFFF00, // $05: yellow
$FF00FF, // $06: magenta
$00FFFF, // $07: cyan
$000000, // $08: EGA black
$FFFFFF, // $09: EGA white
$FF0000, // $0A: EGA red
$00FF00, // $0B: EGA green
$0000FF, // $0C: EGA blue
$FFFF00, // $0D: EGA yellow
$FF00FF, // $0E: EGA magenta
$00FFFF, // $0F: EGA cyan
$800000, // $10: EGA dark red
$008000, // $11: EGA dark green
$000080, // $12: EGA dark blue
$808000, // $13: EGA olive
$800080, // $14: EGA purple
$008080, // $15: EGA teal
$C0C0C0, // $16: EGA silver
$808080, // $17: EGA gray
$FFA500 // $18: orange
);
{@@
Registers a new reader/writer pair for a format
@ -1288,6 +1382,26 @@ begin
raise Exception.Create(lpInvalidFontIndex);
end;
function TsWorksheet.WriteFontColor(ARow, ACol: Cardinal; AFontColor: TsColor): Integer;
var
lCell: PCell;
fnt: TsFont;
begin
lCell := GetCell(ARow, ACol);
fnt := Workbook.GetFont(lCell^.FontIndex);
Result := WriteFont(ARow, ACol, fnt.FontName, fnt.Size, fnt.Style, AFontColor);
end;
function TsWorksheet.WriteFontSize(ARow, ACol: Cardinal; ASize: Integer): Integer;
var
lCell: PCell;
fnt: TsFont;
begin
lCell := GetCell(ARow, ACol);
fnt := Workbook.GetFont(lCell^.FontIndex);
Result := WriteFont(ARow, ACol, fnt.FontName, ASize, fnt.Style, fnt.Color);
end;
{@@
Adds text rotation to the formatting of a cell
@ -1521,8 +1635,7 @@ begin
for i := 0 to Length(GsSpreadFormats) - 1 do
if GsSpreadFormats[i].Format = AFormat then
begin
Result := GsSpreadFormats[i].ReaderClass.Create;
Result.FWorkbook := self;
Result := GsSpreadFormats[i].ReaderClass.Create(self);
Break;
end;
@ -1542,7 +1655,7 @@ begin
for i := 0 to Length(GsSpreadFormats) - 1 do
if GsSpreadFormats[i].Format = AFormat then
begin
Result := GsSpreadFormats[i].WriterClass.Create;
Result := GsSpreadFormats[i].WriterClass.Create(self);
Break;
end;
@ -1657,9 +1770,8 @@ var
AWriter: TsCustomSpreadWriter;
begin
AWriter := CreateSpreadWriter(AFormat);
try
AWriter.WriteToFile(AFileName, Self, AOverwriteExisting);
AWriter.WriteToFile(AFileName, AOverwriteExisting);
finally
AWriter.Free;
end;
@ -1690,7 +1802,7 @@ begin
AWriter := CreateSpreadWriter(AFormat);
try
AWriter.WriteToStream(AStream, Self);
AWriter.WriteToStream(AStream);
finally
AWriter.Free;
end;
@ -1948,11 +2060,101 @@ begin
Result := FFontList.Count;
end;
{@@
Converts a fpspreadsheet color into into a string RRGGBB.
Note that colors are written to xls files as ABGR (where A is 0).
if the color is scRGBColor the color value is taken from the argument
ARGBColor, otherwise from the palette entry for the color index.
}
function TsWorkbook.FPSColorToHexString(AColor: TsColor;
ARGBColor: TFPColor): string;
type
TRgba = packed record Red, Green, Blue, A: Byte end;
var
color: DWord;
r,g,b: Byte;
begin
if AColor = scRGBColor then begin
r := ARGBColor.Red div $100;
g := ARGBColor.Green div $100;
b := ARGBColor.Blue div $100;
end else begin
color := GetPaletteColor(AColor);
r := TRgba(color).Red;
g := TRgba(color).Green;
b := TRgba(color).Blue;
end;
Result := Format('%x%x%x', [r, g, b]);
end;
{@@
Reads the rgb color for the given index from the current palette. Can be
type-cast to TColor for usage in GUI applications.
}
function TsWorkbook.GetPaletteColor(AColorIndex: TsColor): DWord;
begin
if (AColorIndex >= 0) and (AColorIndex < GetPaletteSize) then begin
if ((FPalette = nil) or (Length(FPalette) = 0)) then
Result := LongRGBToExcelPhysical(DEFAULT_PALETTE[AColorIndex])
else
Result := FPalette[AColorIndex];
end else
Result := $000000; // "black" as default
end;
{@@
Returns the size of color palette
}
function TsWorkbook.GetPaletteSize: Integer;
begin
if (FPalette = nil) or (Length(FPalette) = 0) then
Result := High(DEFAULT_PALETTE) + 1
else
Result := Length(FPalette);
end;
{@@
Instructs the Workbook to take colors from the palette pointed to by the parameter
This palette is only used for writing. When reading the palette found in the
file is used.
}
procedure TsWorkbook.UsePalette(APalette: PsPalette; APaletteCount: Word;
AFlipBytes: Boolean);
var
i: Integer;
begin
{$IFOPT R+}
{$DEFINE RNGCHECK}
{$ENDIF}
SetLength(FPalette, APaletteCount);
if AFlipBytes then
for i:=0 to APaletteCount-1 do
{$IFDEF RNGCHECK}
{$R-}
{$ENDIF}
FPalette[i] := LongRGBToExcelPhysical(APalette^[i])
{$IFDEF RNGCHECK}
{$R+}
{$ENDIF}
else
for i:=0 to APaletteCount-1 do
{$IFDEF RNGCHECK}
{$R-}
{$ENDIF}
FPalette[i] := APalette^[i];
{$IFDEF RNGCHECK}
{$R+}
{$ENDIF}
end;
{ TsCustomSpreadReader }
constructor TsCustomSpreadReader.Create;
constructor TsCustomSpreadReader.Create(AWorkbook: TsWorkbook);
begin
inherited Create;
FWorkbook := AWorkbook;
end;
{@@
@ -2006,9 +2208,10 @@ end;
{ TsCustomSpreadWriter }
constructor TsCustomSpreadWriter.Create;
constructor TsCustomSpreadWriter.Create(AWorkbook: TsWorkbook);
begin
inherited Create;
FWorkbook := AWorkbook;
end;
{@@
@ -2082,7 +2285,7 @@ begin
Inc(NextXFIndex);
end;
procedure TsCustomSpreadWriter.ListAllFormattingStyles(AData: TsWorkbook);
procedure TsCustomSpreadWriter.ListAllFormattingStyles;
var
i: Integer;
begin
@ -2090,9 +2293,9 @@ begin
AddDefaultFormats();
for i := 0 to AData.GetWorksheetCount - 1 do
for i := 0 to Workbook.GetWorksheetCount - 1 do
begin
IterateThroughCells(nil, AData.GetWorksheetByIndex(i).Cells, ListAllFormattingStylesCallback);
IterateThroughCells(nil, Workbook.GetWorksheetByIndex(i).Cells, ListAllFormattingStylesCallback);
end;
end;
@ -2139,11 +2342,12 @@ begin
Inc(StrPos);
end;
end;
(*
function TsCustomSpreadWriter.FPSColorToHexString(AColor: TsColor; ARGBColor: TFPColor): string;
{ We use RGB bytes here, but please note that these are physically written
to XLS file as ABGR (where A is 0) }
begin
case AColor of
scBlack: Result := '000000';
scWhite: Result := 'FFFFFF';
@ -2173,7 +2377,7 @@ begin
scRGBCOLOR: Result := Format('%x%x%x', [ARGBColor.Red div $100, ARGBColor.Green div $100, ARGBColor.Blue div $100]);
end;
end;
*)
{@@
Helper function for the spreadsheet writers.
@ -2228,15 +2432,15 @@ end;
Default file writting method.
Opens the file and calls WriteToStream
The workbook written is the one specified in the constructor of the writer.
@param AFileName The output file name.
If the file already exists it will be replaced.
@param AData The Workbook to be saved.
@see TsWorkbook
}
procedure TsCustomSpreadWriter.WriteToFile(const AFileName: string;
AData: TsWorkbook; const AOverwriteExisting: Boolean = False);
const AOverwriteExisting: Boolean = False);
var
OutputFile: TFileStream;
lMode: Word;
@ -2246,7 +2450,7 @@ begin
OutputFile := TFileStream.Create(AFileName, lMode);
try
WriteToStream(OutputFile, AData);
WriteToStream(OutputFile);
finally
OutputFile.Free;
end;
@ -2255,21 +2459,20 @@ end;
{@@
This routine should be overriden in descendent classes.
}
procedure TsCustomSpreadWriter.WriteToStream(AStream: TStream; AData: TsWorkbook);
procedure TsCustomSpreadWriter.WriteToStream(AStream: TStream);
var
lStringList: TStringList;
begin
lStringList := TStringList.Create;
try
WriteToStrings(lStringList, AData);
WriteToStrings(lStringList);
lStringList.SaveToStream(AStream);
finally
lStringList.Free;
end;
end;
procedure TsCustomSpreadWriter.WriteToStrings(AStrings: TStrings;
AData: TsWorkbook);
procedure TsCustomSpreadWriter.WriteToStrings(AStrings: TStrings);
begin
raise Exception.Create(lpUnsupportedWriteFormat);
end;

40
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -149,8 +149,6 @@ type
property OnContextPopup;
end;
function FPSColorToColor(FPSColor: TsColor; ADefault: TColor): TColor;
procedure Register;
implementation
@ -174,37 +172,6 @@ begin
end;
end;
function FPSColorToColor(FPSColor: TsColor; ADefault: TColor): TColor;
begin
case FPSColor of
scBlack : Result := clBlack;
scWhite : Result := clWhite;
scRed : Result := clRed;
scGreen : Result := clLime;
scBlue : Result := clBlue;
scYellow : Result := clYellow;
scMagenta : Result := clFuchsia;
scCyan : Result := clAqua;
scDarkRed : Result := clMaroon;
scDarkGreen: Result := clGreen;
scDarkBlue : Result := clNavy;
scOlive : Result := clOlive;
scPurple : Result := clPurple;
scTeal : Result := clTeal;
scSilver : Result := clSilver;
scGrey : Result := clGray;
//
scGrey10pct: Result := TColor($00E6E6E6);
scGrey20pct: Result := TColor($00CCCCCC);
scOrange : Result := TColor($0000A5FF); // FFA500
scDarkBrown: Result := TColor($002D52A0); // A0522D
scBrown : Result := TColor($003F85CD); // CD853F
scBeige : Result := TColor($00DCF5F5); // F5F5DC
scWheat : Result := TColor($00B3DEF5); // F5DEB3
else Result := ADefault;
end;
end;
procedure Register;
begin
RegisterComponents('Additional',[TsWorksheetGrid]);
@ -302,7 +269,10 @@ begin
Canvas.Brush.Bitmap := FillPattern_BIFF2;
end else begin
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := FPSColorToColor(lCell^.BackgroundColor, Color);
if lCell^.BackgroundColor < FWorkbook.GetPaletteSize then
Canvas.Brush.Color := FWorkbook.GetPaletteColor(lCell^.BackgroundColor)
else
Canvas.Brush.Color := Color;
end;
end else begin
Canvas.Brush.Style := bsSolid;
@ -313,7 +283,7 @@ begin
fnt := FWorkbook.GetFont(lCell^.FontIndex);
if fnt <> nil then begin
Canvas.Font.Name := fnt.FontName;
Canvas.Font.Color := FPSColorToColor(fnt.Color, clBlack);
Canvas.Font.Color := FWorkbook.GetPaletteColor(fnt.Color);
style := [];
if fssBold in fnt.Style then Include(style, fsBold);
if fssItalic in fnt.Style then Include(style, fsItalic);

20
components/fpspreadsheet/fpsutils.pas
View File

@ -34,6 +34,8 @@ function WordLEtoN(AValue: Word): Word;
function DWordLEtoN(AValue: Cardinal): Cardinal;
function WideStringLEToN(const AValue: WideString): WideString;
function LongRGBToExcelPhysical(const RGB: DWord): DWord;
// Other routines
function ParseIntervalString(const AStr: string;
var AFirstCellRow, AFirstCellCol, ACount: Integer;
@ -155,6 +157,24 @@ begin
{$ENDIF}
end;
{ Converts RGB part of a LongRGB logical structure to its physical representation
IOW: RGBA (where A is 0 and omitted in the function call) => ABGR
Needed for conversion of palette colors. }
function LongRGBToExcelPhysical(const RGB: DWord): DWord;
begin
{$IFDEF FPC}
{$IFDEF ENDIAN_LITTLE}
result := RGB shl 8; //tags $00 at end for the A byte
result := SwapEndian(result); //flip byte order
{$ELSE}
//Big endian
result := RGB; //leave value as is //todo: verify if this turns out ok
{$ENDIF}
{$ELSE}
// messed up result
{$ENDIF}
end;
{@@
Parses strings like A5:A10 into an selection interval information
}

234
components/fpspreadsheet/tests/colortests.pas Normal file
View File

@ -0,0 +1,234 @@
unit colortests;
{$mode objfpc}{$H+}
interface
{ Color tests
This unit tests writing out to and reading back from files.
}
uses
// Not using Lazarus package as the user may be working with multiple versions
// Instead, add .. to unit search path
Classes, SysUtils, fpcunit, testregistry,
fpspreadsheet, xlsbiff5, xlsbiff8 {and a project requirement for lclbase for utf8 handling},
testsutility;
type
{ TSpreadWriteReadColorTests }
//Write to xls/xml file and read back
TSpreadWriteReadColorTests = class(TTestCase)
private
protected
// Set up expected values:
procedure SetUp; override;
procedure TearDown; override;
procedure TestWriteReadBackgroundColors(WhichPalette: Integer);
procedure TestWriteReadFontColors(WhichPalette: Integer);
published
// Writes out colors & reads back.
// Background colors...
procedure TestWriteRead_Background_Internal; // internal palette
procedure TestWriteRead_Background_Biff5; // official biff5 palette
procedure TestWriteRead_Background_Biff8; // official biff8 palette
// Font colors...
procedure TestWriteRead_Font_Internal; // internal palette
procedure TestWriteRead_Font_Biff5; // official biff5 palette
procedure TestWriteRead_Font_Biff8; // official biff8 palette
end;
implementation
const
ColorsSheet = 'Colors';
{ TSpreadWriteReadColorTests }
procedure TSpreadWriteReadColorTests.SetUp;
begin
inherited SetUp;
end;
procedure TSpreadWriteReadColorTests.TearDown;
begin
inherited TearDown;
end;
procedure TSpreadWriteReadColorTests.TestWriteReadBackgroundColors(WhichPalette: Integer);
// WhichPalette = 5: BIFF5 palette
// 8: BIFF8 palette
// else internal palette
// see also "manualtests".
const
CELLTEXT = 'Color test';
var
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
row, col: Integer;
MyCell: PCell;
TempFile: string; //write xls/xml to this file and read back from it
color: TsColor;
expectedRGB: DWord;
currentRGB: DWord;
begin
TempFile:=GetTempFileName;
{// Not needed: use workbook.writetofile with overwrite=true
if fileexists(TempFile) then
DeleteFile(TempFile);
}
MyWorkbook := TsWorkbook.Create;
MyWorkSheet:= MyWorkBook.AddWorksheet(ColorsSheet);
// Define palette
case whichPalette of
5: MyWorkbook.UsePalette(@PALETTE_BIFF5, High(PALETTE_BIFF5)+1, true);
8: MyWorkbook.UsePalette(@PALETTE_BIFF8, High(PALETTE_BIFF8)+1, true);
// else use default palette
end;
// Write out all colors
row := 0;
col := 0;
for color := 0 to MyWorkbook.GetPaletteSize-1 do begin
MyWorksheet.WriteUTF8Text(row, col, CELLTEXT);
MyWorksheet.WriteBackgroundColor(row, col, color);
MyCell := MyWorksheet.FindCell(row, col);
if MyCell = nil then
fail('Error in test code. Failed to get cell.');
currentRGB := MyWorkbook.GetPaletteColor(MyCell^.BackgroundColor);
expectedRGB := MyWorkbook.GetPaletteColor(color);
CheckEquals(currentRGB, expectedRGB,
'Test unsaved background color, cell ' + CellNotation(MyWorksheet,0,0));
inc(row);
end;
MyWorkBook.WriteToFile(TempFile,sfExcel8,true);
MyWorkbook.Free;
// Open the spreadsheet, as biff8
MyWorkbook := TsWorkbook.Create;
MyWorkbook.ReadFromFile(TempFile, sfExcel8);
MyWorksheet := GetWorksheetByName(MyWorkBook, ColorsSheet);
if MyWorksheet=nil then
fail('Error in test code. Failed to get named worksheet');
for row := 0 to MyWorksheet.GetLastRowNumber do begin
MyCell := MyWorksheet.FindCell(row, col);
if MyCell = nil then
fail('Error in test code. Failed to get cell.');
color := TsColor(row);
currentRGB := MyWorkbook.GetPaletteColor(MyCell^.BackgroundColor);
expectedRGB := MyWorkbook.GetPaletteColor(color);
CheckEquals(currentRGB, expectedRGB,
'Test saved background color, cell '+CellNotation(MyWorksheet,Row,Col));
end;
MyWorkbook.Free;
DeleteFile(TempFile);
end;
procedure TSpreadWriteReadColorTests.TestWriteReadFontColors(WhichPalette: Integer);
// WhichPalette = 5: BIFF5 palette
// 8: BIFF8 palette
// else internal palette
// see also "manualtests".
const
CELLTEXT = 'Color test';
var
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
row, col: Integer;
MyCell: PCell;
TempFile: string; //write xls/xml to this file and read back from it
color, colorInFile: TsColor;
expectedRGB, currentRGB: DWord;
begin
TempFile:=GetTempFileName;
{// Not needed: use workbook.writetofile with overwrite=true
if fileexists(TempFile) then
DeleteFile(TempFile);
}
MyWorkbook := TsWorkbook.Create;
MyWorkSheet:= MyWorkBook.AddWorksheet(ColorsSheet);
// Define palette
case whichPalette of
5: MyWorkbook.UsePalette(@PALETTE_BIFF5, High(PALETTE_BIFF5)+1, true);
8: MyWorkbook.UsePalette(@PALETTE_BIFF8, High(PALETTE_BIFF8)+1, true);
// else use default palette
end;
// Write out all colors
row := 0;
col := 0;
for color := 0 to MyWorkbook.GetPaletteSize-1 do begin
MyWorksheet.WriteUTF8Text(row, col, CELLTEXT);
MyWorksheet.WriteFontColor(row, col, color);
MyCell := MyWorksheet.FindCell(row, col);
if MyCell = nil then
fail('Error in test code. Failed to get cell.');
colorInFile := MyWorkbook.GetFont(MyCell^.FontIndex).Color;
currentRGB := MyWorkbook.GetPaletteColor(colorInFile);
expectedRGB := MyWorkbook.GetPaletteColor(color);
CheckEquals(currentRGB, expectedRGB,
'Test unsaved font color, cell ' + CellNotation(MyWorksheet,0,0));
inc(row);
end;
MyWorkBook.WriteToFile(TempFile,sfExcel8,true);
MyWorkbook.Free;
// Open the spreadsheet, as biff8
MyWorkbook := TsWorkbook.Create;
MyWorkbook.ReadFromFile(TempFile, sfExcel8);
MyWorksheet := GetWorksheetByName(MyWorkBook, ColorsSheet);
if MyWorksheet=nil then
fail('Error in test code. Failed to get named worksheet');
for row := 0 to MyWorksheet.GetLastRowNumber do begin
MyCell := MyWorksheet.FindCell(row, col);
if MyCell = nil then
fail('Error in test code. Failed to get cell.');
color := TsColor(row);
colorInFile := MyWorkbook.GetFont(MyCell^.FontIndex).Color;
currentRGB := MyWorkbook.GetPaletteColor(colorInFile);
expectedRGB := MyWorkbook.GetPaletteColor(color);
CheckEquals(currentRGB, expectedRGB,
'Test saved font color, cell '+CellNotation(MyWorksheet,Row,Col));
end;
MyWorkbook.Free;
DeleteFile(TempFile);
end;
procedure TSpreadWriteReadColorTests.TestWriteRead_Background_Internal;
begin
TestWriteReadBackgroundColors(0);
end;
procedure TSpreadWriteReadColorTests.TestWriteRead_Background_Biff5;
begin
TestWriteReadBackgroundColors(5);
end;
procedure TSpreadWriteReadColorTests.TestWriteRead_Background_Biff8;
begin
TestWriteReadBackgroundColors(8);
end;
procedure TSpreadWriteReadColorTests.TestWriteRead_Font_Internal;
begin
TestWriteReadFontColors(0);
end;
procedure TSpreadWriteReadColorTests.TestWriteRead_Font_Biff5;
begin
TestWriteReadFontColors(5);
end;
procedure TSpreadWriteReadColorTests.TestWriteRead_Font_Biff8;
begin
TestWriteReadFontColors(8);
end;
initialization
RegisterTest(TSpreadWriteReadColorTests);
end.

190
components/fpspreadsheet/tests/fonttests.pas Normal file
View File

@ -0,0 +1,190 @@
unit fonttests;
{$mode objfpc}{$H+}
interface
{ Font tests
This unit tests writing out to and reading back from files.
}
uses
// Not using Lazarus package as the user may be working with multiple versions
// Instead, add .. to unit search path
Classes, SysUtils, fpcunit, testregistry,
fpspreadsheet, xlsbiff8 {and a project requirement for lclbase for utf8 handling},
testsutility;
var
// Norm to test against - list of font sizes that should occur in spreadsheet
SollSizes: array[0..12] of single; //"Soll" is a German word in Dutch accountancy jargon meaning "normative value to check against". There ;)
SollStyles: array[0..15] of TsFontStyles;
// Initializes Soll*/normative variables.
// Useful in test setup procedures to make sure the norm is correct.
procedure InitSollSizes;
procedure InitSollStyles;
type
{ TSpreadWriteReadFontTests }
//Write to xls/xml file and read back
TSpreadWriteReadFontTests = class(TTestCase)
private
protected
// Set up expected values:
procedure SetUp; override;
procedure TearDown; override;
procedure TestWriteReadFont(AFontName: String);
published
procedure TestWriteReadFont_Arial;
procedure TestWriteReadFont_TimesNewRoman;
procedure TestWriteReadFont_CourierNew;
end;
implementation
uses
TypInfo;
const
FontSheet = 'Font';
// When adding tests, add values to this array
// and increase array size in variable declaration
procedure InitSollSizes;
begin
// Set up norm - MUST match spreadsheet cells exactly
SollSizes[0]:=8.0;
SollSizes[1]:=9.0;
SollSizes[2]:=10.0;
SollSizes[3]:=11.0;
SollSizes[4]:=12.0;
SollSizes[5]:=13.0;
SollSizes[6]:=14.0;
SollSizes[7]:=16.0;
SollSizes[8]:=18.0;
SollSizes[9]:=20.0;
SollSizes[10]:=24.0;
SollSizes[11]:=32.0;
SollSizes[12]:=48.0;
end;
procedure InitSollStyles;
begin
SollStyles[0] := [];
SollStyles[1] := [fssBold];
SolLStyles[2] := [fssItalic];
SollStyles[3] := [fssBold, fssItalic];
SollStyles[4] := [fssUnderline];
SollStyles[5] := [fssUnderline, fssBold];
SollStyles[6] := [fssUnderline, fssItalic];
SollStyles[7] := [fssUnderline, fssBold, fssItalic];
SollStyles[8] := [fssStrikeout];
SollStyles[9] := [fssStrikeout, fssBold];
SolLStyles[10] := [fssStrikeout, fssItalic];
SollStyles[11] := [fssStrikeout, fssBold, fssItalic];
SollStyles[12] := [fssStrikeout, fssUnderline];
SollStyles[13] := [fssStrikeout, fssUnderline, fssBold];
SollStyles[14] := [fssStrikeout, fssUnderline, fssItalic];
SollStyles[15] := [fssStrikeout, fssUnderline, fssBold, fssItalic];
end;
{ TSpreadWriteReadFontTests }
procedure TSpreadWriteReadFontTests.SetUp;
begin
inherited SetUp;
InitSollSizes;
InitSollStyles;
end;
procedure TSpreadWriteReadFontTests.TearDown;
begin
inherited TearDown;
end;
procedure TSpreadWriteReadFontTests.TestWriteReadFont(AFontName: String);
var
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
row, col: Integer;
MyCell: PCell;
TempFile: string; //write xls/xml to this file and read back from it
cellText: String;
font: TsFont;
currValue: String;
expectedValue: String;
begin
TempFile:=GetTempFileName;
{// Not needed: use workbook.writetofile with overwrite=true
if fileexists(TempFile) then
DeleteFile(TempFile);
}
MyWorkbook := TsWorkbook.Create;
MyWorkSheet:= MyWorkBook.AddWorksheet(FontSheet);
// Write out all font styles at various sizes
for row := 0 to High(SollSizes) do begin
for col := 0 to High(SollStyles) do begin
cellText := Format('%s, %.1f-pt', [AFontName, SollSizes[row]]);
MyWorksheet.WriteUTF8Text(row, col, celltext);
MyWorksheet.WriteFont(row, col, AFontName, SollSizes[row], SollStyles[col], scBlack);
MyCell := MyWorksheet.FindCell(row, col);
if MyCell = nil then
fail('Error in test code. Failed to get cell.');
font := MyWorkbook.GetFont(MyCell^.FontIndex);
CheckEquals(SollSizes[row], font.Size,
'Test unsaved font size, cell ' + CellNotation(MyWorksheet,0,0));
currValue := GetEnumName(TypeInfo(TsFontStyles), byte(font.Style));
expectedValue := GetEnumName(TypeInfo(TsFontStyles), byte(SollStyles[col]));
CheckEquals(currValue, expectedValue,
'Test unsaved font style, cell ' + CellNotation(MyWorksheet,0,0));
end;
end;
MyWorkBook.WriteToFile(TempFile,sfExcel8,true);
MyWorkbook.Free;
// Open the spreadsheet, as biff8
MyWorkbook := TsWorkbook.Create;
MyWorkbook.ReadFromFile(TempFile, sfExcel8);
MyWorksheet := GetWorksheetByName(MyWorkBook, FontSheet);
if MyWorksheet=nil then
fail('Error in test code. Failed to get named worksheet');
for row := 0 to MyWorksheet.GetLastRowNumber do
for col := 0 to MyWorksheet.GetLastColNumber do begin
MyCell := MyWorksheet.FindCell(row, col);
if MyCell = nil then
fail('Error in test code. Failed to get cell.');
font := MyWorkbook.GetFont(MyCell^.FontIndex);
CheckEquals(SollSizes[row], font.Size,
'Test saved font size, cell '+CellNotation(MyWorksheet,Row,Col));
currValue := GetEnumName(TypeInfo(TsFontStyles), byte(font.Style));
expectedValue := GetEnumName(TypeInfo(TsFontStyles), byte(SollStyles[col]));
CheckEquals(currValue, expectedValue,
'Test unsaved font style, cell ' + CellNotation(MyWorksheet,0,0));
end;
MyWorkbook.Free;
DeleteFile(TempFile);
end;
procedure TSpreadWriteReadFontTests.TestWriteReadFont_Arial;
begin
TestWriteReadFont('Arial');
end;
procedure TSpreadWriteReadFontTests.TestWriteReadFont_TimesNewRoman;
begin
TestWriteReadFont('TimesNewRoman');
end;
procedure TSpreadWriteReadFontTests.TestWriteReadFont_CourierNew;
begin
TestWriteReadFont('CourierNew');
end;
initialization
RegisterTest(TSpreadWriteReadFontTests);
end.

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

@ -53,8 +53,6 @@ type
procedure TestWriteReadWordWrap;
// Test alignments
procedure TestWriteReadAlignments;
// Test background colors
procedure TestWriteReadBackgroundColors;
end;
implementation
@ -398,63 +396,6 @@ begin
DeleteFile(TempFile);
end;
procedure TSpreadWriteReadFormatTests.TestWriteReadBackgroundColors;
// see also "manualtests".
const
CELLTEXT = 'Color test';
var
MyWorksheet: TsWorksheet;
MyWorkbook: TsWorkbook;
row, col: Integer;
MyCell: PCell;
TempFile: string; //write xls/xml to this file and read back from it
color: TsColor;
begin
TempFile:=GetTempFileName;
{// Not needed: use workbook.writetofile with overwrite=true
if fileexists(TempFile) then
DeleteFile(TempFile);
}
// Write out all colors
MyWorkbook := TsWorkbook.Create;
MyWorkSheet:= MyWorkBook.AddWorksheet(FmtNumbersSheet);
row := 0;
col := 0;
for color := Low(TsColor) to scGrey20pct do begin // !!! other colors not working yet!
// for color in TsColor do begin // this is the full test - failing!
MyWorksheet.WriteUTF8Text(row, col, CELLTEXT);
MyWorksheet.WriteBackgroundColor(row, col, color);
MyCell := MyWorksheet.FindCell(row, col);
if MyCell = nil then
fail('Error in test code. Failed to get cell.');
CheckEquals(color = MyCell^.BackgroundColor, true,
'Test unsaved background color, cell ' + CellNotation(MyWorksheet,0,0));
inc(row);
end;
MyWorkBook.WriteToFile(TempFile,sfExcel8,true);
MyWorkbook.Free;
// Open the spreadsheet, as biff8
MyWorkbook := TsWorkbook.Create;
MyWorkbook.ReadFromFile(TempFile, sfExcel8);
MyWorksheet:=GetWorksheetByName(MyWorkBook, FmtNumbersSheet);
if MyWorksheet=nil then
fail('Error in test code. Failed to get named worksheet');
for row := 0 to MyWorksheet.GetLastRowNumber do begin
MyCell := MyWorksheet.FindCell(row, col);
if MyCell = nil then
fail('Error in test code. Failed to get cell.');
color := TsColor(row);
CheckEquals(color = MyCell^.BackgroundColor, true,
'Test saved background color, cell '+CellNotation(MyWorksheet,Row,Col));
end;
MyWorkbook.Free;
DeleteFile(TempFile);
end;
initialization
RegisterTest(TSpreadWriteReadFormatTests);
InitSollFmtData;

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

@ -27,8 +27,8 @@ uses
var
// Norm to test against - list of dates/times that should occur in spreadsheet
SollColors: array[0..22] of tsColor; //"Soll" is a German word in Dutch accountancy jargon meaning "normative value to check against". There ;)
SollColorNames: array[0..22] of string; //matching names for SollColors
SollColors: array[0..16] of tsColor; //"Soll" is a German word in Dutch accountancy jargon meaning "normative value to check against". There ;)
SollColorNames: array[0..16] of string; //matching names for SollColors
// Initializes Soll*/normative variables.
// Useful in test setup procedures to make sure the norm is correct.
procedure InitSollColors;
@ -101,6 +101,8 @@ begin
SollColors[13]:=scTEAL;
SollColors[14]:=scSilver;
SollColors[15]:=scGrey;
SollColors[16]:=scOrange;
{
SollColors[16]:=scGrey10pct;
SollColors[17]:=scGrey20pct;
SollColors[18]:=scOrange;
@ -108,7 +110,7 @@ begin
SollColors[20]:=scBrown;
SollColors[21]:=scBeige;
SollColors[22]:=scWheat;
}
// Corresponding names for display in cells:
SollColorNames[0]:='scBlack';
SollColorNames[1]:='scWhite';
@ -126,6 +128,8 @@ begin
SollColorNames[13]:='scTEAL';
SollColorNames[14]:='scSilver';
SollColorNames[15]:='scGrey';
SollColorNames[16]:='scOrange';
{
SollColorNames[16]:='scGrey10pct';
SollColorNames[17]:='scGrey20pct';
SollColorNames[18]:='scOrange';
@ -133,6 +137,7 @@ begin
SollColorNames[20]:='scBrown';
SollColorNames[21]:='scBeige';
SollColorNames[22]:='scWheat';
}
end;
{ TSpreadManualSetup }

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

@ -217,7 +217,7 @@ begin
fail('Error in test code. Failed to get named worksheet');
ActualNumber:=MyWorkSheet.ReadAsNumber(Row, 0);
CheckEquals(SollNumbers[Row],ActualNumber,'Test value mismatch '
CheckEquals(abs(SollNumbers[Row]-ActualNumber) < 1E-4, true,'Test value mismatch '
+'cell '+CellNotation(MyWorkSheet,Row));
// Finalization

18
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@ -79,7 +79,7 @@
<PackageName Value="FCL"/>
</Item4>
</RequiredPackages>
<Units Count="8">
<Units Count="10">
<Unit0>
<Filename Value="spreadtestgui.lpr"/>
<IsPartOfProject Value="True"/>
@ -120,6 +120,16 @@
<IsPartOfProject Value="True"/>
<UnitName Value="formattests"/>
</Unit7>
<Unit8>
<Filename Value="colortests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="colortests"/>
</Unit8>
<Unit9>
<Filename Value="fonttests.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="fonttests"/>
</Unit9>
</Units>
</ProjectOptions>
<CompilerOptions>
@ -142,7 +152,7 @@
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="5">
<Exceptions Count="6">
<Item1>
<Name Value="EAbort"/>
<Enabled Value="False"/>
@ -161,6 +171,10 @@
<Item5>
<Name Value="EIgnoredTest"/>
</Item5>
<Item6>
<Name Value="EConvertError"/>
<Enabled Value="False"/>
</Item6>
</Exceptions>
</Debugging>
</CONFIG>

5
components/fpspreadsheet/tests/spreadtestgui.lpr
View File

@ -3,9 +3,8 @@ program spreadtestgui;
{$mode objfpc}{$H+}
uses
Interfaces, Forms, GuiTestRunner,
datetests, stringtests,
numberstests, manualtests, testsutility, internaltests, formattests;
Interfaces, Forms, GuiTestRunner, datetests, stringtests, numberstests,
manualtests, testsutility, internaltests, formattests, colortests, fonttests;
begin
Application.Initialize;

25
components/fpspreadsheet/wikitable.pas
View File

@ -70,7 +70,7 @@ type
TsWikiTable_PipesReader = class(TsWikiTableReader)
public
constructor Create; override;
constructor Create(AWorkbook: TsWorkbook); override;
end;
{ TsWikiTableWriter }
@ -81,15 +81,15 @@ type
public
SubFormat: TsSpreadsheetFormat;
{ General writing methods }
procedure WriteToStrings(AStrings: TStrings; AData: TsWorkbook); override;
procedure WriteToStrings_WikiMedia(AStrings: TStrings; AData: TsWorkbook);
procedure WriteToStrings(AStrings: TStrings); override;
procedure WriteToStrings_WikiMedia(AStrings: TStrings);
end;
{ TsWikiTable_WikiMediaWriter }
TsWikiTable_WikiMediaWriter = class(TsWikiTableWriter)
public
constructor Create; override;
constructor Create(AWorkbook: TsWorkbook); override;
end;
implementation
@ -318,18 +318,18 @@ end;
{ TsWikiTable_PipesReader }
constructor TsWikiTable_PipesReader.Create;
constructor TsWikiTable_PipesReader.Create(AWorkbook: TsWorkbook);
begin
inherited Create;
inherited Create(AWorkbook);
SubFormat := sfWikiTable_Pipes;
end;
{ TsWikiTableWriter }
procedure TsWikiTableWriter.WriteToStrings(AStrings: TStrings; AData: TsWorkbook);
procedure TsWikiTableWriter.WriteToStrings(AStrings: TStrings);
begin
case SubFormat of
sfWikiTable_WikiMedia: WriteToStrings_WikiMedia(AStrings, AData);
sfWikiTable_WikiMedia: WriteToStrings_WikiMedia(AStrings);
end;
end;
@ -345,8 +345,7 @@ Format mediawiki:
! style="background-color:green;color:white;" | PASS
|}
*)
procedure TsWikiTableWriter.WriteToStrings_WikiMedia(AStrings: TStrings;
AData: TsWorkbook);
procedure TsWikiTableWriter.WriteToStrings_WikiMedia(AStrings: TStrings);
var
i, j: Integer;
lCurStr: string = '';
@ -356,7 +355,7 @@ var
lColorStr: String;
begin
AStrings.Add('{| border="1" cellpadding="2" class="wikitable sortable"');
FWorksheet := AData.GetFirstWorksheet();
FWorksheet := Workbook.GetFirstWorksheet();
for i := 0 to FWorksheet.GetLastRowNumber() do
begin
AStrings.Add('|-');
@ -404,9 +403,9 @@ end;
{ TsWikiTable_WikiMediaWriter }
constructor TsWikiTable_WikiMediaWriter.Create;
constructor TsWikiTable_WikiMediaWriter.Create(AWorkbook: TsWorkbook);
begin
inherited Create;
inherited Create(AWorkbook);
SubFormat := sfWikiTable_WikiMedia;
end;

144
components/fpspreadsheet/xlsbiff2.pas
View File

@ -45,6 +45,8 @@ type
WorkBookEncoding: TsEncoding;
RecordSize: Word;
FWorksheet: TsWorksheet;
FXFList: TFPList;
FFont: TsFont;
procedure ReadRowInfo(AStream: TStream);
protected
procedure ApplyCellFormatting(ARow, ACol: Word; XF, AFormat, AFont, AStyle: Byte);
@ -53,12 +55,16 @@ type
{ Record writing methods }
procedure ReadBlank(AStream: TStream); override;
procedure ReadFont(AStream: TStream);
procedure ReadFontColor(AStream: TStream);
procedure ReadFormula(AStream: TStream); override;
procedure ReadLabel(AStream: TStream); override;
procedure ReadNumber(AStream: TStream); override;
procedure ReadInteger(AStream: TStream);
procedure ReadXF(AStream: TStream);
public
{ General reading methods }
constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override;
procedure ReadFromStream(AStream: TStream; AData: TsWorkbook); override;
end;
@ -71,14 +77,14 @@ type
procedure WriteBOF(AStream: TStream);
procedure WriteCellFormatting(AStream: TStream; ACell: PCell; XFIndex: Word);
procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AData: TsWorkbook; AFontIndex: Integer);
procedure WriteFonts(AStream: TStream; AData: TsWorkbook);
procedure WriteFont(AStream: TStream; AFontIndex: Integer);
procedure WriteFonts(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);
procedure WriteXFRecords(AStream: TStream; AData: TsWorkbook);
procedure WriteXFRecords(AStream: TStream);
protected
procedure AddDefaultFormats(); override;
procedure WriteBlank(AStream: TStream; const ARow, ACol: Cardinal; ACell: PCell); override;
@ -88,9 +94,21 @@ type
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); override;
public
{ General writing methods }
procedure WriteToStream(AStream: TStream; AData: TsWorkbook); override;
procedure WriteToStream(AStream: TStream); override;
end;
const
PALETTE_BIFF2: array[$0..$07] of DWord = (
$000000, // $00: black
$FFFFFF, // $01: white
$FF0000, // $02: red
$00FF00, // $03: green
$0000FF, // $04: blue
$FFFF00, // $05: yellow
$FF00FF, // $06: magenta
$00FFFF // $07: cyan
);
implementation
const
@ -117,6 +135,11 @@ const
INT_EXCEL_CHART = $0020;
INT_EXCEL_MACRO_SHEET = $0040;
type
TXFData = class
FontIndex: Integer;
end;
{ TsSpreadBIFF2Writer }
procedure TsSpreadBIFF2Writer.AddDefaultFormats();
@ -219,15 +242,13 @@ end;
Excel 2.x files support only one Worksheet per Workbook,
so only the first will be written.
}
procedure TsSpreadBIFF2Writer.WriteToStream(AStream: TStream; AData: TsWorkbook);
procedure TsSpreadBIFF2Writer.WriteToStream(AStream: TStream);
begin
WriteBOF(AStream);
WriteFonts(AStream, AData);
WriteXFRecords(AStream, AData);
WriteCellsToStream(AStream, AData.GetFirstWorksheet.Cells);
WriteFonts(AStream);
WriteXFRecords(AStream);
WriteCellsToStream(AStream, Workbook.GetFirstWorksheet.Cells);
WriteEOF(AStream);
end;
@ -358,7 +379,7 @@ begin
end;
end;
procedure TsSpreadBIFF2Writer.WriteXFRecords(AStream: TStream; AData: TsWorkbook);
procedure TsSpreadBIFF2Writer.WriteXFRecords(AStream: TStream);
begin
WriteXF(AStream, 0, 0); // XF0
WriteXF(AStream, 0, 0); // XF1
@ -378,7 +399,7 @@ begin
WriteXF(AStream, 0, 0); // XF15 - Default, no formatting
// Add all further non-standard/built-in formatting styles
ListAllFormattingStyles(AData);
ListAllFormattingStyles;
WriteXFFieldsForFormattingStyles(AStream);
end;
@ -416,15 +437,14 @@ end;
Writes an Excel 2 font record
The font data is passed as font index.
}
procedure TsSpreadBIFF2Writer.WriteFont(AStream: TStream; AData: TsWorkbook;
AFontIndex: Integer);
procedure TsSpreadBIFF2Writer.WriteFont(AStream: TStream; AFontIndex: Integer);
var
Len: Byte;
lFontName: AnsiString;
optn: Word;
font: TsFont;
begin
font := AData.GetFont(AFontIndex);
font := Workbook.GetFont(AFontIndex);
if font = nil then // this happens for FONT4 in case of BIFF
exit;
@ -465,12 +485,12 @@ begin
AStream.WriteWord(WordToLE(word(font.Color)));
end;
procedure TsSpreadBiff2Writer.WriteFonts(AStream: TStream; AData: TsWorkbook);
procedure TsSpreadBiff2Writer.WriteFonts(AStream: TStream);
var
i: Integer;
begin
for i:=0 to AData.GetFontCount-1 do
WriteFont(AStream, AData, i);
for i:=0 to Workbook.GetFontCount-1 do
WriteFont(AStream, i);
end;
{
@ -773,17 +793,35 @@ end;
{ TsSpreadBIFF2Reader }
constructor TsSpreadBIFF2Reader.Create(AWorkbook: TsWorkbook);
begin
inherited Create(AWorkbook);
FXFList := TFPList.Create;
end;
destructor TsSpreadBIFF2Reader.Destroy;
var
j: integer;
begin
for j := FXFList.Count-1 downto 0 do TObject(FXFList[j]).Free;
FXFList.Free;
inherited;
end;
procedure TsSpreadBIFF2Reader.ApplyCellFormatting(ARow, ACol: Word;
XF, AFormat, AFont, AStyle: Byte);
var
lCell: PCell;
xfData: TXFData;
begin
lCell := FWorksheet.GetCell(ARow, ACol);
if Assigned(lCell) then begin
xfData := TXFData(FXFList.items[xf]);
// Font index
Include(lCell^.UsedFormattingFields, uffFont);
lCell^.FontIndex := AFont;
lCell^.FontIndex := xfData.FontIndex; //AFont;
// Horizontal justification
if AStyle and $07 <> 0 then begin
@ -825,30 +863,34 @@ var
lOptions: Word;
Len: Byte;
lFontName: UTF8String;
font: TsFont;
begin
font := TsFont.Create;
FFont := TsFont.Create;
{ Height of the font in twips = 1/20 of a point }
lHeight := WordLEToN(AStream.ReadWord); // WordToLE(200)
font.Size := lHeight/20;
FFont.Size := lHeight/20;
{ Option flags }
lOptions := WordLEToN(AStream.ReadWord);
font.Style := [];
if lOptions and $0001 <> 0 then Include(font.Style, fssBold);
if lOptions and $0002 <> 0 then Include(font.Style, fssItalic);
if lOptions and $0004 <> 0 then Include(font.Style, fssUnderline);
if lOptions and $0008 <> 0 then Include(font.Style, fssStrikeout);
FFont.Style := [];
if lOptions and $0001 <> 0 then Include(FFont.Style, fssBold);
if lOptions and $0002 <> 0 then Include(FFont.Style, fssItalic);
if lOptions and $0004 <> 0 then Include(FFont.Style, fssUnderline);
if lOptions and $0008 <> 0 then Include(FFont.Style, fssStrikeout);
{ Font name: Unicodestring, char count in 1 byte }
Len := AStream.ReadByte();
SetLength(lFontName, Len);
AStream.ReadBuffer(lFontName[1], Len);
font.FontName := lFontName;
FFont.FontName := lFontName;
{ Add font to workbook's font list }
FWorkbook.AddFont(font);
FWorkbook.AddFont(FFont);
end;
procedure TsSpreadBIFF2Reader.ReadFontColor(AStream: TStream);
begin
FFont.Color := WordLEToN(AStream.ReadWord);
end;
procedure TsSpreadBIFF2Reader.ReadFromStream(AStream: TStream; AData: TsWorkbook);
@ -879,15 +921,17 @@ begin
case RecordType of
INT_EXCEL_ID_BLANK: ReadBlank(AStream);
INT_EXCEL_ID_FONT: ReadFont(AStream);
INT_EXCEL_ID_INTEGER: ReadInteger(AStream);
INT_EXCEL_ID_NUMBER: ReadNumber(AStream);
INT_EXCEL_ID_LABEL: ReadLabel(AStream);
INT_EXCEL_ID_FORMULA: ReadFormula(AStream);
INT_EXCEL_ID_ROWINFO: ReadRowInfo(AStream);
INT_EXCEL_ID_BOF: ;
INT_EXCEL_ID_EOF: BIFF2EOF := True;
INT_EXCEL_ID_BLANK : ReadBlank(AStream);
INT_EXCEL_ID_FONT : ReadFont(AStream);
INT_EXCEL_ID_FONTCOLOR : ReadFontColor(AStream);
INT_EXCEL_ID_INTEGER : ReadInteger(AStream);
INT_EXCEL_ID_NUMBER : ReadNumber(AStream);
INT_EXCEL_ID_LABEL : ReadLabel(AStream);
INT_EXCEL_ID_FORMULA : ReadFormula(AStream);
INT_EXCEL_ID_ROWINFO : ReadRowInfo(AStream);
INT_EXCEL_ID_XF : ReadXF(AStream);
INT_EXCEL_ID_BOF : ;
INT_EXCEL_ID_EOF : BIFF2EOF := True;
else
// nothing
@ -1020,6 +1064,30 @@ begin
end;
end;
procedure TsSpreadBIFF2Reader.ReadXF(AStream: TStream);
type
TXFRecord = packed record // see p. 224
FontIndex: byte; // Offset 0, Size 1
NotUsed: byte; // Offset 1, Size 1
NumFormat_Flags: byte; // Offset 2, Size 1
HorAlign_Border_BackGround: Byte; // Offset 3, Size 1
end;
var
xfData: TXFData;
xf: TXFRecord;
b: Byte;
begin
AStream.ReadBuffer(xf, SizeOf(xf));
xfData := TXFData.Create;
// Font index
xfData.FontIndex := xf.FontIndex;
// Add the XF to the list
FXFList.Add(xfData);
end;
{*******************************************************************
* Initialization section
*

100
components/fpspreadsheet/xlsbiff5.pas
View File

@ -134,11 +134,85 @@ type
procedure WriteXF(AStream: TStream; AFontIndex: Word; AXF_TYPE_PROT: Byte);
public
{ General writing methods }
procedure WriteToFile(const AFileName: string; AData: TsWorkbook;
procedure WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean = False); override;
procedure WriteToStream(AStream: TStream; AData: TsWorkbook); override;
procedure WriteToStream(AStream: TStream); override;
end;
const
PALETTE_BIFF5: array[$00..$3F] of DWord = (
$000000, // $00: black
$FFFFFF, // $01: white
$FF0000, // $02: red
$00FF00, // $03: green
$0000FF, // $04: blue
$FFFF00, // $05: yellow
$FF00FF, // $06: magenta
$00FFFF, // $07: cyan
$000000, // $08: EGA black
$FFFFFF, // $09: EGA white
$FF0000, // $0A: EGA red
$00FF00, // $0B: EGA green
$0000FF, // $0C: EGA blue
$FFFF00, // $0D: EGA yellow
$FF00FF, // $0E: EGA magenta
$00FFFF, // $0F: EGA cyan
$800000, // $10: EGA dark red
$008000, // $11: EGA dark green
$000080, // $12: EGA dark blue
$808000, // $13: EGA olive
$800080, // $14: EGA purple
$008080, // $15: EGA teal
$C0C0C0, // $16: EGA silver
$808080, // $17: EGA gray
$8080FF, // $18:
$802060, // $19:
$FFFFC0, // $1A:
$A0E0F0, // $1B:
$600080, // $1C:
$FF8080, // $1D:
$0080C0, // $1E:
$C0C0FF, // $1F:
$000080, // $20:
$FF00FF, // $21:
$FFFF00, // $22:
$00FFFF, // $23:
$800080, // $24:
$800000, // $25:
$008080, // $26:
$0000FF, // $27:
$00CFFF, // $28:
$69FFFF, // $29:
$E0FFE0, // $2A:
$FFFF80, // $2B:
$A6CAF0, // $2C:
$DD9CB3, // $2D:
$B38FEE, // $2E:
$E3E3E3, // $2F:
$2A6FF9, // $30:
$3FB8CD, // $31:
$488436, // $32:
$958C41, // $33:
$8E5E42, // $34:
$A0627A, // $35:
$624FAC, // $36:
$969696, // $37:
$1D2FBE, // $38:
$286676, // $39:
$004500, // $3A:
$453E01, // $3B:
$6A2813, // $3C:
$85396A, // $3D:
$4A3285, // $3E:
$424242 // $3F:
);
implementation
const
@ -285,7 +359,7 @@ const
*
*******************************************************************}
procedure TsSpreadBIFF5Writer.WriteToFile(const AFileName: string;
AData: TsWorkbook; const AOverwriteExisting: Boolean);
const AOverwriteExisting: Boolean);
var
MemStream: TMemoryStream;
OutputStorage: TOLEStorage;
@ -294,7 +368,7 @@ begin
MemStream := TMemoryStream.Create;
OutputStorage := TOLEStorage.Create;
try
WriteToStream(MemStream, AData);
WriteToStream(MemStream);
// Only one stream is necessary for any number of worksheets
OLEDocument.Stream := MemStream;
@ -315,7 +389,7 @@ end;
* part of the document, just the BIFF records
*
*******************************************************************}
procedure TsSpreadBIFF5Writer.WriteToStream(AStream: TStream; AData: TsWorkbook);
procedure TsSpreadBIFF5Writer.WriteToStream(AStream: TStream);
var
FontData: TFPCustomFont;
MyData: TMemoryStream;
@ -324,14 +398,12 @@ var
i, len: Integer;
begin
{ Store some data about the workbook that other routines need }
WorkBookEncoding := AData.Encoding;
WorkBookEncoding := Workbook.Encoding;
{ Write workbook globals }
WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS);
WriteCodepage(AStream, WorkBookEncoding);
WriteWindow1(AStream);
FontData := TFPCustomFont.Create;
@ -388,18 +460,18 @@ begin
WriteStyle(AStream);
// A BOUNDSHEET for each worksheet
for i := 0 to AData.GetWorksheetCount - 1 do
for i := 0 to Workbook.GetWorksheetCount - 1 do
begin
len := Length(Boundsheets);
SetLength(Boundsheets, len + 1);
Boundsheets[len] := WriteBoundsheet(AStream, AData.GetWorksheetByIndex(i).Name);
Boundsheets[len] := WriteBoundsheet(AStream, Workbook.GetWorksheetByIndex(i).Name);
end;
WriteEOF(AStream);
{ Write each worksheet }
for i := 0 to AData.GetWorksheetCount - 1 do
for i := 0 to Workbook.GetWorksheetCount - 1 do
begin
{ First goes back and writes the position of the BOF of the
sheet on the respective BOUNDSHEET record }
@ -411,12 +483,10 @@ begin
WriteBOF(AStream, INT_BOF_SHEET);
WriteIndex(AStream);
WriteDimensions(AStream, AData.GetWorksheetByIndex(i));
WriteDimensions(AStream, Workbook.GetWorksheetByIndex(i));
WriteWindow2(AStream, True);
WriteCellsToStream(AStream, AData.GetWorksheetByIndex(i).Cells);
WriteCellsToStream(AStream, Workbook.GetWorksheetByIndex(i).Cells);
WriteEOF(AStream);
end;

250
components/fpspreadsheet/xlsbiff8.pas
View File

@ -143,7 +143,7 @@ type
procedure ReadLabel(AStream: TStream); override;
procedure ReadNumber(AStream: TStream); override;
public
constructor Create; override;
constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override;
{ General reading methods }
procedure ReadFromFile(AFileName: string; AData: TsWorkbook); override;
@ -154,8 +154,6 @@ type
TsSpreadBIFF8Writer = class(TsSpreadBIFFWriter)
private
// Convert our representation of RGB color to physical ARGB in Excel file
function LongRGBToExcelPhysical(const RGB: DWord): DWord;
// Writes index to XF record according to cell's formatting
procedure WriteXFIndex(AStream: TStream; ACell: PCell);
procedure WriteXFFieldsForFormattingStyles(AStream: TStream);
@ -174,13 +172,12 @@ type
procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFont: TsFont);
procedure WriteFonts(AStream: TStream; AData: TsWorkbook);
procedure WriteFonts(AStream: TStream);
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
const AFormula: TsFormula; ACell: PCell); override;
procedure WriteIndex(AStream: TStream);
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override;
procedure WritePalette(AStream: TStream);
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: double; ACell: PCell); override;
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
@ -193,16 +190,86 @@ type
AHorAlignment: TsHorAlignment = haDefault; AVertAlignment: TsVertAlignment = vaDefault;
AWordWrap: Boolean = false; AddBackground: Boolean = false;
ABackgroundColor: TsColor = scSilver);
procedure WriteXFRecords(AStream: TStream; AData: TsWorkbook);
procedure WriteXFRecords(AStream: TStream);
public
// constructor Create;
// destructor Destroy; override;
{ General writing methods }
procedure WriteToFile(const AFileName: string; AData: TsWorkbook;
procedure WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean = False); override;
procedure WriteToStream(AStream: TStream; AData: TsWorkbook); override;
procedure WriteToStream(AStream: TStream); override;
end;
const
PALETTE_BIFF8: array[$00..$3F] of DWord = (
$000000, // $00: black // 8 built-in default colors
$FFFFFF, // $01: white
$FF0000, // $02: red
$00FF00, // $03: green
$0000FF, // $04: blue
$FFFF00, // $05: yellow
$FF00FF, // $06: magenta
$00FFFF, // $07: cyan
$000000, // $08: EGA black
$FFFFFF, // $09: EGA white
$FF0000, // $0A: EGA red
$00FF00, // $0B: EGA green
$0000FF, // $0C: EGA blue
$FFFF00, // $0D: EGA yellow
$FF00FF, // $0E: EGA magenta
$00FFFF, // $0F: EGA cyan
$800000, // $10: EGA dark red
$008000, // $11: EGA dark green
$000080, // $12: EGA dark blue
$808000, // $13: EGA olive
$800080, // $14: EGA purple
$008080, // $15: EGA teal
$C0C0C0, // $16: EGA silver
$808080, // $17: EGA gray
$9999FF, // $18:
$993366, // $19:
$FFFFCC, // $1A:
$CCFFFF, // $1B:
$660066, // $1C:
$FF8080, // $1D:
$0066CC, // $1E:
$CCCCFF, // $1F:
$000080, // $20:
$FF00FF, // $21:
$FFFF00, // $22:
$00FFFF, // $23:
$800080, // $24:
$800000, // $25:
$008080, // $26:
$0000FF, // $27:
$00CCFF, // $28:
$CCFFFF, // $29:
$CCFFCC, // $2A:
$FFFF99, // $2B:
$99CCFF, // $2C:
$FF99CC, // $2D:
$CC99FF, // $2E:
$FFCC99, // $2F:
$3366FF, // $30:
$33CCCC, // $31:
$99CC00, // $32:
$FFCC00, // $33:
$FF9900, // $34:
$FF6600, // $35:
$666699, // $36:
$969696, // $37:
$003366, // $38:
$339966, // $39:
$003300, // $3A:
$333300, // $3B:
$993300, // $3C:
$993366, // $3D:
$333399, // $3E:
$333333 // $3F:
);
implementation
const
@ -229,8 +296,6 @@ const
INT_EXCEL_ID_SST = $00FC; //BIFF8 only
INT_EXCEL_ID_CONTINUE = $003C;
INT_EXCEL_ID_LABELSST = $00FD; //BIFF8 only
INT_EXCEL_ID_PALETTE = $0092;
INT_EXCEL_ID_CODEPAGE = $0042;
INT_EXCEL_ID_FORMAT = $041E;
INT_EXCEL_ID_FORCEFULLCALCULATION = $08A3;
@ -345,24 +410,6 @@ const
{ TsSpreadBIFF8Writer }
function TsSpreadBIFF8Writer.LongRGBToExcelPhysical(const RGB: DWord): DWord;
// Converts RGB part of a LongRGB logical structure
// to its physical representation
// IOW: RGBA (where A is 0 and omitted in the function call) => ABGR
begin
{$IFDEF FPC}
{$IFDEF ENDIAN_LITTLE}
result:=(RGB shl 8); //tags $00 at end for the A byte
result:=SwapEndian(result); //flip byte order
{$ELSE}
//Big endian
result:=RGB; //leave value as is //todo: verify if this turns out ok
{$ENDIF}
{$ELSE}
// messed up result
{$ENDIF}
end;
{ Index to XF record, according to formatting }
procedure TsSpreadBIFF8Writer.WriteXFIndex(AStream: TStream; ACell: PCell);
var
@ -558,7 +605,7 @@ end;
*
*******************************************************************}
procedure TsSpreadBIFF8Writer.WriteToFile(const AFileName: string;
AData: TsWorkbook; const AOverwriteExisting: Boolean);
const AOverwriteExisting: Boolean);
var
MemStream: TMemoryStream;
OutputStorage: TOLEStorage;
@ -567,7 +614,7 @@ begin
MemStream := TMemoryStream.Create;
OutputStorage := TOLEStorage.Create;
try
WriteToStream(MemStream, AData);
WriteToStream(MemStream);
// Only one stream is necessary for any number of worksheets
OLEDocument.Stream := MemStream;
@ -588,7 +635,7 @@ end;
* part of the document, just the BIFF records
*
*******************************************************************}
procedure TsSpreadBIFF8Writer.WriteToStream(AStream: TStream; AData: TsWorkbook);
procedure TsSpreadBIFF8Writer.WriteToStream(AStream: TStream);
var
MyData: TMemoryStream;
CurrentPos: Int64;
@ -602,31 +649,26 @@ begin
WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS);
WriteWindow1(AStream);
WriteFonts(AStream, AData);
// PALETTE
WriteFonts(AStream);
WritePalette(AStream);
// XF Records
WriteXFRecords(AStream, AData);
WriteXFRecords(AStream);
WriteStyle(AStream);
// A BOUNDSHEET for each worksheet
for i := 0 to AData.GetWorksheetCount - 1 do
for i := 0 to Workbook.GetWorksheetCount - 1 do
begin
len := Length(Boundsheets);
SetLength(Boundsheets, len + 1);
Boundsheets[len] := WriteBoundsheet(AStream, AData.GetWorksheetByIndex(i).Name);
Boundsheets[len] := WriteBoundsheet(AStream, Workbook.GetWorksheetByIndex(i).Name);
end;
WriteEOF(AStream);
{ Write each worksheet }
for i := 0 to AData.GetWorksheetCount - 1 do
for i := 0 to Workbook.GetWorksheetCount - 1 do
begin
sheet := AData.GetWorksheetByIndex(i);
sheet := Workbook.GetWorksheetByIndex(i);
{ First goes back and writes the position of the BOF of the
sheet on the respective BOUNDSHEET record }
@ -938,12 +980,12 @@ end;
* used fonts in the workbook.
*
*******************************************************************}
procedure TsSpreadBiff8Writer.WriteFonts(AStream: TStream; AData: TsWorkbook);
procedure TsSpreadBiff8Writer.WriteFonts(AStream: TStream);
var
i: Integer;
begin
for i:=0 to AData.GetFontCount-1 do
WriteFont(AStream, AData.GetFont(i));
for i:=0 to Workbook.GetFontCount-1 do
WriteFont(AStream, Workbook.GetFont(i));
end;
{*******************************************************************
@ -1321,90 +1363,6 @@ begin
AStream.WriteBuffer(AValue, 8);
end;
(*******************************************************************
* TsSpreadBIFF8Writer.WritePalette
*
* DESCRIPTION: Writes Excel PALETTE records
*
*******************************************************************)
procedure TsSpreadBIFF8Writer.WritePalette(AStream: TStream);
begin
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_PALETTE));
AStream.WriteWord(WordToLE(2+4*56));
{ Number of colors }
AStream.WriteWord(WordToLE(56));
{ Now the colors, first the standard 16 from Excel }
AStream.WriteDWord(LongRGBToExcelPhysical($000000)); // $08
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FF0000));
AStream.WriteDWord(LongRGBToExcelPhysical($00FF00));
AStream.WriteDWord(LongRGBToExcelPhysical($0000FF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFF00));
AStream.WriteDWord(LongRGBToExcelPhysical($FF00FF));
AStream.WriteDWord(LongRGBToExcelPhysical($00FFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($800000));
AStream.WriteDWord(LongRGBToExcelPhysical($008000));
AStream.WriteDWord(LongRGBToExcelPhysical($000080));
AStream.WriteDWord(LongRGBToExcelPhysical($808000));
AStream.WriteDWord(LongRGBToExcelPhysical($800080));
AStream.WriteDWord(LongRGBToExcelPhysical($008080));
AStream.WriteDWord(LongRGBToExcelPhysical($C0C0C0));
AStream.WriteDWord(LongRGBToExcelPhysical($808080)); //$17
{ Now some colors which we define ourselves }
AStream.WriteDWord(LongRGBToExcelPhysical($E6E6E6)); //$18 //todo: shouldn't we write $18..$3F and add this color later? see 5.74.3 Built-In Default Colour Tables
AStream.WriteDWord(LongRGBToExcelPhysical($CCCCCC)); //$19 //todo: shouldn't we write $18..$3F and add this color later? see 5.74.3 Built-In Default Colour Tables
{ And padding }
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF)); //$20 //todo: is this still correct?
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF)); //$30
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
AStream.WriteDWord(LongRGBToExcelPhysical($FFFFFF));
end;
{*******************************************************************
* TsSpreadBIFF8Writer.WriteStyle ()
*
@ -1627,12 +1585,12 @@ begin
// Background Pattern Color, always zeroed
if AddBackground then
AStream.WriteWord(WordToLE(FPSColorToEXCELPalette(ABackgroundColor)))
AStream.WriteWord(WordToLE(ABackgroundColor))
else
AStream.WriteWord(0);
end;
procedure TsSpreadBIFF8Writer.WriteXFRecords(AStream: TStream; AData: TsWorkbook);
procedure TsSpreadBIFF8Writer.WriteXFRecords(AStream: TStream);
begin
// XF0
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []);
@ -1668,7 +1626,7 @@ begin
WriteXF(AStream, 0, 0, 0, XF_ROTATION_HORIZONTAL, []);
// Add all further non-standard/built-in formatting styles
ListAllFormattingStyles(AData);
ListAllFormattingStyles;
WriteXFFieldsForFormattingStyles(AStream);
end;
@ -1952,7 +1910,7 @@ begin
CurStreamPos := AStream.Position;
if RecordType<>INT_EXCEL_ID_CONTINUE then begin
if RecordType <> INT_EXCEL_ID_CONTINUE then begin
case RecordType of
INT_EXCEL_ID_BOF: ;
INT_EXCEL_ID_BOUNDSHEET: ReadBoundSheet(AStream);
@ -1963,6 +1921,7 @@ begin
INT_EXCEL_ID_XF: ReadXF(AStream);
INT_EXCEL_ID_FORMAT: ReadFormat(AStream);
INT_EXCEL_ID_DATEMODE: ReadDateMode(AStream);
INT_EXCEL_ID_PALETTE: ReadPalette(AStream);
else
// nothing
end;
@ -2140,8 +2099,10 @@ begin
XFData := TXFRecordData(FXFList.Items[XFIndex]);
// Font
Include(lCell^.UsedFormattingFields, uffFont);
lCell^.FontIndex := XFData.FontIndex;
if XFData.FontIndex > 0 then begin
Include(lCell^.UsedFormattingFields, uffFont);
lCell^.FontIndex := XFData.FontIndex;
end;
// Alignment
lCell^.HorAlignment := XFData.HorAlignment;
@ -2161,8 +2122,10 @@ begin
Exclude(lCell^.UsedFormattingFields, uffBorder);
// Background color
Include(lCell^.UsedFormattingFields, uffBackgroundColor);
lCell^.BackgroundColor := XFData.BackgroundColor;
if XFData.BackgroundColor <> 0 then begin
Include(lCell^.UsedFormattingFields, uffBackgroundColor);
lCell^.BackgroundColor := XFData.BackgroundColor;
end;
end;
end;
@ -2172,9 +2135,9 @@ begin
Result:=UTF16ToUTF8(ReadWideString(AStream, ALength));
end;
constructor TsSpreadBIFF8Reader.Create;
constructor TsSpreadBIFF8Reader.Create(AWorkbook: TsWorkbook);
begin
inherited Create;
inherited Create(AWorkbook);
FXFList := TFPList.Create;
FFormatList := TFPList.Create;
end;
@ -2188,6 +2151,7 @@ begin
FXFList.Free;
FFormatList.Free;
if Assigned(FSharedStringTable) then FSharedStringTable.Free;
inherited;
end;
procedure TsSpreadBIFF8Reader.ReadFromFile(AFileName: string; AData: TsWorkbook);
@ -2532,8 +2496,8 @@ begin
Include(lData.Borders, cbSouth);
// Background color;
xf.Border_Background_3 := WordLEToN(xf.Border_Background_3);
lData.BackgroundColor := ExcelPaletteToFPSColor(xf.Border_Background_3 AND $007F);
xf.Border_Background_3 := DWordLEToN(xf.Border_Background_3);
lData.BackgroundColor := xf.Border_Background_3 AND $007F;
// Add the XF to the list
FXFList.Add(lData);

137
components/fpspreadsheet/xlscommon.pas
View File

@ -19,6 +19,7 @@ const
INT_EXCEL_ID_FONT = $0031;
INT_EXCEL_ID_CODEPAGE = $0042;
INT_EXCEL_ID_DATEMODE = $0022;
INT_EXCEL_ID_PALETTE = $0092;
{ Formula constants TokenID values }
@ -285,16 +286,18 @@ type
FCodepage: string; // in a format prepared for lconvencoding.ConvertEncoding
FDateMode: TDateMode;
// converts an Excel color index to a color value.
function ExcelPaletteToFPSColor(AIndex: Word): TsColor;
// function ExcelPaletteToFPSColor(AIndex: Word): TsColor;
// Here we can add reading of records which didn't change across BIFF2-8 versions
// Workbook Globals records
procedure ReadCodePage(AStream: TStream);
// Figures out what the base year for dates is for this file
procedure ReadDateMode(AStream: TStream);
// Read palette
procedure ReadPalette(AStream: TStream);
// Read row info
procedure ReadRowInfo(const AStream: TStream); virtual;
procedure ReadRowInfo(AStream: TStream); virtual;
public
constructor Create; override;
constructor Create(AWorkbook: TsWorkbook); override;
end;
{ TsSpreadBIFFWriter }
@ -304,7 +307,7 @@ type
FDateMode: TDateMode;
FLastRow: Integer;
FLastCol: Word;
function FPSColorToExcelPalette(AColor: TsColor): Word;
// function FPSColorToExcelPalette(AColor: TsColor): Word;
procedure GetLastRowCallback(ACell: PCell; AStream: TStream);
function GetLastRowIndex(AWorksheet: TsWorksheet): Integer;
procedure GetLastColCallback(ACell: PCell; AStream: TStream);
@ -316,8 +319,10 @@ type
procedure WriteCodepage(AStream: TStream; AEncoding: TsEncoding);
// Writes out DATEMODE record depending on FDateMode
procedure WriteDateMode(AStream: TStream);
// Writes out a PALETTE record containing all colors defined in the workbook
procedure WritePalette(AStream: TStream);
public
constructor Create; override;
constructor Create(AWorkbook: TsWorkbook); override;
end;
function IsExpNumberFormat(s: String; out Decimals: Word): Boolean;
@ -383,13 +388,13 @@ end;
{ TsSpreadBIFFReader }
constructor TsSpreadBIFFReader.Create;
constructor TsSpreadBIFFReader.Create(AWorkbook: TsWorkbook);
begin
inherited Create;
inherited Create(AWorkbook);
// Initial base date in case it won't be read from file
FDateMode := dm1900;
end;
(*
function TsSpreadBIFFReader.ExcelPaletteToFPSColor(AIndex: Word): TsColor;
begin
case AIndex of
@ -414,7 +419,7 @@ begin
EXTRA_COLOR_PALETTE_GREY20PCT: Result := scGrey20pct;
end;
end;
*)
// In BIFF 8 it seams to always use the UTF-16 codepage
procedure TsSpreadBIFFReader.ReadCodePage(AStream: TStream);
var
@ -492,8 +497,23 @@ begin
end;
end;
// Read the palette
procedure TsSpreadBIFFReader.ReadPalette(AStream: TStream);
var
i, n: Word;
pal: Array of DWord;
begin
n := WordLEToN(AStream.ReadWord) + 8;
SetLength(pal, n);
for i:=0 to 7 do
pal[i] := Workbook.GetPaletteColor(i);
for i:=8 to n-1 do
pal[i] := DWordLEToN(AStream.ReadDWord);
Workbook.UsePalette(@pal[0], n, false);
end;
// Read the part of the ROW record that is common to all BIFF versions
procedure TsSpreadBIFFReader.ReadRowInfo(const AStream: TStream);
procedure TsSpreadBIFFReader.ReadRowInfo(AStream: TStream);
type
TRowRecord = packed record
RowIndex: Word;
@ -515,53 +535,15 @@ begin
end;
end;
function TsSpreadBIFFWriter.FPSColorToExcelPalette(AColor: TsColor): Word;
begin
case AColor of
scBlack: Result := BUILT_IN_COLOR_PALLETE_BLACK;
scWhite: Result := BUILT_IN_COLOR_PALLETE_WHITE;
scRed: Result := BUILT_IN_COLOR_PALLETE_RED;
scGREEN: Result := BUILT_IN_COLOR_PALLETE_GREEN;
scBLUE: Result := BUILT_IN_COLOR_PALLETE_BLUE;
scYELLOW: Result := BUILT_IN_COLOR_PALLETE_YELLOW;
scMAGENTA: Result := BUILT_IN_COLOR_PALLETE_MAGENTA;
scCYAN: Result := BUILT_IN_COLOR_PALLETE_CYAN;
scDarkRed: Result := BUILT_IN_COLOR_PALLETE_DARK_RED;
scDarkGreen: Result := BUILT_IN_COLOR_PALLETE_DARK_GREEN;
scDarkBlue: Result := BUILT_IN_COLOR_PALLETE_DARK_BLUE;
scOLIVE: Result := BUILT_IN_COLOR_PALLETE_OLIVE;
scPURPLE: Result := BUILT_IN_COLOR_PALLETE_PURPLE;
scTEAL: Result := BUILT_IN_COLOR_PALLETE_TEAL;
scSilver: Result := BUILT_IN_COLOR_PALLETE_SILVER;
scGrey: Result := BUILT_IN_COLOR_PALLETE_GREY;
//
scGrey10pct: Result := EXTRA_COLOR_PALETTE_GREY10PCT;
scGrey20pct: Result := EXTRA_COLOR_PALETTE_GREY20PCT;
end;
end;
procedure TsSpreadBIFFWriter.GetLastRowCallback(ACell: PCell; AStream: TStream);
begin
if ACell^.Row > FLastRow then FLastRow := ACell^.Row;
end;
{ TsSpreadBIFFWriter }
function TsSpreadBIFFWriter.GetLastRowIndex(AWorksheet: TsWorksheet): Integer;
constructor TsSpreadBIFFWriter.Create(AWorkbook: TsWorkbook);
begin
FLastRow := 0;
IterateThroughCells(nil, AWorksheet.Cells, GetLastRowCallback);
Result := FLastRow;
end;
procedure TsSpreadBIFFWriter.GetLastColCallback(ACell: PCell; AStream: TStream);
begin
if ACell^.Col > FLastCol then FLastCol := ACell^.Col;
end;
function TsSpreadBIFFWriter.GetLastColIndex(AWorksheet: TsWorksheet): Word;
begin
FLastCol := 0;
IterateThroughCells(nil, AWorksheet.Cells, GetLastColCallback);
Result := FLastCol;
inherited Create(AWorkbook);
// Initial base date in case it won't be set otherwise.
// Use 1900 to get a bit more range between 1900..1904.
FDateMode := dm1900;
end;
function TsSpreadBIFFWriter.FormulaElementKindToExcelTokenID(
@ -736,6 +718,30 @@ begin
end;
end;
procedure TsSpreadBIFFWriter.GetLastRowCallback(ACell: PCell; AStream: TStream);
begin
if ACell^.Row > FLastRow then FLastRow := ACell^.Row;
end;
function TsSpreadBIFFWriter.GetLastRowIndex(AWorksheet: TsWorksheet): Integer;
begin
FLastRow := 0;
IterateThroughCells(nil, AWorksheet.Cells, GetLastRowCallback);
Result := FLastRow;
end;
procedure TsSpreadBIFFWriter.GetLastColCallback(ACell: PCell; AStream: TStream);
begin
if ACell^.Col > FLastCol then FLastCol := ACell^.Col;
end;
function TsSpreadBIFFWriter.GetLastColIndex(AWorksheet: TsWorksheet): Word;
begin
FLastCol := 0;
IterateThroughCells(nil, AWorksheet.Cells, GetLastColCallback);
Result := FLastCol;
end;
procedure TsSpreadBIFFWriter.WriteCodepage(AStream: TStream;
AEncoding: TsEncoding);
var
@ -774,12 +780,25 @@ begin
end;
end;
constructor TsSpreadBIFFWriter.Create;
procedure TsSpreadBIFFWriter.WritePalette(AStream: TStream);
var
i, n: Integer;
begin
inherited Create;
// Initial base date in case it won't be set otherwise.
// Use 1900 to get a bit more range between 1900..1904.
FDateMode := dm1900;
{ BIFF Record header }
AStream.WriteWord(WordToLE(INT_EXCEL_ID_PALETTE));
AStream.WriteWord(WordToLE(2 + 4*56));
{ Number of colors }
AStream.WriteWord(WordToLE(56));
{ Take the colors from the palette of the Worksheet }
{ Skip the first 8 entries - they are hard-coded into Excel }
n := Workbook.GetPaletteSize;
for i:=8 to 63 do
if i < n then
AStream.WriteDWord(DWordToLE(Workbook.GetPaletteColor(i)))
else
AStream.WriteDWord(DWordToLE($FFFFFF));
end;

69
components/fpspreadsheet/xlsxooxml.pas
View File

@ -49,7 +49,7 @@ type
{ Strings with the contents of files }
FContentTypes: string;
FRelsRels: string;
FWorkbook, FWorkbookRels, FStyles, FSharedStrings: string;
FWorkbookString, FWorkbookRelsString, FStylesString, FSharedStrings: string;
FSheets: array of string;
FSharedStringsCount: Integer;
{ Streams with the contents of files }
@ -59,8 +59,8 @@ type
FSSheets: array of TStringStream;
FCurSheetNum: Integer;
{ Routines to write those files }
procedure WriteGlobalFiles(AData: TsWorkbook);
procedure WriteContent(AData: TsWorkbook);
procedure WriteGlobalFiles;
procedure WriteContent;
procedure WriteWorksheet(CurSheet: TsWorksheet);
function GetStyleIndex(ACell: PCell): Cardinal;
{ Record writing methods }
@ -69,13 +69,12 @@ type
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; const AValue: double; ACell: PCell); override;
procedure WriteDateTime(AStream: TStream; const ARow, ACol: Cardinal; const AValue: TDateTime; ACell: PCell); override;
public
constructor Create; override;
constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override;
{ General writing methods }
procedure WriteStringToFile(AFileName, AString: string);
procedure WriteToFile(const AFileName: string; AData: TsWorkbook;
const AOverwriteExisting: Boolean = False); override;
procedure WriteToStream(AStream: TStream; AData: TsWorkbook); override;
procedure WriteToFile(const AFileName: string; const AOverwriteExisting: Boolean = False); override;
procedure WriteToStream(AStream: TStream); override;
end;
implementation
@ -117,7 +116,7 @@ const
{ TsSpreadOOXMLWriter }
procedure TsSpreadOOXMLWriter.WriteGlobalFiles(AData: TsWorkbook);
procedure TsSpreadOOXMLWriter.WriteGlobalFiles;
var
i: Integer;
begin
@ -133,7 +132,7 @@ begin
// <Override PartName="/docProps/app.xml" ContentType="application/vnd.openxmlformats-officedocument.extended-properties+xml"/>
' <Override PartName="/xl/_rels/workbook.xml.rels" ContentType="application/vnd.openxmlformats-package.relationships+xml" />' + LineEnding +
' <Override PartName="/xl/workbook.xml" ContentType="' + MIME_SHEET + '" />' + LineEnding;
for i := 1 to AData.GetWorksheetCount do
for i := 1 to Workbook.GetWorksheetCount do
begin
FContentTypes := FContentTypes +
Format(' <Override PartName="/xl/worksheets/sheet%d.xml" ContentType="%s" />', [i, MIME_WORKSHEET]) + LineEnding;
@ -149,7 +148,7 @@ begin
'<Relationship Type="' + SCHEMAS_DOCUMENT + '" Target="xl/workbook.xml" Id="rId1" />' + LineEnding +
'</Relationships>';
FStyles :=
FStylesString :=
XML_HEADER + LineEnding +
'<styleSheet xmlns="' + SCHEMAS_SPREADML + '">' + LineEnding +
' <fonts count="2">' + LineEnding +
@ -189,28 +188,28 @@ begin
'</styleSheet>';
end;
procedure TsSpreadOOXMLWriter.WriteContent(AData: TsWorkbook);
procedure TsSpreadOOXMLWriter.WriteContent;
var
i: Integer;
begin
{ Workbook relations - Mark relation to all sheets }
FWorkbookRels :=
FWorkbookRelsString :=
XML_HEADER + LineEnding +
'<Relationships xmlns="' + SCHEMAS_RELS + '">' + LineEnding +
'<Relationship Id="rId1" Type="' + SCHEMAS_STYLES + '" Target="styles.xml" />' + LineEnding +
'<Relationship Id="rId2" Type="' + SCHEMAS_STRINGS + '" Target="sharedStrings.xml" />' + LineEnding;
for i := 1 to AData.GetWorksheetCount do
for i := 1 to Workbook.GetWorksheetCount do
begin
FWorkbookRels := FWorkbookRels +
FWorkbookRelsString := FWorkbookRelsString +
Format('<Relationship Type="%s" Target="worksheets/sheet%d.xml" Id="rId%d" />', [SCHEMAS_WORKSHEET, i, i+2]) + LineEnding;
end;
FWorkbookRels := FWorkbookRels +
FWorkbookRelsString := FWorkbookRelsString +
'</Relationships>';
// Global workbook data - Mark all sheets
FWorkbook :=
FWorkbookString :=
XML_HEADER + LineEnding +
'<workbook xmlns="' + SCHEMAS_SPREADML + '" xmlns:r="' + SCHEMAS_DOC_RELS + '">' + LineEnding +
' <fileVersion appName="fpspreadsheet" />' + LineEnding + // lastEdited="4" lowestEdited="4" rupBuild="4505"
@ -219,13 +218,13 @@ begin
' <workbookView xWindow="480" yWindow="90" windowWidth="15195" windowHeight="12525" />' + LineEnding +
' </bookViews>' + LineEnding;
FWorkbook := FWorkbook + ' <sheets>' + LineEnding;
for i := 1 to AData.GetWorksheetCount do
FWorkbook := FWorkbook +
FWorkbookString := FWorkbookString + ' <sheets>' + LineEnding;
for i := 1 to Workbook.GetWorksheetCount do
FWorkbookString := FWorkbookString +
Format(' <sheet name="Sheet%d" sheetId="%d" r:id="rId%d" />', [i, i, i+2]) + LineEnding;
FWorkbook := FWorkbook + ' </sheets>' + LineEnding;
FWorkbookString := FWorkbookString + ' </sheets>' + LineEnding;
FWorkbook := FWorkbook +
FWorkbookString := FWorkbookString +
' <calcPr calcId="114210" />' + LineEnding +
'</workbook>';
@ -236,10 +235,8 @@ begin
// Write all worksheets, which fills also FSharedStrings
SetLength(FSheets, 0);
for i := 0 to AData.GetWorksheetCount - 1 do
begin
WriteWorksheet(Adata.GetWorksheetByIndex(i));
end;
for i := 0 to Workbook.GetWorksheetCount - 1 do
WriteWorksheet(Workbook.GetWorksheetByIndex(i));
// Finalization of the shared strings document
FSharedStrings :=
@ -354,9 +351,9 @@ begin
else Result := 0;
end;
constructor TsSpreadOOXMLWriter.Create;
constructor TsSpreadOOXMLWriter.Create(AWorkbook: TsWorkbook);
begin
inherited Create;
inherited Create(AWorkbook);
FPointSeparatorSettings := DefaultFormatSettings;
FPointSeparatorSettings.DecimalSeparator := '.';
@ -388,35 +385,35 @@ end;
Writes an OOXML document to the disc
}
procedure TsSpreadOOXMLWriter.WriteToFile(const AFileName: string;
AData: TsWorkbook; const AOverwriteExisting: Boolean);
const AOverwriteExisting: Boolean);
var
lStream: TFileStream;
begin
lStream:=TFileStream.Create(AFileName,fmCreate);
lStream:=TFileStream.Create(AFileName, fmCreate);
try
WriteToStream(lStream, AData);
WriteToStream(lStream);
finally
FreeAndNil(lStream);
end;
end;
procedure TsSpreadOOXMLWriter.WriteToStream(AStream: TStream; AData: TsWorkbook);
procedure TsSpreadOOXMLWriter.WriteToStream(AStream: TStream);
var
FZip: TZipper;
i: Integer;
begin
{ Fill the strings with the contents of the files }
WriteGlobalFiles(AData);
WriteContent(AData);
WriteGlobalFiles;
WriteContent;
{ Write the data to streams }
FSContentTypes := TStringStream.Create(FContentTypes);
FSRelsRels := TStringStream.Create(FRelsRels);
FSWorkbookRels := TStringStream.Create(FWorkbookRels);
FSWorkbook := TStringStream.Create(FWorkbook);
FSStyles := TStringStream.Create(FStyles);
FSWorkbookRels := TStringStream.Create(FWorkbookRelsString);
FSWorkbook := TStringStream.Create(FWorkbookString);
FSStyles := TStringStream.Create(FStylesString);
FSSharedStrings := TStringStream.Create(FSharedStrings);
SetLength(FSSheets, Length(FSheets));