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

fpspreadsheet: Rename number format codes "nfCurrencyDash"/"nfCurrencyDashRed" to "nfAccounting"/"nfAccountingRed" and implement alignment of currency symbols as in Excel. Fix number format parser bug causing a failure in the corresponding test case.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3080 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-05-22 21:54:24 +00:00
parent dde6e12a85
commit 239633cb51
11 changed files with 2189 additions and 2083 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -213,6 +213,7 @@ begin
// Write formatted numbers
s := '31415.9265359';
val(s, number, i);
inc(r, 2);
MyWorksheet.WriteUTF8Text(r, 0, 'The number '+s+' is displayed in various formats:');
inc(r,2);
@@ -310,15 +311,15 @@ begin
MyWorksheet.WriteNumber(r, 2, -number, nfCurrencyRed, 0, 'USD');
MyWorksheet.WriteNumber(r, 3, 0.0, nfCurrencyRed, 0, 'USD');
inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfCurrencyDash, 0 decs');
MyWorksheet.WriteNumber(r, 1, number, nfCurrencyDash, 0, 'USD');
MyWorksheet.WriteNumber(r, 2, -number, nfCurrencyDash, 0, 'USD');
MyWorksheet.WriteNumber(r, 3, 0.0, nfCurrencyDash, 0, 'USD');
MyWorksheet.WriteUTF8Text(r, 0, 'nfAccounting, 0 decs');
MyWorksheet.WriteNumber(r, 1, number, nfAccounting, 0, 'USD');
MyWorksheet.WriteNumber(r, 2, -number, nfAccounting, 0, 'USD');
MyWorksheet.WriteNumber(r, 3, 0.0, nfAccounting, 0, 'USD');
inc(r);
MyWorksheet.WriteUTF8Text(r, 0, 'nfCurrencyDashRed, 0 decs');
MyWorksheet.WriteNumber(r, 1, number, nfCurrencyDashRed, 0, 'USD');
MyWorksheet.WriteNumber(r, 2, -number, nfCurrencyDashRed, 0, 'USD');
MyWorksheet.WriteNumber(r, 3, 0.0, nfCurrencyDashRed, 0, 'USD');
MyWorksheet.WriteUTF8Text(r, 0, 'nfAccountingRed, 0 decs');
MyWorksheet.WriteNumber(r, 1, -number, nfAccountingRed, 0, 'USD');
MyWorksheet.WriteNumber(r, 2, number, nfAccountingRed, 0, 'USD');
MyWorksheet.WriteNumber(r, 3, 0.0, nfAccountingRed, 0, 'USD');
inc(r,2);
MyWorksheet.WriteUTF8Text(r, 0, 'nfCustom, "EUR "#,##0_);("EUR "#,##0)');

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

