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"/> <UseAnsiStrings Value="False"/>
</SyntaxOptions> </SyntaxOptions>
</Parsing> </Parsing>
<Linking>
<Debugging>
<DebugInfoType Value="dsStabs"/>
</Debugging>
</Linking>
<Other> <Other>
<CompilerPath Value="$(CompPath)"/> <CompilerPath Value="$(CompPath)"/>
</Other> </Other>

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

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

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

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

32
components/fpspreadsheet/fpsopendocument.pas
View File

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

273
components/fpspreadsheet/fpspreadsheet.pas
View File

@@ -179,12 +179,63 @@ type
TsHorAlignment = (haDefault, haLeft, haCenter, haRight); TsHorAlignment = (haDefault, haLeft, haCenter, haRight);
TsVertAlignment = (vaDefault, vaTop, vaCenter, vaBottom); 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. {@@ 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 However, please note that they are physically written to XLS file as
ABGR (where A is 0) } ABGR (where A is 0) }
(*
TsColor = ( // R G B color value: TsColor = ( // R G B color value:
scBlack , // 000000H scBlack, // 000000H
scWhite, // FFFFFFH scWhite, // FFFFFFH
scRed, // FF0000H scRed, // FF0000H
scGREEN, // 00FF00H scGREEN, // 00FF00H
@@ -211,14 +262,18 @@ type
// //
scRGBCOLOR // Defined via TFPColor 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" } {@@ Font style (redefined to avoid usage of "Graphics" }
TsFontStyle = (fssBold, fssItalic, fssStrikeOut, fssUnderline); TsFontStyle = (fssBold, fssItalic, fssStrikeOut, fssUnderline);
TsFontStyles = set of TsFontStyle; TsFontStyles = set of TsFontStyle;
{@@ Font } {@@ Font }
TsFont = class TsFont = class
FontName: String; FontName: String;
Size: Single; // in "points" Size: Single; // in "points"
@@ -269,7 +324,7 @@ type
PRow = ^TRow; PRow = ^TRow;
TCol = record TCol = record
Col: Byte; Col: Cardinal;
Width: Single; // in "characters". Excel uses the with of char "0" in 1st font Width: Single; // in "characters". Excel uses the with of char "0" in 1st font
end; end;
@@ -324,6 +379,8 @@ type
function WriteFont(ARow, ACol: Cardinal; const AFontName: String; function WriteFont(ARow, ACol: Cardinal; const AFontName: String;
AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; overload; AFontSize: Single; AFontStyle: TsFontStyles; AFontColor: TsColor): Integer; overload;
procedure WriteFont(ARow, ACol: Cardinal; AFontIndex: 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 WriteTextRotation(ARow, ACol: Cardinal; ARotation: TsTextRotation);
procedure WriteUsedFormatting(ARow, ACol: Cardinal; AUsedFormatting: TsUsedFormattingFields); procedure WriteUsedFormatting(ARow, ACol: Cardinal; AUsedFormatting: TsUsedFormattingFields);
procedure WriteBackgroundColor(ARow, ACol: Cardinal; AColor: TsColor); procedure WriteBackgroundColor(ARow, ACol: Cardinal; AColor: TsColor);
@@ -356,6 +413,7 @@ type
FFormat: TsSpreadsheetFormat; FFormat: TsSpreadsheetFormat;
FFontList: TFPList; FFontList: TFPList;
FBuiltinFontCount: Integer; FBuiltinFontCount: Integer;
FPalette: array of DWord;
{ Internal methods } { Internal methods }
procedure RemoveWorksheetsCallback(data, arg: pointer); procedure RemoveWorksheetsCallback(data, arg: pointer);
public public
@@ -393,6 +451,11 @@ type
procedure InitFonts; procedure InitFonts;
procedure RemoveAllFonts; procedure RemoveAllFonts;
procedure SetDefaultFont(const AFontName: String; ASize: Single); 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 {@@ 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 } and support a single encoding for the whole document, like Excel 2 to 5 }
property Encoding: TsEncoding read FEncoding write FEncoding; property Encoding: TsEncoding read FEncoding write FEncoding;
@@ -415,12 +478,12 @@ type
procedure ReadLabel(AStream: TStream); virtual; abstract; procedure ReadLabel(AStream: TStream); virtual; abstract;
procedure ReadNumber(AStream: TStream); virtual; abstract; procedure ReadNumber(AStream: TStream); virtual; abstract;
public public
constructor Create; virtual; // To allow descendents to override it constructor Create(AWorkbook: TsWorkbook); virtual; // To allow descendents to override it
{ General writing methods } { General writing methods }
procedure ReadFromFile(AFileName: string; AData: TsWorkbook); virtual; procedure ReadFromFile(AFileName: string; AData: TsWorkbook); virtual;
procedure ReadFromStream(AStream: TStream; AData: TsWorkbook); virtual; procedure ReadFromStream(AStream: TStream; AData: TsWorkbook); virtual;
procedure ReadFromStrings(AStrings: TStrings; AData: TsWorkbook); virtual; procedure ReadFromStrings(AStrings: TStrings; AData: TsWorkbook); virtual;
property Wordbook: TsWorkbook read FWorkbook; property Workbook: TsWorkbook read FWorkbook;
end; end;
{@@ TsSpreadWriter class reference type } {@@ TsSpreadWriter class reference type }
@@ -433,14 +496,14 @@ type
TsCustomSpreadWriter = class TsCustomSpreadWriter = class
private private
FWorkbook: TsWorkbook;
protected protected
{ Helper routines } { Helper routines }
procedure AddDefaultFormats(); virtual; procedure AddDefaultFormats(); virtual;
function ExpandFormula(AFormula: TsFormula): TsExpandedFormula; function ExpandFormula(AFormula: TsFormula): TsExpandedFormula;
function FindFormattingInList(AFormat: PCell): Integer; function FindFormattingInList(AFormat: PCell): Integer;
function FPSColorToHexString(AColor: TsColor; ARGBColor: TFPColor): string;
procedure ListAllFormattingStylesCallback(ACell: PCell; AStream: TStream); procedure ListAllFormattingStylesCallback(ACell: PCell; AStream: TStream);
procedure ListAllFormattingStyles(AData: TsWorkbook); procedure ListAllFormattingStyles;
{ Helpers for writing } { Helpers for writing }
procedure WriteCellCallback(ACell: PCell; AStream: TStream); procedure WriteCellCallback(ACell: PCell; AStream: TStream);
procedure WriteCellsToStream(AStream: TStream; ACells: TAVLTree); procedure WriteCellsToStream(AStream: TStream; ACells: TAVLTree);
@@ -458,13 +521,13 @@ type
} }
FFormattingStyles: array of TCell; FFormattingStyles: array of TCell;
NextXFIndex: Integer; // Indicates which should be the next XF (Style) Index when filling the styles list 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 } { General writing methods }
procedure IterateThroughCells(AStream: TStream; ACells: TAVLTree; ACallback: TCellsCallback); procedure IterateThroughCells(AStream: TStream; ACells: TAVLTree; ACallback: TCellsCallback);
procedure WriteToFile(const AFileName: string; AData: TsWorkbook; procedure WriteToFile(const AFileName: string; const AOverwriteExisting: Boolean = False); virtual;
const AOverwriteExisting: Boolean = False); virtual; procedure WriteToStream(AStream: TStream); virtual;
procedure WriteToStream(AStream: TStream; AData: TsWorkbook); virtual; procedure WriteToStrings(AStrings: TStrings); virtual;
procedure WriteToStrings(AStrings: TStrings; AData: TsWorkbook); virtual; property Workbook: TsWorkbook read FWorkbook;
end; end;
{@@ List of registered formats } {@@ List of registered formats }
@@ -537,7 +600,6 @@ function GetFileFormatName(AFormat: TsSpreadsheetFormat): String;
function SciFloat(AValue: Double; ADecimals: Word): String; function SciFloat(AValue: Double; ADecimals: Word): String;
function TimeIntervalToString(AValue: TDateTime): String; function TimeIntervalToString(AValue: TDateTime): String;
implementation implementation
uses uses
@@ -551,6 +613,38 @@ resourcestring
lpUnknownSpreadsheetFormat = 'unknown format'; lpUnknownSpreadsheetFormat = 'unknown format';
lpInvalidFontIndex = 'Invalid font index'; 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 Registers a new reader/writer pair for a format
@@ -1288,6 +1382,26 @@ begin
raise Exception.Create(lpInvalidFontIndex); raise Exception.Create(lpInvalidFontIndex);
end; 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 Adds text rotation to the formatting of a cell
@@ -1521,8 +1635,7 @@ begin
for i := 0 to Length(GsSpreadFormats) - 1 do for i := 0 to Length(GsSpreadFormats) - 1 do
if GsSpreadFormats[i].Format = AFormat then if GsSpreadFormats[i].Format = AFormat then
begin begin
Result := GsSpreadFormats[i].ReaderClass.Create; Result := GsSpreadFormats[i].ReaderClass.Create(self);
Result.FWorkbook := self;
Break; Break;
end; end;
@@ -1542,7 +1655,7 @@ begin
for i := 0 to Length(GsSpreadFormats) - 1 do for i := 0 to Length(GsSpreadFormats) - 1 do
if GsSpreadFormats[i].Format = AFormat then if GsSpreadFormats[i].Format = AFormat then
begin begin
Result := GsSpreadFormats[i].WriterClass.Create; Result := GsSpreadFormats[i].WriterClass.Create(self);
Break; Break;
end; end;
@@ -1657,9 +1770,8 @@ var
AWriter: TsCustomSpreadWriter; AWriter: TsCustomSpreadWriter;
begin begin
AWriter := CreateSpreadWriter(AFormat); AWriter := CreateSpreadWriter(AFormat);
try try
AWriter.WriteToFile(AFileName, Self, AOverwriteExisting); AWriter.WriteToFile(AFileName, AOverwriteExisting);
finally finally
AWriter.Free; AWriter.Free;
end; end;
@@ -1690,7 +1802,7 @@ begin
AWriter := CreateSpreadWriter(AFormat); AWriter := CreateSpreadWriter(AFormat);
try try
AWriter.WriteToStream(AStream, Self); AWriter.WriteToStream(AStream);
finally finally
AWriter.Free; AWriter.Free;
end; end;
@@ -1948,11 +2060,101 @@ begin
Result := FFontList.Count; Result := FFontList.Count;
end; 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 } { TsCustomSpreadReader }
constructor TsCustomSpreadReader.Create; constructor TsCustomSpreadReader.Create(AWorkbook: TsWorkbook);
begin begin
inherited Create; inherited Create;
FWorkbook := AWorkbook;
end; end;
{@@ {@@
@@ -2006,9 +2208,10 @@ end;
{ TsCustomSpreadWriter } { TsCustomSpreadWriter }
constructor TsCustomSpreadWriter.Create; constructor TsCustomSpreadWriter.Create(AWorkbook: TsWorkbook);
begin begin
inherited Create; inherited Create;
FWorkbook := AWorkbook;
end; end;
{@@ {@@
@@ -2082,7 +2285,7 @@ begin
Inc(NextXFIndex); Inc(NextXFIndex);
end; end;
procedure TsCustomSpreadWriter.ListAllFormattingStyles(AData: TsWorkbook); procedure TsCustomSpreadWriter.ListAllFormattingStyles;
var var
i: Integer; i: Integer;
begin begin
@@ -2090,9 +2293,9 @@ begin
AddDefaultFormats(); AddDefaultFormats();
for i := 0 to AData.GetWorksheetCount - 1 do for i := 0 to Workbook.GetWorksheetCount - 1 do
begin begin
IterateThroughCells(nil, AData.GetWorksheetByIndex(i).Cells, ListAllFormattingStylesCallback); IterateThroughCells(nil, Workbook.GetWorksheetByIndex(i).Cells, ListAllFormattingStylesCallback);
end; end;
end; end;
@@ -2139,11 +2342,12 @@ begin
Inc(StrPos); Inc(StrPos);
end; end;
end; end;
(*
function TsCustomSpreadWriter.FPSColorToHexString(AColor: TsColor; ARGBColor: TFPColor): string; function TsCustomSpreadWriter.FPSColorToHexString(AColor: TsColor; ARGBColor: TFPColor): string;
{ We use RGB bytes here, but please note that these are physically written { We use RGB bytes here, but please note that these are physically written
to XLS file as ABGR (where A is 0) } to XLS file as ABGR (where A is 0) }
begin begin
case AColor of case AColor of
scBlack: Result := '000000'; scBlack: Result := '000000';
scWhite: Result := 'FFFFFF'; 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]); scRGBCOLOR: Result := Format('%x%x%x', [ARGBColor.Red div $100, ARGBColor.Green div $100, ARGBColor.Blue div $100]);
end; end;
end; end;
*)
{@@ {@@
Helper function for the spreadsheet writers. Helper function for the spreadsheet writers.
@@ -2228,15 +2432,15 @@ end;
Default file writting method. Default file writting method.
Opens the file and calls WriteToStream 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. @param AFileName The output file name.
If the file already exists it will be replaced. If the file already exists it will be replaced.
@param AData The Workbook to be saved.
@see TsWorkbook @see TsWorkbook
} }
procedure TsCustomSpreadWriter.WriteToFile(const AFileName: string; procedure TsCustomSpreadWriter.WriteToFile(const AFileName: string;
AData: TsWorkbook; const AOverwriteExisting: Boolean = False); const AOverwriteExisting: Boolean = False);
var var
OutputFile: TFileStream; OutputFile: TFileStream;
lMode: Word; lMode: Word;
@@ -2246,7 +2450,7 @@ begin
OutputFile := TFileStream.Create(AFileName, lMode); OutputFile := TFileStream.Create(AFileName, lMode);
try try
WriteToStream(OutputFile, AData); WriteToStream(OutputFile);
finally finally
OutputFile.Free; OutputFile.Free;
end; end;
@@ -2255,21 +2459,20 @@ end;
{@@ {@@
This routine should be overriden in descendent classes. This routine should be overriden in descendent classes.
} }
procedure TsCustomSpreadWriter.WriteToStream(AStream: TStream; AData: TsWorkbook); procedure TsCustomSpreadWriter.WriteToStream(AStream: TStream);
var var
lStringList: TStringList; lStringList: TStringList;
begin begin
lStringList := TStringList.Create; lStringList := TStringList.Create;
try try
WriteToStrings(lStringList, AData); WriteToStrings(lStringList);
lStringList.SaveToStream(AStream); lStringList.SaveToStream(AStream);
finally finally
lStringList.Free; lStringList.Free;
end; end;
end; end;
procedure TsCustomSpreadWriter.WriteToStrings(AStrings: TStrings; procedure TsCustomSpreadWriter.WriteToStrings(AStrings: TStrings);
AData: TsWorkbook);
begin begin
raise Exception.Create(lpUnsupportedWriteFormat); raise Exception.Create(lpUnsupportedWriteFormat);
end; end;

40
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@@ -149,8 +149,6 @@ type
property OnContextPopup; property OnContextPopup;
end; end;
function FPSColorToColor(FPSColor: TsColor; ADefault: TColor): TColor;
procedure Register; procedure Register;
implementation implementation
@@ -174,37 +172,6 @@ begin
end; end;
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; procedure Register;
begin begin
RegisterComponents('Additional',[TsWorksheetGrid]); RegisterComponents('Additional',[TsWorksheetGrid]);
@@ -302,7 +269,10 @@ begin
Canvas.Brush.Bitmap := FillPattern_BIFF2; Canvas.Brush.Bitmap := FillPattern_BIFF2;
end else begin end else begin
Canvas.Brush.Style := bsSolid; 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;
end else begin end else begin
Canvas.Brush.Style := bsSolid; Canvas.Brush.Style := bsSolid;
@@ -313,7 +283,7 @@ begin
fnt := FWorkbook.GetFont(lCell^.FontIndex); fnt := FWorkbook.GetFont(lCell^.FontIndex);
if fnt <> nil then begin if fnt <> nil then begin
Canvas.Font.Name := fnt.FontName; Canvas.Font.Name := fnt.FontName;
Canvas.Font.Color := FPSColorToColor(fnt.Color, clBlack); Canvas.Font.Color := FWorkbook.GetPaletteColor(fnt.Color);
style := []; style := [];
if fssBold in fnt.Style then Include(style, fsBold); if fssBold in fnt.Style then Include(style, fsBold);
if fssItalic in fnt.Style then Include(style, fsItalic); 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 DWordLEtoN(AValue: Cardinal): Cardinal;
function WideStringLEToN(const AValue: WideString): WideString; function WideStringLEToN(const AValue: WideString): WideString;
function LongRGBToExcelPhysical(const RGB: DWord): DWord;
// Other routines // Other routines
function ParseIntervalString(const AStr: string; function ParseIntervalString(const AStr: string;
var AFirstCellRow, AFirstCellCol, ACount: Integer; var AFirstCellRow, AFirstCellCol, ACount: Integer;
@@ -155,6 +157,24 @@ begin
{$ENDIF} {$ENDIF}
end; 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 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; procedure TestWriteReadWordWrap;
// Test alignments // Test alignments
procedure TestWriteReadAlignments; procedure TestWriteReadAlignments;
// Test background colors
procedure TestWriteReadBackgroundColors;
end; end;
implementation implementation
@@ -398,63 +396,6 @@ begin
DeleteFile(TempFile); DeleteFile(TempFile);
end; 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 initialization
RegisterTest(TSpreadWriteReadFormatTests); RegisterTest(TSpreadWriteReadFormatTests);
InitSollFmtData; InitSollFmtData;

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

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

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

@@ -217,7 +217,7 @@ begin
fail('Error in test code. Failed to get named worksheet'); fail('Error in test code. Failed to get named worksheet');
ActualNumber:=MyWorkSheet.ReadAsNumber(Row, 0); 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)); +'cell '+CellNotation(MyWorkSheet,Row));
// Finalization // Finalization

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

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

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

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

25
components/fpspreadsheet/wikitable.pas
View File

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

144
components/fpspreadsheet/xlsbiff2.pas
View File

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

100
components/fpspreadsheet/xlsbiff5.pas
View File

@@ -134,11 +134,85 @@ type
procedure WriteXF(AStream: TStream; AFontIndex: Word; AXF_TYPE_PROT: Byte); procedure WriteXF(AStream: TStream; AFontIndex: Word; AXF_TYPE_PROT: Byte);
public public
{ General writing methods } { General writing methods }
procedure WriteToFile(const AFileName: string; AData: TsWorkbook; procedure WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean = False); override; const AOverwriteExisting: Boolean = False); override;
procedure WriteToStream(AStream: TStream; AData: TsWorkbook); override; procedure WriteToStream(AStream: TStream); override;
end; 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 implementation
const const
@@ -285,7 +359,7 @@ const
* *
*******************************************************************} *******************************************************************}
procedure TsSpreadBIFF5Writer.WriteToFile(const AFileName: string; procedure TsSpreadBIFF5Writer.WriteToFile(const AFileName: string;
AData: TsWorkbook; const AOverwriteExisting: Boolean); const AOverwriteExisting: Boolean);
var var
MemStream: TMemoryStream; MemStream: TMemoryStream;
OutputStorage: TOLEStorage; OutputStorage: TOLEStorage;
@@ -294,7 +368,7 @@ begin
MemStream := TMemoryStream.Create; MemStream := TMemoryStream.Create;
OutputStorage := TOLEStorage.Create; OutputStorage := TOLEStorage.Create;
try try
WriteToStream(MemStream, AData); WriteToStream(MemStream);
// Only one stream is necessary for any number of worksheets // Only one stream is necessary for any number of worksheets
OLEDocument.Stream := MemStream; OLEDocument.Stream := MemStream;
@@ -315,7 +389,7 @@ end;
* part of the document, just the BIFF records * part of the document, just the BIFF records
* *
*******************************************************************} *******************************************************************}
procedure TsSpreadBIFF5Writer.WriteToStream(AStream: TStream; AData: TsWorkbook); procedure TsSpreadBIFF5Writer.WriteToStream(AStream: TStream);
var var
FontData: TFPCustomFont; FontData: TFPCustomFont;
MyData: TMemoryStream; MyData: TMemoryStream;
@@ -324,14 +398,12 @@ var
i, len: Integer; i, len: Integer;
begin begin
{ Store some data about the workbook that other routines need } { Store some data about the workbook that other routines need }
WorkBookEncoding := AData.Encoding; WorkBookEncoding := Workbook.Encoding;
{ Write workbook globals } { Write workbook globals }
WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS); WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS);
WriteCodepage(AStream, WorkBookEncoding); WriteCodepage(AStream, WorkBookEncoding);
WriteWindow1(AStream); WriteWindow1(AStream);
FontData := TFPCustomFont.Create; FontData := TFPCustomFont.Create;
@@ -388,18 +460,18 @@ begin
WriteStyle(AStream); WriteStyle(AStream);
// A BOUNDSHEET for each worksheet // A BOUNDSHEET for each worksheet
for i := 0 to AData.GetWorksheetCount - 1 do for i := 0 to Workbook.GetWorksheetCount - 1 do
begin begin
len := Length(Boundsheets); len := Length(Boundsheets);
SetLength(Boundsheets, len + 1); SetLength(Boundsheets, len + 1);
Boundsheets[len] := WriteBoundsheet(AStream, AData.GetWorksheetByIndex(i).Name); Boundsheets[len] := WriteBoundsheet(AStream, Workbook.GetWorksheetByIndex(i).Name);
end; end;
WriteEOF(AStream); WriteEOF(AStream);
{ Write each worksheet } { Write each worksheet }
for i := 0 to AData.GetWorksheetCount - 1 do for i := 0 to Workbook.GetWorksheetCount - 1 do
begin begin
{ First goes back and writes the position of the BOF of the { First goes back and writes the position of the BOF of the
sheet on the respective BOUNDSHEET record } sheet on the respective BOUNDSHEET record }
@@ -411,12 +483,10 @@ begin
WriteBOF(AStream, INT_BOF_SHEET); WriteBOF(AStream, INT_BOF_SHEET);
WriteIndex(AStream); WriteIndex(AStream);
WriteDimensions(AStream, Workbook.GetWorksheetByIndex(i));
WriteDimensions(AStream, AData.GetWorksheetByIndex(i));
WriteWindow2(AStream, True); WriteWindow2(AStream, True);
WriteCellsToStream(AStream, AData.GetWorksheetByIndex(i).Cells); WriteCellsToStream(AStream, Workbook.GetWorksheetByIndex(i).Cells);
WriteEOF(AStream); WriteEOF(AStream);
end; end;