@@ -128,8 +128,8 @@
<UnitName Value="mainform"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="394"/>
<CursorPos X="40" Y="412"/>
<TopLine Value="395"/>
<CursorPos X="16" Y="400"/>
<UsageCount Value="200"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
@@ -139,18 +139,19 @@
<UnitName Value="fpspreadsheet"/>
<EditorIndex Value="5"/>
<WindowIndex Value="0"/>
<TopLine Value="132"/>
<CursorPos X="16" Y="164"/>
<TopLine Value="3041"/>
<CursorPos X="65" Y="3072"/>
<UsageCount Value="100"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<UnitName Value="fpspreadsheetgrid"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="6"/>
<WindowIndex Value="0"/>
<TopLine Value="636"/>
<CursorPos X="20" Y="647"/>
<TopLine Value="912"/>
<CursorPos X="9" Y="920"/>
<UsageCount Value="100"/>
<Loaded Value="True"/>
</Unit3>
@@ -160,7 +161,7 @@
<WindowIndex Value="0"/>
<TopLine Value="25"/>
<CursorPos X="4" Y="44"/>
<UsageCount Value="3"/>
<UsageCount Value="2"/>
</Unit4>
<Unit5>
<Filename Value="c:\lazarus27\fpc\2.2.4\source\packages\winunits-base\src\activex.pp"/>
@@ -168,7 +169,7 @@
<WindowIndex Value="0"/>
<TopLine Value="49"/>
<CursorPos X="10" Y="24"/>
<UsageCount Value="3"/>
<UsageCount Value="2"/>
</Unit5>
<Unit6>
<Filename Value="c:\lazarus27\fpc\2.2.4\source\packages\fcl-base\src\avl_tree.pp"/>
@@ -176,7 +177,7 @@
<WindowIndex Value="0"/>
<TopLine Value="37"/>
<CursorPos X="14" Y="83"/>
<UsageCount Value="3"/>
<UsageCount Value="2"/>
</Unit6>
<Unit7>
<Filename Value="c:\Lazarus\lcl\grids.pas"/>
@@ -184,14 +185,14 @@
<WindowIndex Value="0"/>
<TopLine Value="1516"/>
<CursorPos X="28" Y="1534"/>
<UsageCount Value="3"/>
<UsageCount Value="2"/>
</Unit7>
<Unit8>
<Filename Value="c:\Lazarus\lcl\include\customform.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="2021"/>
<CursorPos X="1" Y="2041"/>
<UsageCount Value="3"/>
<UsageCount Value="2"/>
</Unit8>
<Unit9>
<Filename Value="..\..\fpsallformats.pas"/>
@@ -199,7 +200,7 @@
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="62" Y="13"/>
<UsageCount Value="3"/>
<UsageCount Value="2"/>
</Unit9>
<Unit10>
<Filename Value="..\..\wikitable.pas"/>
@@ -207,7 +208,7 @@
<WindowIndex Value="0"/>
<TopLine Value="48"/>
<CursorPos X="41" Y="60"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit10>
<Unit11>
<Filename Value="..\..\fpsopendocument.pas"/>
@@ -215,7 +216,7 @@
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="1"/>
<UsageCount Value="5"/>
<UsageCount Value="4"/>
</Unit11>
<Unit12>
<Filename Value="d:\lazarus-svn\lcl\grids.pas"/>
@@ -223,16 +224,16 @@
<WindowIndex Value="0"/>
<TopLine Value="4852"/>
<CursorPos X="16" Y="4884"/>
<UsageCount Value="45"/>
<UsageCount Value="44"/>
</Unit12>
<Unit13>
<Filename Value="..\..\fpsutils.pas"/>
<UnitName Value="fpsutils"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/>
<TopLine Value="1206"/>
<CursorPos X="21" Y="1222"/>
<UsageCount Value="62"/>
<TopLine Value="1044"/>
<CursorPos X="32" Y="1050"/>
<UsageCount Value="66"/>
<Loaded Value="True"/>
</Unit13>
<Unit14>
@@ -240,22 +241,26 @@
<WindowIndex Value="0"/>
<TopLine Value="1212"/>
<CursorPos X="3" Y="1218"/>
<UsageCount Value="1"/>
<UsageCount Value="10"/>
</Unit14>
<Unit15>
<Filename Value="d:\lazarus-svn\lcl\graphics.pp"/>
<UnitName Value="Graphics"/>
<EditorIndex Value="7"/>
<WindowIndex Value="0"/>
<TopLine Value="1937"/>
<CursorPos X="11" Y="1956"/>
<UsageCount Value="30"/>
<TopLine Value="86"/>
<CursorPos X="5" Y="104"/>
<UsageCount Value="33"/>
<Loaded Value="True"/>
</Unit15>
<Unit16>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\rtl\objpas\classes\classesh.inc"/>
<EditorIndex Value="8"/>
<WindowIndex Value="0"/>
<TopLine Value="248"/>
<CursorPos X="22" Y="263"/>
<UsageCount Value="9"/>
<TopLine Value="76"/>
<CursorPos X="3" Y="95"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit16>
<Unit17>
<Filename Value="..\..\xlsbiff8.pas"/>
@@ -264,7 +269,7 @@
<WindowIndex Value="0"/>
<TopLine Value="1920"/>
<CursorPos X="21" Y="1924"/>
<UsageCount Value="92"/>
<UsageCount Value="96"/>
<Loaded Value="True"/>
</Unit17>
<Unit18>
@@ -273,24 +278,23 @@
<WindowIndex Value="0"/>
<TopLine Value="1091"/>
<CursorPos X="12" Y="1122"/>
<UsageCount Value="5"/>
<UsageCount Value="4"/>
</Unit18>
<Unit19>
<Filename Value="d:\lazarus-svn\lcl\include\wincontrol.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="7344"/>
<CursorPos X="30" Y="7349"/>
<UsageCount Value="3"/>
<UsageCount Value="2"/>
</Unit19>
<Unit20>
<Filename Value="..\..\xlscommon.pas"/>
<UnitName Value="xlscommon"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/>
<TopLine Value="650"/>
<CursorPos X="16" Y="662"/>
<UsageCount Value="88"/>
<CursorPos X="24" Y="662"/>
<UsageCount Value="92"/>
<Bookmarks Count="1">
<Item0 X="41" Y="1209" ID="1"/>
</Bookmarks>
@@ -302,7 +306,7 @@
<WindowIndex Value="0"/>
<TopLine Value="76"/>
<CursorPos X="49" Y="92"/>
<UsageCount Value="65"/>
<UsageCount Value="64"/>
</Unit21>
<Unit22>
<Filename Value="..\..\xlsbiff2.pas"/>
@@ -310,7 +314,7 @@
<WindowIndex Value="0"/>
<TopLine Value="548"/>
<CursorPos X="1" Y="560"/>
<UsageCount Value="66"/>
<UsageCount Value="65"/>
</Unit22>
<Unit23>
<Filename Value="d:\lazarus-svn\lcl\lclproc.pas"/>
@@ -318,7 +322,7 @@
<WindowIndex Value="0"/>
<TopLine Value="841"/>
<CursorPos X="19" Y="852"/>
<UsageCount Value="8"/>
<UsageCount Value="7"/>
</Unit23>
<Unit24>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\packages\fcl-image\src\fpcanvas.pp"/>
@@ -326,14 +330,14 @@
<WindowIndex Value="0"/>
<TopLine Value="111"/>
<CursorPos X="3" Y="112"/>
<UsageCount Value="11"/>
<UsageCount Value="10"/>
</Unit24>
<Unit25>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\rtl\objpas\classes\lists.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="141"/>
<CursorPos X="3" Y="143"/>
<UsageCount Value="7"/>
<UsageCount Value="6"/>
</Unit25>
<Unit26>
<Filename Value="d:\Prog_Delphi\common\units\XLS.pas"/>
@@ -341,14 +345,14 @@
<WindowIndex Value="0"/>
<TopLine Value="114"/>
<CursorPos X="42" Y="152"/>
<UsageCount Value="7"/>
<UsageCount Value="6"/>
</Unit26>
<Unit27>
<Filename Value="d:\lazarus-svn\lcl\include\pen.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="354"/>
<CursorPos X="1" Y="385"/>
<UsageCount Value="12"/>
<UsageCount Value="11"/>
</Unit27>
<Unit28>
<Filename Value="d:\lazarus-svn\lcl\controls.pp"/>
@@ -356,14 +360,14 @@
<WindowIndex Value="0"/>
<TopLine Value="2222"/>
<CursorPos X="14" Y="2242"/>
<UsageCount Value="7"/>
<UsageCount Value="6"/>
</Unit28>
<Unit29>
<Filename Value="d:\lazarus-svn\lcl\include\control.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="2696"/>
<CursorPos X="23" Y="2712"/>
<UsageCount Value="8"/>
<UsageCount Value="7"/>
</Unit29>
<Unit30>
<Filename Value="..\..\fpspreadsheetchart.pas"/>
@@ -371,7 +375,7 @@
<WindowIndex Value="0"/>
<TopLine Value="170"/>
<CursorPos X="37" Y="204"/>
<UsageCount Value="2"/>
<UsageCount Value="1"/>
</Unit30>
<Unit31>
<Filename Value="d:\lazarus-svn\components\lazutils\lazutf8.pas"/>
@@ -379,7 +383,7 @@
<WindowIndex Value="0"/>
<TopLine Value="3180"/>
<CursorPos X="1" Y="3212"/>
<UsageCount Value="3"/>
<UsageCount Value="2"/>
</Unit31>
<Unit32>
<Filename Value="d:\lazarus-svn\lcl\colorbox.pas"/>
@@ -387,7 +391,7 @@
<WindowIndex Value="0"/>
<TopLine Value="584"/>
<CursorPos X="3" Y="598"/>
<UsageCount Value="11"/>
<UsageCount Value="10"/>
</Unit32>
<Unit33>
<Filename Value="d:\lazarus-svn\lcl\dialogs.pp"/>
@@ -395,7 +399,7 @@
<WindowIndex Value="0"/>
<TopLine Value="222"/>
<CursorPos X="3" Y="253"/>
<UsageCount Value="3"/>
<UsageCount Value="2"/>
</Unit33>
<Unit34>
<Filename Value="d:\lazarus-svn\lcl\forms.pp"/>
@@ -403,7 +407,7 @@
<WindowIndex Value="0"/>
<TopLine Value="932"/>
<CursorPos X="3" Y="939"/>
<UsageCount Value="3"/>
<UsageCount Value="2"/>
</Unit34>
<Unit35>
<Filename Value="C:\development\lazarus\lcl\graphics.pp"/>
@@ -411,7 +415,7 @@
<WindowIndex Value="0"/>
<TopLine Value="2053"/>
<CursorPos X="30" Y="1945"/>
<UsageCount Value="6"/>
<UsageCount Value="5"/>
</Unit35>
<Unit36>
<Filename Value="C:\development\fpc\packages\fcl-image\src\fpcanvas.pp"/>
@@ -419,14 +423,14 @@
<WindowIndex Value="0"/>
<TopLine Value="89"/>
<CursorPos X="15" Y="97"/>
<UsageCount Value="5"/>
<UsageCount Value="4"/>
</Unit36>
<Unit37>
<Filename Value="C:\development\fpc\packages\fcl-image\src\fpfont.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="54"/>
<CursorPos X="3" Y="57"/>
<UsageCount Value="5"/>
<UsageCount Value="4"/>
</Unit37>
<Unit38>
<Filename Value="C:\development\lazarus\lcl\graphmath.pp"/>
@@ -434,7 +438,7 @@
<WindowIndex Value="0"/>
<TopLine Value="584"/>
<CursorPos X="3" Y="439"/>
<UsageCount Value="5"/>
<UsageCount Value="4"/>
</Unit38>
<Unit39>
<Filename Value="C:\development\lazarus\lcl\graphtype.pp"/>
@@ -442,7 +446,7 @@
<WindowIndex Value="0"/>
<TopLine Value="234"/>
<CursorPos X="3" Y="33"/>
<UsageCount Value="5"/>
<UsageCount Value="4"/>
</Unit39>
<Unit40>
<Filename Value="C:\development\lazarus\lcl\lcltype.pp"/>
@@ -450,7 +454,7 @@
<WindowIndex Value="0"/>
<TopLine Value="1628"/>
<CursorPos X="3" Y="1643"/>
<UsageCount Value="5"/>
<UsageCount Value="4"/>
</Unit40>
<Unit41>
<Filename Value="C:\development\lazarus\lcl\graphutil.pp"/>
@@ -458,7 +462,7 @@
<WindowIndex Value="0"/>
<TopLine Value="128"/>
<CursorPos X="12" Y="143"/>
<UsageCount Value="5"/>
<UsageCount Value="4"/>
</Unit41>
<Unit42>
<Filename Value="C:\development\fpc\rtl\objpas\math.pp"/>
@@ -466,14 +470,14 @@
<WindowIndex Value="0"/>
<TopLine Value="144"/>
<CursorPos X="10" Y="159"/>
<UsageCount Value="8"/>
<UsageCount Value="7"/>
</Unit42>
<Unit43>
<Filename Value="C:\development\fpc\rtl\i386\i386.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="1497"/>
<CursorPos X="1" Y="1515"/>
<UsageCount Value="11"/>
<UsageCount Value="10"/>
</Unit43>
<Unit44>
<Filename Value="C:\development\lazarus\lcl\grids.pas"/>
@@ -481,7 +485,7 @@
<WindowIndex Value="0"/>
<TopLine Value="794"/>
<CursorPos X="15" Y="1010"/>
<UsageCount Value="12"/>
<UsageCount Value="11"/>
</Unit44>
<Unit45>
<Filename Value="..\..\..\spktoolbar\SpkGraphTools\SpkGraphTools.pas"/>
@@ -489,227 +493,227 @@
<WindowIndex Value="0"/>
<TopLine Value="136"/>
<CursorPos X="1" Y="143"/>
<UsageCount Value="3"/>
<UsageCount Value="2"/>
</Unit45>
<Unit46>
<Filename Value="C:\development\fpc\rtl\objpas\classes\lists.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="34"/>
<CursorPos X="1" Y="49"/>
<UsageCount Value="11"/>
<UsageCount Value="10"/>
</Unit46>
<Unit47>
<Filename Value="C:\development\lazarus\lcl\include\canvas.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="1705"/>
<CursorPos X="1" Y="1720"/>
<UsageCount Value="11"/>
<UsageCount Value="10"/>
</Unit47>
<Unit48>
<Filename Value="C:\development\lazarus\lcl\include\font.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="1139"/>
<CursorPos X="25" Y="1161"/>
<UsageCount Value="11"/>
<UsageCount Value="10"/>
</Unit48>
<Unit49>
<Filename Value="C:\development\lazarus\lcl\include\winapih.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="156"/>
<CursorPos X="10" Y="171"/>
<UsageCount Value="5"/>
<UsageCount Value="4"/>
</Unit49>
<Unit50>
<Filename Value="C:\development\lazarus\lcl\include\intfbasewinapi.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="1577"/>
<CursorPos X="3" Y="1579"/>
<UsageCount Value="5"/>
<UsageCount Value="4"/>
</Unit50>
<Unit51>
<Filename Value="C:\development\fpc\rtl\inc\except.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="202"/>
<CursorPos X="1" Y="227"/>
<UsageCount Value="10"/>
<UsageCount Value="9"/>
</Unit51>
<Unit52>
<Filename Value="d:\lazarus-svn\lcl\include\menuitem.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="69"/>
<CursorPos X="28" Y="82"/>
<UsageCount Value="11"/>
<UsageCount Value="10"/>
</Unit52>
<Unit53>
<Filename Value="d:\lazarus-svn\lcl\include\application.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="1371"/>
<CursorPos X="1" Y="1390"/>
<UsageCount Value="10"/>
<UsageCount Value="9"/>
</Unit53>
<Unit54>
<Filename Value="d:\lazarus-svn\lcl\include\font.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="648"/>
<CursorPos X="1" Y="675"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit54>
<Unit55>
<Filename Value="d:\lazarus-svn\lcl\include\fontdialog.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="24"/>
<CursorPos X="1" Y="49"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit55>
<Unit56>
<Filename Value="C:\development\fpc\rtl\objpas\sysutils\sysinth.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="50"/>
<CursorPos X="3" Y="57"/>
<UsageCount Value="8"/>
<UsageCount Value="7"/>
</Unit56>
<Unit57>
<Filename Value="C:\development\fpc\rtl\inc\wstrings.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="169"/>
<CursorPos X="1" Y="185"/>
<UsageCount Value="8"/>
<UsageCount Value="7"/>
</Unit57>
<Unit58>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\rtl\objpas\sysutils\dati.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="890"/>
<CursorPos X="16" Y="796"/>
<UsageCount Value="15"/>
<UsageCount Value="14"/>
</Unit58>
<Unit59>
<Filename Value="d:\lazarus-svn\fpc\2.6.2\source\rtl\objpas\sysutils\sysinth.inc"/>
<WindowIndex Value="0"/>
<TopLine Value="36"/>
<CursorPos X="5" Y="43"/>
<UsageCount Value="13"/>
<UsageCount Value="12"/>
</Unit59>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="164" Column="60" TopLine="132"/>
<Filename Value="..\..\fpsutils.pas"/>
<Caret Line="1066" Column="1" TopLine="1047"/>
</Position1>
<Position2>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1511" Column="15" TopLine="1478"/>
<Filename Value="..\..\fpsutils.pas"/>
<Caret Line="1067" Column="1" TopLine="1047"/>
</Position2>
<Position3>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1170" Column="36" TopLine="1170"/>
<Filename Value="..\..\fpsutils.pas"/>
<Caret Line="1068" Column="1" TopLine="1047"/>
</Position3>
<Position4>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
<Filename Value="..\..\fpsutils.pas"/>
<Caret Line="1069" Column="10" TopLine="1047"/>
</Position4>
<Position5>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="940" Column="14" TopLine="908"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1043" Column="1" TopLine="1030"/>
</Position5>
<Position6>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="960" Column="14" TopLine="928"/>
<Filename Value="..\..\fpsutils.pas"/>
<Caret Line="1066" Column="1" TopLine="1047"/>
</Position6>
<Position7>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1013" Column="14" TopLine="982"/>
<Filename Value="..\..\fpsutils.pas"/>
<Caret Line="1067" Column="1" TopLine="1047"/>
</Position7>
<Position8>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1059" Column="14" TopLine="1027"/>
<Filename Value="..\..\fpsutils.pas"/>
<Caret Line="1068" Column="1" TopLine="1047"/>
</Position8>
<Position9>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1081" Column="41" TopLine="1049"/>
<Filename Value="..\..\fpsutils.pas"/>
<Caret Line="1069" Column="1" TopLine="1053"/>
</Position9>
<Position10>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1089" Column="43" TopLine="1057"/>
<Filename Value="..\..\fpsutils.pas"/>
<Caret Line="1070" Column="1" TopLine="1053"/>
</Position10>
<Position11>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1093" Column="14" TopLine="1061"/>
<Filename Value="..\..\fpsutils.pas"/>
<Caret Line="1072" Column="1" TopLine="1053"/>
</Position11>
<Position12>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1157" Column="14" TopLine="1126"/>
<Filename Value="..\..\fpsutils.pas"/>
<Caret Line="1086" Column="5" TopLine="1053"/>
</Position12>
<Position13>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1197" Column="20" TopLine="1177"/>
<Filename Value="..\..\fpsutils.pas"/>
<Caret Line="882" Column="16" TopLine="882"/>
</Position13>
<Position14>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="403" Column="16" TopLine="397"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="174" Column="21" TopLine="174"/>
</Position14>
<Position15>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="924" Column="14" TopLine="893"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position15>
<Position16>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="413" Column="19" TopLine="402"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="147" Column="16" TopLine="116"/>
</Position16>
<Position17>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="414" Column="33" TopLine="388"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="193" Column="13" TopLine="162"/>
</Position17>
<Position18>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="854" Column="39" TopLine="825"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="311" Column="29" TopLine="280"/>
</Position18>
<Position19>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="672" Column="1" TopLine="648"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="439" Column="73" TopLine="410"/>
</Position19>
<Position20>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="870" Column="1" TopLine="832"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="900" Column="47" TopLine="869"/>
</Position20>
<Position21>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="867" Column="24" TopLine="848"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1872" Column="81" TopLine="1841"/>
</Position21>
<Position22>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="926" Column="34" TopLine="907"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1877" Column="76" TopLine="1846"/>
</Position22>
<Position23>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="956" Column="1" TopLine="937"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1878" Column="18" TopLine="1847"/>
</Position23>
<Position24>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1024" Column="63" TopLine="1006"/>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="3071" Column="19" TopLine="3040"/>
</Position24>
<Position25>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="1478" Column="48" TopLine="1478"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1030" Column="47" TopLine="1030"/>
</Position25>
<Position26>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position26>
<Position27>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1058" Column="9" TopLine="1039"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="65" Column="62" TopLine="36"/>
</Position27>
<Position28>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1055" Column="44" TopLine="1039"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1788" Column="3" TopLine="1788"/>
</Position28>
<Position29>
<Filename Value="..\..\xlscommon.pas"/>
<Caret Line="1135" Column="22" TopLine="1120"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position29>
<Position30>
<Filename Value="..\..\fpspreadsheet.pas"/>
<Caret Line="164" Column="16" TopLine="132"/>
<Filename Value="..\..\fpspreadsheetgrid.pas"/>
<Caret Line="886" Column="40" TopLine="855"/>
</Position30>
</JumpHistory>
</ProjectOptions>

1
components/fpspreadsheet/examples/fpsgrid/mainform.lfm
View File

@@ -102,6 +102,7 @@ object Form1: TForm1
Align = alClient
ColCount = 2
ExtendedSelect = False
MouseWheelOption = mwGrid
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goRowSizing, goColSizing, goThumbTracking, goSmoothScroll, goFixedColSizing]
RowCount = 2
TabOrder = 0

2954
components/fpspreadsheet/examples/fpsgrid/mainform.lrs
View File

File diff suppressed because it is too large Load Diff

91
components/fpspreadsheet/fpsnumformatparser.pas
View File

@@ -57,6 +57,7 @@ type
FNumFormat: TsNumberFormat;
FConversionDirection: TsConversionDirection;
FIsTime: Boolean;
FIsAccounting: Boolean;
FStatus: Integer;
function GetFormatString: String;
function GetParsedSectionCount: Integer;
@@ -139,6 +140,7 @@ begin
FFormatSettings := DefaultFormatSettings;
FFormatSettings.DecimalSeparator := '.';
FFormatSettings.ThousandSeparator := ',';
FIsAccounting := (ANumFormat in [nfAccounting, nfAccountingRed]);
Parse(AFormatString);
end;
@@ -283,14 +285,18 @@ var
i: Integer;
ns: Integer;
s: String;
isCurr: Boolean;
begin
ns := Length(FSections);
if (ns > 1) and (FNumFormat in [nfCurrencyRed, nfAccountingRed]) then
FSections[1].Color := scRed;
for i:=0 to ns-1 do begin
if FSections[i].FormatString = '' then
FSections[i].NumFormat := nfGeneral;
if (FSections[i].CurrencySymbol <> '') {and (FSections[i].NumFormat in [nfFixed, nfFixedTh])} then
if (FSections[i].CurrencySymbol <> '') or FIsAccounting then
FSections[i].NumFormat := nfCurrency;
if FSections[i].CompareOperation <> coNotUsed then begin
@@ -300,7 +306,7 @@ begin
// Check format strings
case FSections[i].NumFormat of
nfGeneral, nfFixed, nfFixedTh, nfPercentage, nfExp, nfSci, nfCurrency:
nfGeneral, nfFixed, nfFixedTh, nfPercentage, nfExp, nfSci, nfCurrency, nfAccounting:
try
s := FormatFloat(FSections[i].FormatString, 1.0, FWorkBook.FormatSettings);
except
@@ -319,39 +325,33 @@ begin
end;
end;
if (ns > 1) and (FNumFormat in [nfCurrencyRed, nfCurrencyDashRed]) then
FSections[1].Color := scRed;
// Extract built-in NumFormat identifier for currency (needs several entries in
// three sections).
if (ns = 3) and
(FSections[0].NumFormat = nfCurrency) and
(FSections[1].NumFormat = nfCurrency) and
((FSections[2].NumFormat = nfCurrency) or (FSections[2].FormatString = '-'))
then begin
FNumFormat := nfCurrency;
if ((FSections[2].FormatString = '-') or (FSections[2].FormatString = '"-"')) then begin
if (FSections[1].Color = scRed) then
FNumFormat := nfCurrencyDashRed
else
FNumFormat := nfCurrencyDash;
end else begin
if (FSections[1].Color = scRed) then
FNumFormat := nfCurrencyRed;
end;
end else
isCurr := ((ns = 2) and (FSections[0].NumFormat = nfCurrency) and (FSections[1].NumFormat = nfCurrency))
or ((ns = 3) and (FSections[0].NumFormat = nfCurrency) and (FSections[1].NumFormat = nfCurrency) and
((FSections[2].NumFormat = nfCurrency) or (FSections[2].FormatString = '-')) );
if isCurr then begin
if FIsAccounting then
FNumFormat := IfThen(FSections[1].Color = scRed, nfAccountingRed, nfAccounting)
else
FNumFormat := IfThen(FSections[1].Color = scRed, nfCurrency, nfCurrencyRed);
end;
// If there are other multi-section formatstrings they must be a custom format
if (ns > 1) then begin
for i:=1 to ns-1 do
if FSections[i].FormatString <> '' then begin
FNumFormat := nfCustom;
break;
end;
if fNumFormat <> nfCustom then
if not isCurr then begin
if (ns > 1) then begin
for i:=1 to ns-1 do
if FSections[i].FormatString <> '' then begin
FNumFormat := nfCustom;
break;
end;
if fNumFormat <> nfCustom then
FNumFormat := FSections[0].NumFormat;
end
else
FNumFormat := FSections[0].NumFormat;
end
else
FNumFormat := FSections[0].NumFormat;
end;
// Add colors to section format strings
if (FConversionDirection = cdFromFPSpreadsheet) then
@@ -660,11 +660,17 @@ begin
if s = FWorkbook.FormatSettings.ShortDateFormat then
nf := nfShortDate
else
if s = StripAMPM(FWorkbook.FormatSettings.LongTimeFormat) then
nf := IfThen(isAMPM, nfLongTimeAM, nfLongTime)
if (s = StripAMPM(FWorkbook.FormatSettings.LongTimeFormat)) and (not isAMPM) then
nf := nfLongTime
else
if s = StripAMPM(FWorkbook.FormatSettings.ShortTimeFormat) then
nf := IfThen(isAMPM, nfShortTimeAM, nfShortTime)
if (s = AddAMPM(FWorkbook.FormatSettings.LongTimeFormat, FWorkbook.FormatSettings)) and isAMPM then
nf := nfLongTimeAM
else
if (s = StripAMPM(FWorkbook.FormatSettings.ShortTimeFormat)) and (not isAMPM) then
nf := nfShortTime
else
if (s = AddAMPM(FWorkbook.FormatSettings.ShortTimeFormat, FWorkbook.FormatSettings)) and isAMPM then
nf := nfShortTimeAM
else
if s[1] = '[' then
nf := nfTimeInterval
@@ -719,8 +725,17 @@ begin
token := FCurrent^;
case token of
// Strip Excel's formatting symbols
'\', '*':
;
'\': ;
'*':
begin
FIsAccounting := true;
AddChar('*');
inc(FCurrent);
if (FCurrent <= FEnd) then begin
token := FCurrent^;
AddChar(token);
end;
end;
'_':
inc(FCurrent);
'"':
@@ -820,6 +835,8 @@ begin
nf := nfPercentage
else if hasThSep then
nf := nfFixedTh
else if FIsAccounting then
nf := nfAccounting
else
nf := nfFixed;
end else