250
components/fpspreadsheet/xlsbiff8.pas
View File

@@ -143,7 +143,7 @@ type
procedure ReadLabel(AStream: TStream); override; procedure ReadLabel(AStream: TStream); override;
procedure ReadNumber(AStream: TStream); override; procedure ReadNumber(AStream: TStream); override;
public public
constructor Create; override; constructor Create(AWorkbook: TsWorkbook); override;
destructor Destroy; override; destructor Destroy; override;
{ General reading methods } { General reading methods }
procedure ReadFromFile(AFileName: string; AData: TsWorkbook); override; procedure ReadFromFile(AFileName: string; AData: TsWorkbook); override;
@@ -154,8 +154,6 @@ type
TsSpreadBIFF8Writer = class(TsSpreadBIFFWriter) TsSpreadBIFF8Writer = class(TsSpreadBIFFWriter)
private 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 // Writes index to XF record according to cell's formatting
procedure WriteXFIndex(AStream: TStream; ACell: PCell); procedure WriteXFIndex(AStream: TStream; ACell: PCell);
procedure WriteXFFieldsForFormattingStyles(AStream: TStream); procedure WriteXFFieldsForFormattingStyles(AStream: TStream);
@@ -174,13 +172,12 @@ type
procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet); procedure WriteDimensions(AStream: TStream; AWorksheet: TsWorksheet);
procedure WriteEOF(AStream: TStream); procedure WriteEOF(AStream: TStream);
procedure WriteFont(AStream: TStream; AFont: TsFont); procedure WriteFont(AStream: TStream; AFont: TsFont);
procedure WriteFonts(AStream: TStream; AData: TsWorkbook); procedure WriteFonts(AStream: TStream);
procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteFormula(AStream: TStream; const ARow, ACol: Cardinal;
const AFormula: TsFormula; ACell: PCell); override; const AFormula: TsFormula; ACell: PCell); override;
procedure WriteIndex(AStream: TStream); procedure WriteIndex(AStream: TStream);
procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteLabel(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: string; ACell: PCell); override; const AValue: string; ACell: PCell); override;
procedure WritePalette(AStream: TStream);
procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteNumber(AStream: TStream; const ARow, ACol: Cardinal;
const AValue: double; ACell: PCell); override; const AValue: double; ACell: PCell); override;
procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal; procedure WriteRPNFormula(AStream: TStream; const ARow, ACol: Cardinal;
@@ -193,16 +190,86 @@ type
AHorAlignment: TsHorAlignment = haDefault; AVertAlignment: TsVertAlignment = vaDefault; AHorAlignment: TsHorAlignment = haDefault; AVertAlignment: TsVertAlignment = vaDefault;
AWordWrap: Boolean = false; AddBackground: Boolean = false; AWordWrap: Boolean = false; AddBackground: Boolean = false;
ABackgroundColor: TsColor = scSilver); ABackgroundColor: TsColor = scSilver);
procedure WriteXFRecords(AStream: TStream; AData: TsWorkbook); procedure WriteXFRecords(AStream: TStream);
public public
// constructor Create;
// destructor Destroy; override;
{ General writing methods } { General writing methods }
procedure WriteToFile(const AFileName: string; AData: TsWorkbook; procedure WriteToFile(const AFileName: string;
const AOverwriteExisting: Boolean = False); override; const AOverwriteExisting: Boolean = False); override;
procedure WriteToStream(AStream: TStream; AData: TsWorkbook); override; procedure WriteToStream(AStream: TStream); override;
end; 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 implementation
const const
@@ -229,8 +296,6 @@ const
INT_EXCEL_ID_SST = $00FC; //BIFF8 only INT_EXCEL_ID_SST = $00FC; //BIFF8 only
INT_EXCEL_ID_CONTINUE = $003C; INT_EXCEL_ID_CONTINUE = $003C;
INT_EXCEL_ID_LABELSST = $00FD; //BIFF8 only 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_FORMAT = $041E;
INT_EXCEL_ID_FORCEFULLCALCULATION = $08A3; INT_EXCEL_ID_FORCEFULLCALCULATION = $08A3;
@@ -345,24 +410,6 @@ const
{ TsSpreadBIFF8Writer } { 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 } { Index to XF record, according to formatting }
procedure TsSpreadBIFF8Writer.WriteXFIndex(AStream: TStream; ACell: PCell); procedure TsSpreadBIFF8Writer.WriteXFIndex(AStream: TStream; ACell: PCell);
var var
@@ -558,7 +605,7 @@ end;
* *
*******************************************************************} *******************************************************************}
procedure TsSpreadBIFF8Writer.WriteToFile(const AFileName: string; procedure TsSpreadBIFF8Writer.WriteToFile(const AFileName: string;
AData: TsWorkbook; const AOverwriteExisting: Boolean); const AOverwriteExisting: Boolean);
var var
MemStream: TMemoryStream; MemStream: TMemoryStream;
OutputStorage: TOLEStorage; OutputStorage: TOLEStorage;
@@ -567,7 +614,7 @@ begin
MemStream := TMemoryStream.Create; MemStream := TMemoryStream.Create;
OutputStorage := TOLEStorage.Create; OutputStorage := TOLEStorage.Create;
try try
WriteToStream(MemStream, AData); WriteToStream(MemStream);
// Only one stream is necessary for any number of worksheets // Only one stream is necessary for any number of worksheets
OLEDocument.Stream := MemStream; OLEDocument.Stream := MemStream;
@@ -588,7 +635,7 @@ end;
* part of the document, just the BIFF records * part of the document, just the BIFF records
* *
*******************************************************************} *******************************************************************}
procedure TsSpreadBIFF8Writer.WriteToStream(AStream: TStream; AData: TsWorkbook); procedure TsSpreadBIFF8Writer.WriteToStream(AStream: TStream);
var var
MyData: TMemoryStream; MyData: TMemoryStream;
CurrentPos: Int64; CurrentPos: Int64;
@@ -602,31 +649,26 @@ begin
WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS); WriteBOF(AStream, INT_BOF_WORKBOOK_GLOBALS);
WriteWindow1(AStream); WriteWindow1(AStream);
WriteFonts(AStream);
WriteFonts(AStream, AData);
// PALETTE
WritePalette(AStream); WritePalette(AStream);
WriteXFRecords(AStream);
// XF Records
WriteXFRecords(AStream, AData);
WriteStyle(AStream); WriteStyle(AStream);
// A BOUNDSHEET for each worksheet // A BOUNDSHEET for each worksheet
for i := 0 to AData.GetWorksheetCount - 1 do for i := 0 to Workbook.GetWorksheetCount - 1 do
begin begin
len := Length(Boundsheets); len := Length(Boundsheets);
SetLength(Boundsheets, len + 1); SetLength(Boundsheets, len + 1);
Boundsheets[len] := WriteBoundsheet(AStream, AData.GetWorksheetByIndex(i).Name); Boundsheets[len] := WriteBoundsheet(AStream, Workbook.GetWorksheetByIndex(i).Name);
end; end;
WriteEOF(AStream); WriteEOF(AStream);
{ Write each worksheet } { Write each worksheet }
for i := 0 to AData.GetWorksheetCount - 1 do for i := 0 to Workbook.GetWorksheetCount - 1 do
begin begin
sheet := AData.GetWorksheetByIndex(i); sheet := Workbook.GetWorksheetByIndex(i);
{ First goes back and writes the position of the BOF of the { First goes back and writes the position of the BOF of the
sheet on the respective BOUNDSHEET record } sheet on the respective BOUNDSHEET record }
@@ -938,12 +980,12 @@ end;
* used fonts in the workbook. * used fonts in the workbook.
* *
*******************************************************************} *******************************************************************}
procedure TsSpreadBiff8Writer.WriteFonts(AStream: TStream; AData: TsWorkbook); procedure TsSpreadBiff8Writer.WriteFonts(AStream: TStream);
var var
i: Integer; i: Integer;
begin begin
for i:=0 to AData.GetFontCount-1 do for i:=0 to Workbook.GetFontCount-1 do
WriteFont(AStream, AData.GetFont(i)); WriteFont(AStream, Workbook.GetFont(i));
end; end;
{******************************************************************* {*******************************************************************
@@ -1321,90 +1363,6 @@ begin
AStream.WriteBuffer(AValue, 8); AStream.WriteBuffer(AValue, 8);
end; 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 () * TsSpreadBIFF8Writer.WriteStyle ()
* *
@@ -1627,12 +1585,12 @@ begin
// Background Pattern Color, always zeroed // Background Pattern Color, always zeroed
if AddBackground then if AddBackground then
AStream.WriteWord(WordToLE(FPSColorToEXCELPalette(ABackgroundColor))) AStream.WriteWord(WordToLE(ABackgroundColor))
else else
AStream.WriteWord(0); AStream.WriteWord(0);
end; end;
procedure TsSpreadBIFF8Writer.WriteXFRecords(AStream: TStream; AData: TsWorkbook); procedure TsSpreadBIFF8Writer.WriteXFRecords(AStream: TStream);
begin begin
// XF0 // XF0
WriteXF(AStream, 0, 0, MASK_XF_TYPE_PROT_STYLE_XF, XF_ROTATION_HORIZONTAL, []); 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, []); WriteXF(AStream, 0, 0, 0, XF_ROTATION_HORIZONTAL, []);
// Add all further non-standard/built-in formatting styles // Add all further non-standard/built-in formatting styles
ListAllFormattingStyles(AData); ListAllFormattingStyles;
WriteXFFieldsForFormattingStyles(AStream); WriteXFFieldsForFormattingStyles(AStream);
end; end;
@@ -1952,7 +1910,7 @@ begin
CurStreamPos := AStream.Position; CurStreamPos := AStream.Position;
if RecordType<>INT_EXCEL_ID_CONTINUE then begin if RecordType <> INT_EXCEL_ID_CONTINUE then begin
case RecordType of case RecordType of
INT_EXCEL_ID_BOF: ; INT_EXCEL_ID_BOF: ;
INT_EXCEL_ID_BOUNDSHEET: ReadBoundSheet(AStream); INT_EXCEL_ID_BOUNDSHEET: ReadBoundSheet(AStream);
@@ -1963,6 +1921,7 @@ begin
INT_EXCEL_ID_XF: ReadXF(AStream); INT_EXCEL_ID_XF: ReadXF(AStream);
INT_EXCEL_ID_FORMAT: ReadFormat(AStream); INT_EXCEL_ID_FORMAT: ReadFormat(AStream);
INT_EXCEL_ID_DATEMODE: ReadDateMode(AStream); INT_EXCEL_ID_DATEMODE: ReadDateMode(AStream);
INT_EXCEL_ID_PALETTE: ReadPalette(AStream);
else else
// nothing // nothing
end; end;
@@ -2140,8 +2099,10 @@ begin
XFData := TXFRecordData(FXFList.Items[XFIndex]); XFData := TXFRecordData(FXFList.Items[XFIndex]);
// Font // Font
Include(lCell^.UsedFormattingFields, uffFont); if XFData.FontIndex > 0 then begin
lCell^.FontIndex := XFData.FontIndex; Include(lCell^.UsedFormattingFields, uffFont);
lCell^.FontIndex := XFData.FontIndex;
end;
// Alignment // Alignment
lCell^.HorAlignment := XFData.HorAlignment; lCell^.HorAlignment := XFData.HorAlignment;
@@ -2161,8 +2122,10 @@ begin
Exclude(lCell^.UsedFormattingFields, uffBorder); Exclude(lCell^.UsedFormattingFields, uffBorder);
// Background color // Background color
Include(lCell^.UsedFormattingFields, uffBackgroundColor); if XFData.BackgroundColor <> 0 then begin
lCell^.BackgroundColor := XFData.BackgroundColor; Include(lCell^.UsedFormattingFields, uffBackgroundColor);
lCell^.BackgroundColor := XFData.BackgroundColor;
end;
end; end;
end; end;
@@ -2172,9 +2135,9 @@ begin
Result:=UTF16ToUTF8(ReadWideString(AStream, ALength)); Result:=UTF16ToUTF8(ReadWideString(AStream, ALength));
end; end;
constructor TsSpreadBIFF8Reader.Create; constructor TsSpreadBIFF8Reader.Create(AWorkbook: TsWorkbook);
begin begin
inherited Create; inherited Create(AWorkbook);
FXFList := TFPList.Create; FXFList := TFPList.Create;
FFormatList := TFPList.Create; FFormatList := TFPList.Create;
end; end;
@@ -2188,6 +2151,7 @@ begin
FXFList.Free; FXFList.Free;
FFormatList.Free; FFormatList.Free;
if Assigned(FSharedStringTable) then FSharedStringTable.Free; if Assigned(FSharedStringTable) then FSharedStringTable.Free;
inherited;
end; end;
procedure TsSpreadBIFF8Reader.ReadFromFile(AFileName: string; AData: TsWorkbook); procedure TsSpreadBIFF8Reader.ReadFromFile(AFileName: string; AData: TsWorkbook);
@@ -2532,8 +2496,8 @@ begin
Include(lData.Borders, cbSouth); Include(lData.Borders, cbSouth);
// Background color; // Background color;
xf.Border_Background_3 := WordLEToN(xf.Border_Background_3); xf.Border_Background_3 := DWordLEToN(xf.Border_Background_3);
lData.BackgroundColor := ExcelPaletteToFPSColor(xf.Border_Background_3 AND $007F); lData.BackgroundColor := xf.Border_Background_3 AND $007F;
// Add the XF to the list // Add the XF to the list
FXFList.Add(lData); FXFList.Add(lData);

137
components/fpspreadsheet/xlscommon.pas
View File

@@ -19,6 +19,7 @@ const
INT_EXCEL_ID_FONT = $0031; INT_EXCEL_ID_FONT = $0031;
INT_EXCEL_ID_CODEPAGE = $0042; INT_EXCEL_ID_CODEPAGE = $0042;
INT_EXCEL_ID_DATEMODE = $0022; INT_EXCEL_ID_DATEMODE = $0022;
INT_EXCEL_ID_PALETTE = $0092;
{ Formula constants TokenID values } { Formula constants TokenID values }
@@ -285,16 +286,18 @@ type
FCodepage: string; // in a format prepared for lconvencoding.ConvertEncoding FCodepage: string; // in a format prepared for lconvencoding.ConvertEncoding
FDateMode: TDateMode; FDateMode: TDateMode;
// converts an Excel color index to a color value. // 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 // Here we can add reading of records which didn't change across BIFF2-8 versions
// Workbook Globals records // Workbook Globals records
procedure ReadCodePage(AStream: TStream); procedure ReadCodePage(AStream: TStream);
// Figures out what the base year for dates is for this file // Figures out what the base year for dates is for this file
procedure ReadDateMode(AStream: TStream); procedure ReadDateMode(AStream: TStream);
// Read palette
procedure ReadPalette(AStream: TStream);
// Read row info // Read row info
procedure ReadRowInfo(const AStream: TStream); virtual; procedure ReadRowInfo(AStream: TStream); virtual;
public public
constructor Create; override; constructor Create(AWorkbook: TsWorkbook); override;
end; end;
{ TsSpreadBIFFWriter } { TsSpreadBIFFWriter }
@@ -304,7 +307,7 @@ type
FDateMode: TDateMode; FDateMode: TDateMode;
FLastRow: Integer; FLastRow: Integer;
FLastCol: Word; FLastCol: Word;
function FPSColorToExcelPalette(AColor: TsColor): Word; // function FPSColorToExcelPalette(AColor: TsColor): Word;
procedure GetLastRowCallback(ACell: PCell; AStream: TStream); procedure GetLastRowCallback(ACell: PCell; AStream: TStream);
function GetLastRowIndex(AWorksheet: TsWorksheet): Integer; function GetLastRowIndex(AWorksheet: TsWorksheet): Integer;
procedure GetLastColCallback(ACell: PCell; AStream: TStream); procedure GetLastColCallback(ACell: PCell; AStream: TStream);
@@ -316,8 +319,10 @@ type
procedure WriteCodepage(AStream: TStream; AEncoding: TsEncoding); procedure WriteCodepage(AStream: TStream; AEncoding: TsEncoding);
// Writes out DATEMODE record depending on FDateMode // Writes out DATEMODE record depending on FDateMode
procedure WriteDateMode(AStream: TStream); procedure WriteDateMode(AStream: TStream);
// Writes out a PALETTE record containing all colors defined in the workbook
procedure WritePalette(AStream: TStream);
public public
constructor Create; override; constructor Create(AWorkbook: TsWorkbook); override;
end; end;
function IsExpNumberFormat(s: String; out Decimals: Word): Boolean; function IsExpNumberFormat(s: String; out Decimals: Word): Boolean;
@@ -383,13 +388,13 @@ end;
{ TsSpreadBIFFReader } { TsSpreadBIFFReader }
constructor TsSpreadBIFFReader.Create; constructor TsSpreadBIFFReader.Create(AWorkbook: TsWorkbook);
begin begin
inherited Create; inherited Create(AWorkbook);
// Initial base date in case it won't be read from file // Initial base date in case it won't be read from file
FDateMode := dm1900; FDateMode := dm1900;
end; end;
(*
function TsSpreadBIFFReader.ExcelPaletteToFPSColor(AIndex: Word): TsColor; function TsSpreadBIFFReader.ExcelPaletteToFPSColor(AIndex: Word): TsColor;
begin begin
case AIndex of case AIndex of
@@ -414,7 +419,7 @@ begin
EXTRA_COLOR_PALETTE_GREY20PCT: Result := scGrey20pct; EXTRA_COLOR_PALETTE_GREY20PCT: Result := scGrey20pct;
end; end;
end; end;
*)
// In BIFF 8 it seams to always use the UTF-16 codepage // In BIFF 8 it seams to always use the UTF-16 codepage
procedure TsSpreadBIFFReader.ReadCodePage(AStream: TStream); procedure TsSpreadBIFFReader.ReadCodePage(AStream: TStream);
var var
@@ -492,8 +497,23 @@ begin
end; end;
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 // 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 type
TRowRecord = packed record TRowRecord = packed record
RowIndex: Word; RowIndex: Word;
@@ -515,53 +535,15 @@ begin
end; end;
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); { TsSpreadBIFFWriter }
begin
if ACell^.Row > FLastRow then FLastRow := ACell^.Row;
end;
function TsSpreadBIFFWriter.GetLastRowIndex(AWorksheet: TsWorksheet): Integer; constructor TsSpreadBIFFWriter.Create(AWorkbook: TsWorkbook);
begin begin
FLastRow := 0; inherited Create(AWorkbook);
IterateThroughCells(nil, AWorksheet.Cells, GetLastRowCallback); // Initial base date in case it won't be set otherwise.
Result := FLastRow; // Use 1900 to get a bit more range between 1900..1904.
end; FDateMode := dm1900;
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; end;
function TsSpreadBIFFWriter.FormulaElementKindToExcelTokenID( function TsSpreadBIFFWriter.FormulaElementKindToExcelTokenID(
@@ -736,6 +718,30 @@ begin
end; end;
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; procedure TsSpreadBIFFWriter.WriteCodepage(AStream: TStream;
AEncoding: TsEncoding); AEncoding: TsEncoding);
var var
@@ -774,12 +780,25 @@ begin
end; end;
end; end;
constructor TsSpreadBIFFWriter.Create; procedure TsSpreadBIFFWriter.WritePalette(AStream: TStream);
var
i, n: Integer;
begin begin
inherited Create; { BIFF Record header }
// Initial base date in case it won't be set otherwise. AStream.WriteWord(WordToLE(INT_EXCEL_ID_PALETTE));
// Use 1900 to get a bit more range between 1900..1904. AStream.WriteWord(WordToLE(2 + 4*56));
FDateMode := dm1900;
{ 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; end;

69
components/fpspreadsheet/xlsxooxml.pas
View File

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