15
components/fpspreadsheet/fpspreadsheet.pas
View File

@@ -159,7 +159,7 @@ type
// numbers
nfFixed, nfFixedTh, nfExp, nfSci, nfPercentage,
// currency
nfCurrency, nfCurrencyRed, nfCurrencyDash, nfCurrencyDashRed,
nfCurrency, nfCurrencyRed, nfAccounting, nfAccountingRed,
// dates and times
nfShortDateTime, nfFmtDateTime, nfShortDate, nfLongDate, nfShortTime, nfLongTime,
nfShortTimeAM, nfLongTimeAM, nfTimeInterval,
@@ -1249,6 +1249,8 @@ function TsWorksheet.ReadAsUTF8Text(ARow, ACol: Cardinal): ansistring;
ANumberFormat: TsNumberFormat; ANumberFormatStr: string; ADecimals: byte): ansistring;
var
fs: TFormatSettings;
left, right: String;
i: Integer;
begin
fs := FWorkbook.FormatSettings;
if IsNan(Value) then
@@ -1262,6 +1264,13 @@ function TsWorksheet.ReadAsUTF8Text(ARow, ACol: Cardinal): ansistring;
else
if (ANumberFormat = nfPercentage) then
Result := FormatFloat(ANumberFormatStr, Value*100, fs)
else
if (ANumberFormat in [nfAccounting, nfAccountingRed]) then
case SplitAccountingFormatString(ANumberFormatStr, Sign(Value), left, right) of
0: Result := FormatFloat(ANumberFormatStr, Value, fs);
1: Result := FormatFloat(left, abs(Value), fs) + ' ' + Right;
2: Result := Left + ' ' + FormatFloat(right, abs(Value), fs);
end
else
Result := FormatFloat(ANumberFormatStr, Value, fs)
end;
@@ -2862,7 +2871,7 @@ begin
and (item.NumFormat = ANumFormat)
and (item.FormatString = AFormatString)
and (item.Decimals = ADecimals)
and (not (item.NumFormat in [nfCurrency, nfCurrencyRed, nfCurrencyDash, nfCurrencyDashRed])
and (not (item.NumFormat in [nfCurrency, nfCurrencyRed, nfAccounting, nfAccountingRed])
or (item.CurrencySymbol = ACurrencySymbol))
then
exit;
@@ -3094,7 +3103,7 @@ begin
case AFormat^.NumberFormat of
nfFixed, nfFixedTh, nfPercentage, nfExp, nfSci:
if (FFormattingStyles[i].Decimals <> AFormat^.Decimals) then Continue;
nfCurrency, nfCurrencyRed, nfCurrencyDash, nfCurrencyDashRed:
nfCurrency, nfCurrencyRed, nfAccounting, nfAccountingRed:
begin
if (FFormattingStyles[i].Decimals <> AFormat^.Decimals) then Continue;
if (FFormattingStyles[i].CurrencySymbol <> AFormat^.CurrencySymbol) then Continue;

292
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@@ -105,6 +105,7 @@ type
{ Protected declarations }
procedure DefaultDrawCell(ACol, ARow: Integer; var ARect: TRect; AState: TGridDrawState); override;
procedure DoPrepareCanvas(ACol, ARow: Integer; AState: TGridDrawState); override;
// procedure DrawAccountingCell(ACell: PCell; ARect: TRect; AState: TGridDrawState);
procedure DrawAllRows; override;
procedure DrawCellBorders; overload;
procedure DrawCellBorders(ACol, ARow: Integer; ARect: TRect); overload;
@@ -118,6 +119,10 @@ type
function GetEditText(ACol, ARow: Integer): String; override;
function HasBorder(ACell: PCell; ABorder: TsCellBorder): Boolean;
procedure HeaderSized(IsColumn: Boolean; index: Integer); override;
procedure InternalDrawTextInCell(AText, AMeasureText: String; ARect: TRect;
AJustification: Byte; ACellHorAlign: TsHorAlignment;
ACellVertAlign: TsVertAlignment; ATextRot: TsTextRotation;
ATextWrap, ReplaceTooLong: Boolean);
procedure KeyDown(var Key : Word; Shift : TShiftState); override;
procedure Loaded; override;
procedure LoadFromWorksheet(AWorksheet: TsWorksheet);
@@ -321,6 +326,14 @@ implementation
uses
Types, LCLType, LCLIntf, Math, fpCanvas, GraphUtil, fpsUtils;
const
HOR_ALIGNMENTS: array[haLeft..haRight] of TAlignment = (
taLeftJustify, taCenter, taRightJustify
);
VERT_ALIGNMENTS: array[TsVertAlignment] of TTextLayout = (
tlBottom, tlTop, tlCenter, tlBottom
);
var
FillPattern_BIFF2: TBitmap = nil;
@@ -665,7 +678,7 @@ begin
Canvas.Font.Size := round(fnt.Size);
end;
end;
if (lCell^.NumberFormat in [nfCurrencyRed, nfCurrencyDashRed]) and
if (lCell^.NumberFormat in [nfCurrencyRed, nfAccountingRed]) and
not IsNaN(lCell^.NumberValue) and (lCell^.NumberValue < 0)
then
Canvas.Font.Color := FWorkbook.GetPaletteColor(scRed);
@@ -859,17 +872,11 @@ end;
text wrapping }
procedure TsCustomWorksheetGrid.DrawTextInCell(ACol, ARow: Integer; ARect: TRect;
AState: TGridDrawState);
const
HOR_ALIGNMENTS: array[haLeft..haRight] of TAlignment = (
taLeftJustify, taCenter, taRightJustify
);
VERT_ALIGNMENTS: array[TsVertAlignment] of TTextLayout = (
tlBottom, tlTop, tlCenter, tlBottom
);
var
ts: TTextStyle;
flags: Cardinal;
txt: String;
txtL, txtR: String;
txtRect: TRect;
P: TPoint;
w, h, h0, hline: Integer;
@@ -879,7 +886,10 @@ var
wrapped: Boolean;
horAlign: TsHorAlignment;
vertAlign: TsVertAlignment;
txtRot: TsTextRotation;
lCell: PCell;
txtLeft, txtRight: String;
justif: Byte;
begin
if FWorksheet = nil then
exit;
@@ -887,6 +897,8 @@ begin
c := ACol - FHeaderCount;
r := ARow - FHeaderCount;
lCell := FWorksheet.FindCell(r, c);
// Header
if lCell = nil then begin
if ShowHeaders and ((ACol = 0) or (ARow = 0)) then begin
ts.Alignment := taCenter;
@@ -898,27 +910,71 @@ begin
exit;
end;
txt := GetCellText(ACol, ARow);
if txt = '' then
exit;
// Cells
wrapped := (uffWordWrap in lCell^.UsedFormattingFields) or (lCell^.TextRotation = rtStacked);
txtRot := lCell^.TextRotation;
vertAlign := lCell^.VertAlignment;
if lCell^.HorAlignment <> haDefault then
horAlign := lCell^.HorAlignment
else begin
if lCell^.ContentType = cctNumber then
if (lCell^.ContentType in [cctNumber, cctDateTime]) then
horAlign := haRight
else
horAlign := haLeft;
if lCell^.TextRotation = rt90DegreeCounterClockwiseRotation then begin
if txtRot = rt90DegreeCounterClockwiseRotation then begin
if horAlign = haRight then horAlign := haLeft else horAlign := haRight;
end;
end;
vertAlign := lCell^.VertAlignment;
wrapped := (uffWordWrap in lCell^.UsedFormattingFields)
or (lCell^.TextRotation = rtStacked);
InflateRect(ARect, -constCellPadding, -constCellPadding);
if (lCell^.NumberFormat in [nfAccounting, nfAccountingRed]) and not IsNaN(lCell^.Numbervalue)
then begin
case SplitAccountingFormatString(lCell^.NumberFormatStr, Sign(lCell^.NumberValue),
txtLeft, txtRight) of
1: begin
txtLeft := FormatFloat(txtLeft, lCell^.NumberValue);
if txtLeft = '' then exit;
txt := txtLeft + ' ' + txtRight;
end;
2: begin
txtRight := FormatFloat(txtRight, lCell^.NumberValue);
if txtRight = '' then exit;
txt := txtLeft + ' ' + txtRight;
end;
end;
InternalDrawTextInCell(txtLeft, txt, ARect, 0, horAlign, vertAlign,
txtRot, wrapped, true);
InternalDrawTextInCell(txtRight, txt, ARect, 2, horAlign, vertAlign,
txtRot, wrapped, true);
end else begin
txt := GetCellText(ACol, ARow);
if txt = '' then
exit;
case horAlign of
haLeft : justif := 0;
haCenter : justif := 1;
haRight : justif := 2;
end;
InternalDrawTextInCell(txt, txt, ARect, justif, horAlign, vertAlign,
txtRot, wrapped, false);
end;
end;
(*
procedure InternalDrawTextInCell(AText, AMeasureText: String; ARect: TRect;
AJustification: Byte; ACellHorAlign: TsHorAlignment;
ACellVertAlign: TsVertAlignment; ATextRot: TsTextRotation;
ATextWrap, ReplaceTooLong: Boolean);
if (lCell^.TextRotation in [trHorizontal, rtStacked]) or
(not (uffTextRotation in lCell^.UsedFormattingFields))
then begin
@@ -1023,6 +1079,7 @@ begin
end;
end;
end;
*)
procedure TsCustomWorksheetGrid.EditingDone;
var
@@ -1805,6 +1862,207 @@ begin
end;
end;
{ Internal generl text drawing method.
- AText: text to be drawn
- AMeasureText: text used for checking if the text fits into the text rectangle.
If too large and ReplaceTooLong = true, a series of # is drawn.
- ARect: Rectangle in which the text is drawn
- AJustification: determines whether the text is drawn at the "start" (0),
"center" (1) or "end" (2) of the drawing rectangle. Start/center/end are
seen along the text drawing direction.
- ACellHorAlign: Is the HorAlignment property stored in the cell
- ACellVertAlign: Is the VertAlignment property stored in the cell
- ATextRot: determines the rotation angle of the text.
- ATextWrap: determines if the text can wrap over multiple lines
- ReplaceTooLang: if true too-long texts are replaced by a series of # filling
the cell. }
procedure TsCustomWorksheetGrid.InternalDrawTextInCell(AText, AMeasureText: String;
ARect: TRect; AJustification: Byte; ACellHorAlign: TsHorAlignment;
ACellVertAlign: TsVertAlignment; ATextRot: TsTextRotation;
ATextWrap, ReplaceTooLong: Boolean);
var
ts: TTextStyle;
flags: Cardinal;
txt: String;
txtL, txtR: String;
txtRect: TRect;
P: TPoint;
w, h, h0, hline: Integer;
i: Integer;
L: TStrings;
c, r: Integer;
wrapped: Boolean;
begin
wrapped := ATextWrap or (ATextRot = rtStacked);
if AMeasureText = '' then txt := AText else txt := AMeasureText;
flags := DT_WORDBREAK and not DT_SINGLELINE or DT_CALCRECT;
txtRect := ARect;
if (ATextRot in [trHorizontal, rtStacked]) then begin
// HORIZONAL TEXT DRAWING DIRECTION
Canvas.Font.Orientation := 0;
ts := Canvas.TextStyle;
ts.Opaque := false;
if wrapped then begin
ts.Wordbreak := true;
ts.SingleLine := false;
LCLIntf.DrawText(Canvas.Handle, PChar(txt), Length(txt), txtRect, flags);
w := txtRect.Right - txtRect.Left;
h := txtRect.Bottom - txtRect.Top;
end else begin
ts.WordBreak := false;
ts.SingleLine := false;
w := Canvas.TextWidth(AMeasureText);
h := Canvas.TextHeight('Tg');
end;
if ATextRot = rtStacked then begin
// Stacked
ts.Alignment := HOR_ALIGNMENTS[ACellHorAlign];
if h > ARect.Bottom - ARect.Top then begin
if ReplaceTooLong then begin
txt := '#';
repeat
txt := txt + '#';
LCLIntf.DrawText(Canvas.Handle, PChar(txt), Length(txt), txtRect, flags);
until txtRect.Bottom - txtRect.Top > ARect.Bottom - ARect.Top;
AText := copy(txt, 1, Length(txt)-1);
end;
ts.Layout := tlTop;
end else
case AJustification of
0: ts.Layout := tlTop;
1: ts.Layout := tlCenter;
2: ts.Layout := tlBottom;
end;
Canvas.TextStyle := ts;
Canvas.TextRect(ARect, ARect.Left, ARect.Top, AText);
end else begin
// Horizontal
if h > ARect.Bottom - ARect.Top then
ts.Layout := tlTop
else
ts.Layout := VERT_ALIGNMENTS[ACellVertAlign];
if w > ARect.Right - ARect.Left then begin
if ReplaceTooLong then begin
txt := '';
repeat
txt := txt + '#';
LCLIntf.DrawText(Canvas.Handle, PChar(txt), Length(txt), txtRect, flags);
until txtRect.Right - txtRect.Left > ARect.Right - ARect.Left;
AText := Copy(txt, 1, Length(txt)-1);
end;
ts.Alignment := taLeftJustify;
end else
case AJustification of
0: ts.Alignment := taLeftJustify;
1: ts.Alignment := taCenter;
2: ts.Alignment := taRightJustify;
end;
Canvas.TextStyle := ts;
Canvas.TextRect(ARect,ARect.Left, ARect.Top, AText);
end;
end
else
begin
// ROTATED TEXT DRAWING DIRECTION
// Since there is not good API for multiline rotated text, we draw the text
// line by line.
L := TStringList.Create;
try
txtRect := Bounds(ARect.Left, ARect.Top, ARect.Bottom - ARect.Top, ARect.Right - ARect.Left);
hline := Canvas.TextHeight('Tg');
if wrapped then begin
// Extract wrapped lines
L.Text := WrapText(Canvas, txt, txtRect.Right - txtRect.Left);
// Calculate size of wrapped text
flags := DT_WORDBREAK and not DT_SINGLELINE or DT_CALCRECT;
LCLIntf.DrawText(Canvas.Handle, PChar(L.Text), Length(L.Text), txtRect, flags);
w := txtRect.Right - txtRect.Left;
h := txtRect.Bottom - txtRect.Top;
h0 := hline;
end
else begin
L.Text := txt;
w := Canvas.TextWidth(txt);
h := hline;
h0 := 0;
end;
if w > ARect.Bottom - ARect.Top then begin
if ReplaceTooLong then begin
txt := '#';
repeat
txt := txt + '#';
until Canvas.TextWidth(txt) > ARect.Bottom - ARect.Top;
L.Text := Copy(txt, 1, Length(txt)-1);
end;
end;
ts := Canvas.TextStyle;
ts.SingleLine := true; // Draw text line by line
ts.Clipping := false;
ts.Layout := tlTop;
ts.Alignment := taLeftJustify;
ts.Opaque := false;
if ATextRot = rt90DegreeClockwiseRotation then begin
// Clockwise
Canvas.Font.Orientation := -900;
case ACellHorAlign of
haLeft : P.X := Min(ARect.Right-1, ARect.Left + h - h0);
haCenter : P.X := Min(ARect.Right-1, (ARect.Left + ARect.Right + h) div 2);
haRight : P.X := ARect.Right - 1;
end;
for i:= 0 to L.Count-1 do begin
w := Canvas.TextWidth(L[i]);
case AJustification of
0: P.Y := ARect.Top; // corresponds to "top"
1: P.Y := Max(ARect.Top, (Arect.Top + ARect.Bottom - w) div 2); // "center"
2: P.Y := Max(ARect.Top, ARect.Bottom -w); // "bottom"
end; {
case vertAlign of
vaTop : P.Y := ARect.Top;
vaCenter : P.Y := Max(ARect.Top, (ARect.Top + ARect.Bottom - w) div 2);
vaBottom : P.Y := Max(ARect.Top, ARect.Bottom - w);
end;}
Canvas.TextRect(ARect, P.X, P.Y, L[i], ts);
dec(P.X, hline);
end
end
else begin
// Counter-clockwise
Canvas.Font.Orientation := +900;
case ACellHorAlign of
haLeft : P.X := ARect.Left;
haCenter : P.X := Max(ARect.Left, (ARect.Left + ARect.Right - h + h0) div 2);
haRight : P.X := MAx(ARect.Left, ARect.Right - h + h0);
end;
for i:= 0 to L.Count-1 do begin
w := Canvas.TextWidth(L[i]);
case AJustification of
0: P.Y := ARect.Bottom; // like "Bottom"
1: P.Y := Min(ARect.Bottom, (ARect.Top + ARect.Bottom + w) div 2); // "Center"
2: P.Y := Min(ARect.Bottom, ARect.Top + w); // like "top"
end; {
case vertAlign of
vaTop : P.Y := Min(ARect.Bottom, ARect.Top + w);
vaCenter : P.Y := Min(ARect.Bottom, (ARect.Top + ARect.Bottom + w) div 2);
vaBottom : P.Y := ARect.Bottom;
end;}
Canvas.TextRect(ARect, P.X, P.Y, L[i], ts);
inc(P.X, hline);
end;
end;
finally
L.Free;
end;
end;
end;
{ Catches the ESC key during editing in order to restore the old cell text }
procedure TsCustomWorksheetGrid.KeyDown(var Key : Word; Shift : TShiftState);
begin

528
components/fpspreadsheet/fpsutils.pas
View File

@@ -68,24 +68,15 @@ function MillimetersToTwips(AValue: Single): Integer;
function IfThen(ACondition: Boolean; AValue1,AValue2: TsNumberFormat): TsNumberFormat; overload;
function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean;
(*
function IsCurrencyFormat(s: String; out Decimals: Byte; out CurrSymbol: String;
out IsCurrencyRedFmt, IsCurrencyDashFmt: Boolean): Boolean;
function IsExpNumberFormat(s: String; out Decimals: Byte; out IsSci: Boolean): Boolean;
function IsFixedNumberFormat(s: String; out Decimals: Byte): Boolean;
function IsPercentNumberFormat(s: String; out Decimals: Byte): Boolean;
function IsThousandSepNumberFormat(s: String; out Decimals: Byte): Boolean;
function IsDateFormat(s: String; out IsLong: Boolean): Boolean;
{function IsTimeFormat(s: String; out isLong, isAMPM, isInterval: Boolean;
out SecDecimals: Byte): Boolean;
*)
function BuildNumberFormatString(ANumberFormat: TsNumberFormat;
const AFormatSettings: TFormatSettings; ADecimals: Integer = -1;
ACurrencySymbol: String = '?'): String;
function BuildDateTimeFormatString(ANumberFormat: TsNumberFormat;
const AFormatSettings: TFormatSettings; AFormatString: String = ''): String;
function BuildCurrencyFormatString(const AFormatSettings: TFormatSettings;
ADecimals: Integer; ANegativeValuesRed: Boolean; AAccountingStyle: Boolean;
ACurrencySymbol: String = '?'): String;
function AddAMPM(const ATimeFormatString: String;
const AFormatSettings: TFormatSettings): String;
@@ -94,12 +85,14 @@ function CountDecs(AFormatString: String; ADecChars: TsDecsChars = ['0']): Byte;
function AddIntervalBrackets(AFormatString: String): String;
function SpecialDateTimeFormat(ACode: String;
const AFormatSettings: TFormatSettings; ForWriting: Boolean): String;
function SplitAccountingFormatString(const AFormatString: String; ASection: ShortInt;
var ALeft, ARight: String): Byte;
function SciFloat(AValue: Double; ADecimals: Byte): String;
//function TimeIntervalToString(AValue: TDateTime; AFormatStr: String): String;
procedure MakeTimeIntervalMask(Src: String; var Dest: String);
// These two functions are copies of fpc trunk until they are available in "stable"
// These two functions are copies of fpc trunk until they are available in stable fpc.
function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
Options : TFormatDateTimeOptions = []): string;
function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
@@ -516,7 +509,6 @@ begin
Result := Round((AValue * 20 * 72) / 25.4);
end;
{ Returns either AValue1 or AValue2, depending on the condition.
For reduciton of typing... }
function IfThen(ACondition: Boolean; AValue1, AValue2: TsNumberFormat): TsNumberFormat;
@@ -524,262 +516,12 @@ begin
if ACondition then Result := AValue1 else Result := AValue2;
end;
{ Format checking procedures }
{ Checks whether the given number format code is for date/times. }
function IsDateTimeFormat(AFormat: TsNumberFormat): Boolean;
begin
Result := AFormat in [nfFmtDateTime, nfShortDateTime, nfShortDate, nfLongDate,
nfShortTime, nfLongTime, nfShortTimeAM, nfLongTimeAM, nfTimeInterval];
end;
(*
{ This simple parsing procedure of the Excel format string checks for a fixed
float format s, i.e. s can be '0', '0.00', '000', '0,000', and returns the
number of decimals, i.e. number of zeros behind the decimal point }
function IsFixedNumberFormat(s: String; out Decimals: Byte): Boolean;
var
i: Integer;
p: Integer;
decs: String;
begin
Decimals := 0;
// Excel time formats with milliseconds ("mm:ss.000") can be incorrectly
// detected as fixed number formats. Check this case at first.
if pos('s.0', s) > 0 then begin
Result := false;
exit;
end;
// Check if s is a valid format mask.
try
FormatFloat(s, 1.0);
except
on EConvertError do begin
Result := false;
exit;
end;
end;
// If it is count the zeros - each one is a decimal.
if s = '0' then
Result := true
else begin
p := pos('.', s); // position of decimal point;
if p = 0 then begin
Result := false;
end else begin
Result := true;
for i:= p+1 to Length(s) do
if s[i] = '0' then begin
inc(Decimals)
end
else
exit; // ignore characters after the last 0
end;
end;
end;
{ This function checks whether the format string corresponds to a thousand
separator format like "#,##0.000' and returns the number of fixed decimals
(i.e. zeros after the decimal point) }
function IsThousandSepNumberFormat(s: String; out Decimals: Byte): Boolean;
var
i, p: Integer;
begin
Decimals := 0;
// Check if s is a valid format string
try
FormatFloat(s, 1.0);
except
on EConvertError do begin
Result := false;
exit;
end;
end;
// If it is look for the thousand separator. If found count decimals.
Result := (Pos(',', s) > 0);
if Result then begin
p := pos('.', s);
if p > 0 then
for i := p+1 to Length(s) do
if s[i] = '0' then
inc(Decimals)
else
exit; // ignore format characters after the last 0
end;
end;
{ This function checks whether the format string corresponds to percent
formatting and determines the number of decimals }
function IsPercentNumberFormat(s: String; out Decimals: Byte): Boolean;
var
i, p: Integer;
begin
Decimals := 0;
// The signature of the percent format is a percent sign at the end of the
// format string.
Result := (s <> '') and (s[Length(s)] = '%');
if Result then begin
// Check for a valid format string
try
FormatDateTime(s, 1.0);
except
on EConvertError do begin
Result := false;
exit;
end;
end;
// Count decimals
p := pos('.', s);
if p > 0 then
for i := p+1 to Length(s)-1 do
if s[i] = '0' then
inc(Decimals)
else
exit; // ignore characters after last 0
end;
end;
{ This function checks whether the format string corresponds to a currency format. }
function IsCurrencyFormat(s: String; out Decimals: Byte; out CurrSymbol: String;
out IsCurrencyRedFmt, IsCurrencyDashFmt: Boolean): Boolean;
begin
Result := false; // TO DO !!!!
end;
{ This function checks whether the format string corresponds to exponential
formatting and determines the number of decimals. If it contains a # character
the function assumes a "scientific" format rounding the exponent to multiples
of 2. }
function IsExpNumberFormat(s: String; out Decimals: Byte;
out IsSci: Boolean): Boolean;
var
i, pdp, pe, ph: Integer;
begin
Result := false;
Decimals := 0;
IsSci := false;
if SameText(s, 'General') then
exit;
// Check for a valid format string
try
FormatDateTime(s, 1.0);
except
on EConvertError do begin
exit;
end;
end;
pe := pos('e', lowercase(s));
result := pe > 0;
if Result then begin
// The next character must be a "+", "-", or "0"
if (pe = Length(s)) or not (s[pe+1] in ['+', '-', '0']) then begin
Result := false;
exit;
end;
// Count decimals
pdp := pos('.', s);
if (pdp > 0) then begin
if pdp < pe then
for i:=pdp+1 to pe-1 do
if s[i] = '0' then
inc(Decimals)
else
break; // ignore characters after last 0
end;
// Look for hash signs # as indicator of the "scientific" format
ph := pos('#', s);
if ph > 0 then IsSci := true;
end;
end;
{ IsDateFormat checks if the format string s corresponds to a date format }
function IsDateFormat(s: String; out IsLong: Boolean): Boolean;
begin
s := Lowercase(s);
// Day, month, year are separated by a slash
// We also check part of the year/month/day symbol because there may be
// other control code with a slash.
Result := (pos('y/', s) > 0) or (pos('m/', s) > 0) or (pos('/m', s) > 0) or (pos('/d', s) > 0);
if Result then
// Check validity of format string
try
FormatDateTime(s, now);
s := Lowercase(s);
isLong := (pos('mmm', s) <> 0) or (pos('mmmm', s) <> 0);
except on EConvertError do
Result := false;
end;
end;
{ IsTimeFormat checks if the format string s is a time format. isLong is
true if the string contains hours, minutes and seconds (two colons).
isAMPM is true if the string contains "AM/PM", "A/P" or "AMPM".
isInterval is true if the string contains square bracket codes for time intervals.
SecDecimals is the number of decimals for the seconds. }
function IsTimeFormat(s: String; out isLong, isAMPM, isInterval: Boolean;
out SecDecimals: Byte): Boolean;
var
p, pdp, i, count: Integer;
begin
isLong := false;
isAMPM := false;
SecDecimals := 0;
// Time parts are separated by a colon
p := pos(':', s);
result := p > 0;
if Result then begin
count := 1;
s := Uppercase(s);
// Seek for "H:MM:SS" or "H:MM" to see if it is a long or short time format.
if pos('H:MM:SS', s) <> 0 then
isLong := true
else
if pos('H:MM', s) <> 0 then
isLong := false
else
// If there are is a second colon s is a "long" time format
for i:=p+1 to Length(s) do
if s[i] = ':' then begin
isLong := true;
break;
end;
// Seek for "AM/PM" etc to detect that specific format
isAMPM := (pos('AM/PM', s) > 0) or (pos('A/P', s) > 0) or (pos('AMPM', s) > 0);
// Look for special square bracket symbols indicating the interval format.
isInterval := (pos('[H]', s) <> 0) or (pos('[HH]', s) <> 0) or
(pos('[M]', s) <> 0) or (pos('[MM]', s) <> 0) or
(pos('[N]', s) <> 0) or (pos('[NN]', s) <> 0) or
(pos('[S]', s) <> 0) or (pos('[SS]', s) <> 0);
// Count decimals
pdp := pos('.', s);
if (pdp > 0) then
for i:=pdp+1 to Length(s) do
if (s[i] in ['0', 'z', 'Z']) then
inc(SecDecimals)
else
break; // ignore characters after last 0
// Check validity of format string
try
FormatDateTime(s, now);
except on EConvertError do
Result := false;
end;
end;
end;
*)
{ Builds a date/time format string from the numberformat code. If the format code
is nfFmtDateTime the given AFormatString is used. AFormatString can use the
@@ -824,36 +566,88 @@ begin
end;
end;
{ Builds a currency format string. The presentation of negative values (brackets,
or minus signs) is taken from the provided format settings. The format string
consists of three sections, separated by semicolons.
Additional code is inserted for the destination file format:
- AAccountingStyle = true adds code to align the currency symbols below each
other.
- ANegativeValuesRed adds code to the second section of the format code (for
negative values) to apply a red font color.
This code has to be removed by StripAccountingSymbols before applying to
FormatFloat. }
function BuildCurrencyFormatString(const AFormatSettings: TFormatSettings;
ADecimals: Integer; ANegativeValuesRed: Boolean; AAccountingStyle: Boolean;
ACurrencySymbol: String = '?'): String;
const
POS_FMT: array[0..3, boolean] of string = ( //0: value, 1: currency symbol
('"%1:s"%0:s', '"%1:s"* %0:s'), // 0: $1
('%0:s"%1:s"', '%0:s* "%1:s"'), // 1: 1$
('"%1:s" %0:s', '"%1:s"* %0:s'), // 2: $ 1
('%0:s "%1:s"', '%0:s* "%1:s"') // 3: 1 $
);
NEG_FMT: array[0..15, boolean] of string = (
('("%1:s"%0:s)', '"%1:s"* (%0:s)'), // 0: ($1)
('-"%1:s"%0:s', '"%1:s"* -%0:s'), // 1: -$1
('"%1:s"-%0:s', '"%1:s"* -%0:s'), // 2: $-1
('"%1:s"%0:s-', '"%1:s"* %0:s-'), // 3: $1-
('(%0:s"%1:s")', '(%0:s)"%1:s"'), // 4: (1$)
('-%0:s"%1:s"', '-%0:s"%1:s"'), // 5: -1$
('%0:s-"%1:s"', '%0:s-"%1:s"'), // 6: 1-$
('%0:s"%1:s"-', '%0:s-"%1:s"'), // 7: 1$-
('-%0:s "%1:s"', '-%0:s"%1:s"'), // 8: -1 $
('-"%1:s" %0:s', '"%1:s"* -%0:s'), // 9: -$ 1
('%0:s "%1:s"-', '%0:s- "%1:s"'), // 10: 1 $-
('"%1:s" %0:s-', '"%1:s"* %0:s-'), // 11: $ 1-
('"%1:s" -%0:s', '"%1:s"* -%0:s'), // 12: $ -1
('%0:s- "%1:s"', '%0:s- "%1:s"'), // 13: 1- $
('("%1:s" %0:s)', '"%1:s"* (%0:s)'), // 14: ($ 1)
('(%0:s "%1:s")', '(%0:s) "%1:s"') // 15: (1 $)
);
var
decs: String;
cf, ncf: Byte;
p, n: String;
begin
cf := AFormatSettings.CurrencyFormat;
ncf := AFormatSettings.NegCurrFormat;
if ADecimals < 0 then ADecimals := AFormatSettings.CurrencyDecimals;
if ACurrencySymbol = '?' then ACurrencySymbol := AFormatSettings.CurrencyString;
decs := DupeString('0', ADecimals);
if ADecimals > 0 then decs := '.' + decs;
p := POS_FMT[cf, AAccountingStyle];
n := NEG_FMT[ncf, AAccountingStyle];
// add extra space for the sign of the number for perfect alignment in Excel
if AAccountingStyle then
case ncf of
0, 14: p := p + '_)';
3, 11: p := p + '_-';
4, 15: p := '_(' + p;
5, 8 : p := '_-' + p;
end;
if ACurrencySymbol <> '' then begin
Result := Format(p, ['#,##0' + decs, ACurrencySymbol]) + ';'
+ Format(n, ['#,##0' + decs, ACurrencySymbol]) + ';'
+ Format(p, [IfThen(AAccountingStyle, '-', '0'+decs), ACurrencySymbol]);
end
else begin
Result := '#,##0' + decs;
case ncf of
0, 14, 15 : Result := Result + ';(#,##0' + decs + ')';
1, 2, 5, 6, 8, 9, 12: Result := Result + ';-#,##0' + decs;
else Result := Result + ';#,##0' + decs + '-';
end;
Result := Result + ';' + IfThen(AAccountingStyle, '-', '0'+decs);
end;
end;
{ Builds a number format string from the numberformat code, the count of
decimals, and the currencysymbol (if not empty). }
function BuildNumberFormatString(ANumberFormat: TsNumberFormat;
const AFormatSettings: TFormatSettings; ADecimals: Integer = -1;
ACurrencySymbol: String = '?'): String;
const
POS_FMT: array[0..3] of string = ( //0: value, 1: currency symbol
'"%1:s"%0:s',
'%0:s"%1:s"',
'"%1:s" %0:s',
'%0:s "%1:s"'
);
NEG_FMT: array[0..15] of string = (
'("%1:s"%0:s)', // 0
'-"%1:s"%0:s', // 1
'"%1:s"-%0:s', // 2
'"%1:s"%0:s-', // 3
'(%0:s"%1:s")', // 4
'-%0:s"%1:s"', // 5
'-%0:s-"%1:s"', // 6
'%0:s"%1:s"-', // 7
'-%0:s "%1:s"', // 8
'-"%1:s" %0:s', // 9
'%0:s "%1:s"-', // 10
'"%1:s" %0:s-', // 11
'"%1:s" -%0:s', // 12
'%0:s- "%1:s"', // 13
'("%1:s" %0:s)', // 14
'(%0:s "%1:s")' // 15
);
var
decs: String;
cf, ncf: Byte;
@@ -876,28 +670,14 @@ begin
Result := '##0' + decs + 'E+0';
nfPercentage:
Result := '0' + decs + '%';
nfCurrency,
nfCurrencyRed,
nfCurrencyDash,
nfCurrencyDashRed:
begin
Result := '';
if ACurrencySymbol <> '' then
Result := Format(POS_FMT[cf], ['#,##0' + decs, ACurrencySymbol]) + ';'
+ Format(NEG_FMT[ncf], ['#,##0' + decs, ACurrencySymbol])
else begin
Result := '#,##0' + decs;
case ncf of
0, 14, 15 : Result := Result + ';(#,##0' + decs + ')';
1, 5, 6, 8, 9, 12: Result := Result + ';-#,##0' + decs;
else Result := Result + ';#,##0' + decs + '-';
end;
end;
if ANumberFormat in [nfCurrency, nfCurrencyRed] then
Result := Result +';' + Format(POS_FMT[cf], ['0' + decs, ACurrencySymbol])
else
Result := Result + ';-';
end;
nfCurrency, nfCurrencyRed, nfAccounting, nfAccountingRed:
Result := BuildCurrencyFormatString(
AFormatSettings,
ADecimals,
ANumberFormat in [nfCurrencyRed, nfAccountingRed],
ANumberFormat in [nfAccounting, nfAccountingRed],
ACurrencySymbol
);
end;
end;
@@ -998,6 +778,84 @@ begin
Result := ACode;
end;
{ Splits the sections +1 (positive) or -1 (negative values) or 0 (zero values)
of the accounting format string at the position of the '*' into a left
and right part and returns 1 if the format string is in the left, and 2 if
it is in the right part. Additionally removes Excel format codes '_' }
function SplitAccountingFormatString(const AFormatString: String; ASection: ShortInt;
var ALeft, ARight: String): Byte;
var
P: PChar;
PStart, PEnd: PChar;
token: Char;
done: Boolean;
i: Integer;
begin
Result := 0;
PStart := PChar(@AFormatString[1]);
PEnd := PStart + Length(AFormatString);
P := PStart;
done := false;
case ASection of
-1 : while (P < PEnd) and not done do begin
token := P^;
if token = ';' then done := true;
inc(P);
end;
0 : for i := 1 to 2 do begin
done := false;
while (P < PEnd) and not done do begin
token := P^;
if token = ';' then done := true;
inc(P);
end;
end;
+1: ;
end;
ALeft := '';
done := false;
while (P < PEnd) and not done do begin
token := P^;
case token of
'_': inc(P);
';': done := true;
'"': ;
'*': begin
inc(P);
done := true;
end;
'0',
'#': begin
ALeft := ALeft + token;
Result := 1;
end;
else ALeft := ALeft + token;
end;
inc(P);
end;
ARight := '';
done := false;
while (P < PEnd) and not done do begin
token := P^;
case token of
'_': inc(P);
';': done := true;
'"': ;
'0',
'#': begin
ARight := ARight + token;
Result := 2;
end;
else ARight := ARight + token;
end;
inc(P);
end;
end;
{ Formats the number AValue in "scientific" format with the given number of
decimals. "Scientific" is the same as "exponential", but with exponents rounded
to multiples of 3 (like for "kilo" - "Mega" - "Giga" etc.). }
@@ -1017,45 +875,7 @@ begin
Result := Format('%.*fE%d', [ADecimals, m, ex]);
end;
end;
(*
{ Formats the number AValue as a time string according to the format string.
If the hour part is between square brackets it can be greater than 24 hours.
Dto for the minutes or seconds part, with the higher-value part being added
and no longer being shown explicitly.
Example:
AValue = 1:30:02, FormatStr = "[mm]:ss]" --> "90:02" }
function TimeIntervalToString(AValue: TDateTime; AFormatStr: String): String;
var
hrs, mins, secs: Integer;
diff: Double;
h,m,s,z: Word;
ts: String;
fmt: String;
p: Integer;
begin {
fmt := Lowercase(AFormatStr);
p := pos('h]', fmt);
if p > 0 then begin
System.Delete(fmt, 1, p+2);
Result := FormatDateTime(fmt, AValue);
DecodeTime(frac(abs(AValue)), h, m, s, z);
hrs := h + trunc(abs(AValue))*24;
Result := FormatDateTime(fmt, AValue);
end;
for i
p := pos('h
}
ts := DefaultFormatSettings.TimeSeparator;
DecodeTime(frac(abs(AValue)), h, m, s, z);
hrs := h + trunc(abs(AValue))*24;
if z > 499 then inc(s);
if hrs > 0 then
Result := Format('%d%s%.2d%s%.2d', [hrs, ts, m, ts, s])
else
Result := Format('%d%s%.2d', [m, ts, s]);
if AValue < 0.0 then Result := '-' + Result;
end;
*)
{ Creates a "time interval" format string having the first code identifier
in square brackets. }
procedure MakeTimeIntervalMask(Src: String; var Dest: String);
@@ -1079,12 +899,11 @@ end;
{******************************************************************************}
{******************************************************************************}
{ Patch for SysUtils.FormatDateTime }
{ Remove when the feature of square brackets in time format masks is in rtl }
{ Remove when the feature of square brackets in time format masks is in rtl }
{******************************************************************************}
{******************************************************************************}
// Copied from "fpc/rtl/objpas/sysutils/datei.inc"
{ DateTimeToString formats DateTime to the given format in FormatStr }
procedure DateTimeToString(out Result: string; const FormatStr: string; const DateTime: TDateTime;
const FormatSettings: TFormatSettings; Options : TFormatDateTimeOptions = []);
@@ -1428,9 +1247,6 @@ begin
DateTimeToString(Result, FormatStr, DateTime, DefaultFormatSettings, Options);
end;
{ FormatDateTime formats DateTime to the given format string FormatStr }
function FormatDateTime(const FormatStr: string; DateTime: TDateTime;
Options : TFormatDateTimeOptions = []): string;
begin

4
components/fpspreadsheet/tests/numformatparsertests.pas
View File

@@ -149,8 +149,8 @@ var
begin
MyWorkbook := TsWorkbook.Create; // needed to provide the FormatSettings for the parser
try
for i:=0 to 6 do begin
parser := TsNumFormatParser.Create(MyWorkbook, ParserTestData[i].FormatString);
for i:=0 to 5 do begin
parser := TsNumFormatParser.Create(MyWorkbook, ParserTestData[i].FormatString, cdToFPSpreadsheet);
try
CheckEquals(ParserTestData[i].SollFormatString, parser.FormatString,
'Test format string ' + ParserTestData[i].FormatString + ' construction mismatch');

100
components/fpspreadsheet/xlsbiff2.pas
View File

@@ -219,7 +219,7 @@ begin
nfGeneral:
;
nfFixed, nfFixedTh, nfPercentage, nfExp,
nfCurrency, nfCurrencyRed, nfCurrencyDash, nfCurrencyDashRed:
nfCurrency, nfCurrencyRed, nfAccounting, nfAccountingRed:
if ADecimals > 0 then ADecimals := 2;
nfSci:
begin
@@ -266,56 +266,56 @@ var
fmt: String;
begin
case AFormatCell^.NumberFormat of
nfGeneral : Result := 0;
nfFixed : Result := IfThen(AFormatCell^.Decimals = 0, 1, 2);
nfFixedTh : Result := IfThen(AFormatCell^.Decimals = 0, 3, 4);
nfCurrency,
nfCurrencyDash : Result := IfThen(AFormatCell^.Decimals = 0, 5, 7);
nfCurrencyRed,
nfCurrencyDashRed: Result := IfThen(AFormatCell^.Decimals = 0, 6, 8);
nfPercentage : Result := IfThen(AFormatCell^.Decimals = 0, 9, 10);
nfExp, nfSci : Result := 11;
nfShortDate : Result := 12;
nfLongDate : Result := 13;
nfShortTimeAM : Result := 16;
nfLongTimeAM : Result := 17;
nfShortTime : Result := 18;
nfLongTime : Result := 19;
nfShortDateTime : Result := 20;
nfFmtDateTime : begin
fmt := lowercase(AFormatCell^.NumberFormatStr);
if (fmt = 'd-mmm') or (fmt = 'd/mmm') or
(fmt = 'd-mm') or (fmt = 'd/mm') or
(fmt = 'dd-mm') or (fmt = 'dd/mm') or
(fmt = 'dd-mmm') or (fmt = 'dd/mmm')
then
Result := 14
else
if (fmt = 'mmm-yy') or (fmt = 'mmm/yy') or
(fmt = 'mm-yy') or (fmt = 'mm/yy') or
(fmt = 'm-yy') or (fmt = 'm/y') or
(fmt = 'mmm-yyyy') or (fmt = 'mmm/yyyy') or
(fmt = 'mm-yyyy') or (fmt = 'mm/yyyy') or
(fmt = 'm-yyyy') or (fmt = 'm/yyyy')
then
Result := 15
else
if (fmt = 'nn:ss') or (fmt = 'mm:ss') or
(fmt = 'n:ss') or (fmt = 'm:ss')
then
Result := 19
else
if (fmt = 'nn:ss.z') or (fmt = 'mm:ss.z') or
(fmt = 'n:ss.z') or (fmt = 'm:ss.z') or
(fmt = 'nn:ss.zzz') or (fmt = 'mm:ss.zzz') or
(fmt = 'n:ss.zzz') or (fmt = 'm:ss.zzz')
then
Result := 19
else
Result := 20;
end;
nfGeneral,
nfCustom,
nfTimeInterval : Result := 0;
nfTimeInterval : Result := 0;
nfFixed : Result := IfThen(AFormatCell^.Decimals = 0, 1, 2);
nfFixedTh : Result := IfThen(AFormatCell^.Decimals = 0, 3, 4);
nfCurrency,
nfAccounting : Result := IfThen(AFormatCell^.Decimals = 0, 5, 7);
nfCurrencyRed,
nfAccountingRed : Result := IfThen(AFormatCell^.Decimals = 0, 6, 8);
nfPercentage : Result := IfThen(AFormatCell^.Decimals = 0, 9, 10);
nfExp, nfSci : Result := 11;
nfShortDate : Result := 12;
nfLongDate : Result := 13;
nfShortTimeAM : Result := 16;
nfLongTimeAM : Result := 17;
nfShortTime : Result := 18;
nfLongTime : Result := 19;
nfShortDateTime : Result := 20;
nfFmtDateTime : begin
fmt := lowercase(AFormatCell^.NumberFormatStr);
if (fmt = 'd-mmm') or (fmt = 'd/mmm') or
(fmt = 'd-mm') or (fmt = 'd/mm') or
(fmt = 'dd-mm') or (fmt = 'dd/mm') or
(fmt = 'dd-mmm') or (fmt = 'dd/mmm')
then
Result := 14
else
if (fmt = 'mmm-yy') or (fmt = 'mmm/yy') or
(fmt = 'mm-yy') or (fmt = 'mm/yy') or
(fmt = 'm-yy') or (fmt = 'm/y') or
(fmt = 'mmm-yyyy') or (fmt = 'mmm/yyyy') or
(fmt = 'mm-yyyy') or (fmt = 'mm/yyyy') or
(fmt = 'm-yyyy') or (fmt = 'm/yyyy')
then
Result := 15
else
if (fmt = 'nn:ss') or (fmt = 'mm:ss') or
(fmt = 'n:ss') or (fmt = 'm:ss')
then
Result := 19
else
if (fmt = 'nn:ss.z') or (fmt = 'mm:ss.z') or
(fmt = 'n:ss.z') or (fmt = 'm:ss.z') or
(fmt = 'nn:ss.zzz') or (fmt = 'mm:ss.zzz') or
(fmt = 'n:ss.zzz') or (fmt = 'm:ss.zzz')
then
Result := 19
else
Result := 20;
end;
end;
end;

8
components/fpspreadsheet/xlscommon.pas
View File

@@ -567,10 +567,10 @@ begin
AddFormat(38, '_(#,##0_);[Red](#,##0)', nfCurrencyRed, 0);
AddFormat(39, '_(#,##0.00_);(#,##0.00)', nfCurrency, 2);
AddFormat(40, '_(#,##0.00_);[Red](#,##0.00)', nfCurrencyRed, 2);
AddFormat(41, '_("'+cs+'"* #,##0_);_("'+cs+'"* (#,##0);_("'+cs+'"* "-"_);_(@_)', nfCurrencyDash, 0);
AddFormat(42, '_(* #,##0_);_(* (#,##0);_(* "-"_);_(@_)', nfCurrencyDash, 0);
AddFormat(43, '_("'+cs+'"* #,##0.00_);_("'+cs+'"* (#,##0.00);_("'+cs+'"* "-"??_);_(@_)', nfCurrencyDash, 2);
AddFormat(44, '_(* #,##0.00_);_(* (#,##0.00);_(* "-"??_);_(@_)', nfCurrencyDash, 2);
AddFormat(41, '_("'+cs+'"* #,##0_);_("'+cs+'"* (#,##0);_("'+cs+'"* "-"_);_(@_)', nfAccounting, 0);
AddFormat(42, '_(* #,##0_);_(* (#,##0);_(* "-"_);_(@_)', nfAccounting, 0);
AddFormat(43, '_("'+cs+'"* #,##0.00_);_("'+cs+'"* (#,##0.00);_("'+cs+'"* "-"??_);_(@_)', nfAccounting, 2);
AddFormat(44, '_(* #,##0.00_);_(* (#,##0.00);_(* "-"??_);_(@_)', nfAccounting, 2);
AddFormat(45, 'mm:ss', nfFmtDateTime);
AddFormat(46, '[h]:mm:ss', nfTimeInterval);
AddFormat(47, 'mm:ss.0', nfFmtDateTime);