├── .gitignore ├── Demo ├── d1.dpr └── d1.dproj ├── LICENSE.TXT ├── ProjectGroup1.groupproj ├── README.MD ├── packages ├── Excel4DelphiLib.dpk └── Excel4DelphiLib.dproj └── source ├── Excel4Delphi.Common.pas ├── Excel4Delphi.Formula.pas ├── Excel4Delphi.NumberFormats.pas ├── Excel4Delphi.Stream.pas ├── Excel4Delphi.Utils.pas ├── Excel4Delphi.Xml.pas └── Excel4Delphi.pas /.gitignore: -------------------------------------------------------------------------------- 1 | # 2 | # NOTE! Don't add files that are generated in specific 3 | # subdirectories here. Add them in the ".gitignore" file 4 | # in that subdirectory instead. 5 | # 6 | # NOTE! Please use 'git-ls-files -i --exclude-standard' 7 | # command after changing this file, to see if there are 8 | # any tracked files which get ignored after the change. 9 | # 10 | # Normal rules 11 | # 12 | 13 | *.vrc 14 | *.vlb 15 | *.dcu 16 | *.res 17 | *.cfg 18 | *.dcp 19 | *.dsk 20 | *.identcache 21 | *.~dsk 22 | *.hlp 23 | *.gid 24 | *.cnt 25 | *.fts 26 | *.diff 27 | *.stat 28 | *.tmp 29 | 30 | *.pdb 31 | *.vshost.exe.manifest 32 | *.~*~ 33 | *.bak 34 | *.$$$ 35 | 36 | *.inf 37 | *.dat 38 | *.ini 39 | *.exe 40 | *.dll 41 | *.log 42 | *.cbk 43 | *.orig 44 | *.rar 45 | *.zip 46 | 47 | *.dproj.local 48 | 49 | 50 | *.groupproj.local 51 | *.tvsconfig 52 | 53 | *.patch 54 | 55 | */lib/* 56 | */LOG/* 57 | */Skin/* 58 | **/__history/* 59 | **/__recovery/* 60 | **/__astcache/* 61 | _Help/* 62 | -------------------------------------------------------------------------------- /Demo/d1.dpr: -------------------------------------------------------------------------------- 1 | program d1; 2 | 3 | {$APPTYPE CONSOLE} 4 | {$R *.res} 5 | 6 | uses 7 | Excel4Delphi, 8 | Excel4Delphi.Stream, 9 | System.SysUtils; 10 | 11 | procedure CreateNewBook; 12 | // Creating new workbook 13 | var 14 | workBook: TZWorkBook; 15 | begin 16 | workBook := TZWorkBook.Create(nil); 17 | try 18 | workBook.Sheets.Add('My sheet'); 19 | workBook.Sheets[0].ColCount := 10; 20 | workBook.Sheets[0].RowCount := 10; 21 | workBook.Sheets[0].CellRef['A', 0].AsString := 'Hello'; 22 | workBook.Sheets[0].RangeRef['A', 0, 'B', 2].Merge(); 23 | workBook.SaveToFile('file.xlsx'); 24 | finally 25 | workBook.Free(); 26 | end; 27 | end; 28 | 29 | begin 30 | try 31 | { TODO -oUser -cConsole Main : Insert code here } 32 | CreateNewBook; 33 | except 34 | on E: Exception do 35 | Writeln(E.ClassName, ': ', E.Message); 36 | end; 37 | 38 | end. 39 | -------------------------------------------------------------------------------- /Demo/d1.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {816DAEA1-9E11-497C-A824-7E1883933742} 4 | 18.8 5 | FMX 6 | d1.dpr 7 | True 8 | Debug 9 | Win32 10 | 1 11 | Console 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Cfg_1 29 | true 30 | true 31 | 32 | 33 | true 34 | Base 35 | true 36 | 37 | 38 | .\$(Platform)\$(Config) 39 | .\$(Platform)\$(Config) 40 | false 41 | false 42 | false 43 | false 44 | false 45 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 46 | d1 47 | ..\source;$(DCC_UnitSearchPath) 48 | 1033 49 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 50 | 51 | 52 | DBXSqliteDriver;IndyIPCommon;RESTComponents;bindcompdbx;DBXInterBaseDriver;vcl;IndyIPServer;vclactnband;SilpoUa;vclFireDAC;IndySystem;tethering;svnui;dsnapcon;FireDACADSDriver;FireDACMSAccDriver;fmxFireDAC;vclimg;FireDAC;vcltouch;vcldb;bindcompfmx;svn;horse_wizard;FireDACSqliteDriver;FireDACPgDriver;inetdb;soaprtl;DbxCommonDriver;fmx;FireDACIBDriver;fmxdae;xmlrtl;soapmidas;fmxobj;vclwinx;GalaxyComponents;rtl;DbxClientDriver;CustomIPTransport;vcldsnap;dbexpress;IndyCore;DOSCommandDR;vclx;bindcomp;appanalytics;dsnap;fgx;FireDACCommon;IndyIPClient;bindcompvcl;RESTBackendComponents;VCLRESTComponents;soapserver;dbxcds;VclSmp;adortl;vclie;CEF4Delphi_FMX;bindengine;DBXMySQLDriver;CloudService;dsnapxml;FireDACMySQLDriver;dbrtl;IndyProtocols;inetdbxpress;FireDACCommonODBC;FireDACCommonDriver;inet;fmxase;$(DCC_UsePackage) 53 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 54 | Debug 55 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 56 | 1033 57 | true 58 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 59 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 60 | 61 | 62 | DEBUG;$(DCC_Define) 63 | true 64 | false 65 | true 66 | true 67 | true 68 | 69 | 70 | false 71 | 1033 72 | (None) 73 | 74 | 75 | false 76 | RELEASE;$(DCC_Define) 77 | 0 78 | 0 79 | 80 | 81 | 82 | MainSource 83 | 84 | 85 | Cfg_2 86 | Base 87 | 88 | 89 | Base 90 | 91 | 92 | Cfg_1 93 | Base 94 | 95 | 96 | 97 | Delphi.Personality.12 98 | Application 99 | 100 | 101 | 102 | d1.dpr 103 | 104 | 105 | Microsoft Office 2000 Sample Automation Server Wrapper Components 106 | Microsoft Office XP Sample Automation Server Wrapper Components 107 | 108 | 109 | 110 | 111 | 112 | true 113 | 114 | 115 | 116 | 117 | true 118 | 119 | 120 | 121 | 122 | true 123 | 124 | 125 | 126 | 127 | d1.exe 128 | true 129 | 130 | 131 | 132 | 133 | 1 134 | 135 | 136 | Contents\MacOS 137 | 1 138 | 139 | 140 | 0 141 | 142 | 143 | 144 | 145 | classes 146 | 1 147 | 148 | 149 | classes 150 | 1 151 | 152 | 153 | 154 | 155 | res\xml 156 | 1 157 | 158 | 159 | res\xml 160 | 1 161 | 162 | 163 | 164 | 165 | library\lib\armeabi-v7a 166 | 1 167 | 168 | 169 | 170 | 171 | library\lib\armeabi 172 | 1 173 | 174 | 175 | library\lib\armeabi 176 | 1 177 | 178 | 179 | 180 | 181 | library\lib\armeabi-v7a 182 | 1 183 | 184 | 185 | 186 | 187 | library\lib\mips 188 | 1 189 | 190 | 191 | library\lib\mips 192 | 1 193 | 194 | 195 | 196 | 197 | library\lib\armeabi-v7a 198 | 1 199 | 200 | 201 | library\lib\arm64-v8a 202 | 1 203 | 204 | 205 | 206 | 207 | library\lib\armeabi-v7a 208 | 1 209 | 210 | 211 | 212 | 213 | res\drawable 214 | 1 215 | 216 | 217 | res\drawable 218 | 1 219 | 220 | 221 | 222 | 223 | res\values 224 | 1 225 | 226 | 227 | res\values 228 | 1 229 | 230 | 231 | 232 | 233 | res\values-v21 234 | 1 235 | 236 | 237 | res\values-v21 238 | 1 239 | 240 | 241 | 242 | 243 | res\values 244 | 1 245 | 246 | 247 | res\values 248 | 1 249 | 250 | 251 | 252 | 253 | res\drawable 254 | 1 255 | 256 | 257 | res\drawable 258 | 1 259 | 260 | 261 | 262 | 263 | res\drawable-xxhdpi 264 | 1 265 | 266 | 267 | res\drawable-xxhdpi 268 | 1 269 | 270 | 271 | 272 | 273 | res\drawable-ldpi 274 | 1 275 | 276 | 277 | res\drawable-ldpi 278 | 1 279 | 280 | 281 | 282 | 283 | res\drawable-mdpi 284 | 1 285 | 286 | 287 | res\drawable-mdpi 288 | 1 289 | 290 | 291 | 292 | 293 | res\drawable-hdpi 294 | 1 295 | 296 | 297 | res\drawable-hdpi 298 | 1 299 | 300 | 301 | 302 | 303 | res\drawable-xhdpi 304 | 1 305 | 306 | 307 | res\drawable-xhdpi 308 | 1 309 | 310 | 311 | 312 | 313 | res\drawable-mdpi 314 | 1 315 | 316 | 317 | res\drawable-mdpi 318 | 1 319 | 320 | 321 | 322 | 323 | res\drawable-hdpi 324 | 1 325 | 326 | 327 | res\drawable-hdpi 328 | 1 329 | 330 | 331 | 332 | 333 | res\drawable-xhdpi 334 | 1 335 | 336 | 337 | res\drawable-xhdpi 338 | 1 339 | 340 | 341 | 342 | 343 | res\drawable-xxhdpi 344 | 1 345 | 346 | 347 | res\drawable-xxhdpi 348 | 1 349 | 350 | 351 | 352 | 353 | res\drawable-xxxhdpi 354 | 1 355 | 356 | 357 | res\drawable-xxxhdpi 358 | 1 359 | 360 | 361 | 362 | 363 | res\drawable-small 364 | 1 365 | 366 | 367 | res\drawable-small 368 | 1 369 | 370 | 371 | 372 | 373 | res\drawable-normal 374 | 1 375 | 376 | 377 | res\drawable-normal 378 | 1 379 | 380 | 381 | 382 | 383 | res\drawable-large 384 | 1 385 | 386 | 387 | res\drawable-large 388 | 1 389 | 390 | 391 | 392 | 393 | res\drawable-xlarge 394 | 1 395 | 396 | 397 | res\drawable-xlarge 398 | 1 399 | 400 | 401 | 402 | 403 | res\values 404 | 1 405 | 406 | 407 | res\values 408 | 1 409 | 410 | 411 | 412 | 413 | 1 414 | 415 | 416 | Contents\MacOS 417 | 1 418 | 419 | 420 | 0 421 | 422 | 423 | 424 | 425 | Contents\MacOS 426 | 1 427 | .framework 428 | 429 | 430 | Contents\MacOS 431 | 1 432 | .framework 433 | 434 | 435 | 0 436 | 437 | 438 | 439 | 440 | 1 441 | .dylib 442 | 443 | 444 | 1 445 | .dylib 446 | 447 | 448 | 1 449 | .dylib 450 | 451 | 452 | Contents\MacOS 453 | 1 454 | .dylib 455 | 456 | 457 | Contents\MacOS 458 | 1 459 | .dylib 460 | 461 | 462 | 0 463 | .dll;.bpl 464 | 465 | 466 | 467 | 468 | 1 469 | .dylib 470 | 471 | 472 | 1 473 | .dylib 474 | 475 | 476 | 1 477 | .dylib 478 | 479 | 480 | Contents\MacOS 481 | 1 482 | .dylib 483 | 484 | 485 | Contents\MacOS 486 | 1 487 | .dylib 488 | 489 | 490 | 0 491 | .bpl 492 | 493 | 494 | 495 | 496 | 0 497 | 498 | 499 | 0 500 | 501 | 502 | 0 503 | 504 | 505 | 0 506 | 507 | 508 | 0 509 | 510 | 511 | Contents\Resources\StartUp\ 512 | 0 513 | 514 | 515 | Contents\Resources\StartUp\ 516 | 0 517 | 518 | 519 | 0 520 | 521 | 522 | 523 | 524 | 1 525 | 526 | 527 | 1 528 | 529 | 530 | 1 531 | 532 | 533 | 534 | 535 | 1 536 | 537 | 538 | 1 539 | 540 | 541 | 1 542 | 543 | 544 | 545 | 546 | 1 547 | 548 | 549 | 1 550 | 551 | 552 | 1 553 | 554 | 555 | 556 | 557 | 1 558 | 559 | 560 | 1 561 | 562 | 563 | 1 564 | 565 | 566 | 567 | 568 | 1 569 | 570 | 571 | 1 572 | 573 | 574 | 1 575 | 576 | 577 | 578 | 579 | 1 580 | 581 | 582 | 1 583 | 584 | 585 | 1 586 | 587 | 588 | 589 | 590 | 1 591 | 592 | 593 | 1 594 | 595 | 596 | 1 597 | 598 | 599 | 600 | 601 | 1 602 | 603 | 604 | 1 605 | 606 | 607 | 1 608 | 609 | 610 | 611 | 612 | 1 613 | 614 | 615 | 1 616 | 617 | 618 | 1 619 | 620 | 621 | 622 | 623 | 1 624 | 625 | 626 | 1 627 | 628 | 629 | 1 630 | 631 | 632 | 633 | 634 | 1 635 | 636 | 637 | 1 638 | 639 | 640 | 1 641 | 642 | 643 | 644 | 645 | 1 646 | 647 | 648 | 1 649 | 650 | 651 | 1 652 | 653 | 654 | 655 | 656 | 1 657 | 658 | 659 | 1 660 | 661 | 662 | 1 663 | 664 | 665 | 666 | 667 | 1 668 | 669 | 670 | 1 671 | 672 | 673 | 1 674 | 675 | 676 | 677 | 678 | 1 679 | 680 | 681 | 1 682 | 683 | 684 | 1 685 | 686 | 687 | 688 | 689 | 1 690 | 691 | 692 | 1 693 | 694 | 695 | 1 696 | 697 | 698 | 699 | 700 | 1 701 | 702 | 703 | 1 704 | 705 | 706 | 1 707 | 708 | 709 | 710 | 711 | 1 712 | 713 | 714 | 1 715 | 716 | 717 | 1 718 | 719 | 720 | 721 | 722 | 1 723 | 724 | 725 | 1 726 | 727 | 728 | 1 729 | 730 | 731 | 732 | 733 | 1 734 | 735 | 736 | 1 737 | 738 | 739 | 1 740 | 741 | 742 | 743 | 744 | 1 745 | 746 | 747 | 1 748 | 749 | 750 | 1 751 | 752 | 753 | 754 | 755 | 1 756 | 757 | 758 | 1 759 | 760 | 761 | 1 762 | 763 | 764 | 765 | 766 | 1 767 | 768 | 769 | 1 770 | 771 | 772 | 1 773 | 774 | 775 | 776 | 777 | 1 778 | 779 | 780 | 1 781 | 782 | 783 | 1 784 | 785 | 786 | 787 | 788 | 1 789 | 790 | 791 | 1 792 | 793 | 794 | 795 | 796 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 797 | 1 798 | 799 | 800 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 801 | 1 802 | 803 | 804 | 805 | 806 | 1 807 | 808 | 809 | 1 810 | 811 | 812 | 813 | 814 | ..\ 815 | 1 816 | 817 | 818 | ..\ 819 | 1 820 | 821 | 822 | 823 | 824 | 1 825 | 826 | 827 | 1 828 | 829 | 830 | 1 831 | 832 | 833 | 834 | 835 | 1 836 | 837 | 838 | 1 839 | 840 | 841 | 1 842 | 843 | 844 | 845 | 846 | ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF 847 | 1 848 | 849 | 850 | 851 | 852 | ..\ 853 | 1 854 | 855 | 856 | ..\ 857 | 1 858 | 859 | 860 | 861 | 862 | Contents 863 | 1 864 | 865 | 866 | Contents 867 | 1 868 | 869 | 870 | 871 | 872 | Contents\Resources 873 | 1 874 | 875 | 876 | Contents\Resources 877 | 1 878 | 879 | 880 | 881 | 882 | library\lib\armeabi-v7a 883 | 1 884 | 885 | 886 | library\lib\arm64-v8a 887 | 1 888 | 889 | 890 | 1 891 | 892 | 893 | 1 894 | 895 | 896 | 1 897 | 898 | 899 | 1 900 | 901 | 902 | Contents\MacOS 903 | 1 904 | 905 | 906 | Contents\MacOS 907 | 1 908 | 909 | 910 | 0 911 | 912 | 913 | 914 | 915 | library\lib\armeabi-v7a 916 | 1 917 | 918 | 919 | 920 | 921 | 1 922 | 923 | 924 | 1 925 | 926 | 927 | 928 | 929 | Assets 930 | 1 931 | 932 | 933 | Assets 934 | 1 935 | 936 | 937 | 938 | 939 | Assets 940 | 1 941 | 942 | 943 | Assets 944 | 1 945 | 946 | 947 | 948 | 949 | 950 | 951 | 952 | 953 | 954 | 955 | 956 | 957 | 958 | 959 | True 960 | 961 | 962 | 12 963 | 964 | 965 | 966 | 967 | 968 | -------------------------------------------------------------------------------- /LICENSE.TXT: -------------------------------------------------------------------------------- 1 | Copyright (C) 2012 Ruslan Neborak 2 | 3 | Read/write xlsx (Office Open XML file format (Spreadsheet)) 4 | Author: Ruslan V. Neborak 5 | e-mail: avemey@tut.by 6 | URL: http://avemey.com 7 | License: zlib 8 | Last update: 2016.07.03 9 | 10 | This software is provided 'as-is', without any express or implied 11 | warranty. In no event will the authors be held liable for any damages 12 | arising from the use of this software. 13 | 14 | Permission is granted to anyone to use this software for any purpose, 15 | including commercial applications, and to alter it and redistribute it 16 | freely, subject to the following restrictions: 17 | 18 | 1. The origin of this software must not be misrepresented; you must not 19 | claim that you wrote the original software. If you use this software 20 | in a product, an acknowledgment in the product documentation would be 21 | appreciated but is not required. 22 | 23 | 2. Altered source versions must be plainly marked as such, and must not be 24 | misrepresented as being the original software. 25 | 26 | 3. This notice may not be removed or altered from any source 27 | distribution. -------------------------------------------------------------------------------- /ProjectGroup1.groupproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {C109B1B1-616E-4033-A1CA-7BB780922A8C} 4 | 5 | 6 | 7 | 8 | 9 | 10 | packages\Excel4DelphiLib.dproj 11 | 12 | 13 | 14 | Default.Personality.12 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | -------------------------------------------------------------------------------- /README.MD: -------------------------------------------------------------------------------- 1 | 2 | # Excel4Delphi 3 | Read, Write excel 2002/2003 XML (SpreadsheetML / XML Spreadsheet) library. 4 | 5 | fork from https://github.com/Avemey/zexmlss 6 | 7 | ## Exchamples 8 | 9 | ```pas 10 | // Creating new workbook 11 | var workBook: TZWorkBook; 12 | ... 13 | workBook := TZWorkBook.Create(); 14 | try 15 | workBook.Sheets.Add('My sheet'); 16 | workBook.Sheets[0].ColCount := 10; 17 | workBook.Sheets[0].RowCount := 10; 18 | workBook.Sheets[0].CellRef['A', 0].AsString := 'Hello'; 19 | workBook.Sheets[0].RangeRef['A', 0, 'B', 2].Merge(); 20 | workBook.SaveToFile('file.xlsx'); 21 | finally 22 | workBook.Free(); 23 | end 24 | ``` 25 | 26 | ```pas 27 | // Editing exists workbook 28 | var workBook: TZWorkBook; 29 | ... 30 | workBook := TZWorkBook.Create(); 31 | try 32 | workBook.LoadFromFile('file.xlsx'); 33 | workBook.Sheets[0].CellRef['A', 0].AsString := 'Hello'; 34 | workBook.Sheets[0].CellRef['A', 0].FontStyle := [fsBold]; 35 | workBook.SaveToFile('file.xlsx'); 36 | finally 37 | workBook.Free(); 38 | end 39 | ``` -------------------------------------------------------------------------------- /packages/Excel4DelphiLib.dpk: -------------------------------------------------------------------------------- 1 | package Excel4DelphiLib; 2 | 3 | {$IFDEF IMPLICITBUILDING This IFDEF should not be used by users} 4 | {$ALIGN 8} 5 | {$ASSERTIONS ON} 6 | {$BOOLEVAL OFF} 7 | {$DEBUGINFO OFF} 8 | {$EXTENDEDSYNTAX ON} 9 | {$IMPORTEDDATA ON} 10 | {$IOCHECKS ON} 11 | {$LOCALSYMBOLS ON} 12 | {$LONGSTRINGS ON} 13 | {$OPENSTRINGS ON} 14 | {$OPTIMIZATION OFF} 15 | {$OVERFLOWCHECKS OFF} 16 | {$RANGECHECKS OFF} 17 | {$REFERENCEINFO ON} 18 | {$SAFEDIVIDE OFF} 19 | {$STACKFRAMES ON} 20 | {$TYPEDADDRESS OFF} 21 | {$VARSTRINGCHECKS ON} 22 | {$WRITEABLECONST ON} 23 | {$MINENUMSIZE 1} 24 | {$IMAGEBASE $400000} 25 | {$DEFINE DEBUG} 26 | {$ENDIF IMPLICITBUILDING} 27 | {$DESCRIPTION 'Excel4Delphi Component'} 28 | {$IMPLICITBUILD ON} 29 | 30 | requires 31 | vcl; 32 | 33 | contains 34 | Excel4Delphi in '..\source\Excel4Delphi.pas', 35 | Excel4Delphi.Xml in '..\source\Excel4Delphi.Xml.pas', 36 | Excel4Delphi.Common in '..\source\Excel4Delphi.Common.pas', 37 | Excel4Delphi.Formula in '..\source\Excel4Delphi.Formula.pas', 38 | Excel4Delphi.Utils in '..\source\Excel4Delphi.Utils.pas', 39 | Excel4Delphi.Stream in '..\source\Excel4Delphi.Stream.pas', 40 | Excel4Delphi.NumberFormats in '..\source\Excel4Delphi.NumberFormats.pas'; 41 | 42 | end. 43 | -------------------------------------------------------------------------------- /packages/Excel4DelphiLib.dproj: -------------------------------------------------------------------------------- 1 | 2 | 3 | {24D460A3-E03B-4BE3-AEE9-B3212F356CCD} 4 | Excel4DelphiLib.dpk 5 | True 6 | Debug 7 | 4225 8 | Package 9 | VCL 10 | 19.2 11 | Win32 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_2 34 | true 35 | true 36 | 37 | 38 | false 39 | false 40 | false 41 | false 42 | false 43 | 00400000 44 | true 45 | true 46 | Excel4DelphiLib 47 | Excel4Delphi Component 48 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;DUnitX.Loggers.GUI;Winapi;$(DCC_Namespace) 49 | 1049 50 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= 51 | 52 | 53 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 54 | Debug 55 | true 56 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 57 | 1033 58 | 59 | 60 | RELEASE;$(DCC_Define) 61 | 0 62 | false 63 | 0 64 | 65 | 66 | DEBUG;$(DCC_Define) 67 | false 68 | true 69 | 70 | 71 | Debug 72 | 73 | 74 | 75 | MainSource 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | Cfg_2 87 | Base 88 | 89 | 90 | Base 91 | 92 | 93 | Cfg_1 94 | Base 95 | 96 | 97 | 98 | Delphi.Personality.12 99 | Package 100 | 101 | 102 | 103 | Excel4DelphiLib.dpk 104 | 105 | 106 | 107 | False 108 | False 109 | False 110 | True 111 | True 112 | True 113 | False 114 | 115 | 116 | 12 117 | 118 | 119 | 120 | 121 | -------------------------------------------------------------------------------- /source/Excel4Delphi.Common.pas: -------------------------------------------------------------------------------- 1 | unit Excel4Delphi.Common; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.Types, System.Classes, Excel4Delphi, Excel4Delphi.Xml; 7 | 8 | const 9 | ZE_MMinInch: real = 25.4; 10 | 11 | type 12 | TTempFileStream = class(THandleStream) 13 | private 14 | FFileName: string; 15 | public 16 | constructor Create(); 17 | destructor Destroy; override; 18 | property FileName: string read FFileName; 19 | end; 20 | 21 | // Попытка преобразовать строку в число 22 | function ZEIsTryStrToFloat(const st: string; out retValue: double): boolean; 23 | function ZETryStrToFloat(const st: string; valueIfError: double = 0): double; overload; 24 | function ZETryStrToFloat(const st: string; out isOk: boolean; valueIfError: double = 0): double; overload; 25 | 26 | // Попытка преобразовать строку в boolean 27 | function ZETryStrToBoolean(const st: string; valueIfError: boolean = false): boolean; 28 | 29 | // заменяет все запятые на точки 30 | function ZEFloatSeparator(st: string): string; 31 | 32 | // Проверяет заголовки страниц, при необходимости корректирует 33 | function ZECheckTablesTitle(var XMLSS: TZWorkBook; const SheetsNumbers: array of integer; 34 | const SheetsNames: array of string; out _pages: TIntegerDynArray; out _names: TStringDynArray; 35 | out retCount: integer): boolean; 36 | 37 | // Очищает массивы 38 | procedure ZESClearArrays(var _pages: TIntegerDynArray; var _names: TStringDynArray); 39 | 40 | // Переводит строку в boolean 41 | function ZEStrToBoolean(const val: string): boolean; 42 | 43 | // Заменяет в строке последовательности на спецсимволы 44 | function ZEReplaceEntity(const st: string): string; 45 | 46 | // despite formal angle datatype declaration in default "range check off" mode 47 | // it can be anywhere -32K to +32K 48 | // This fn brings it back into -90 .. +90 range 49 | function ZENormalizeAngle90(const value: TZCellTextRotate): integer; 50 | 51 | ///

52 | /// Despite formal angle datatype declaration in default "range check off" mode it can be anywhere -32K to +32K 53 | /// This fn brings it back into 0 .. +179 range 54 | ///

55 | function ZENormalizeAngle180(const value: TZCellTextRotate): integer; 56 | 57 | implementation 58 | 59 | uses 60 | {$IFDEF MSWINDOWS} 61 | Winapi.windows, 62 | {$ENDIF} 63 | System.DateUtils, System.IOUtils; 64 | 65 | function FileCreateTemp(var tempName: string): THandle; 66 | {$IFNDEF MSWINDOWS} 67 | var 68 | FS: TFileStream; 69 | {$ENDIF} 70 | begin 71 | Result := INVALID_HANDLE_VALUE; 72 | tempName := TPath.GetTempFileName(); 73 | if tempName <> '' then 74 | begin 75 | {$IFDEF MSWINDOWS} 76 | Result := CreateFile(PChar(tempName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, 77 | FILE_ATTRIBUTE_TEMPORARY or FILE_FLAG_DELETE_ON_CLOSE, 0); 78 | {$ELSE} 79 | Result := FileCreate(tempName, fmCreate); 80 | {$ENDIF} 81 | if Result = INVALID_HANDLE_VALUE then 82 | TFile.Delete(tempName); 83 | end; 84 | end; 85 | 86 | constructor TTempFileStream.Create(); 87 | var 88 | FileHandle: THandle; 89 | begin 90 | FileHandle := FileCreateTemp(FFileName); 91 | if FileHandle = INVALID_HANDLE_VALUE then 92 | raise Exception.Create('Не удалось создать временный файл'); 93 | inherited Create(FileHandle); 94 | end; 95 | 96 | destructor TTempFileStream.Destroy; 97 | begin 98 | if THandle(Handle) <> INVALID_HANDLE_VALUE then 99 | FileClose(Handle); 100 | inherited Destroy; 101 | end; 102 | 103 | // despite formal angle datatype declaration in default "range check off" mode 104 | // it can be anywhere -32K to +32K 105 | // This fn brings it back into -90 .. +90 range for Excel XML 106 | function ZENormalizeAngle90(const value: TZCellTextRotate): integer; 107 | var 108 | Neg: boolean; 109 | A: integer; 110 | begin 111 | if (value >= -90) and (value <= +90) then 112 | Result := value 113 | else 114 | begin (* Special values: 270; 450; -450; 180; -180; 135 *) 115 | Neg := value < 0; (* F, F, T, F, T, F *) 116 | A := Abs(value) mod 360; // 0..359 (* 270, 90, 90, 180, 180, 135 *) 117 | if A > 180 then 118 | A := A - 360; // -179..+180 (* -90, 90, 90, 180, 180, 135 *) 119 | if A < 0 then 120 | begin 121 | Neg := not Neg; (* T, -"- F, T, F, T, F *) 122 | A := -A; // 0..180 (* 90, -"- 90, 90, 180, 180, 135 *) 123 | end; 124 | if A > 90 then 125 | A := A - 180; // 91..180 -> -89..0 (* 90, 90, 90, 0, 0, -45 *) 126 | Result := A; 127 | If Neg then 128 | Result := -Result; (* -90, +90, -90, 0, 0, -45 *) 129 | end; 130 | end; 131 | 132 | // despite formal angle datatype declaration in default "range check off" mode 133 | // it can be anywhere -32K to +32K 134 | // This fn brings it back into 0 .. +180 range 135 | function ZENormalizeAngle180(const value: TZCellTextRotate): integer; 136 | begin 137 | Result := ZENormalizeAngle90(value); 138 | If Result < 0 then 139 | Result := 90 - Result; 140 | end; 141 | 142 | // Заменяет в строке последовательности на спецсимволы 143 | // INPUT 144 | // const st: string - входящая строка 145 | // RETURN 146 | // string - обработанная строка 147 | function ZEReplaceEntity(const st: string): string; 148 | var 149 | s, s1: string; 150 | i: integer; 151 | isAmp: boolean; 152 | ch: char; 153 | 154 | procedure CheckS(); 155 | begin 156 | s1 := UpperCase(s); 157 | if (s1 = '>') then 158 | s := '>' 159 | else if (s1 = '<') then 160 | s := '<' 161 | else if (s1 = '&') then 162 | s := '&' 163 | else if (s1 = '&APOS;') then 164 | s := '''' 165 | else if (s1 = '"') then 166 | s := '"'; 167 | end; // _checkS 168 | 169 | begin 170 | s := ''; 171 | Result := ''; 172 | isAmp := false; 173 | for i := 1 to length(st) do 174 | begin 175 | ch := st[i]; 176 | case ch of 177 | '&': 178 | begin 179 | if (isAmp) then 180 | begin 181 | Result := Result + s; 182 | s := ch; 183 | end 184 | else 185 | begin 186 | isAmp := true; 187 | s := ch; 188 | end; 189 | end; 190 | ';': 191 | begin 192 | if (isAmp) then 193 | begin 194 | s := s + ch; 195 | CheckS(); 196 | Result := Result + s; 197 | s := ''; 198 | isAmp := false; 199 | end 200 | else 201 | begin 202 | Result := Result + s + ch; 203 | s := ''; 204 | end; 205 | end; 206 | else 207 | if (isAmp) then 208 | s := s + ch 209 | else 210 | Result := Result + ch; 211 | end; // case 212 | end; // for 213 | if (s > '') then 214 | begin 215 | CheckS(); 216 | Result := Result + s; 217 | end; 218 | end; // ZEReplaceEntity 219 | 220 | // Переводит строку в boolean 221 | // INPUT 222 | // const val: string - переводимая строка 223 | function ZEStrToBoolean(const val: string): boolean; 224 | begin 225 | if (val = '1') or (UpperCase(val) = 'TRUE') then 226 | Result := true 227 | else 228 | Result := false; 229 | end; 230 | 231 | // Попытка преобразовать строку в boolean 232 | // const st: string - строка для распознавания 233 | // valueIfError: boolean - значение, которое подставляется при ошибке преобразования 234 | function ZETryStrToBoolean(const st: string; valueIfError: boolean = false): boolean; 235 | begin 236 | Result := valueIfError; 237 | if (st > '') then 238 | begin 239 | if (CharInSet(st[1], ['T', 't', '1', '-'])) then 240 | Result := true 241 | else if (CharInSet(st[1], ['F', 'f', '0'])) then 242 | Result := false 243 | else 244 | Result := valueIfError; 245 | end; 246 | end; // ZETryStrToBoolean 247 | 248 | function ZEIsTryStrToFloat(const st: string; out retValue: double): boolean; 249 | begin 250 | retValue := ZETryStrToFloat(st, Result); 251 | end; 252 | 253 | // Попытка преобразовать строку в число 254 | // INPUT 255 | // const st: string - строка 256 | // out isOk: boolean - если true - ошибки небыло 257 | // valueIfError: double - значение, которое подставляется при ошибке преобразования 258 | function ZETryStrToFloat(const st: string; out isOk: boolean; valueIfError: double = 0): double; 259 | var 260 | s: string; 261 | i: integer; 262 | begin 263 | Result := 0; 264 | isOk := true; 265 | if (length(trim(st)) <> 0) then 266 | begin 267 | s := ''; 268 | for i := 1 to length(st) do 269 | if (CharInSet(st[i], ['.', ','])) then 270 | s := s + FormatSettings.DecimalSeparator 271 | else if (st[i] <> ' ') then 272 | s := s + st[i]; 273 | 274 | isOk := TryStrToFloat(s, Result); 275 | if (not isOk) then 276 | Result := valueIfError; 277 | end; 278 | end; // ZETryStrToFloat 279 | 280 | // Попытка преобразовать строку в число 281 | // INPUT 282 | // const st: string - строка 283 | // valueIfError: double - значение, которое подставляется при ошибке преобразования 284 | function ZETryStrToFloat(const st: string; valueIfError: double = 0): double; 285 | var 286 | s: string; 287 | i: integer; 288 | begin 289 | Result := 0; 290 | if (trim(st) <> '') then 291 | begin 292 | s := ''; 293 | for i := 1 to length(st) do 294 | if (CharInSet(st[i], ['.', ','])) then 295 | s := s + FormatSettings.DecimalSeparator 296 | else if (st[i] <> ' ') then 297 | s := s + st[i]; 298 | try 299 | Result := StrToFloat(s); 300 | except 301 | Result := valueIfError; 302 | end; 303 | end; 304 | end; // ZETryStrToFloat 305 | 306 | // заменяет все запятые на точки 307 | function ZEFloatSeparator(st: string): string; 308 | var 309 | k: integer; 310 | begin 311 | Result := ''; 312 | for k := 1 to length(st) do 313 | if (st[k] = ',') then 314 | Result := Result + '.' 315 | else 316 | Result := Result + st[k]; 317 | end; 318 | 319 | // Очищает массивы 320 | procedure ZESClearArrays(var _pages: TIntegerDynArray; var _names: TStringDynArray); 321 | begin 322 | SetLength(_pages, 0); 323 | SetLength(_names, 0); 324 | _names := nil; 325 | _pages := nil; 326 | end; 327 | 328 | resourcestring 329 | DefaultSheetName = 'Sheet'; 330 | 331 | // делает уникальную строку, добавляя к строке '(num)' 332 | // топорно, но работает 333 | // INPUT 334 | // var st: string - строка 335 | // n: integer - номер 336 | procedure ZECorrectStrForSave(var st: string; n: integer); 337 | var 338 | l, i, m, num: integer; 339 | s: string; 340 | begin 341 | if trim(st) = '' then 342 | st := DefaultSheetName; // behave uniformly with ZECheckTablesTitle 343 | 344 | l := length(st); 345 | if st[l] <> ')' then 346 | st := st + '(' + inttostr(n) + ')' 347 | else 348 | begin 349 | m := l; 350 | for i := l downto 1 do 351 | if st[i] = '(' then 352 | begin 353 | m := i; 354 | break; 355 | end; 356 | if m <> l then 357 | begin 358 | s := copy(st, m + 1, l - m - 1); 359 | try 360 | num := StrToInt(s) + 1; 361 | except 362 | num := n; 363 | end; 364 | Delete(st, m, l - m + 1); 365 | st := st + '(' + inttostr(num) + ')'; 366 | end 367 | else 368 | st := st + '(' + inttostr(n) + ')'; 369 | end; 370 | end; // ZECorrectStrForSave 371 | 372 | // делаем уникальные значения массивов 373 | // INPUT 374 | // var mas: array of string - массив со значениями 375 | procedure ZECorrectTitles(var mas: array of string); 376 | var 377 | i, num, k, _kol: integer; 378 | s: string; 379 | begin 380 | num := 0; 381 | _kol := High(mas); 382 | while (num < _kol) do 383 | begin 384 | s := UpperCase(mas[num]); 385 | k := 0; 386 | for i := num + 1 to _kol do 387 | begin 388 | if (s = UpperCase(mas[i])) then 389 | begin 390 | inc(k); 391 | ZECorrectStrForSave(mas[i], k); 392 | end; 393 | end; 394 | inc(num); 395 | if k > 0 then 396 | num := 0; 397 | end; 398 | end; // CorrectTitles 399 | 400 | // Проверяет заголовки страниц, при необходимости корректирует 401 | // INPUT 402 | // var XMLSS: TZWorkBook 403 | // const SheetsNumbers:array of integer 404 | // const SheetsNames: array of string 405 | // var _pages: TIntegerDynArray 406 | // var _names: TStringDynArray 407 | // var retCount: integer 408 | // RETURN 409 | // boolean - true - всё нормально, можно продолжать дальше 410 | // false - что-то не то подсунули, дальше продолжать нельзя 411 | function ZECheckTablesTitle(var XMLSS: TZWorkBook; const SheetsNumbers: array of integer; 412 | const SheetsNames: array of string; out _pages: TIntegerDynArray; out _names: TStringDynArray; 413 | out retCount: integer): boolean; 414 | var 415 | t1, t2, i: integer; 416 | // '!' is allowed; ':' is not; whatever else ? 417 | procedure SanitizeTitle(var s: string); 418 | var 419 | i: integer; 420 | begin 421 | s := trim(s); 422 | for i := 1 to length(s) do 423 | if s[i] = ':' then 424 | s[i] := ';'; 425 | end; 426 | function CoalesceTitle(const i: integer; const checkArray: boolean): string; 427 | begin 428 | if checkArray then 429 | begin 430 | Result := SheetsNames[i]; 431 | SanitizeTitle(Result); 432 | end 433 | else 434 | Result := ''; 435 | 436 | if Result = '' then 437 | begin 438 | Result := XMLSS.Sheets[_pages[i]].Title; 439 | SanitizeTitle(Result); 440 | end; 441 | 442 | if Result = '' then 443 | Result := DefaultSheetName + ' ' + inttostr(_pages[i] + 1); 444 | end; 445 | 446 | begin 447 | Result := false; 448 | t1 := Low(SheetsNumbers); 449 | t2 := High(SheetsNumbers); 450 | retCount := 0; 451 | // если пришёл пустой массив SheetsNumbers - берём все страницы из Sheets 452 | if t1 = t2 + 1 then 453 | begin 454 | retCount := XMLSS.Sheets.Count; 455 | SetLength(_pages, retCount); 456 | for i := 0 to retCount - 1 do 457 | _pages[i] := i; 458 | end 459 | else 460 | begin 461 | // иначе берём страницы из массива SheetsNumbers 462 | for i := t1 to t2 do 463 | begin 464 | if (SheetsNumbers[i] >= 0) and (SheetsNumbers[i] < XMLSS.Sheets.Count) then 465 | begin 466 | inc(retCount); 467 | SetLength(_pages, retCount); 468 | _pages[retCount - 1] := SheetsNumbers[i]; 469 | end; 470 | end; 471 | end; 472 | 473 | if (retCount <= 0) then 474 | exit; 475 | 476 | // названия страниц 477 | // t1 := Low(SheetsNames); // we anyway assume later that Low(_names) == t1 - then let us just skip this. 478 | t2 := High(SheetsNames); 479 | SetLength(_names, retCount); 480 | // if t1 = t2 + 1 then 481 | // begin 482 | // for i := 0 to retCount - 1 do 483 | // begin 484 | // _names[i] := XMLSS.Sheets[_pages[i]].Title; 485 | // if trim(_names[i]) = '' then _names[i] := 'list'; 486 | // end; 487 | // end else 488 | // begin 489 | // if (t2 > retCount) then 490 | // t2 := retCount - 1; 491 | // for i := t1 to t2 do 492 | // _names[i] := SheetsNames[i]; 493 | // if (t2 < retCount) then 494 | // for i := t2 + 1 to retCount - 1 do 495 | // begin 496 | // _names[i] := XMLSS.Sheets[_pages[i]].Title; 497 | // if trim(_names[i]) = '' then _names[i] := 'list'; 498 | // end; 499 | // end; 500 | for i := Low(_names) to High(_names) do 501 | begin 502 | _names[i] := CoalesceTitle(i, i <= t2); 503 | end; 504 | 505 | ZECorrectTitles(_names); 506 | Result := true; 507 | end; // ZECheckTablesTitle 508 | 509 | end. 510 | -------------------------------------------------------------------------------- /source/Excel4Delphi.Formula.pas: -------------------------------------------------------------------------------- 1 | unit Excel4Delphi.Formula; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils; 7 | 8 | const 9 | // ZE_RTA = ZE R1C1 to A1 10 | ZE_RTA_ODF = 1; // преобразовывать для ODF (=[.A1] + [.B1]) 11 | ZE_RTA_ODF_PREFIX = 2; // добавлять префикс для ODF, если первый символ в формуле '=' (of:=[.A1] + [.B1]) 12 | ZE_RTA_NO_ABSOLUTE = 4; // все абсолютные ссылки заменять на относительные (R1C1 => A1) (относительные не меняет) 13 | ZE_RTA_ONLY_ABSOLUTE = 8; // все относительные ссылки заменять на абсолютные (R[1]C[1] => $C$3) (абсолютные не меняет) 14 | ZE_RTA_ODF_NO_BRACKET = $10; // Для ODF, но не добавлять квадратные скобки, разделитель лист/ячейка - точка ".". 15 | ZE_ATR_DEL_PREFIX = 1; // Удалять все символы до первого '=' 16 | 17 | function ZEGetA1byCol(ColNum: integer; StartZero: boolean = true): string; 18 | function ZERangeToRow(range: string): integer; 19 | function ZEGetColByA1(AA: string; StartZero: boolean = true): integer; 20 | function ZER1C1ToA1(const Formula: string; CurCol, CurRow: integer; options: integer; 21 | StartZero: boolean = true): string; 22 | function ZEA1ToR1C1(const Formula: string; CurCol, CurRow: integer; options: integer; 23 | StartZero: boolean = true): string; 24 | function ZEGetCellCoords(const cell: string; out column, row: integer; StartZero: boolean = true): boolean; 25 | 26 | implementation 27 | 28 | const 29 | ZE_STR_ARRAY: array [0 .. 25] of char = ('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 30 | 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z'); 31 | 32 | // Получает номер строки и столбца по строковому значению (для A1 стилей) 33 | // INPUT 34 | // const cell: string - номер ячейки в A1 стиле 35 | // out column: integer - возвращаемый номер столбца 36 | // out row: integer - возвращаемый номер строки 37 | // StartZero: boolean - признак нумерации с нуля 38 | // RETURN 39 | // boolean - true - координаты успешно определены 40 | function ZEGetCellCoords(const cell: string; out column, row: integer; StartZero: boolean = true): boolean; 41 | var 42 | i: integer; 43 | s1, s2: string; 44 | _isOk: boolean; 45 | b: boolean; 46 | 47 | begin 48 | _isOk := true; 49 | s1 := ''; 50 | s2 := ''; 51 | b := false; 52 | for i := 1 to length(cell) do 53 | case cell[i] of 54 | 'A' .. 'Z', 'a' .. 'z': 55 | begin 56 | s1 := s1 + cell[i]; 57 | b := true; 58 | end; 59 | '0' .. '9': 60 | begin 61 | if (not b) then 62 | begin 63 | _isOk := false; 64 | break; 65 | end; 66 | s2 := s2 + cell[i]; 67 | end; 68 | else 69 | begin 70 | _isOk := false; 71 | break; 72 | end; 73 | end; 74 | if (_isOk) then 75 | begin 76 | if (not TryStrToInt(s2, row)) then 77 | _isOk := false 78 | else 79 | begin 80 | if (StartZero) then 81 | dec(row); 82 | column := ZEGetColByA1(s1, StartZero); 83 | if (column < 0) then 84 | _isOk := false; 85 | end; 86 | end; 87 | result := _isOk; 88 | end; // ZEGetCellCoords 89 | 90 | // Попытка преобразовать номер ячейки из R1C1 в A1 стиль 91 | // если не удалось распознать номер ячейки, то возвратит обратно тот же текст 92 | // INPUT 93 | // const st: string - предположительно номер ячеки (диапазон) 94 | // CurCol: integer - номер столбца ячейки 95 | // CurRow: integer - номер строки ячейки 96 | // options: integer - параметры преобразования 97 | // StartZero: boolean - признак нумерации с нуля 98 | // RETURN 99 | // string - номер ячейки в стиле A1 100 | function ReturnA1(const st: string; CurCol, CurRow: integer; options: integer; StartZero: boolean = true): string; 101 | var 102 | s: string; 103 | i, kol: integer; 104 | retTxt: string; 105 | isApos: boolean; 106 | t: integer; 107 | isList: boolean; 108 | isODF: boolean; 109 | isSq: boolean; 110 | isOk: boolean; 111 | isNumber: boolean; 112 | isR, isC: boolean; 113 | isNotLast: boolean; 114 | _c, _r: string; 115 | is_only_absolute: boolean; 116 | is_no_absolute: boolean; 117 | isDelim: boolean; 118 | _num: integer; 119 | _use_bracket: boolean; 120 | 121 | // Возвращает строку 122 | procedure _getR(num: integer); 123 | begin 124 | if (isSq or (num = 0)) then 125 | num := CurRow + num; 126 | if (is_only_absolute and isSq) then 127 | isSq := false 128 | else if (is_no_absolute and (not isSq)) then 129 | isSq := true; 130 | _r := IntToStr(num); 131 | if (not isSq) then 132 | _r := '$' + _r; 133 | isNumber := false; 134 | inc(_num); 135 | end; // _getR 136 | 137 | // Возвращает столбец 138 | procedure _getC(num: integer); 139 | begin 140 | if (isSq or (num = 0)) then 141 | num := CurCol + num; 142 | if (is_only_absolute and isSq) then 143 | isSq := false 144 | else if (is_no_absolute and (not isSq)) then 145 | isSq := true; 146 | _c := ZEGetA1byCol(num, false); 147 | if (not isSq) then 148 | _c := '$' + _c; 149 | isNumber := false; 150 | inc(_num); 151 | end; // _getС 152 | 153 | // Проверяет символ 154 | procedure _checksymbol(ch: char); 155 | begin 156 | if (isApos) then 157 | begin 158 | if (ch <> '''') then 159 | begin 160 | s := s + ch; 161 | exit; 162 | end; 163 | end 164 | else 165 | begin 166 | if (isNumber) then 167 | begin 168 | if (not CharInSet(ch, ['-', '0' .. '9', ']', '[', ''''])) then 169 | begin 170 | if (not(isC xor isR)) then 171 | begin 172 | isOk := false; 173 | exit; 174 | end; 175 | if (not TryStrToInt(s, t)) then 176 | begin 177 | isOk := false; 178 | exit; 179 | end; 180 | 181 | if (isC) then 182 | _getC(t); 183 | if (isR) then 184 | _getR(t); 185 | isSq := false; 186 | s := ''; 187 | end; 188 | end 189 | else // if (isNumber) 190 | begin 191 | // если адрес: RC (без чисел - нули) 192 | if (isR and CharInSet(ch, ['C', 'c'])) then 193 | begin 194 | _getR(0); 195 | s := ''; 196 | isSq := false; 197 | end 198 | else if (isC and (not isNotLast)) then 199 | begin 200 | _getC(0); 201 | s := ''; 202 | isSq := false; 203 | end; 204 | end; 205 | end; 206 | case ch of 207 | '''': 208 | begin 209 | s := s + ch; 210 | isApos := not isApos; 211 | end; 212 | '[': { хм.. } 213 | ; 214 | ']': 215 | isSq := true; 216 | 'R', 'r': 217 | begin 218 | // R - ok, CR - что-то не то 219 | if (isR or isC) then 220 | isOk := false; 221 | isR := true; 222 | s := ''; 223 | isDelim := false; 224 | end; 225 | 'C', 'c': 226 | begin 227 | if (isC or (not isR)) then 228 | isOk := false 229 | else 230 | begin 231 | isC := true; 232 | isR := false; 233 | end; 234 | s := ''; 235 | isDelim := false; 236 | end; 237 | '-', '0' .. '9': 238 | begin 239 | s := s + ch; 240 | if (isC or isR) then 241 | if (not isNumber) then 242 | isNumber := true; 243 | end; 244 | '!': // разделитель страницы 245 | begin 246 | retTxt := retTxt + s; 247 | if (isODF) then // ODF 248 | retTxt := retTxt + '.' 249 | else 250 | retTxt := retTxt + ch; 251 | s := ''; 252 | isList := true; 253 | isDelim := false; 254 | end; 255 | else 256 | if (isDelim and isNotLast) then 257 | s := s + ch 258 | else if (isNotLast) then 259 | isOk := false; // O_o - вроде как не ячейка, выходим и возвращаем всё как есть 260 | end; // case 261 | end; // _checksymbol 262 | 263 | begin 264 | result := ''; 265 | if (TryStrToInt(st, t)) then 266 | begin 267 | result := st; 268 | exit; 269 | end; 270 | kol := length(st); 271 | s := ''; 272 | retTxt := ''; 273 | isApos := false; 274 | isList := false; 275 | isSq := false; 276 | isOk := true; 277 | isNumber := false; 278 | isR := false; 279 | isC := false; 280 | isNotLast := true; 281 | isDelim := true; 282 | _c := ''; 283 | _r := ''; 284 | _num := 0; 285 | 286 | is_no_absolute := (options and ZE_RTA_NO_ABSOLUTE = ZE_RTA_NO_ABSOLUTE); 287 | is_only_absolute := (options and ZE_RTA_ONLY_ABSOLUTE = ZE_RTA_ONLY_ABSOLUTE); 288 | isODF := (options and ZE_RTA_ODF = ZE_RTA_ODF); 289 | for i := 1 to kol do 290 | begin 291 | _checksymbol(st[i]); 292 | if (not isOk) then 293 | break; 294 | end; 295 | isNotLast := false; 296 | // нужно подумать, что делать, если было не 2 преобразования 297 | if ((kol <= 0) or (_num = 0)) then 298 | isOk := false; 299 | _checksymbol(';'); 300 | if (not isOk) then 301 | begin 302 | result := st; 303 | exit; 304 | end; 305 | result := retTxt + _c + _r + s; 306 | _use_bracket := not(options and ZE_RTA_ODF_NO_BRACKET = ZE_RTA_ODF_NO_BRACKET); 307 | if (isODF and _use_bracket) then 308 | begin 309 | if (not isList) then 310 | result := '.' + result; 311 | result := '[' + result + ']'; 312 | end; 313 | end; // ReturnA1 314 | 315 | // Переводит формулу из стиля R1C1 в стиль A1 316 | // INPUT 317 | // const formula: string - формула в стиле R1C1 318 | // CurRow: integer - номер строки ячейки 319 | // CurCol: integer - номер столбца ячейки 320 | // options: integer - настройки преобразования (ZE_RTA_ODF и ZE_RTA_ODF_PREFIX) 321 | // options and ZE_RTA_ODF = ZE_RTA_ODF - преобразовывать для ODF (=[.A1] + [.B1]) 322 | // options and ZE_RTA_ODF_PREFIX = ZE_RTA_ODF_PREFIX - добавлять префикс для ODF, если первый символ в формуле '=' (of:=[.A1] + [.B1]) 323 | // StartZero: boolean- при true счёт строки/ячейки начинается с 0. 324 | // RETURN 325 | // string - текст формулы в стиле R1C1 326 | function ZER1C1ToA1(const Formula: string; CurCol, CurRow: integer; options: integer; 327 | StartZero: boolean = true): string; 328 | var 329 | kol: integer; 330 | i: integer; 331 | retFormula: string; 332 | s: string; 333 | isQuote: boolean; // " ... " 334 | isApos: boolean; // ' ... ' 335 | isNotLast: boolean; 336 | isSq: boolean; 337 | 338 | procedure _checksymbol(ch: char); 339 | begin 340 | case ch of 341 | '"': 342 | begin 343 | if (isApos) then 344 | s := s + ch 345 | else 346 | begin 347 | if (isQuote) then 348 | begin 349 | retFormula := retFormula + s + ch; 350 | s := ''; 351 | end 352 | else 353 | begin 354 | if (s > '') then 355 | begin 356 | // O_o Странно 357 | retFormula := retFormula + ReturnA1(s, CurCol, CurRow, options, StartZero); 358 | s := ''; 359 | end; 360 | s := ch 361 | end; 362 | isQuote := not isQuote; 363 | end; 364 | end; 365 | '''': 366 | begin 367 | s := s + ch; 368 | if (not isQuote) then 369 | isApos := not isApos; 370 | end; 371 | '[': 372 | begin 373 | s := s + ch; 374 | if (not(isQuote or isApos)) then 375 | isSq := true; 376 | end; 377 | ']': 378 | begin 379 | s := s + ch; 380 | if (not(isQuote or isApos)) then 381 | isSq := false; 382 | end; 383 | ':', ';', ' ', '-', '%', '^', '*', '/', '+', '&', '<', '>', '(', ')', '=': // разделители 384 | begin 385 | if (isApos or isQuote or isSq) then 386 | s := s + ch 387 | else 388 | begin 389 | retFormula := retFormula + ReturnA1(s, CurCol, CurRow, options, StartZero); 390 | if (isNotLast) then 391 | retFormula := retFormula + ch; 392 | s := ''; 393 | end; 394 | end; 395 | else 396 | s := s + ch; 397 | end; 398 | end; // _checksymbol 399 | 400 | begin 401 | result := ''; 402 | kol := length(Formula); 403 | retFormula := ''; 404 | s := ''; 405 | if (StartZero) then 406 | begin 407 | inc(CurRow); 408 | inc(CurCol); 409 | end; 410 | isApos := false; 411 | isQuote := false; 412 | isNotLast := true; 413 | isSq := false; 414 | for i := 1 to kol do 415 | _checksymbol(Formula[i]); 416 | isNotLast := false; 417 | _checksymbol(';'); 418 | result := retFormula; 419 | if (options and ZE_RTA_ODF = ZE_RTA_ODF) and (options and ZE_RTA_ODF_PREFIX = ZE_RTA_ODF_PREFIX) then 420 | if (kol > 0) then 421 | if (Formula[1] = '=') then 422 | result := 'of:' + result; 423 | end; // ZER1C1ToA1 424 | 425 | // Попытка преобразовать номер ячейки из A1 в R1C1 стиль 426 | // если не удалось распознать номер ячейки, то возвратит обратно тот же текст 427 | // INPUT 428 | // const st: string - предположительно номер ячеки (диапазон) 429 | // CurCol: integer - номер столбца ячейки 430 | // CurRow: integer - номер строки ячейки 431 | // options: integer - настройки 432 | // StartZero: boolean - признак нумерации с нуля 433 | // RETURN 434 | // string - номер ячейки в стиле R1C1 435 | function ReturnR1C1(const st: string; CurCol, CurRow: integer; StartZero: boolean = true): string; 436 | var 437 | i: integer; 438 | s: string; 439 | isApos: boolean; 440 | _startNumber: boolean; 441 | kol: integer; 442 | num: integer; 443 | t: integer; 444 | isAbsolute: byte; 445 | sa: string; 446 | isNotLast: boolean; 447 | column: string; 448 | isC: boolean; 449 | 450 | procedure _GetColumn(); 451 | begin 452 | // попробовать преобразовать 453 | num := ZEGetColByA1(s, false); 454 | if (num >= 0) then // распознался вроде нормально 455 | begin 456 | if (num > 25000) then // сколько там колонок возможно? 457 | result := result + sa + s 458 | else 459 | begin 460 | column := ''; 461 | if (isAbsolute > 0) then 462 | column := 'C' + IntToStr(num) 463 | else 464 | begin 465 | t := num - CurCol; 466 | if (t <> 0) then 467 | column := 'C[' + IntToStr(t) + ']' 468 | else 469 | column := 'C'; 470 | end; 471 | end; 472 | end 473 | else // что-то не то 474 | result := result + sa + s; 475 | if (isAbsolute > 0) then 476 | dec(isAbsolute); 477 | sa := ''; 478 | s := ''; 479 | isC := true; 480 | end; // _GetColumn 481 | 482 | procedure _checksymbol(ch: char); 483 | begin 484 | if (not CharInSet(ch, ['0' .. '9'])) then 485 | if (not isApos) then 486 | begin 487 | if (_startNumber) then 488 | begin 489 | if (TryStrToInt(s, t)) then // удалось получить число 490 | begin 491 | if (isAbsolute > 0) then 492 | result := result + 'R' + s + column 493 | else 494 | begin 495 | t := t - CurRow; 496 | if (t <> 0) then 497 | result := result + 'R[' + IntToStr(t) + ']' + column 498 | else 499 | result := result + 'R' + column; 500 | end; 501 | if (isAbsolute > 0) then 502 | dec(isAbsolute); 503 | isC := false; 504 | end 505 | else 506 | result := result + sa + s; 507 | s := ''; 508 | sa := ''; 509 | end; 510 | _startNumber := false; 511 | end; 512 | case ch of 513 | '''': 514 | begin 515 | s := s + ch; 516 | if (isApos) then 517 | begin 518 | result := result + s; 519 | s := ''; 520 | end; 521 | isApos := not isApos; 522 | end; 523 | '.': // разделитель для листа (OpenOffice/LibreOffice) 524 | begin 525 | if (isApos) then 526 | s := s + ch 527 | else 528 | begin 529 | if (s > '') then 530 | result := result + s + '!'; 531 | s := ''; 532 | end; 533 | end; 534 | '!': // разделитель для листа (excel) 535 | begin 536 | if (isApos) then 537 | s := s + ch 538 | else 539 | begin 540 | result := result + s + ch; 541 | s := ''; 542 | end; 543 | end; 544 | '$': 545 | begin 546 | if (isApos) then 547 | s := s + ch 548 | else 549 | begin 550 | if (not _startNumber) and (s > '') then 551 | _GetColumn(); 552 | inc(isAbsolute); 553 | sa := ch; 554 | end; 555 | end; 556 | '[': 557 | begin 558 | if (isApos) then 559 | s := s + ch 560 | else 561 | begin 562 | end; 563 | end; 564 | ']': 565 | begin 566 | if (isApos) then 567 | s := s + ch 568 | else 569 | begin 570 | end; 571 | end; 572 | '0' .. '9': 573 | begin 574 | if (isApos) then 575 | s := s + ch 576 | else 577 | begin 578 | if ((not _startNumber) and (not isC)) then 579 | begin 580 | _GetColumn(); 581 | s := ''; 582 | end; 583 | s := s + ch; 584 | _startNumber := true; 585 | end; 586 | end; 587 | else 588 | if (isNotLast) then 589 | s := s + ch; 590 | end; // case 591 | end; // _CheckSymbol 592 | 593 | // Проверяет, с какого символа в строке начать 594 | procedure FindStartNumber(out num: integer); 595 | var 596 | i: integer; 597 | z: boolean; 598 | begin 599 | num := 1; 600 | z := false; 601 | for i := 1 to kol do 602 | case st[i] of 603 | '''': 604 | begin 605 | s := s + st[i]; 606 | z := not z; 607 | end; 608 | '!', '.': 609 | if (not z) then 610 | begin 611 | num := i; 612 | exit; 613 | end; 614 | else 615 | s := s + st[i]; 616 | end; // case 617 | s := ''; 618 | end; // FindStartNumber 619 | 620 | begin 621 | result := ''; 622 | s := ''; 623 | isApos := false; 624 | kol := length(st); 625 | if (kol >= 1) then 626 | if (st[1] <> '$') then 627 | if (TryStrToInt(st, t)) then 628 | begin 629 | result := st; 630 | exit; 631 | end; 632 | FindStartNumber(i); 633 | _startNumber := false; 634 | isAbsolute := 0; 635 | sa := ''; 636 | column := ''; 637 | isNotLast := true; 638 | isC := false; 639 | while (i <= kol) do 640 | begin 641 | _checksymbol(st[i]); 642 | inc(i); 643 | end; // while 644 | isNotLast := false; 645 | _checksymbol(';'); 646 | if (s > '') then 647 | result := result + s; 648 | end; // ReturnR1C1 649 | 650 | // Переводит формулу из стиля A1 в стиль R1C1 651 | // INPUT 652 | // const formula: string - формула в стиле A1 653 | // CurRow: integer - номер строки ячейки 654 | // CurCol: integer - номер столбца ячейки 655 | // options: integer - настройки преобразования 656 | // StartZero: boolean- при true счёт строки/ячейки начинается с 0. 657 | // RETURN 658 | // string - текст формулы в стиле R1C1 659 | function ZEA1ToR1C1(const Formula: string; CurCol, CurRow: integer; options: integer; 660 | StartZero: boolean = true): string; 661 | var 662 | i, l: integer; 663 | s: string; 664 | retFormula: string; 665 | isQuote: boolean; // " ... " 666 | isApos: boolean; // ' ... ' 667 | isNotLast: boolean; 668 | start_num: integer; 669 | 670 | // Проверить символ 671 | // INPUT 672 | // const ch: char - символ для проверки 673 | procedure _checksymbol(const ch: char); 674 | begin 675 | case ch of 676 | '"': 677 | begin; 678 | if (isApos) then 679 | s := s + ch 680 | else 681 | begin 682 | if (isQuote) then 683 | begin 684 | retFormula := retFormula + s + ch; 685 | s := ''; 686 | end 687 | else 688 | begin 689 | if (s > '') then 690 | begin 691 | // O_o Странно 692 | retFormula := retFormula + ReturnR1C1(s, CurCol, CurRow, StartZero); 693 | s := ''; 694 | end; 695 | s := ch 696 | end; 697 | isQuote := not isQuote; 698 | end; 699 | end; 700 | '''': 701 | begin 702 | s := s + ch; 703 | if (not isQuote) then 704 | isApos := not isApos; 705 | end; 706 | ':', ';', ' ', '-', '%', '^', '*', '/', '+', '&', '<', '>', '(', ')', ']', '[', '=': // разделители 707 | begin 708 | if (isQuote or isApos) then 709 | s := s + ch 710 | else 711 | begin 712 | retFormula := retFormula + ReturnR1C1(s, CurCol, CurRow, StartZero); 713 | if (isNotLast) then 714 | if (not CharInSet(ch, ['[', ']'])) then 715 | retFormula := retFormula + ch; 716 | s := ''; 717 | end; 718 | end; 719 | else 720 | s := s + ch; 721 | end; 722 | end; // _CheckSymbol 723 | 724 | procedure FindStartNum(var start_num: integer); 725 | var 726 | i: integer; 727 | begin 728 | for i := 1 to l do 729 | if (Formula[i] = '=') then 730 | begin 731 | start_num := i; 732 | exit; 733 | end; 734 | end; // FindStartNum 735 | 736 | begin 737 | result := ''; 738 | l := length(Formula); 739 | s := ''; 740 | retFormula := ''; 741 | isQuote := false; 742 | isApos := false; 743 | isNotLast := true; 744 | if (StartZero) then 745 | begin 746 | inc(CurRow); 747 | inc(CurCol); 748 | end; 749 | 750 | start_num := 1; 751 | if (options and ZE_ATR_DEL_PREFIX = ZE_ATR_DEL_PREFIX) then 752 | FindStartNum(start_num); 753 | 754 | for i := start_num to l do 755 | _checksymbol(Formula[i]); 756 | isNotLast := false; 757 | _checksymbol(';'); 758 | if (isQuote or isApos) then 759 | retFormula := retFormula + s; 760 | result := retFormula; 761 | end; // ZEA1ToR1C1 762 | 763 | function ZERangeToRow(range: string): integer; 764 | var 765 | i: integer; 766 | begin 767 | for i := 1 to length(range) - 1 do 768 | begin 769 | if CharInSet(range.Chars[i], ['0' .. '9']) then 770 | begin 771 | exit(StrToInt(range.Substring(i))); 772 | end; 773 | end; 774 | raise Exception.Create('Не удалось вычислить номер строки из формулы: ' + range); 775 | end; 776 | 777 | // Возвращает номер столбца по буквенному обозначению 778 | // INPUT 779 | // const AA: string - буквенное обозначение столбца 780 | // StartZero: boolean - если true, то счёт начинает с нуля (т.е. A = 0), в противном случае с 1. 781 | // RETURN 782 | // integer - -1 - не удалось преобразовать 783 | function ZEGetColByA1(AA: string; StartZero: boolean = true): integer; 784 | var 785 | i: integer; 786 | num, t, kol, s: integer; 787 | begin 788 | result := -1; 789 | num := 0; 790 | AA := UpperCase(AA); 791 | kol := length(AA); 792 | s := 1; 793 | for i := kol downto 1 do 794 | begin 795 | if not CharInSet(AA[i], ['A' .. 'Z']) then 796 | continue; 797 | t := ord(AA[i]) - ord('A'); 798 | num := num + (t + 1) * s; 799 | s := s * 26; 800 | if (s < 0) or (num < 0) then 801 | exit; 802 | end; 803 | result := num; 804 | if (StartZero) then 805 | result := result - 1; 806 | end; // ZEGetColByAA 807 | 808 | // Возвращает буквенное обозначение столбца для АА стиля 809 | // INPUT 810 | // ColNum: integer - номер столбца 811 | // StartZero: boolean - если true, то счёт начинается с 0, в противном случае - с 1. 812 | function ZEGetA1byCol(ColNum: integer; StartZero: boolean = true): string; 813 | var 814 | t, n: integer; 815 | s: string; 816 | begin 817 | t := ColNum; 818 | if (not StartZero) then 819 | dec(t); 820 | result := ''; 821 | s := ''; 822 | while t >= 0 do 823 | begin 824 | n := t mod 26; 825 | t := (t div 26) - 1; 826 | // ХЗ как там с кодировками будет 827 | s := s + ZE_STR_ARRAY[n]; 828 | end; 829 | for t := length(s) downto 1 do 830 | result := result + s[t]; 831 | end; // ZEGetAAbyCol 832 | 833 | end. 834 | -------------------------------------------------------------------------------- /source/Excel4Delphi.NumberFormats.pas: -------------------------------------------------------------------------------- 1 | unit Excel4Delphi.NumberFormats; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, Excel4Delphi.Xml; 7 | 8 | const 9 | // Main number formats 10 | ZE_NUMFORMAT_IS_UNKNOWN = 0; 11 | ZE_NUMFORMAT_IS_NUMBER = 1; 12 | ZE_NUMFORMAT_IS_DATETIME = 2; 13 | ZE_NUMFORMAT_IS_STRING = 4; 14 | 15 | // Additional properties for number styles 16 | ZE_NUMFORMAT_NUM_IS_PERCENTAGE = 1 shl 10; 17 | ZE_NUMFORMAT_NUM_IS_SCIENTIFIC = 1 shl 11; 18 | ZE_NUMFORMAT_NUM_IS_CURRENCY = 1 shl 12; 19 | ZE_NUMFORMAT_NUM_IS_FRACTION = 1 shl 13; 20 | 21 | ZE_NUMFORMAT_DATE_IS_ONLY_TIME = 1 shl 14; 22 | 23 | // DateStyles 24 | ZETag_number_date_style = 'number:date-style'; 25 | ZETag_number_time_style = 'number:time-style'; 26 | 27 | ZETag_number_day = 'number:day'; 28 | ZETag_number_text = 'number:text'; 29 | ZETag_number_style = 'number:style'; 30 | ZETag_number_month = 'number:month'; 31 | ZETag_number_year = 'number:year'; 32 | ZETag_number_hours = 'number:hours'; 33 | ZETag_number_minutes = 'number:minutes'; 34 | ZETag_number_seconds = 'number:seconds'; 35 | ZETag_number_day_of_week = 'number:day-of-week'; 36 | ZETag_number_textual = 'number:textual'; 37 | ZETag_number_possessive_form = 'number:possessive-form'; 38 | ZETag_number_am_pm = 'number:am-pm'; 39 | ZETag_number_quarter = 'number:quarter'; 40 | ZETag_number_week_of_year = 'number:week-of-year'; 41 | ZETag_number_era = 'number:era'; 42 | 43 | // NumberStyles: 44 | // WARNING: number style = currency style = percentage style! 45 | // TODO: 46 | // Is need separate number/currency/percentage number styles? 47 | ZETag_number_number_style = 'number:number-style'; 48 | ZETag_number_currency_style = 'number:currency-style'; 49 | ZETag_number_percentage_style = 'number:percentage-style'; 50 | 51 | // for currency 52 | ZETag_number_currency_symbol = 'number:currency-symbol'; 53 | ZETag_number_language = 'number:language'; 54 | ZETag_number_country = 'number:country'; 55 | 56 | ZETag_number_fraction = 'number:fraction'; 57 | ZETag_number_scientific_number = 'number:scientific-number'; 58 | ZETag_number_embedded_text = 'number:embedded-text'; 59 | ZETag_number_number = 'number:number'; 60 | ZETag_number_decimal_places = 'number:decimal-places'; 61 | ZETag_number_decimal_replacement = 'number:decimal-replacement'; 62 | ZETag_number_display_factor = 'number:display-factor'; 63 | ZETag_number_grouping = 'number:grouping'; 64 | ZETag_number_min_integer_digits = 'number:min-integer-digits'; 65 | ZETag_number_position = 'number:position'; 66 | ZETag_number_min_exponent_digits = 'number:min-exponent-digits'; 67 | 68 | ZETag_number_min_numerator_digits = 'number:min-numerator-digits'; 69 | ZETag_number_min_denominator_digits = 'number:min-denominator-digits'; 70 | ZETag_number_denominator_value = 'number:denominator-value'; 71 | 72 | ZETag_number_text_style = 'number:text-style'; 73 | ZETag_number_text_content = 'number:text-content'; 74 | 75 | ZETag_style_text_properties = 'style:text-properties'; 76 | ZETag_style_map = 'style:map'; 77 | ZETag_fo_color = 'fo:color'; 78 | 79 | ZETag_Attr_StyleName = 'style:name'; 80 | ZETag_style_condition = 'style:condition'; 81 | ZETag_style_apply_style_name = 'style:apply-style-name'; 82 | ZETag_long = 'long'; 83 | ZETag_short = 'short'; 84 | ZETag_style_volatile = 'style:volatile'; 85 | 86 | type 87 | TZODSNumberItemOptions = record 88 | isColor: boolean; 89 | ColorStr: string; 90 | StyleType: byte; 91 | end; 92 | 93 | TODSEmbeded_text_props = record 94 | Txt: string; 95 | NumberPosition: integer; 96 | end; 97 | 98 | // Date/Time item for processing date number style 99 | TZDateTimeProcessItem = record 100 | // Item type: 101 | // -1 - error item (ignore) 102 | // 0 - text 103 | // 1 - year (Y/YY/YYYY) 104 | // 2 - month (M/MM/MMM/MMMM/MMMMM) 105 | // 3 - day (D/DD/DDD/DDDD/NN/NNN/NNNN) 106 | // 4 - hour (h/hh) 107 | // 5 - minute (m/mm) 108 | // 6 - second (s/ss) 109 | // 7 - week (WW) 110 | // 8 - quarterly (Q/QQ) 111 | // 9 - era jap (G/GG/GGG/RR/GGGEE) 112 | // 10 - number of the year in era (E/EE/R) 113 | // 11 - AM/PM (a/p AM/PM) 114 | ItemType: integer; 115 | // Text value (for ItemType = 0) 116 | TextValue: string; 117 | // Length for item 118 | Len: integer; 119 | // Additional settings for item 120 | Settings: integer; 121 | end; 122 | 123 | // Simple parser for number format 124 | TNumFormatParser = class 125 | private 126 | FStr: string; 127 | FLen: integer; 128 | FPos: integer; 129 | FReadedSymbol: string; 130 | FReadedSymbolType: integer; 131 | FIsError: integer; 132 | FFirstSymbol: char; 133 | protected 134 | procedure Clear(); 135 | public 136 | constructor Create(); 137 | procedure BeginRead(const AStr: string); 138 | function ReadSymbol(): boolean; 139 | procedure IncPos(ADelta: integer); 140 | property FirstSymbol: char read FFirstSymbol; 141 | property ReadedSymbol: string read FReadedSymbol; 142 | property ReadedSymbolType: integer read FReadedSymbolType; 143 | property StrLength: integer read FLen; 144 | property CurrentPos: integer read FPos; 145 | property IsError: integer read FIsError; 146 | end; 147 | 148 | // Parser for ODS datetime format 149 | TZDateTimeODSFormatParser = class 150 | private 151 | FCount: integer; 152 | FMaxCount: integer; 153 | protected 154 | procedure IncCount(ADelta: integer = 1); 155 | procedure CheckMonthMinute(); 156 | public 157 | FItems: array of TZDateTimeProcessItem; 158 | constructor Create(); 159 | destructor Destroy(); override; 160 | procedure DeleteRepeatedItems(); 161 | function GetValidCount(): integer; 162 | function TryToParseDateFormat(const AFmtStr: string; const AFmtParser: TNumFormatParser = nil): integer; 163 | property Count: integer read FCount; 164 | end; 165 | 166 | // Number format item for write 167 | TODSNumberFormatMapItem = class 168 | private 169 | FCondition: string; 170 | FisCondition: boolean; 171 | FColorStr: string; 172 | FisColor: boolean; 173 | FNumberFormat: string; 174 | FConditionsArray: array [0 .. 1] of array [0 .. 1] of string; 175 | FConditionsCount: integer; 176 | FEmbededTextCount: integer; 177 | FEmbededMaxCount: integer; 178 | FEmbededTextArray: array of TODSEmbeded_text_props; 179 | FNumberFormatParser: TNumFormatParser; 180 | FDateTimeODSFormatParser: TZDateTimeODSFormatParser; 181 | protected 182 | procedure PrepareCommonStyleAttributes(const Xml: TZsspXMLWriterH; const AStyleName: string; 183 | isVolatile: boolean = false); 184 | public 185 | constructor Create(); 186 | destructor Destroy(); override; 187 | procedure Clear(); 188 | function TryToParse(const FNStr: string): boolean; 189 | // Add condition for this number format (max 2) 190 | // INPUT 191 | // const ACondition: string 192 | // const AStyleName: string 193 | function AddCondition(const ACondition, AStyleName: string): boolean; 194 | 195 | // Write number style item ( ) 196 | // INPUT 197 | // const xml: TZsspXMLWriterH - xml 198 | // const AStyleName: string - style name 199 | // const NumProperties: integer - additional number properties (currency/percentage etc) 200 | // isVolatile: boolean - is volatile? 201 | procedure WriteNumberStyle(const Xml: TZsspXMLWriterH; const AStyleName: string; const NumProperties: integer; 202 | isVolatile: boolean = false); 203 | 204 | // Write number text style item ( ) 205 | // INPUT 206 | // const xml: TZsspXMLWriterH - xml 207 | // const AStyleName: string - style name 208 | // isVolatile: boolean - is volatile? (for now - ignore) 209 | procedure WriteTextStyle(const Xml: TZsspXMLWriterH; const AStyleName: string; isVolatile: boolean = false); 210 | 211 | // Write datetime style item ( ) 212 | // INPUT 213 | // const xml: TZsspXMLWriterH - xml 214 | // const AStyleName: string - style name 215 | // isVolatile: boolean - is volatile? (for now - ignore) 216 | // RETURN 217 | // integer - additional properties for datetime style 218 | function WriteDateTimeStyle(const Xml: TZsspXMLWriterH; const AStyleName: string; 219 | isVolatile: boolean = false): integer; 220 | 221 | property Condition: string read FCondition write FCondition; 222 | property isCondition: boolean read FisCondition write FisCondition; 223 | property ColorStr: string read FColorStr write FColorStr; 224 | property isColor: boolean read FisColor write FisColor; 225 | property NumberFormat: string read FNumberFormat write FNumberFormat; 226 | end; 227 | 228 | // Reads and stores number formats for ODS 229 | TZEODSNumberFormatReader = class 230 | private 231 | FItems: array of array [0 .. 1] of string; // index 0 - format num 232 | // index 1 - format 233 | FItemsOptions: array of TZODSNumberItemOptions; 234 | FCount: integer; 235 | FCountMax: integer; 236 | 237 | FEmbededTextCount: integer; 238 | FEmbededMaxCount: integer; 239 | FEmbededTextArray: array of TODSEmbeded_text_props; 240 | procedure AddEmbededText(const AText: string; ANumberPosition: integer); 241 | protected 242 | procedure AddItem(); 243 | procedure ReadNumberFormatCommon(const Xml: TZsspXMLReaderH; const NumberFormatTag: string; 244 | sub_number_type: integer); 245 | function BeginReadFormat(const Xml: TZsspXMLReaderH; out retStartString: string; const NumFormat: integer): integer; 246 | public 247 | constructor Create(); 248 | destructor Destroy(); override; 249 | procedure ReadKnownNumberFormat(const Xml: TZsspXMLReaderH); 250 | procedure ReadDateFormat(const Xml: TZsspXMLReaderH; const ATagName: string); 251 | procedure ReadNumberFormat(const Xml: TZsspXMLReaderH); 252 | procedure ReadCurrencyFormat(const Xml: TZsspXMLReaderH); 253 | procedure ReadPercentageFormat(const Xml: TZsspXMLReaderH); 254 | procedure ReadStringFormat(const Xml: TZsspXMLReaderH); 255 | function TryGetFormatStrByNum(const DataStyleName: string; out retFormatStr: string): boolean; 256 | property Count: integer read FCount; 257 | end; 258 | 259 | TZEODSNumberFormatWriterItem = record 260 | StyleIndex: integer; 261 | NumberFormatName: string; 262 | NumberFormat: string; 263 | end; 264 | 265 | // Writes to ODS number formats and stores number formats names 266 | TZEODSNumberFormatWriter = class 267 | private 268 | FItems: array of TZEODSNumberFormatWriterItem; 269 | FCount: integer; 270 | FCountMax: integer; 271 | FCurrentNFIndex: integer; 272 | 273 | FNFItems: array of TODSNumberFormatMapItem; 274 | FNFItemsCount: integer; 275 | // Additional properties for number formats (currency, percentage etc) 276 | FNumberAdditionalProps: array of integer; 277 | 278 | protected 279 | function TryAddNFItem(const NFStr: string): boolean; 280 | function SeparateNFItems(const NFStr: string): integer; 281 | public 282 | constructor Create(const AMaxCount: integer); 283 | destructor Destroy(); override; 284 | function TryGetNumberFormatName(StyleID: integer; out NumberFormatName: string): boolean; 285 | // Try to find additional properties for number format 286 | // INPUT 287 | // StyleID: integer - style ID 288 | // out NumberFormatProp: integer - finded number additional properties 289 | // RETURN 290 | // boolean - true - additional properties is found 291 | function TryGetNumberFormatAddProp(StyleID: integer; out NumberFormatProp: integer): boolean; 292 | // Try to write number format to xml 293 | // INPUT 294 | // const xml: TZsspXMLWriterH - xml 295 | // StyleID: integer - Style ID 296 | // ANumberFormat: string - number format 297 | // RETURN 298 | // boolean - true - NumberFormat was written ok 299 | function TryWriteNumberFormat(const Xml: TZsspXMLWriterH; StyleID: integer; ANumberFormat: string): boolean; 300 | property Count: integer read FCount; 301 | end; 302 | 303 | // Try to get xlsx number format type by string (very simplistic) 304 | // INPUT 305 | // const FormatStr: string - format ("YYYY.MM.DD" etc) 306 | // RETURN 307 | // integer - 0 - unknown 308 | // 1 and 1 = 1 - number 309 | // 2 and 2 = 2 - datetime 310 | // 4 and 4 = 4 - string 311 | function GetXlsxNumberFormatType(const FormatStr: string): integer; 312 | 313 | // Try to get native number format type by string (very simplistic) 314 | // INPUT 315 | // const FormatStr: string - format ("YYYY.MM.DD" etc) 316 | // RETURN 317 | // integer - 0 - unknown 318 | // 1 and 1 = 1 - number 319 | // 2 and 2 = 2 - datetime 320 | // 4 and 4 = 4 - string 321 | function GetNativeNumberFormatType(const FormatStr: string): integer; 322 | 323 | // Convert native number format to xlsx 324 | // INPUT 325 | // const FormatNative: string - number format 326 | // const AFmtParser: TNumFormatParser - format parser (not NIL!) 327 | // const ADateParser: TZDateTimeODSFormatParser - date parser (not NIL!) 328 | // RETURN 329 | // string - number format fox xlsx and excel 2003 xml 330 | function ConvertFormatNativeToXlsx(const FormatNative: string; const AFmtParser: TNumFormatParser; 331 | const ADateParser: TZDateTimeODSFormatParser): string; overload; 332 | 333 | // Convert native number format to xlsx 334 | // INPUT 335 | // const FormatNative: string - number format 336 | // RETURN 337 | // string - number format fox xlsx and excel 2003 xml 338 | function ConvertFormatNativeToXlsx(const FormatNative: string): string; overload; 339 | function ConvertFormatXlsxToNative(const FormatXlsx: string): string; 340 | function TryXlsxTimeToDateTime(const XlsxDateTime: string; out retDateTime: TDateTime; is1904: boolean = false) 341 | : boolean; 342 | 343 | implementation 344 | 345 | uses 346 | Excel4Delphi.Common, System.StrUtils; 347 | 348 | const 349 | ZE_NUMBER_FORMAT_DECIMAL_SEPARATOR = '.'; 350 | ZE_MAX_NF_ITEMS_COUNT = 3; 351 | ZE_MAP_CONDITIONAL_COLORS_COUNT = 8; 352 | 353 | ZE_MAP_CONDITIONAL_COLORS: array [0 .. ZE_MAP_CONDITIONAL_COLORS_COUNT - 1] of array [0 .. 1] 354 | of string = (('#000000', 'BLACK'), ('#FFFFFF', 'WHITE'), ('#FF0000', 'RED'), ('#00FF00', 'GREEN'), 355 | ('#0000FF', 'BLUE'), ('#FF00FF', 'MAGENTA'), ('#00FFFF', 'CYAN'), ('#FFFF00', 'YELLOW')); 356 | 357 | ZE_VALID_CONDITIONS_STR: TArray = ['>', '<', '>=', '<=', '=']; 358 | 359 | ZE_VALID_NAMED_FORMATS_COUNT = 15; 360 | 361 | ZE_VALID_NAMED_FORMATS: array [0 .. ZE_VALID_NAMED_FORMATS_COUNT - 1] of array [0 .. 1] of string = (('GENERAL', ''), 362 | ('FIXED', '0.00'), ('CURRENCY', '0.00'), ('STANDARD', ''), ('PERCENT', '0.00%'), ('SCIENTIFIC', '0,00E+00'), 363 | ('GENERAL DATE', 'DD.MM.YYYY'), ('DATE', 'DD.MM.YYYY'), ('LONG DATE', 'DD.MM.YYYY'), ('MEDIUM DATE', 'DD-MMM-YY'), 364 | ('SHORT DATE', 'DD.MM.YY'), ('LONG TIME', 'HH:MM:SS'), ('MEDIUM TIME', 'HH:MM AM/PM'), ('SHORT TIME', 'HH:MM'), 365 | ('TIME', 'HH:MM')); 366 | 367 | ZE_DATETIME_ITEM_ERROR = -1; 368 | ZE_DATETIME_ITEM_TEXT = 0; 369 | ZE_DATETIME_ITEM_YEAR = 1; 370 | ZE_DATETIME_ITEM_MONTH = 2; 371 | ZE_DATETIME_ITEM_DAY = 3; 372 | ZE_DATETIME_ITEM_HOUR = 4; 373 | ZE_DATETIME_ITEM_MINUTE = 5; 374 | ZE_DATETIME_ITEM_SECOND = 6; 375 | ZE_DATETIME_ITEM_WEEK = 7; 376 | ZE_DATETIME_ITEM_QUARTER = 8; 377 | ZE_DATETIME_ITEM_ERA_JAP = 9; 378 | ZE_DATETIME_ITEM_ERA_YEAR = 10; 379 | ZE_DATETIME_ITEM_AMPM = 11; 380 | 381 | ZE_DATETIME_AMPM_SHORT_LOW = 0; 382 | ZE_DATETIME_AMPM_SHORT_UP = 1; 383 | ZE_DATETIME_AMPM_LONG_LOW = 2; 384 | ZE_DATETIME_AMPM_LONG_UP = 3; 385 | 386 | { 387 | 388 | LO: 389 | 390 | M Month as 3. 391 | MM Month as 03. 392 | MMM Month as Jan-Dec 393 | MMMM Month as January-December MMMM 394 | MMMMM First letter of Name of Month MMMMM 395 | D Day as 2 D 396 | DD Day as 02 DD 397 | NN or DDD Day as Sun-Sat 398 | NNN or DDDD Day as Sunday to Saturday 399 | NNNN Day followed by comma, as in "Sunday," NNNN 400 | YY Year as 00-99 YY 401 | YYYY Year as 1900-2078 YYYY 402 | WW Calendar week 403 | Q Quarterly as Q1 to Q4 Q 404 | QQ Quarterly as 1st quarter to 4th quarter QQ 405 | G Era on the Japanese Gengou calendar, single character (possible values are: M, T, S, H) 406 | GG Era, abbreviation 407 | GGG Era, full name 408 | E Number of the year within an era, without a leading zero for single-digit years 409 | EE or R Number of the year within an era, with a leading zero for single-digit years 410 | RR or GGGEE Era, full name and year 411 | 412 | h Hours as 0-23 h 413 | hh Hours as 00-23 414 | m Minutes as 0-59 415 | mm Minutes as 00-59 416 | s Seconds as 0-59 417 | ss Seconds as 00-59 418 | 419 | [~buddhist] Thai Buddhist Calendar 420 | [~gengou] Japanese Gengou Calendar 421 | [~gregorian] Gregorian Calendar 422 | [~hanja] Korean Calendar 423 | [~hanja_yoil] Korean Calendar 424 | [~hijri] Arabic Islamic Calendar, currently supported for the following locales: ar_EG, ar_LB, ar_SA, and ar_TN 425 | [~jewish] Jewish Calendar 426 | [~ROC] Republic Of China Calendar 427 | 428 | m$ 429 | m Displays the month as a number without a leading zero. 430 | mm Displays the month as a number with a leading zero when appropriate. 431 | mmm Displays the month as an abbreviation (Jan to Dec). 432 | mmmm Displays the month as a full name (January to December). 433 | mmmmm Displays the month as a single letter (J to D). 434 | d Displays the day as a number without a leading zero. 435 | dd Displays the day as a number with a leading zero when appropriate. 436 | ddd Displays the day as an abbreviation (Sun to Sat). 437 | dddd Displays the day as a full name (Sunday to Saturday). 438 | yy Displays the year as a two-digit number. 439 | yyyy Displays the year as a four-digit number. 440 | 441 | 442 | 443 | h Displays the hour as a number without a leading zero. 444 | [h] Displays elapsed time in hours. If you are working with a formula that returns a time in which the number of hours exceeds 24, use a number format that resembles [h]:mm:ss. 445 | hh Displays the hour as a number with a leading zero when appropriate. If the format contains AM or PM, the hour is based on the 12-hour clock. Otherwise, the hour is based on the 24-hour clock. 446 | m Displays the minute as a number without a leading zero. 447 | [m] Displays elapsed time in minutes. If you are working with a formula that returns a time in which the number of minutes exceeds 60, use a number format that resembles [mm]:ss. 448 | mm Displays the minute as a number with a leading zero when appropriate. 449 | Note The m or mm code must appear immediately after the h or hh code or immediately before the ss code; otherwise, Excel displays the month instead of minutes. 450 | s Displays the second as a number without a leading zero. 451 | [s] Displays elapsed time in seconds. If you are working with a formula that returns a time in which the number of seconds exceeds 60, use a number format that resembles [ss]. 452 | ss Displays the second as a number with a leading zero when appropriate. If you want to display fractions of a second, use a number format that resembles h:mm:ss.00. 453 | 454 | AM/PM, am/pm, A/P, a/p Displays the hour using a 12-hour clock. Excel displays AM, am, A, or a for times from midnight unt 455 | 456 | } 457 | 458 | // Return true if in string AStr after position AStartPos have one of symbols SymbolsArr 459 | // This function checks quotas and brackets. If desired symbol between the quotas - function return FALSE. 460 | // INPUT 461 | // AStartPos: integer - start position 462 | // ALen: integer - string length 463 | // out retPos: integer - returned position of symbol 464 | // const AStr: string - string 465 | // const SymbolsArr: array of string - searching symbols 466 | // RETURN 467 | // boolean - true - one of symbols was found in string after AStartPos (and not between quotas) 468 | function IsHaveSymbolsAfterPosQuotas(AStartPos: integer; ALen: integer; out retPos: integer; const AStr: string; 469 | const SymbolsArr: array of string): boolean; overload; 470 | var 471 | i, j: integer; 472 | _IsQuote: boolean; 473 | _IsBracket: boolean; 474 | ch: char; 475 | _max, _min: integer; 476 | 477 | begin 478 | Result := false; 479 | _IsQuote := false; 480 | _IsBracket := false; 481 | retPos := -1; 482 | _min := Low(SymbolsArr); 483 | _max := High(SymbolsArr); 484 | i := AStartPos + 1; 485 | while (i <= ALen) do 486 | begin 487 | ch := AStr[i]; 488 | 489 | if (not _IsQuote) then 490 | begin 491 | case (ch) of 492 | '[': 493 | _IsBracket := true; 494 | ']': 495 | _IsBracket := false; 496 | '\': 497 | begin 498 | inc(i, 2); 499 | if (i > ALen) then 500 | break; 501 | ch := AStr[i]; 502 | end; 503 | end; 504 | end; 505 | 506 | if ((not _IsBracket) and (ch = '"')) then 507 | _IsQuote := not _IsQuote; 508 | 509 | if ((not _IsQuote) and (not _IsBracket)) then 510 | for j := _min to _max do 511 | if (ch = SymbolsArr[j]) then 512 | begin 513 | retPos := i; 514 | Result := true; 515 | exit; 516 | end; 517 | inc(i); 518 | end; // while i 519 | end; // IsHaveSymbolsAfterPosQuotas 520 | 521 | // Return true if in string AStr after position AStartPos have one of symbols SymbolsArr 522 | // This function checks quotas and brackets. If desired symbol between the quotas - function return FALSE. 523 | // INPUT 524 | // AStartPos: integer - start position 525 | // ALen: integer - string length 526 | // const AStr: string - string 527 | // const SymbolsArr: array of string - searching symbols 528 | // RETURN 529 | // boolean - true - one of symbols was found in string after AStartPos (and not between quotas) 530 | function IsHaveSymbolsAfterPosQuotas(AStartPos: integer; ALen: integer; const AStr: string; 531 | const SymbolsArr: array of string): boolean; overload; 532 | var 533 | retPos: integer; 534 | begin 535 | Result := IsHaveSymbolsAfterPosQuotas(AStartPos, ALen, retPos, AStr, SymbolsArr); 536 | end; // IsHaveSymbolsAfterPosQuotas 537 | 538 | // Try to get xlsx number format type by string (very simplistic) 539 | // INPUT 540 | // const FormatStr: string - format ("YYYY.MM.DD" etc) 541 | // RETURN 542 | // integer - 0 - unknown 543 | // 1 and 1 = 1 - number 544 | // 2 and 2 = 2 - datetime 545 | // 4 and 4 = 4 - string 546 | function GetXlsxNumberFormatType(const FormatStr: string): integer; 547 | var 548 | i, l: integer; 549 | ch: char; 550 | _IsQuote: boolean; 551 | _IsBracket: boolean; 552 | _isFraction: boolean; 553 | 554 | begin 555 | Result := ZE_NUMFORMAT_IS_UNKNOWN; 556 | _isFraction := false; 557 | 558 | // General is not for dates 559 | if ((UpperCase(FormatStr) = 'GENERAL') or (FormatStr = '')) then 560 | exit(ZE_NUMFORMAT_IS_NUMBER); 561 | 562 | _IsQuote := false; 563 | _IsBracket := false; 564 | 565 | l := length(FormatStr); 566 | for i := 1 to l do 567 | begin 568 | ch := FormatStr[i]; 569 | 570 | if ((ch = '"') and (not _IsBracket)) then 571 | _IsQuote := not _IsQuote; 572 | 573 | if ((ch = '[') and (not _IsQuote)) then 574 | _IsBracket := true; 575 | 576 | if ((ch = ']') and (not _IsQuote) and _IsBracket) then 577 | _IsBracket := false; 578 | 579 | // [$RUB] / [$UAH] etc 580 | // TODO: need check for valid country code 581 | if (_IsBracket and (ch = '$')) then 582 | Result := Result or ZE_NUMFORMAT_NUM_IS_CURRENCY; 583 | 584 | if ((not _IsQuote) and (not _IsBracket)) then 585 | case (ch) of 586 | '0', '#', 'E', 'e', '%', '?': 587 | begin 588 | Result := ZE_NUMFORMAT_IS_NUMBER; 589 | 590 | if (IsHaveSymbolsAfterPosQuotas(i - 1, l, FormatStr, ['e', 'E'])) then 591 | Result := Result or ZE_NUMFORMAT_NUM_IS_SCIENTIFIC 592 | else if (IsHaveSymbolsAfterPosQuotas(i - 1, l, FormatStr, ['%'])) then 593 | Result := Result or ZE_NUMFORMAT_NUM_IS_PERCENTAGE 594 | else if (IsHaveSymbolsAfterPosQuotas(i - 1, l, FormatStr, ['/']) or _isFraction) then 595 | Result := Result or ZE_NUMFORMAT_NUM_IS_FRACTION; 596 | 597 | exit; 598 | end; 599 | '@': 600 | begin 601 | Result := ZE_NUMFORMAT_IS_STRING; 602 | exit; 603 | end; 604 | '/': 605 | _isFraction := true; 606 | 'H', 'h', 'S', 's', 'm', 'M', 'd', 'D', 'Y', 'y', ':': 607 | begin 608 | Result := ZE_NUMFORMAT_IS_DATETIME; 609 | exit; 610 | end; 611 | end; 612 | end; // for i 613 | end; // GetXlsxNumberFormatType 614 | 615 | // Try to get native number format type by string (very simplistic) 616 | // INPUT 617 | // const FormatStr: string - format ("YYYY.MM.DD" etc) 618 | // RETURN 619 | // integer - 0 - unknown 620 | // 1 and 1 = 1 - number 621 | // 2 and 2 = 2 - datetime 622 | // 4 and 4 = 4 - string 623 | function GetNativeNumberFormatType(const FormatStr: string): integer; 624 | var 625 | i, l: integer; 626 | ch, _prev: char; 627 | _IsQuote: boolean; 628 | _IsBracket: boolean; 629 | _isSemicolon: boolean; 630 | t: integer; 631 | 632 | function _CheckSemicolon(): boolean; 633 | begin 634 | if not _isSemicolon then 635 | begin 636 | t := i - 1; 637 | _isSemicolon := IsHaveSymbolsAfterPosQuotas(t, l, i, FormatStr, [';']); 638 | end; 639 | 640 | Result := not _isSemicolon; 641 | end; 642 | 643 | begin 644 | Result := ZE_NUMFORMAT_IS_UNKNOWN; 645 | 646 | _isSemicolon := false; 647 | _IsBracket := false; 648 | _IsQuote := false; 649 | _prev := #0; 650 | 651 | l := length(FormatStr); 652 | i := 1; 653 | while (i <= l) do 654 | begin 655 | ch := FormatStr[i]; 656 | 657 | if ((ch = '"') and (not _IsBracket)) then 658 | _IsQuote := not _IsQuote; 659 | 660 | if ((ch = '[') and (not _IsQuote)) then 661 | _IsBracket := true; 662 | 663 | if ((ch = ']') and (not _IsQuote) and _IsBracket) then 664 | _IsBracket := false; 665 | 666 | // [$RUB] / [$UAH] etc 667 | // TODO: need check for valid country code 668 | if (_IsBracket and (ch = '$')) then 669 | Result := Result or ZE_NUMFORMAT_NUM_IS_CURRENCY; 670 | 671 | if ((not _IsQuote) and (not _IsBracket)) then 672 | case (ch) of 673 | '0', '#', '?': 674 | begin 675 | if (_isSemicolon) then 676 | Result := Result or ZE_NUMFORMAT_IS_NUMBER 677 | else 678 | Result := ZE_NUMFORMAT_IS_NUMBER; 679 | 680 | if (IsHaveSymbolsAfterPosQuotas(i - 1, l, t, FormatStr, ['e', 'E'])) then 681 | begin 682 | Result := Result or ZE_NUMFORMAT_NUM_IS_SCIENTIFIC; 683 | i := t; 684 | end 685 | else if (IsHaveSymbolsAfterPosQuotas(i - 1, l, t, FormatStr, ['%'])) then 686 | begin 687 | Result := Result or ZE_NUMFORMAT_NUM_IS_PERCENTAGE; 688 | i := t; 689 | end 690 | else if (IsHaveSymbolsAfterPosQuotas(i - 1, l, t, FormatStr, ['/'])) then 691 | begin 692 | Result := Result or ZE_NUMFORMAT_NUM_IS_FRACTION; 693 | i := t; 694 | end; 695 | 696 | if (_CheckSemicolon()) then 697 | exit; 698 | end; 699 | '%': 700 | begin 701 | if (_isSemicolon) then 702 | Result := Result or ZE_NUMFORMAT_IS_NUMBER or ZE_NUMFORMAT_NUM_IS_PERCENTAGE 703 | else 704 | Result := ZE_NUMFORMAT_IS_NUMBER or ZE_NUMFORMAT_NUM_IS_PERCENTAGE; 705 | 706 | if (_CheckSemicolon()) then 707 | exit; 708 | end; 709 | 'E', 'e': 710 | begin 711 | if ((_prev = '0') or (_prev = '#')) then 712 | Result := ZE_NUMFORMAT_IS_NUMBER or ZE_NUMFORMAT_NUM_IS_SCIENTIFIC 713 | else 714 | Result := ZE_NUMFORMAT_IS_DATETIME; 715 | exit; 716 | end; 717 | '@': 718 | begin 719 | Result := ZE_NUMFORMAT_IS_STRING; 720 | exit; 721 | end; 722 | 'H', 'h', 'S', 's', 'm', 'M', 'd', 'D', 'Y', 'y', ':', 'G', 'Q', 'R', 'W', 'N': 723 | begin 724 | Result := ZE_NUMFORMAT_IS_DATETIME; 725 | exit; 726 | end; 727 | ';': 728 | _isSemicolon := true; 729 | end; 730 | _prev := ch; 731 | inc(i); 732 | end; // while i 733 | end; // GetNativeNumberFormatType 734 | 735 | // Convert native number format to xlsx 736 | // INPUT 737 | // const FormatNative: string - number format 738 | // const AFmtParser: TNumFormatParser - format parser (not NIL!) 739 | // const ADateParser: TZDateTimeODSFormatParser - date parser (not NIL!) 740 | // RETURN 741 | // string - number format fox xlsx and excel 2003 xml 742 | function ConvertFormatNativeToXlsx(const FormatNative: string; const AFmtParser: TNumFormatParser; 743 | const ADateParser: TZDateTimeODSFormatParser): string; overload; 744 | var 745 | _FmtParser: TNumFormatParser; 746 | _DateParser: TZDateTimeODSFormatParser; 747 | _delP: boolean; 748 | _delD: boolean; 749 | _fmt: integer; 750 | _len: integer; 751 | 752 | function _AddText(const AStr: string): string; 753 | begin 754 | Result := ''; 755 | _len := length(AStr); 756 | if (_len = 1) then 757 | case (AStr[1]) of 758 | ' ', '.', ',', ':', '-', '+', '/': 759 | Result := AStr; 760 | else 761 | Result := '\' + AStr; 762 | end // case 763 | else 764 | Result := '"' + AStr + '"'; 765 | end; // _AddText 766 | 767 | function _RepeatSymbol(const ASymbol: string; ALen: integer; AMin, AMax: integer): string; 768 | var 769 | i: integer; 770 | begin 771 | Result := ''; 772 | if (ALen < AMin) then 773 | ALen := AMin; 774 | if (ALen > AMax) then 775 | ALen := AMax; 776 | for i := 1 to ALen do 777 | Result := Result + ASymbol; 778 | end; // _RepeatSymbol 779 | 780 | function _AddMonth(var item: TZDateTimeProcessItem): string; 781 | begin 782 | Result := _RepeatSymbol('M', item.Len, 1, 5); 783 | end; // _AddMonth 784 | 785 | function _AddYear(var item: TZDateTimeProcessItem): string; 786 | begin 787 | if (item.Len <= 2) then 788 | Result := 'YY' 789 | else 790 | Result := 'YYYY'; 791 | end; // _AddYear 792 | 793 | function _AddDay(var item: TZDateTimeProcessItem): string; 794 | begin 795 | Result := _RepeatSymbol('D', item.Len, 1, 4); 796 | end; // _AddDay 797 | 798 | function _AddHour(var item: TZDateTimeProcessItem): string; 799 | begin 800 | Result := _RepeatSymbol('H', item.Len, 1, 2); 801 | end; // _AddHour 802 | 803 | function _AddMinute(var item: TZDateTimeProcessItem): string; 804 | begin 805 | Result := _RepeatSymbol('M', item.Len, 1, 2); 806 | end; // _AddMinute 807 | 808 | function _AddSecond(var item: TZDateTimeProcessItem): string; 809 | begin 810 | Result := _RepeatSymbol('S', item.Len, 1, 2); 811 | 812 | if (item.Settings > 0) then 813 | Result := Result + '.' + _RepeatSymbol('0', item.Settings, 1, item.Settings); 814 | end; // _AddSecond 815 | 816 | function _AddAMPM(var item: TZDateTimeProcessItem): string; 817 | begin 818 | case (item.Settings) of 819 | ZE_DATETIME_AMPM_SHORT_LOW: 820 | Result := 'a/p'; 821 | ZE_DATETIME_AMPM_SHORT_UP: 822 | Result := 'A/P'; 823 | ZE_DATETIME_AMPM_LONG_LOW: 824 | Result := 'am/pm'; 825 | else 826 | Result := 'AM/PM'; 827 | end; 828 | end; // _AddAMPM 829 | 830 | function _GetXlsxDateFormat(): string; 831 | var 832 | i: integer; 833 | begin 834 | Result := ''; 835 | for i := 0 to _DateParser.Count - 1 do 836 | case (_DateParser.FItems[i].ItemType) of 837 | ZE_DATETIME_ITEM_TEXT: 838 | Result := Result + _AddText(_DateParser.FItems[i].TextValue); 839 | ZE_DATETIME_ITEM_YEAR: 840 | Result := Result + _AddYear(_DateParser.FItems[i]); 841 | ZE_DATETIME_ITEM_MONTH: 842 | Result := Result + _AddMonth(_DateParser.FItems[i]); 843 | ZE_DATETIME_ITEM_DAY: 844 | Result := Result + _AddDay(_DateParser.FItems[i]); 845 | ZE_DATETIME_ITEM_HOUR: 846 | Result := Result + _AddHour(_DateParser.FItems[i]); 847 | ZE_DATETIME_ITEM_MINUTE: 848 | Result := Result + _AddMinute(_DateParser.FItems[i]); 849 | ZE_DATETIME_ITEM_SECOND: 850 | Result := Result + _AddSecond(_DateParser.FItems[i]); 851 | ZE_DATETIME_ITEM_WEEK: 852 | ; // ?? 853 | ZE_DATETIME_ITEM_QUARTER: 854 | ; // ?? 855 | ZE_DATETIME_ITEM_ERA_JAP: 856 | ; // ?? 857 | ZE_DATETIME_ITEM_ERA_YEAR: 858 | ; // ?? 859 | ZE_DATETIME_ITEM_AMPM: 860 | Result := Result + _AddAMPM(_DateParser.FItems[i]); 861 | end; // case 862 | 863 | end; // _GetXlsxDateFormat 864 | 865 | begin 866 | _fmt := GetNativeNumberFormatType(FormatNative); 867 | 868 | // For now difference only for datetime 869 | if (_fmt and ZE_NUMFORMAT_IS_DATETIME = ZE_NUMFORMAT_IS_DATETIME) then 870 | begin 871 | Result := ''; 872 | _FmtParser := AFmtParser; 873 | _DateParser := ADateParser; 874 | _delP := AFmtParser = Nil; 875 | _delD := ADateParser = Nil; 876 | try 877 | if (_delD) then 878 | _DateParser := TZDateTimeODSFormatParser.Create(); 879 | if (_delP) then 880 | _FmtParser := TNumFormatParser.Create(); 881 | 882 | if (_DateParser.TryToParseDateFormat(FormatNative, _FmtParser) > 0) then 883 | Result := _GetXlsxDateFormat(); 884 | 885 | finally 886 | if (_delP) then 887 | FreeAndNil(_FmtParser); 888 | if (_delD) then 889 | FreeAndNil(_DateParser); 890 | end; 891 | end 892 | else 893 | Result := FormatNative; 894 | end; // ConvertFormatNativeToXlsx 895 | 896 | function ConvertFormatNativeToXlsx(const FormatNative: string): string; overload; 897 | begin 898 | Result := ConvertFormatNativeToXlsx(FormatNative, nil, nil); 899 | end; // ConvertFormatNativeToXlsx 900 | 901 | function ConvertFormatXlsxToNative(const FormatXlsx: string): string; 902 | var 903 | i, l: integer; 904 | _IsQuote: boolean; 905 | _IsBracket: boolean; 906 | s: string; 907 | ch: char; 908 | _semicolonCount: integer; 909 | _prevCh: char; 910 | _strDateList: string; 911 | z: string; 912 | b: boolean; 913 | _isSlash: boolean; 914 | t: integer; 915 | 916 | procedure _AddToResult(const strItem: string; charDate: char); 917 | begin 918 | Result := Result + strItem; 919 | _strDateList := _strDateList + charDate; 920 | s := ''; 921 | end; 922 | 923 | procedure _CheckStringItem(currCh: char); 924 | begin 925 | z := UpperCase(s); 926 | 927 | if ((z = 'YY') or (z = 'YYYY')) then 928 | _AddToResult(z, 'Y') 929 | else if ((z = 'D') or (z = 'DD')) then 930 | _AddToResult(z, 'D') 931 | else if (z = 'DDD') then 932 | _AddToResult('NN', 'D') 933 | else if (z = 'DDDD') then 934 | _AddToResult('NNN', 'D') 935 | else if (z = 'H') then 936 | _AddToResult('h', 'H') 937 | else if (z = 'HH') then 938 | _AddToResult('hh', 'H') 939 | else if (z = 'S') then 940 | _AddToResult('s', 'S') 941 | else if (z = 'SS') then 942 | _AddToResult('ss', 'S') 943 | else if ((z = 'MMM') or (z = 'MMMM') or (z = 'MMMMM')) then 944 | _AddToResult(z, 'M') 945 | else 946 | // Minute or Month? 947 | // If M/MM between 'H/S' - minutes 948 | if (z = 'M') or (z = 'MM') then 949 | begin 950 | // Is it minute? 951 | b := (_prevCh = ':') or (_prevCh = 'H') or (currCh = 'S') or (currCh = ':'); 952 | if (not b) then 953 | begin 954 | t := length(_strDateList); 955 | // if some spaces (or some other symbols) between date symbols 956 | if (t > 0) then 957 | begin 958 | if (_strDateList[t] = 'H') or (_strDateList[t] = 'S') then 959 | b := true; 960 | if (not b) then 961 | // If previous date symbol was "month" then for now - "minute" 962 | b := pos('M', _strDateList) <> 0; 963 | end; 964 | end; 965 | 966 | // If previous date symbal was "minute" then for now - "month" 967 | if (b) then 968 | b := pos('N', _strDateList) = 0; 969 | 970 | // minutes 971 | if (b) then 972 | begin 973 | if (z = 'M') then 974 | _AddToResult('m', 'N') 975 | else 976 | _AddToResult('mm', 'N') 977 | end 978 | else 979 | _AddToResult(z, 'M'); // months 980 | end 981 | else 982 | Result := Result + s; 983 | 984 | _prevCh := currCh; 985 | s := ''; 986 | end; // _CheckStringItem 987 | 988 | procedure _ProcessOpenBracket(); 989 | begin 990 | if _IsQuote then 991 | s := s + ch 992 | else if not _IsBracket then 993 | begin 994 | _CheckStringItem(ch); 995 | _IsBracket := true; 996 | end; 997 | end; // _ProcessOpenBracket 998 | 999 | // [some data] 1000 | procedure _ProcessCloseBracket(); 1001 | var 1002 | z: string; 1003 | begin 1004 | _IsBracket := not _IsBracket; 1005 | 1006 | z := UpperCase(s); 1007 | if (z = 'COLOR1') then 1008 | s := 'BLACK' 1009 | else if (z = 'COLOR2') then 1010 | s := 'WHITE' 1011 | else if (z = 'COLOR3') then 1012 | s := 'RED'; 1013 | // TODO: need add all possible colorXX (1..64??) 1014 | 1015 | Result := Result + '[' + s + ']'; 1016 | _prevCh := ch; 1017 | s := ''; 1018 | end; // _ProcessCloseBracket 1019 | 1020 | procedure _ProcessQuote(addCloseQuote: boolean = true); 1021 | begin 1022 | if (addCloseQuote) then 1023 | _IsQuote := not _IsQuote; 1024 | 1025 | if (_IsQuote) then 1026 | begin 1027 | if (addCloseQuote) then 1028 | Result := Result + '"'; 1029 | 1030 | Result := Result + s; 1031 | 1032 | if (addCloseQuote) then 1033 | Result := Result + '"'; 1034 | end; 1035 | 1036 | s := ''; 1037 | _prevCh := ch; 1038 | end; // _ProcessQuote 1039 | 1040 | procedure _ProcessSemicolon(); 1041 | begin 1042 | inc(_semicolonCount); 1043 | _CheckStringItem(ch); 1044 | end; // _ProcessSemicolon 1045 | 1046 | procedure _ProcessDateTimeSymbol(DTSymbol: char); 1047 | begin 1048 | if (_prevCh = #0) then 1049 | _prevCh := DTSymbol; 1050 | 1051 | if (_prevCh <> DTSymbol) then 1052 | _CheckStringItem(DTSymbol); 1053 | 1054 | s := s + ch; 1055 | end; 1056 | 1057 | begin 1058 | Result := ''; 1059 | _IsQuote := false; 1060 | _IsBracket := false; 1061 | s := ''; 1062 | _semicolonCount := 0; 1063 | _prevCh := #0; 1064 | 1065 | _strDateList := ''; 1066 | 1067 | l := length(FormatXlsx); 1068 | 1069 | _isSlash := false; 1070 | 1071 | for i := 1 to l do 1072 | begin 1073 | ch := FormatXlsx[i]; 1074 | 1075 | if _isSlash then 1076 | begin 1077 | Result := Result + ch; 1078 | _isSlash := false; 1079 | end 1080 | else if (((_IsQuote and (ch <> '"')) or (_IsBracket and (ch <> ']')))) then 1081 | s := s + ch 1082 | else 1083 | case (ch) of 1084 | '[': 1085 | _ProcessOpenBracket(); 1086 | ']': 1087 | _ProcessCloseBracket(); 1088 | '"': 1089 | _ProcessQuote(); 1090 | ';': 1091 | begin 1092 | // only 3 sections maximum available! 1093 | _ProcessSemicolon(); 1094 | if (_semicolonCount >= 3) then 1095 | break; 1096 | Result := Result + ch; 1097 | end; 1098 | 'y', 'Y': 1099 | _ProcessDateTimeSymbol('Y'); 1100 | 'm', 'M': 1101 | _ProcessDateTimeSymbol('M'); 1102 | 'd', 'D': 1103 | _ProcessDateTimeSymbol('D'); 1104 | 's', 'S': 1105 | _ProcessDateTimeSymbol('S'); 1106 | 'h', 'H': 1107 | _ProcessDateTimeSymbol('H'); 1108 | '\': 1109 | begin 1110 | _CheckStringItem(ch); 1111 | Result := Result + ch; 1112 | _isSlash := true; 1113 | end; 1114 | else 1115 | begin 1116 | _CheckStringItem(ch); 1117 | s := s + ch; 1118 | end; 1119 | end; // case ch 1120 | end; // for i 1121 | 1122 | _CheckStringItem(#0); 1123 | end; // TryConvertXlsxToNative 1124 | 1125 | // Try to convert xlsx datetime as number to DateTime 1126 | // INPUT 1127 | // const XlsxDateTime: string - datetime string from xlsx cell value 1128 | // out retDateTime: TDateTime - output datetime (no sense if function returns false!) 1129 | // is1904: boolean - if true than calc dates from 1904 and from 1900 otherwise 1130 | // RETURN 1131 | // boolean - true - ok 1132 | function TryXlsxTimeToDateTime(const XlsxDateTime: string; out retDateTime: TDateTime; is1904: boolean = false) 1133 | : boolean; 1134 | var 1135 | t: Double; 1136 | s1, s2: string; 1137 | i: integer; 1138 | b: boolean; 1139 | ch: char; 1140 | begin 1141 | b := false; 1142 | Result := false; 1143 | s1 := ''; 1144 | s2 := ''; 1145 | 1146 | for i := 1 to length(XlsxDateTime) do 1147 | begin 1148 | ch := XlsxDateTime[i]; 1149 | if ((ch = '.') or (ch = ',')) then 1150 | begin 1151 | if (b) then 1152 | exit; 1153 | b := true; 1154 | end 1155 | else if (b) then 1156 | s2 := s2 + ch 1157 | else 1158 | s1 := s1 + ch; 1159 | end; 1160 | 1161 | if (s1 = '') then 1162 | s1 := '0'; 1163 | 1164 | if (TryStrToInt(s1, i)) then 1165 | begin 1166 | retDateTime := i; 1167 | if (is1904) then 1168 | retDateTime := IncMonth(retDateTime, 12 * 4); 1169 | 1170 | if (s2 <> '') then 1171 | if (TryStrToFloat('0' + FormatSettings.DecimalSeparator + s2, t)) then 1172 | retDateTime := retDateTime + t; 1173 | Result := true; 1174 | end; 1175 | end; // TryXlsxTimeToDateTime 1176 | 1177 | function TryGetNumFormatByName(ANamedFormat: string; out retNumFormat: string): boolean; 1178 | var 1179 | i: integer; 1180 | begin 1181 | Result := false; 1182 | ANamedFormat := UpperCase(ANamedFormat); 1183 | for i := 0 to ZE_VALID_NAMED_FORMATS_COUNT - 1 do 1184 | if (ZE_VALID_NAMED_FORMATS[i][0] = ANamedFormat) then 1185 | begin 1186 | Result := true; 1187 | retNumFormat := ZE_VALID_NAMED_FORMATS[i][1]; 1188 | break; 1189 | end; 1190 | end; 1191 | 1192 | function TryGetMapColorName(AColor: string; out retColorName: string): boolean; 1193 | var 1194 | i: integer; 1195 | begin 1196 | Result := false; 1197 | for i := 0 to ZE_MAP_CONDITIONAL_COLORS_COUNT - 1 do 1198 | if (ZE_MAP_CONDITIONAL_COLORS[i][0] = AColor) then 1199 | begin 1200 | Result := true; 1201 | retColorName := ZE_MAP_CONDITIONAL_COLORS[i][1]; 1202 | break; 1203 | end; 1204 | end; // TryGetMapColor 1205 | 1206 | function TryGetMapColorColor(AColorName: string; out retColor: string): boolean; 1207 | var 1208 | i: integer; 1209 | begin 1210 | Result := false; 1211 | for i := 0 to ZE_MAP_CONDITIONAL_COLORS_COUNT - 1 do 1212 | if (ZE_MAP_CONDITIONAL_COLORS[i][1] = AColorName) then 1213 | begin 1214 | Result := true; 1215 | retColor := ZE_MAP_CONDITIONAL_COLORS[i][0]; 1216 | break; 1217 | end; 1218 | end; // TryGetMapColorColor 1219 | 1220 | function TryGetMapCondition(AConditionStr: string; out retODSCondution: string): boolean; 1221 | var 1222 | i: integer; 1223 | s: string; 1224 | a: array [0 .. 3] of string; 1225 | kol: integer; 1226 | ch: char; 1227 | _isNumber: boolean; 1228 | _isCond: boolean; 1229 | 1230 | procedure _AddItem(); 1231 | begin 1232 | if (kol < 3) then 1233 | begin 1234 | a[kol] := s; 1235 | s := ''; 1236 | inc(kol); 1237 | end; 1238 | end; // _AddItem 1239 | 1240 | procedure _ProcessSymbol(var isPrevTypeSymbol: boolean; var newTypeSymbol: boolean); 1241 | begin 1242 | if (isPrevTypeSymbol and (s <> '')) then 1243 | _AddItem(); 1244 | 1245 | s := s + ch; 1246 | 1247 | isPrevTypeSymbol := false; 1248 | newTypeSymbol := true; 1249 | end; // _ProcessSymbol 1250 | 1251 | function _CheckCondition(): boolean; 1252 | var 1253 | i: integer; 1254 | d: Double; 1255 | begin 1256 | Result := false; 1257 | for i := Low(ZE_VALID_CONDITIONS_STR) to High(ZE_VALID_CONDITIONS_STR) do 1258 | if (a[0] = ZE_VALID_CONDITIONS_STR[i]) then 1259 | begin 1260 | Result := true; 1261 | break; 1262 | end; 1263 | 1264 | if (Result) then 1265 | Result := ZEIsTryStrToFloat(a[1], d); 1266 | 1267 | if (Result) then 1268 | retODSCondution := 'value()' + a[0] + a[1]; 1269 | end; // _CheckCondition 1270 | 1271 | begin 1272 | Result := false; 1273 | retODSCondution := ''; 1274 | kol := 0; 1275 | _isNumber := false; 1276 | _isCond := false; 1277 | 1278 | for i := 1 to length(AConditionStr) do 1279 | begin 1280 | ch := AConditionStr[i]; 1281 | case (ch) of 1282 | '0' .. '9', '.', ',': 1283 | begin 1284 | if (ch = ',') then 1285 | ch := '.'; 1286 | _ProcessSymbol(_isCond, _isNumber); 1287 | end; 1288 | '>', '<', '=': 1289 | _ProcessSymbol(_isNumber, _isCond); 1290 | ' ': 1291 | if (s <> '') then 1292 | _AddItem(); 1293 | end; 1294 | end; // for i 1295 | 1296 | if (s <> '') then 1297 | _AddItem(); 1298 | 1299 | if (kol >= 2) then 1300 | Result := _CheckCondition(); 1301 | end; // TryGetMapCondition 1302 | 1303 | /// /::::::::::::: TZDateTimeODSFormatParser ::::::::::::::::://// 1304 | 1305 | constructor TZDateTimeODSFormatParser.Create(); 1306 | begin 1307 | FCount := 0; 1308 | FMaxCount := 16; 1309 | SetLength(FItems, FMaxCount); 1310 | end; 1311 | 1312 | destructor TZDateTimeODSFormatParser.Destroy(); 1313 | begin 1314 | SetLength(FItems, 0); 1315 | inherited Destroy; 1316 | end; 1317 | 1318 | procedure TZDateTimeODSFormatParser.IncCount(ADelta: integer = 1); 1319 | begin 1320 | if (ADelta > 0) then 1321 | begin 1322 | inc(FCount, ADelta); 1323 | if (FCount >= FMaxCount) then 1324 | begin 1325 | FMaxCount := FCount + 10; 1326 | SetLength(FItems, FMaxCount); 1327 | end; 1328 | end; 1329 | end; // IncCount 1330 | 1331 | procedure TZDateTimeODSFormatParser.CheckMonthMinute(); 1332 | var 1333 | i: integer; 1334 | _left, _right: boolean; 1335 | // Return FALSE if date and TRUE if time 1336 | function _CheckNeighbors(ADateType: integer): boolean; 1337 | begin 1338 | Result := false; 1339 | case (ADateType) of 1340 | (* 1341 | ZE_DATETIME_ITEM_DAY, 1342 | ZE_DATETIME_ITEM_YEAR, 1343 | ZE_DATETIME_ITEM_WEEK, 1344 | ZE_DATETIME_ITEM_MONTH, 1345 | ZE_DATETIME_ITEM_QUARTER: 1346 | Result := false; 1347 | *) 1348 | ZE_DATETIME_ITEM_AMPM, ZE_DATETIME_ITEM_HOUR, ZE_DATETIME_ITEM_SECOND: 1349 | Result := true; 1350 | end; 1351 | end; // _CheckNeighbors 1352 | 1353 | procedure _TryToCheckMonth(AIndex: integer); 1354 | var 1355 | i: integer; 1356 | begin 1357 | _right := false; 1358 | _left := false; 1359 | FItems[AIndex].Settings := 0; 1360 | 1361 | for i := AIndex - 1 downto 0 do 1362 | if (FItems[i].ItemType > 0) then 1363 | begin 1364 | _left := _CheckNeighbors(FItems[i].ItemType); 1365 | break; 1366 | end; 1367 | 1368 | for i := AIndex + 1 to FCount - 1 do 1369 | if (FItems[i].ItemType > 0) then 1370 | begin 1371 | _right := _CheckNeighbors(FItems[i].ItemType); 1372 | break; 1373 | end; 1374 | 1375 | if (_left or _right) then 1376 | FItems[AIndex].ItemType := ZE_DATETIME_ITEM_MINUTE; 1377 | end; // _TryToCheckMonth 1378 | 1379 | begin 1380 | for i := 0 to FCount - 1 do 1381 | if ((FItems[i].ItemType = ZE_DATETIME_ITEM_MONTH) and (FItems[i].Settings = 1)) then 1382 | _TryToCheckMonth(i); 1383 | end; // CheckMonthMinute 1384 | 1385 | function TZDateTimeODSFormatParser.TryToParseDateFormat(const AFmtStr: string; 1386 | const AFmtParser: TNumFormatParser): integer; 1387 | var 1388 | _parser: TNumFormatParser; 1389 | _isFree: boolean; 1390 | s: string; 1391 | _ch, _prevCh: char; 1392 | _tmp: string; 1393 | _len: integer; 1394 | t: integer; 1395 | _pos: integer; 1396 | 1397 | procedure _ProcessDateTimeItem(); 1398 | begin 1399 | if (s <> '') then 1400 | begin 1401 | _tmp := UpperCase(s); 1402 | _len := length(_tmp); 1403 | 1404 | FItems[FCount].Settings := 0; 1405 | FItems[FCount].Len := _len; 1406 | FItems[FCount].TextValue := s; 1407 | 1408 | case (_tmp[1]) of 1409 | 'Y', 'J', 'V': 1410 | FItems[FCount].ItemType := ZE_DATETIME_ITEM_YEAR; 1411 | 'M': 1412 | begin 1413 | FItems[FCount].ItemType := ZE_DATETIME_ITEM_MONTH; 1414 | // If can't recognize month / minute 1415 | if (_len <= 2) then 1416 | FItems[FCount].Settings := 1; 1417 | end; 1418 | 'D': 1419 | FItems[FCount].ItemType := ZE_DATETIME_ITEM_DAY; 1420 | 'N': 1421 | begin 1422 | FItems[FCount].ItemType := ZE_DATETIME_ITEM_DAY; 1423 | inc(FItems[FCount].Len); 1424 | end; 1425 | 'H': 1426 | FItems[FCount].ItemType := ZE_DATETIME_ITEM_HOUR; 1427 | 'W': 1428 | FItems[FCount].ItemType := ZE_DATETIME_ITEM_WEEK; 1429 | 'Q': 1430 | FItems[FCount].ItemType := ZE_DATETIME_ITEM_QUARTER; 1431 | 'R': 1432 | if (_len = 1) then 1433 | begin 1434 | FItems[FCount].ItemType := ZE_DATETIME_ITEM_ERA_YEAR; 1435 | FItems[FCount].Len := 2; 1436 | end 1437 | else 1438 | begin 1439 | FItems[FCount].ItemType := ZE_DATETIME_ITEM_ERA_JAP; 1440 | FItems[FCount].Len := 4; 1441 | end; 1442 | 'E': 1443 | FItems[FCount].ItemType := ZE_DATETIME_ITEM_ERA_YEAR; 1444 | else 1445 | FItems[FCount].ItemType := ZE_DATETIME_ITEM_TEXT; 1446 | end; // case 1447 | 1448 | IncCount(); 1449 | 1450 | s := ''; 1451 | end; 1452 | end; // _ProcessDateTimeItem() 1453 | 1454 | procedure _AddItemCommon(const AStr: string; ALen: integer; AItemType: integer; ASettings: integer = 0); 1455 | begin 1456 | FItems[FCount].ItemType := AItemType; 1457 | FItems[FCount].Len := ALen; 1458 | FItems[FCount].TextValue := AStr; 1459 | FItems[FCount].Settings := ASettings; 1460 | IncCount(); 1461 | end; 1462 | 1463 | procedure _ProcessAMPM(); 1464 | begin 1465 | // check for a/p A/P 1466 | if (_parser.CurrentPos + 1 <= _parser.StrLength) then 1467 | begin 1468 | _tmp := Copy(AFmtStr, _parser.CurrentPos - 1, 3); 1469 | 1470 | if (UpperCase(_tmp) = 'A/P') then 1471 | begin 1472 | if (_parser.FirstSymbol = 'a') then 1473 | t := ZE_DATETIME_AMPM_SHORT_LOW 1474 | else 1475 | t := ZE_DATETIME_AMPM_SHORT_UP; 1476 | _AddItemCommon(_tmp, 3, ZE_DATETIME_ITEM_AMPM, t); 1477 | _parser.IncPos(2); 1478 | 1479 | exit; 1480 | end; 1481 | end; 1482 | 1483 | // check for am/pm AM/PM 1484 | if (_parser.CurrentPos + 3 <= _parser.StrLength) then 1485 | begin 1486 | _tmp := Copy(AFmtStr, _parser.CurrentPos - 1, 5); 1487 | 1488 | if (UpperCase(_tmp) = 'AM/PM') then 1489 | begin 1490 | if (_parser.FirstSymbol = 'a') then 1491 | t := ZE_DATETIME_AMPM_LONG_LOW 1492 | else 1493 | t := ZE_DATETIME_AMPM_LONG_UP; 1494 | _AddItemCommon(_tmp, 5, ZE_DATETIME_ITEM_AMPM, t); 1495 | _parser.IncPos(4); 1496 | 1497 | exit; 1498 | end; 1499 | end; 1500 | 1501 | // It is not AM/PM. May be a year? 1502 | s := s + 'Y'; 1503 | end; // _ProcessAMPM 1504 | 1505 | procedure _ProcessSeconds(); 1506 | begin 1507 | s := _ch; 1508 | _len := 1; 1509 | t := 0; 1510 | while (_parser.CurrentPos <= _parser.StrLength) do 1511 | begin 1512 | _ch := AFmtStr[_parser.CurrentPos]; 1513 | case (_ch) of 1514 | 's', 'S': 1515 | begin 1516 | s := s + _ch; 1517 | inc(_len); 1518 | end 1519 | else 1520 | begin 1521 | if ((_ch = '.') or (_ch = ',')) then 1522 | begin 1523 | s := s + '.'; 1524 | while (_parser.CurrentPos <= _parser.StrLength) do 1525 | begin 1526 | _parser.IncPos(1); 1527 | if (AFmtStr[_parser.CurrentPos] = '0') then 1528 | begin 1529 | s := s + '0'; 1530 | inc(t); 1531 | end 1532 | else 1533 | break; 1534 | end; // while 1535 | end; // if 1536 | 1537 | break; 1538 | end; 1539 | end; 1540 | _parser.IncPos(1); 1541 | end; // while 1542 | _AddItemCommon(s, _len, ZE_DATETIME_ITEM_SECOND, t); 1543 | s := ''; 1544 | end; // _ProcessSeconds 1545 | 1546 | procedure _TryToAddEraJap(); 1547 | begin 1548 | _tmp := UpperCase(s); 1549 | t := -1; 1550 | if (_tmp = 'G') then 1551 | t := 1 1552 | else if (_tmp = 'GG') then 1553 | t := 2 1554 | else if (_tmp = 'GGG') then 1555 | t := 3 1556 | else if (_tmp = 'GGGEE') then 1557 | t := 4; 1558 | 1559 | if (t > 0) then 1560 | _AddItemCommon(s, t, ZE_DATETIME_ITEM_ERA_JAP, t); 1561 | 1562 | s := ''; 1563 | end; 1564 | 1565 | procedure _ProcessEraJap(); 1566 | begin 1567 | s := _ch; 1568 | _pos := _parser.CurrentPos; 1569 | while (_pos <= _parser.StrLength) do 1570 | begin 1571 | _ch := AFmtStr[_pos]; 1572 | case (_ch) of 1573 | 'g', 'G', 'e', 'E': 1574 | s := s + _ch; 1575 | else 1576 | begin 1577 | _TryToAddEraJap(); 1578 | exit; 1579 | end; 1580 | end; 1581 | inc(_pos); 1582 | _parser.IncPos(1); 1583 | end; // while 1584 | 1585 | if (s <> '') then 1586 | _TryToAddEraJap(); 1587 | end; // _ProcessEraJap 1588 | 1589 | procedure _ProcessSymbol(); 1590 | begin 1591 | _ch := _parser.FirstSymbol; 1592 | 1593 | if (UpperCase(_prevCh) = UpperCase(_ch)) then 1594 | s := s + _ch 1595 | else 1596 | begin 1597 | _ProcessDateTimeItem(); 1598 | 1599 | // TODO: 1600 | // Need check all symbols for other locales (A/J/V - as year etc) 1601 | case (_ch) of 1602 | 'a', 'A': 1603 | _ProcessAMPM(); 1604 | 'y', 'Y', 'j', 'J', // German year ?? 1605 | 'v', 'V', // Finnish year ?? 1606 | 'm', 'M', 'd', 'D', 'n', 'N', 'h', 'H', 'w', 'W', 'r', 'R', 'q', 'Q', 'e', 'E': 1607 | s := s + _ch; 1608 | 's', 'S': 1609 | _ProcessSeconds(); 1610 | 'g', 'G': 1611 | _ProcessEraJap(); 1612 | else 1613 | s := s + _ch; 1614 | end; // case 1615 | end; 1616 | 1617 | _prevCh := _ch; 1618 | end; // _ProcessSymbol 1619 | 1620 | procedure _ProcessText(); 1621 | begin 1622 | _ProcessDateTimeItem(); 1623 | FItems[FCount].ItemType := ZE_DATETIME_ITEM_TEXT; 1624 | FItems[FCount].TextValue := _parser.ReadedSymbol; 1625 | IncCount(); 1626 | end; // _ProcessText 1627 | 1628 | begin 1629 | FCount := 0; 1630 | _parser := AFmtParser; 1631 | _isFree := AFmtParser = nil; 1632 | if (_isFree) then 1633 | _parser := TNumFormatParser.Create(); 1634 | 1635 | s := ''; 1636 | _prevCh := #0; 1637 | 1638 | try 1639 | _parser.BeginRead(AFmtStr); 1640 | 1641 | while (_parser.ReadSymbol()) do 1642 | begin 1643 | case (_parser.ReadedSymbolType) of 1644 | 0: 1645 | _ProcessSymbol(); 1646 | 1: 1647 | ; // brackets - modiefier: color, calendar or conditions ?? 1648 | 2, 3: 1649 | _ProcessText(); 1650 | end; 1651 | end; // while 1652 | 1653 | _ProcessDateTimeItem(); 1654 | 1655 | CheckMonthMinute(); 1656 | 1657 | finally 1658 | if (_isFree) then 1659 | FreeAndNil(_parser); 1660 | end; 1661 | 1662 | Result := FCount; 1663 | end; // TryToParseDateFormat 1664 | 1665 | procedure TZDateTimeODSFormatParser.DeleteRepeatedItems(); 1666 | var 1667 | i, j: integer; 1668 | begin 1669 | for i := 1 to FCount - 2 do 1670 | if (FItems[i].ItemType > 0) then 1671 | for j := FCount - 1 downto i + 1 do 1672 | if (FItems[i].ItemType = FItems[j].ItemType) then 1673 | begin 1674 | if (FItems[i].ItemType = ZE_DATETIME_ITEM_DAY) then 1675 | begin 1676 | if (FItems[i].Len = FItems[j].Len) then 1677 | FItems[j].ItemType := ZE_DATETIME_ITEM_ERROR; 1678 | end 1679 | else 1680 | FItems[j].ItemType := ZE_DATETIME_ITEM_ERROR; 1681 | end; 1682 | end; // DeleteRepeatedItems 1683 | 1684 | function TZDateTimeODSFormatParser.GetValidCount(): integer; 1685 | var 1686 | i: integer; 1687 | begin 1688 | Result := 0; 1689 | for i := 1 to FCount - 1 do 1690 | if (FItems[i].ItemType >= 0) then 1691 | inc(Result); 1692 | end; // GetValidCount 1693 | 1694 | /// /::::::::::::: TNumFormatParser ::::::::::::::::://// 1695 | 1696 | procedure TNumFormatParser.Clear(); 1697 | begin 1698 | FLen := -1; 1699 | FPos := 1; 1700 | FStr := ''; 1701 | FIsError := 0; 1702 | FReadedSymbolType := 0; 1703 | FReadedSymbol := ''; 1704 | FFirstSymbol := #0; 1705 | end; 1706 | 1707 | constructor TNumFormatParser.Create(); 1708 | begin 1709 | Clear(); 1710 | end; 1711 | 1712 | procedure TNumFormatParser.BeginRead(const AStr: string); 1713 | begin 1714 | Clear(); 1715 | FStr := AStr; 1716 | FLen := length(AStr); 1717 | end; 1718 | 1719 | function TNumFormatParser.ReadSymbol(): boolean; 1720 | var 1721 | ch: char; 1722 | procedure _ReadBeforeSymbol(Symbol: char); 1723 | begin 1724 | if (FPos <= FLen) then 1725 | FFirstSymbol := FStr[FPos]; 1726 | 1727 | while (FPos <= FLen) do 1728 | begin 1729 | ch := FStr[FPos]; 1730 | inc(FPos); 1731 | 1732 | if (ch = Symbol) then 1733 | exit; 1734 | 1735 | FReadedSymbol := FReadedSymbol + ch; 1736 | end; // while 1737 | 1738 | FIsError := FIsError or 2; 1739 | end; // _ReadBeforeSymbol 1740 | 1741 | begin 1742 | FFirstSymbol := #0; 1743 | if (FPos > FLen) then 1744 | begin 1745 | Result := false; 1746 | exit; 1747 | end; 1748 | 1749 | FReadedSymbol := ''; 1750 | 1751 | Result := true; 1752 | while (FPos <= FLen) do 1753 | begin 1754 | ch := FStr[FPos]; 1755 | inc(FPos); 1756 | 1757 | case ch of 1758 | '[': 1759 | begin 1760 | FReadedSymbolType := 1; 1761 | _ReadBeforeSymbol(']'); 1762 | exit; 1763 | end; 1764 | '"': 1765 | begin 1766 | FReadedSymbolType := 2; 1767 | _ReadBeforeSymbol('"'); 1768 | exit; 1769 | end; 1770 | '\': 1771 | begin 1772 | if (FPos <= FLen) then 1773 | begin 1774 | FFirstSymbol := FStr[FPos]; 1775 | FReadedSymbol := FFirstSymbol; 1776 | end 1777 | else 1778 | begin 1779 | FIsError := FIsError or 4; 1780 | FReadedSymbol := ''; 1781 | end; 1782 | inc(FPos); 1783 | FReadedSymbolType := 3; 1784 | exit; 1785 | end; 1786 | else 1787 | begin 1788 | FReadedSymbol := ch; 1789 | FFirstSymbol := ch; 1790 | FReadedSymbolType := 0; 1791 | exit; 1792 | end; 1793 | end; // case 1794 | end; // while 1795 | 1796 | FIsError := FIsError or 1; 1797 | end; // ReadSymbol 1798 | 1799 | procedure TNumFormatParser.IncPos(ADelta: integer); 1800 | begin 1801 | inc(FPos, ADelta); 1802 | if (FPos < 1) then 1803 | FPos := 1; 1804 | end; // IncPos 1805 | 1806 | /// /::::::::::::: TZEODSNumberFormatReader ::::::::::::::::://// 1807 | 1808 | procedure TZEODSNumberFormatReader.AddEmbededText(const AText: string; ANumberPosition: integer); 1809 | var 1810 | i, _pos: integer; 1811 | begin 1812 | if (FEmbededTextCount >= FEmbededMaxCount) then 1813 | begin 1814 | inc(FEmbededMaxCount, 10); 1815 | SetLength(FEmbededTextArray, FEmbededMaxCount); 1816 | end; 1817 | 1818 | _pos := -1; 1819 | 1820 | for i := 0 to FEmbededTextCount - 1 do 1821 | if (ANumberPosition < FEmbededTextArray[i].NumberPosition) then 1822 | begin 1823 | _pos := i; 1824 | break; 1825 | end; 1826 | 1827 | if (_pos >= 0) then 1828 | begin 1829 | for i := FEmbededTextCount + 1 downto _pos + 1 do 1830 | FEmbededTextArray[i] := FEmbededTextArray[i - 1]; 1831 | end 1832 | else 1833 | _pos := FEmbededTextCount; 1834 | 1835 | FEmbededTextArray[_pos].Txt := AText; 1836 | FEmbededTextArray[_pos].NumberPosition := ANumberPosition; 1837 | 1838 | inc(FEmbededTextCount); 1839 | end; 1840 | 1841 | procedure TZEODSNumberFormatReader.AddItem(); 1842 | var 1843 | i: integer; 1844 | begin 1845 | inc(FCount); 1846 | if (FCount >= FCountMax) then 1847 | begin 1848 | inc(FCountMax, 20); 1849 | SetLength(FItems, FCountMax); 1850 | SetLength(FItemsOptions, FCountMax); 1851 | for i := FCount to FCount - 1 do 1852 | begin 1853 | FItemsOptions[i].isColor := false; 1854 | FItemsOptions[i].ColorStr := ''; 1855 | end; 1856 | end; 1857 | end; 1858 | 1859 | constructor TZEODSNumberFormatReader.Create(); 1860 | var 1861 | i: integer; 1862 | begin 1863 | FCount := 0; 1864 | FCountMax := 20; 1865 | FEmbededMaxCount := 10; 1866 | SetLength(FItems, FCountMax); 1867 | SetLength(FItemsOptions, FCountMax); 1868 | SetLength(FEmbededTextArray, FEmbededMaxCount); 1869 | for i := 0 to FCountMax - 1 do 1870 | begin 1871 | FItemsOptions[i].isColor := false; 1872 | FItemsOptions[i].ColorStr := ''; 1873 | FItemsOptions[i].StyleType := 0; 1874 | end; 1875 | end; 1876 | 1877 | destructor TZEODSNumberFormatReader.Destroy(); 1878 | begin 1879 | SetLength(FItems, 0); 1880 | SetLength(FItemsOptions, 0); 1881 | SetLength(FEmbededTextArray, 0); 1882 | inherited; 1883 | end; 1884 | 1885 | function TZEODSNumberFormatReader.BeginReadFormat(const Xml: TZsspXMLReaderH; out retStartString: string; 1886 | const NumFormat: integer): integer; 1887 | begin 1888 | Result := FCount; 1889 | AddItem(); 1890 | FItems[Result][0] := Xml.Attributes[ZETag_Attr_StyleName]; 1891 | FItemsOptions[Result].StyleType := NumFormat; 1892 | retStartString := ''; 1893 | end; // BeginReadFormat 1894 | 1895 | // Read date format: .. 1896 | procedure TZEODSNumberFormatReader.ReadDateFormat(const Xml: TZsspXMLReaderH; const ATagName: string); 1897 | var 1898 | num: integer; 1899 | s, _result: string; 1900 | _isLong: boolean; 1901 | t: integer; 1902 | i: integer; 1903 | 1904 | function CheckIsLong(const isTrue, isFalse: string): string; 1905 | begin 1906 | if (Xml.Attributes[ZETag_number_style] = ZETag_long) then 1907 | Result := isTrue 1908 | else 1909 | Result := isFalse; 1910 | end; 1911 | 1912 | begin 1913 | _isLong := false; 1914 | num := BeginReadFormat(Xml, _result, ZE_NUMFORMAT_IS_DATETIME); 1915 | 1916 | while Xml.ReadToEndTagByName(ATagName) do 1917 | begin 1918 | // Day 1919 | if ((Xml.TagName = ZETag_number_day) and (Xml.IsTagOfData)) then 1920 | _result := _result + CheckIsLong('DD', 'D') 1921 | else 1922 | // Text 1923 | if Xml.IsTagEndByName(ZETag_number_text) then 1924 | begin 1925 | s := Xml.TextBeforeTag; 1926 | t := length(s); 1927 | if (t = 1) then 1928 | begin 1929 | case (s[1]) of 1930 | ' ', '.', ':', '-', '/', '*': 1931 | ; 1932 | else 1933 | s := '\' + s; 1934 | end; // case 1935 | end 1936 | else 1937 | s := '"' + s + '"'; 1938 | 1939 | _result := _result + s; 1940 | end 1941 | else 1942 | // Month 1943 | if (Xml.TagName = ZETag_number_month) then 1944 | begin 1945 | _isLong := Xml.Attributes[ZETag_number_style] = ZETag_long; 1946 | s := Xml.Attributes[ZETag_number_textual]; 1947 | if (ZEStrToBoolean(s)) then 1948 | _result := _result + IfThen(_isLong, 'MMMM', 'MMM') 1949 | else 1950 | _result := _result + IfThen(_isLong, 'MM', 'M') 1951 | end 1952 | else 1953 | // Year 1954 | if (Xml.TagName = ZETag_number_year) then 1955 | _result := _result + CheckIsLong('YYYY', 'YY') 1956 | else 1957 | // Hours 1958 | if (Xml.TagName = ZETag_number_hours) then 1959 | _result := _result + CheckIsLong('HH', 'H') 1960 | else 1961 | // Minutes 1962 | if (Xml.TagName = ZETag_number_minutes) then 1963 | _result := _result + CheckIsLong('mm', 'm') 1964 | else 1965 | // Seconds 1966 | if (Xml.TagName = ZETag_number_seconds) then 1967 | begin 1968 | _result := _result + CheckIsLong('ss', 's'); 1969 | s := Xml.Attributes[ZETag_number_decimal_places]; 1970 | if (s <> '') then 1971 | if (TryStrToInt(s, t)) then 1972 | if (t > 0) then 1973 | begin 1974 | _result := _result + '.'; 1975 | for i := 1 to t do 1976 | _result := _result + '0'; 1977 | end; 1978 | end 1979 | else 1980 | // AM/PM 1981 | if (Xml.TagName = ZETag_number_am_pm) then 1982 | begin 1983 | _result := _result + 'AM/PM'; 1984 | end 1985 | else 1986 | // Era 1987 | if (Xml.TagName = ZETag_number_era) then 1988 | begin 1989 | // Attr: number:calendar 1990 | // number:style 1991 | _result := _result + IfThen(_isLong, 'GG', 'G') 1992 | end 1993 | else 1994 | // Quarter 1995 | if (Xml.TagName = ZETag_number_quarter) then 1996 | begin 1997 | // Attr: number:calendar 1998 | // number:style 1999 | _result := _result + CheckIsLong('QQ', 'Q') 2000 | end 2001 | else 2002 | // Day of week 2003 | if (Xml.TagName = ZETag_number_day_of_week) then 2004 | begin 2005 | // Attr: number:calendar 2006 | // number:style 2007 | _result := _result + CheckIsLong('NNN', 'NN') 2008 | end 2009 | else 2010 | // Week of year 2011 | if (Xml.TagName = ZETag_number_week_of_year) then 2012 | begin 2013 | // Attr: number:calendar 2014 | _result := _result + 'WW'; 2015 | end; 2016 | 2017 | if (Xml.Eof()) then 2018 | break; 2019 | end; // while 2020 | FItems[num][1] := _result; 2021 | end; // ReadDateFormat 2022 | 2023 | // Read string format .. 2024 | procedure TZEODSNumberFormatReader.ReadStringFormat(const Xml: TZsspXMLReaderH); 2025 | var 2026 | num: integer; 2027 | _result: string; 2028 | 2029 | begin 2030 | num := BeginReadFormat(Xml, _result, ZE_NUMFORMAT_IS_STRING); 2031 | 2032 | // Possible attributes for tag "number:text-style": 2033 | // number:country 2034 | // number:language 2035 | // number:rfc-language-tag 2036 | // number:script 2037 | // number:title 2038 | // number:transliteration-country 2039 | // number:transliteration-format 2040 | // number:transliteration-language 2041 | // number:transliteration-style 2042 | // style:display-name 2043 | // style:name 2044 | // style:volatile 2045 | 2046 | // Possible child elements: 2047 | // number:text * 2048 | // number:text-content * 2049 | // style:map 2050 | // style:textproperties 2051 | while ((not Xml.IsTagEnd) or (Xml.TagName <> ZETag_number_text_style)) do 2052 | begin 2053 | Xml.ReadTag(); 2054 | 2055 | // number:text-content 2056 | if ((Xml.TagName = ZETag_number_text_content)) then 2057 | _result := _result + '@' 2058 | else 2059 | // Text 2060 | if ((Xml.TagName = ZETag_number_text) and (Xml.IsTagEnd)) then 2061 | _result := _result + '"' + Xml.TextBeforeTag + '"'; 2062 | 2063 | if (Xml.Eof()) then 2064 | break; 2065 | end; // while 2066 | FItems[num][1] := _result; 2067 | end; // ReadStringFormat 2068 | 2069 | // Read known numbers formats (date/number/percentage etc) 2070 | procedure TZEODSNumberFormatReader.ReadKnownNumberFormat(const Xml: TZsspXMLReaderH); 2071 | begin 2072 | if (Xml.TagName = ZETag_number_number_style) then 2073 | ReadNumberFormat(Xml) 2074 | else if (Xml.TagName = ZETag_number_currency_style) then 2075 | ReadCurrencyFormat(Xml) 2076 | else if (Xml.TagName = ZETag_number_percentage_style) then 2077 | ReadPercentageFormat(Xml) 2078 | else if (Xml.TagName = ZETag_number_date_style) then 2079 | ReadDateFormat(Xml, ZETag_number_date_style) 2080 | else if (Xml.TagName = ZETag_number_time_style) then 2081 | ReadDateFormat(Xml, ZETag_number_time_style) 2082 | else if (Xml.TagName = ZETag_number_text_style) then 2083 | ReadStringFormat(Xml); 2084 | end; 2085 | 2086 | procedure TZEODSNumberFormatReader.ReadCurrencyFormat(const Xml: TZsspXMLReaderH); 2087 | begin 2088 | ReadNumberFormatCommon(Xml, ZETag_number_currency_style, ZE_NUMFORMAT_NUM_IS_CURRENCY); 2089 | end; 2090 | 2091 | // Read number style: .. 2092 | procedure TZEODSNumberFormatReader.ReadNumberFormat(const Xml: TZsspXMLReaderH); 2093 | begin 2094 | ReadNumberFormatCommon(Xml, ZETag_number_number_style, 0); 2095 | end; 2096 | 2097 | // Read number style: .. 2098 | procedure TZEODSNumberFormatReader.ReadPercentageFormat(const Xml: TZsspXMLReaderH); 2099 | begin 2100 | ReadNumberFormatCommon(Xml, ZETag_number_percentage_style, ZE_NUMFORMAT_NUM_IS_PERCENTAGE); 2101 | end; 2102 | 2103 | // Read Number/currency/percentage number format style 2104 | // INPUT 2105 | // const xml: TZsspXMLReaderH - xml 2106 | // const NumberFormatTag: string - tag name 2107 | // sub_number_type: integer - additional flag for number (percentage/scientific etc) 2108 | procedure TZEODSNumberFormatReader.ReadNumberFormatCommon(const Xml: TZsspXMLReaderH; const NumberFormatTag: string; 2109 | sub_number_type: integer); 2110 | var 2111 | num: integer; 2112 | s, _result, _txt, _style_name: string; 2113 | _cond_text: string; 2114 | _cond: string; 2115 | _decimalPlaces: integer; 2116 | _min_int_digits: integer; 2117 | _display_factor: integer; 2118 | _number_grouping: boolean; 2119 | _number_position: integer; 2120 | _is_number_decimal_replacement: boolean; 2121 | ch: char; 2122 | 2123 | _min_numerator_digits: integer; 2124 | _min_denominator_digits: integer; 2125 | _denominator_value: integer; 2126 | 2127 | procedure _TryGetIntValue(const ATagName: string; out retIntValue: integer; const ADefValue: integer = 0); 2128 | begin 2129 | s := Xml.Attributes[ATagName]; 2130 | if (not TryStrToInt(s, retIntValue)) then 2131 | retIntValue := ADefValue; 2132 | end; 2133 | 2134 | procedure _ReadNumber_NumberPrepare(); 2135 | begin 2136 | FEmbededTextCount := 0; 2137 | 2138 | _TryGetIntValue(ZETag_number_decimal_places, _decimalPlaces); 2139 | _TryGetIntValue(ZETag_number_min_integer_digits, _min_int_digits); 2140 | 2141 | s := Xml.Attributes[ZETag_number_display_factor]; 2142 | if (s <> '') then 2143 | begin 2144 | if (not TryStrToInt(s, _display_factor)) then 2145 | _display_factor := 1; 2146 | end 2147 | else 2148 | _display_factor := 1; 2149 | 2150 | _number_grouping := false; 2151 | s := Xml.Attributes[ZETag_number_grouping]; 2152 | if (s <> '') then 2153 | _number_grouping := ZEStrToBoolean(s); 2154 | 2155 | _is_number_decimal_replacement := Xml.Attributes.IsContainsAttribute(ZETag_number_decimal_replacement); 2156 | end; // _ReadNumber_NumberPrepare 2157 | 2158 | procedure _ReadEmbededText(); 2159 | begin 2160 | _number_position := -100; 2161 | while ((not Xml.IsTagEnd) or (Xml.TagName <> ZETag_number_number)) do 2162 | begin 2163 | Xml.ReadTag(); 2164 | 2165 | // .. 2166 | if (Xml.TagName = ZETag_number_embedded_text) then 2167 | begin 2168 | if (Xml.IsTagStart) then 2169 | _TryGetIntValue(ZETag_number_position, _number_position, -100) 2170 | else if ((Xml.IsTagEnd) and (_number_position >= 0)) then 2171 | if (Xml.TextBeforeTag <> '') then 2172 | AddEmbededText(ZEReplaceEntity(Xml.TextBeforeTag), _number_position); 2173 | end; 2174 | 2175 | if (Xml.Eof()) then 2176 | break; 2177 | end; // while 2178 | end; // _ReadEmbededText 2179 | 2180 | function _GetRepeatedString(ACount: integer; const AStr: string): string; 2181 | var 2182 | i: integer; 2183 | begin 2184 | Result := ''; 2185 | for i := 1 to ACount do 2186 | Result := Result + AStr; 2187 | end; 2188 | 2189 | // .. 2190 | procedure _ReadNumber_Number(); 2191 | var 2192 | i, j: integer; 2193 | _pos: integer; 2194 | _currentpos: integer; // current position for embeded text 2195 | 2196 | begin 2197 | _currentpos := 0; 2198 | _ReadNumber_NumberPrepare(); 2199 | 2200 | if (Xml.IsTagStart) then 2201 | _ReadEmbededText(); 2202 | 2203 | if (FEmbededTextCount > 0) then 2204 | begin 2205 | s := ''; 2206 | _pos := 0; 2207 | 2208 | for i := 0 to FEmbededTextCount - 1 do 2209 | if (FEmbededTextArray[i].NumberPosition >= 0) then 2210 | begin 2211 | _currentpos := FEmbededTextArray[i].NumberPosition; 2212 | // TODO: need test. For example: if symbol "%" not one? (%0%0.00% or "%"0.0) 2213 | (* 2214 | if (FEmbededTextArray[i].Txt = '%') then 2215 | _txt := '%' 2216 | else 2217 | *) 2218 | _txt := '"' + ZEReplaceEntity(FEmbededTextArray[i].Txt) + '"'; 2219 | 2220 | if (_currentpos <= _min_int_digits) then 2221 | ch := '0' 2222 | else 2223 | ch := '#'; 2224 | 2225 | for j := _pos to _currentpos - 1 do 2226 | s := ch + s; 2227 | s := _txt + s; 2228 | _pos := _currentpos; 2229 | end; 2230 | 2231 | if (_currentpos < _min_int_digits) then 2232 | for j := _pos to _min_int_digits - 1 do 2233 | s := '0' + s; 2234 | 2235 | _result := _result + s; 2236 | end 2237 | else 2238 | begin 2239 | if (_min_int_digits = 0) then 2240 | _result := _result + '#' 2241 | else 2242 | for i := 0 to _min_int_digits - 1 do 2243 | _result := _result + '0'; 2244 | end; 2245 | 2246 | if (_decimalPlaces > 0) then 2247 | begin 2248 | if (_is_number_decimal_replacement) then 2249 | ch := '#' 2250 | else 2251 | ch := '0'; 2252 | 2253 | _result := _result + ZE_NUMBER_FORMAT_DECIMAL_SEPARATOR; 2254 | for i := 0 to _decimalPlaces - 1 do 2255 | _result := _result + ch; 2256 | end; 2257 | end; // _ReadNumber_Number 2258 | 2259 | // 2260 | procedure _ReadNumber_Fraction(); 2261 | begin 2262 | _ReadNumber_NumberPrepare(); 2263 | 2264 | _TryGetIntValue(ZETag_number_min_numerator_digits, _min_numerator_digits); 2265 | _TryGetIntValue(ZETag_number_min_denominator_digits, _min_denominator_digits); 2266 | // TODO: do not forget about denominator_value! 2267 | _TryGetIntValue(ZETag_number_denominator_value, _denominator_value); 2268 | 2269 | if (_min_int_digits <= 0) then 2270 | s := '#' 2271 | else 2272 | s := _GetRepeatedString(_min_int_digits, '0'); 2273 | 2274 | _result := _result + s; 2275 | 2276 | if ((_min_numerator_digits > 0) and (_min_denominator_digits > 0)) then 2277 | _result := _result + ' ' + _GetRepeatedString(_min_numerator_digits, '?') + '/' + 2278 | _GetRepeatedString(_min_denominator_digits, '?'); 2279 | 2280 | FItemsOptions[num].StyleType := FItemsOptions[num].StyleType or ZE_NUMFORMAT_NUM_IS_FRACTION; 2281 | end; // _ReadNumber_Fraction 2282 | 2283 | // 2284 | procedure _ReadNumber_Scientific(); 2285 | var 2286 | _min_exponent_digits: integer; 2287 | 2288 | begin 2289 | _ReadNumber_NumberPrepare(); 2290 | 2291 | _TryGetIntValue(ZETag_number_min_exponent_digits, _min_exponent_digits); 2292 | 2293 | if (_min_exponent_digits > 0) then 2294 | begin 2295 | _result := _result + _GetRepeatedString(_min_int_digits, '0') + ZE_NUMBER_FORMAT_DECIMAL_SEPARATOR + 2296 | _GetRepeatedString(_decimalPlaces, '0') + 'E+' + _GetRepeatedString(_min_exponent_digits, '0'); 2297 | 2298 | FItemsOptions[num].StyleType := FItemsOptions[num].StyleType or ZE_NUMFORMAT_NUM_IS_SCIENTIFIC; 2299 | end; 2300 | end; // _ReadNumber_Scientific 2301 | 2302 | // .. 2303 | procedure _ReadCurrecny_Symbol(); 2304 | begin 2305 | // TODO: need get currency symbol by attributes: 2306 | // ZETag_number_language = 'number:language' 2307 | // ZETag_number_country = 'number:country' 2308 | if (Xml.IsTagStart) then 2309 | while ((not Xml.IsTagEnd) or (Xml.TagName <> ZETag_number_currency_symbol)) do 2310 | begin 2311 | Xml.ReadTag(); 2312 | 2313 | (* //if need currency name in future 2314 | if (xml.TagName = ZETag_number_currency_symbol) then 2315 | s := xml.TextBeforeTag; 2316 | *) 2317 | 2318 | if (Xml.Eof()) then 2319 | break; 2320 | end; // while 2321 | end; // _ReadCurrecny_Symbol 2322 | 2323 | // 2324 | procedure _ReadStyleMap(); 2325 | var 2326 | i: integer; 2327 | 2328 | begin 2329 | _cond := ZEReplaceEntity(Xml.Attributes[ZETag_style_condition]); 2330 | if (_cond <> '') then 2331 | begin 2332 | i := pos('value()', _cond); 2333 | if (i = 1) then 2334 | delete(_cond, 1, 7) 2335 | else 2336 | exit; 2337 | 2338 | if (_cond <> '') then 2339 | begin 2340 | _style_name := Xml.Attributes[ZETag_style_apply_style_name]; 2341 | for i := 0 to FCount - 1 do 2342 | if (FItems[i][0] = _style_name) then 2343 | begin 2344 | _txt := FItems[i][1]; 2345 | 2346 | _cond_text := _cond_text + '[' + _cond + ']' + _txt + ';'; 2347 | 2348 | break; 2349 | end; 2350 | end; // if 2351 | end; // if 2352 | end; // _ReadStyleMap 2353 | 2354 | // (color by condition) 2355 | procedure _ReadStyleTextProperties(); 2356 | begin 2357 | // for now only colors 2358 | s := UpperCase(Xml.Attributes[ZETag_fo_color]); 2359 | if (TryGetMapColorName(s, _txt)) then 2360 | begin 2361 | FItemsOptions[num].isColor := true; 2362 | FItemsOptions[num].ColorStr := _txt; 2363 | _result := _result + '[' + _txt + ']'; 2364 | end; 2365 | end; // _ReadStyleTextProperties 2366 | 2367 | begin 2368 | num := BeginReadFormat(Xml, _result, ZE_NUMFORMAT_IS_NUMBER or sub_number_type); 2369 | _cond_text := ''; 2370 | 2371 | while ((not Xml.IsTagEnd) or (Xml.TagName <> NumberFormatTag)) do 2372 | begin 2373 | Xml.ReadTag(); 2374 | 2375 | if (Xml.TagName = ZETag_number_number) then 2376 | _ReadNumber_Number() 2377 | else if (Xml.TagName = ZETag_number_fraction) then 2378 | _ReadNumber_Fraction() 2379 | else if (Xml.TagName = ZETag_number_scientific_number) then 2380 | _ReadNumber_Scientific() 2381 | else if (Xml.TagName = ZETag_number_currency_symbol) then 2382 | _ReadCurrecny_Symbol() 2383 | else if ((Xml.TagName = ZETag_number_text) and (Xml.IsTagEnd)) then 2384 | begin 2385 | s := ZEReplaceEntity(Xml.TextBeforeTag); 2386 | if (s = '"') then 2387 | _result := _result + '\' + s 2388 | else if (s = '%') then 2389 | _result := _result + s 2390 | else 2391 | _result := _result + '"' + s + '"'; 2392 | end 2393 | else if (Xml.TagName = ZETag_style_map) then 2394 | _ReadStyleMap() 2395 | else if (Xml.TagName = ZETag_style_text_properties) then 2396 | _ReadStyleTextProperties(); 2397 | 2398 | if (Xml.Eof()) then 2399 | break; 2400 | end; // while 2401 | 2402 | // first - map number styles, after - current readed number format 2403 | FItems[num][1] := _cond_text + _result; 2404 | end; // ReadNumberFormatCommon 2405 | 2406 | function TZEODSNumberFormatReader.TryGetFormatStrByNum(const DataStyleName: string; out retFormatStr: string): boolean; 2407 | var 2408 | i: integer; 2409 | begin 2410 | Result := false; 2411 | for i := 0 to FCount - 1 do 2412 | if (FItems[i][0] = DataStyleName) then 2413 | begin 2414 | Result := true; 2415 | retFormatStr := FItems[i][1]; 2416 | break; 2417 | end; 2418 | end; // TryGetFormatStrByNum 2419 | 2420 | /// /::::::::::::: TZEODSNumberFormatWriter ::::::::::::::::://// 2421 | 2422 | constructor TZEODSNumberFormatWriter.Create(const AMaxCount: integer); 2423 | var 2424 | i: integer; 2425 | begin 2426 | FCount := 0; 2427 | FCountMax := AMaxCount; 2428 | if (FCountMax < 10) then 2429 | FCountMax := 10; 2430 | SetLength(FItems, FCountMax); 2431 | 2432 | SetLength(FNumberAdditionalProps, FCountMax); 2433 | for i := 0 to FCountMax - 1 do 2434 | FNumberAdditionalProps[i] := 0; 2435 | 2436 | FCurrentNFIndex := 100; 2437 | 2438 | FNFItemsCount := 0; 2439 | SetLength(FNFItems, ZE_MAX_NF_ITEMS_COUNT); 2440 | for i := 0 to ZE_MAX_NF_ITEMS_COUNT - 1 do 2441 | FNFItems[i] := TODSNumberFormatMapItem.Create(); 2442 | end; 2443 | 2444 | destructor TZEODSNumberFormatWriter.Destroy(); 2445 | var 2446 | i: integer; 2447 | begin 2448 | SetLength(FItems, 0); 2449 | for i := 0 to ZE_MAX_NF_ITEMS_COUNT - 1 do 2450 | FreeAndNil(FNFItems[i]); 2451 | SetLength(FNFItems, 0); 2452 | 2453 | SetLength(FNumberAdditionalProps, 0); 2454 | 2455 | inherited; 2456 | end; 2457 | 2458 | // Try to find number format name for style num StyleID 2459 | // INPUT 2460 | // StyleID: integer - style ID 2461 | // out NumberFormatName: string - finded number format name 2462 | // RETURN 2463 | // boolean - true - number format finded 2464 | function TZEODSNumberFormatWriter.TryGetNumberFormatName(StyleID: integer; out NumberFormatName: string): boolean; 2465 | var 2466 | i: integer; 2467 | begin 2468 | Result := false; 2469 | for i := 0 to FCount - 1 do 2470 | if (FItems[i].StyleIndex = StyleID) then 2471 | begin 2472 | NumberFormatName := FItems[i].NumberFormatName; 2473 | Result := true; 2474 | break; 2475 | end; 2476 | end; // TryGetNumberFormatName 2477 | 2478 | // Try to find additional properties for number format 2479 | // INPUT 2480 | // StyleID: integer - style ID 2481 | // out NumberFormatProp: integer - finded number additional properties 2482 | // RETURN 2483 | // boolean - true - additional properties is found 2484 | function TZEODSNumberFormatWriter.TryGetNumberFormatAddProp(StyleID: integer; out NumberFormatProp: integer): boolean; 2485 | begin 2486 | Result := (StyleID >= 0) and (StyleID < FCountMax); 2487 | 2488 | if (Result) then 2489 | NumberFormatProp := FNumberAdditionalProps[StyleID] 2490 | else 2491 | NumberFormatProp := 0; 2492 | end; // TryGetNumberFormatAddProp 2493 | 2494 | // Separate number format string by ";". 2495 | // INPUT 2496 | // const NFStr: string - Number format string (like "nf1;nf2;nf3") 2497 | // RETURN 2498 | // integer - count of number format items 2499 | function TZEODSNumberFormatWriter.SeparateNFItems(const NFStr: string): integer; 2500 | var 2501 | i, l: integer; 2502 | b: boolean; 2503 | s: string; 2504 | ch: char; 2505 | begin 2506 | b := true; 2507 | s := ''; 2508 | 2509 | l := length(NFStr); 2510 | 2511 | for i := 1 to l do 2512 | begin 2513 | ch := NFStr[i]; 2514 | 2515 | if (ch = '"') then 2516 | b := not b; 2517 | 2518 | if (b) then 2519 | begin 2520 | if (ch = ';') then 2521 | begin 2522 | TryAddNFItem(s); 2523 | s := ''; 2524 | end 2525 | else 2526 | s := s + ch; 2527 | end 2528 | else 2529 | s := s + ch; 2530 | end; // for i 2531 | 2532 | if (s <> '') then 2533 | TryAddNFItem(s); 2534 | 2535 | Result := FNFItemsCount; 2536 | end; // PrepareNFItems 2537 | 2538 | // Try to add NumberFormat item (from string "NF1;NF2;NF3") 2539 | // Checks: 2540 | // 1. Count of NF items (max = 3) 2541 | // 2. is NF item valid 2542 | // INPUT 2543 | // const NFStr: string - NF item 2544 | // RETURN 2545 | // boolean - true - item added 2546 | function TZEODSNumberFormatWriter.TryAddNFItem(const NFStr: string): boolean; 2547 | begin 2548 | Result := false; 2549 | 2550 | if (FNFItemsCount < ZE_MAX_NF_ITEMS_COUNT) then 2551 | begin 2552 | Result := FNFItems[FNFItemsCount].TryToParse(NFStr); 2553 | if (Result) then 2554 | inc(FNFItemsCount); 2555 | end; 2556 | end; // TryAddNFItem 2557 | 2558 | // Try to write number format to xml 2559 | // INPUT 2560 | // const xml: TZsspXMLWriterH - xml 2561 | // StyleID: integer - Style ID 2562 | // ANumberFormat: string - number format 2563 | // RETURN 2564 | // boolean - true - NumberFormat was written ok 2565 | function TZEODSNumberFormatWriter.TryWriteNumberFormat(const Xml: TZsspXMLWriterH; StyleID: integer; 2566 | ANumberFormat: string): boolean; 2567 | var 2568 | s: string; 2569 | _nfType: integer; 2570 | _nfName: string; 2571 | 2572 | function _WriteNumberNumber(NumProperties: integer = 0): boolean; 2573 | var 2574 | i: integer; 2575 | num: integer; 2576 | _item_name: string; 2577 | 2578 | begin 2579 | Result := false; 2580 | // NumberFormat = "part1;part2;part3" 2581 | // part1 - for numbers > 0 (or for condition1) 2582 | // part2 - for numbers < 0 (or for condition2) 2583 | // part3 - for 0 (or for other numbers if used condition1 and condition2) 2584 | // partX = [condition][color]number_format 2585 | 2586 | if (SeparateNFItems(ANumberFormat) > 0) then 2587 | begin 2588 | if (FNFItemsCount = 1) then 2589 | begin 2590 | FNFItems[0].WriteNumberStyle(Xml, _nfName, NumProperties); 2591 | Result := true; 2592 | end 2593 | else 2594 | begin 2595 | num := 0; 2596 | for i := 0 to FNFItemsCount - 2 do 2597 | begin 2598 | if (FNFItems[i].isCondition) then 2599 | s := FNFItems[i].Condition 2600 | else 2601 | case i of 2602 | 0: 2603 | s := '>0'; 2604 | 1: 2605 | s := '< 0'; 2606 | else 2607 | s := ''; 2608 | end; 2609 | 2610 | if (s <> '') then 2611 | begin 2612 | _item_name := _nfName + 'P' + IntToStr(num); 2613 | FNFItems[FNFItemsCount - 1].AddCondition(s, _item_name); 2614 | FNFItems[i].WriteNumberStyle(Xml, _item_name, NumProperties, true); 2615 | inc(num); 2616 | end; 2617 | end; // for i 2618 | 2619 | FNFItems[FNFItemsCount - 1].WriteNumberStyle(Xml, _nfName, NumProperties); 2620 | Result := true; 2621 | end; 2622 | end; // if 2623 | end; // _WriteNumberNumber 2624 | 2625 | function _WriteCurrency(): boolean; 2626 | begin 2627 | Result := _WriteNumberNumber(ZE_NUMFORMAT_NUM_IS_CURRENCY); 2628 | end; 2629 | 2630 | function _WritePercentage(): boolean; 2631 | begin 2632 | Result := _WriteNumberNumber(ZE_NUMFORMAT_NUM_IS_PERCENTAGE); 2633 | end; 2634 | 2635 | function _WriteDateTime(): boolean; 2636 | var 2637 | _addProp: integer; 2638 | begin 2639 | Result := false; 2640 | 2641 | if (SeparateNFItems(ANumberFormat) > 0) then 2642 | begin 2643 | // For now use only first NF item 2644 | // TODO: 2645 | // Are conditions implements for date styles? 2646 | _addProp := FNFItems[0].WriteDateTimeStyle(Xml, _nfName); 2647 | _nfType := _nfType or _addProp; 2648 | Result := true; 2649 | end; // if 2650 | end; // _WriteDateTime 2651 | 2652 | function _WriteStringFormat(): boolean; 2653 | begin 2654 | Result := false; 2655 | if (SeparateNFItems(ANumberFormat) > 0) then 2656 | begin 2657 | // For now use only first NF item 2658 | // TODO: 2659 | // Are conditions implements for text styles? 2660 | FNFItems[0].WriteTextStyle(Xml, _nfName); 2661 | Result := true; 2662 | end; // if 2663 | end; // _WriteStringFormat 2664 | 2665 | function _WriteNumberStyle(): boolean; 2666 | begin 2667 | FNFItemsCount := 0; 2668 | _nfName := 'N' + IntToStr(FCurrentNFIndex); 2669 | Result := false; 2670 | 2671 | _nfType := GetNativeNumberFormatType(ANumberFormat); 2672 | 2673 | case (_nfType and $FF) of 2674 | ZE_NUMFORMAT_IS_NUMBER: 2675 | begin 2676 | if (_nfType and ZE_NUMFORMAT_NUM_IS_CURRENCY = ZE_NUMFORMAT_NUM_IS_CURRENCY) then 2677 | Result := _WriteCurrency() 2678 | else if (_nfType and ZE_NUMFORMAT_NUM_IS_PERCENTAGE = ZE_NUMFORMAT_NUM_IS_PERCENTAGE) then 2679 | Result := _WritePercentage() 2680 | else 2681 | Result := _WriteNumberNumber(); 2682 | end; 2683 | ZE_NUMFORMAT_IS_DATETIME: 2684 | Result := _WriteDateTime(); 2685 | ZE_NUMFORMAT_IS_STRING: 2686 | Result := _WriteStringFormat(); 2687 | end; 2688 | end; // _WriteNumberStyle 2689 | 2690 | procedure _AddItem(const NFName: string); 2691 | begin 2692 | if (FCount >= FCountMax) then 2693 | begin 2694 | inc(FCountMax, 10); 2695 | SetLength(FItems, FCountMax); 2696 | SetLength(FNumberAdditionalProps, FCountMax); 2697 | end; 2698 | 2699 | FItems[FCount].StyleIndex := StyleID; 2700 | FItems[FCount].NumberFormatName := NFName; 2701 | FItems[FCount].NumberFormat := ANumberFormat; 2702 | 2703 | FNumberAdditionalProps[StyleID] := _nfType; 2704 | 2705 | inc(FCount); 2706 | end; 2707 | 2708 | function _CheckIsDuplicate(): boolean; 2709 | var 2710 | i: integer; 2711 | begin 2712 | Result := false; 2713 | for i := 0 to FCount - 1 do 2714 | if (FItems[i].NumberFormat = ANumberFormat) then 2715 | begin 2716 | _nfType := FNumberAdditionalProps[StyleID]; 2717 | _AddItem(FItems[i].NumberFormatName); 2718 | Result := true; 2719 | break; 2720 | end; 2721 | end; // _CheckIsDuplicate 2722 | 2723 | begin 2724 | Result := false; 2725 | ANumberFormat := Trim(ANumberFormat); 2726 | 2727 | if ((ANumberFormat = '@') or (ANumberFormat = '')) then 2728 | exit; 2729 | 2730 | s := UpperCase(ANumberFormat); 2731 | 2732 | if ((s = 'GENERAL') or (s = 'STANDART')) then 2733 | exit; 2734 | 2735 | if (TryGetNumFormatByName(ANumberFormat, s)) then 2736 | if (s = '') then 2737 | exit 2738 | else 2739 | ANumberFormat := s; 2740 | 2741 | if (_CheckIsDuplicate()) then 2742 | Result := true 2743 | else 2744 | begin 2745 | Result := _WriteNumberStyle(); 2746 | 2747 | if (Result) then 2748 | begin 2749 | _AddItem(_nfName); 2750 | inc(FCurrentNFIndex); 2751 | end; 2752 | end; 2753 | end; // TryWriteNumberFormat 2754 | 2755 | /// /::::::::::::: TODSNumberFormatMapItem ::::::::::::::::://// 2756 | 2757 | constructor TODSNumberFormatMapItem.Create(); 2758 | begin 2759 | FEmbededMaxCount := 10; 2760 | SetLength(FEmbededTextArray, FEmbededMaxCount); 2761 | FNumberFormatParser := TNumFormatParser.Create(); 2762 | FDateTimeODSFormatParser := TZDateTimeODSFormatParser.Create(); 2763 | end; 2764 | 2765 | destructor TODSNumberFormatMapItem.Destroy(); 2766 | begin 2767 | SetLength(FEmbededTextArray, 0); 2768 | FreeAndNil(FNumberFormatParser); 2769 | FreeAndNil(FDateTimeODSFormatParser); 2770 | inherited Destroy; 2771 | end; 2772 | 2773 | procedure TODSNumberFormatMapItem.Clear(); 2774 | begin 2775 | FCondition := ''; 2776 | FisCondition := false; 2777 | FColorStr := ''; 2778 | FisColor := false; 2779 | FNumberFormat := ''; 2780 | FConditionsCount := 0; 2781 | end; // Clear 2782 | 2783 | function TODSNumberFormatMapItem.TryToParse(const FNStr: string): boolean; 2784 | var 2785 | s: string; 2786 | i: integer; 2787 | _IsQuote: boolean; 2788 | _IsBracket: boolean; 2789 | ch: char; 2790 | _isError: boolean; 2791 | _raw: string; // raw string without brackets 2792 | _tmp: string; 2793 | 2794 | procedure _ProcessOpenBracket(); 2795 | begin 2796 | if (_IsBracket) then 2797 | _isError := true 2798 | else 2799 | begin 2800 | _raw := _raw + s; 2801 | s := ''; 2802 | _IsBracket := true; 2803 | end; 2804 | end; // _ProcessOpenBracket 2805 | 2806 | procedure _ProcessCloseBracket(); 2807 | begin 2808 | if (_IsBracket) then 2809 | begin 2810 | // is it color? 2811 | if (TryGetMapColorColor(Trim(UpperCase(s)), _tmp)) then 2812 | begin 2813 | FisColor := true; 2814 | FColorStr := _tmp; 2815 | end 2816 | else 2817 | // is it condition? 2818 | if (TryGetMapCondition(s, _tmp)) then 2819 | begin 2820 | FisCondition := true; 2821 | FCondition := _tmp; 2822 | end; 2823 | 2824 | // TODO: need add: 2825 | // calendar: 2826 | // [~buddhist] 2827 | // [~gengou] 2828 | // [~gregorian]) 2829 | // [~hanja] [~hanja_yoil] 2830 | // [~hijri] 2831 | // [~jewish] 2832 | // [~ROC] 2833 | // NatNumX / DBNumX transliteration 2834 | // currency 2835 | 2836 | _IsBracket := false; 2837 | s := ''; 2838 | end 2839 | else 2840 | _isError := true 2841 | end; // _ProcessCloseBracket 2842 | 2843 | procedure _ProcessQuote(); 2844 | begin 2845 | if (not _IsBracket) then 2846 | _IsQuote := not _IsQuote; 2847 | end; // _ProcessQuote 2848 | 2849 | function _FinalCheck(): boolean; 2850 | begin 2851 | Result := true; 2852 | 2853 | if (not _IsQuote) then 2854 | begin 2855 | _raw := _raw + s; 2856 | s := ''; 2857 | end; 2858 | 2859 | if (_IsQuote and (not _isError) and (s <> '')) then 2860 | begin 2861 | _raw := _raw + s + '"'; 2862 | s := ''; 2863 | _ProcessQuote(); 2864 | end; 2865 | 2866 | // TODO: add checking for valid NF here 2867 | 2868 | end; // _FinalCheck 2869 | 2870 | begin 2871 | Result := false; 2872 | Clear(); 2873 | _raw := ''; 2874 | 2875 | _isError := false; 2876 | _IsQuote := false; 2877 | _IsBracket := false; 2878 | s := ''; 2879 | 2880 | for i := 1 to length(FNStr) do 2881 | begin 2882 | ch := FNStr[i]; 2883 | 2884 | if (ch = '"') then 2885 | _ProcessQuote(); 2886 | 2887 | if (_IsQuote) then 2888 | s := s + ch 2889 | else 2890 | case (ch) of 2891 | '[': 2892 | _ProcessOpenBracket(); 2893 | ']': 2894 | _ProcessCloseBracket(); 2895 | else 2896 | s := s + ch; 2897 | end; // case 2898 | end; // for i 2899 | 2900 | if (_FinalCheck()) then 2901 | Result := not(_isError or _IsQuote or _IsBracket or (_raw = '')); 2902 | 2903 | if (Result) then 2904 | FNumberFormat := _raw; 2905 | end; // TryToParse 2906 | 2907 | function TODSNumberFormatMapItem.AddCondition(const ACondition, AStyleName: string): boolean; 2908 | begin 2909 | Result := FConditionsCount < 2; 2910 | if (Result) then 2911 | begin 2912 | FConditionsArray[FConditionsCount][0] := ACondition; 2913 | FConditionsArray[FConditionsCount][1] := AStyleName; 2914 | inc(FConditionsCount); 2915 | end; 2916 | end; // AddCondition 2917 | 2918 | procedure TODSNumberFormatMapItem.PrepareCommonStyleAttributes(const Xml: TZsspXMLWriterH; const AStyleName: string; 2919 | isVolatile: boolean = false); 2920 | begin 2921 | Xml.Attributes.Clear(); 2922 | Xml.Attributes.Add(ZETag_Attr_StyleName, AStyleName); 2923 | if (isVolatile) then 2924 | Xml.Attributes.Add(ZETag_style_volatile, 'true'); 2925 | end; // PrepareCommonStyleAttributes 2926 | 2927 | procedure TODSNumberFormatMapItem.WriteNumberStyle(const Xml: TZsspXMLWriterH; const AStyleName: string; 2928 | const NumProperties: integer; isVolatile: boolean = false); 2929 | var 2930 | i: integer; 2931 | _DecimalCount: integer; 2932 | _IntDigitsCount: integer; 2933 | _TotalDigitsCount: integer; 2934 | _MinIntDigitsCount: integer; 2935 | _currentpos: integer; 2936 | _isFirstText: boolean; 2937 | _firstText: string; 2938 | _txt_len: integer; 2939 | _numeratorDigitsCount: integer; 2940 | _denomenatorDigitsCount: integer; 2941 | _isFraction: boolean; 2942 | _isSci: boolean; 2943 | _exponentDigitsCount: integer; 2944 | s: string; 2945 | 2946 | // 2947 | procedure _WriteStyleMap(num: integer); 2948 | begin 2949 | Xml.Attributes.Clear(); 2950 | Xml.Attributes.Add(ZETag_style_condition, FConditionsArray[num][0]); 2951 | Xml.Attributes.Add(ZETag_style_apply_style_name, FConditionsArray[num][1]); 2952 | Xml.WriteEmptyTag(ZETag_style_map, true, true); 2953 | end; // _WriteConditionItem 2954 | 2955 | // 2956 | procedure _WriteTextProperties(); 2957 | begin 2958 | if (isColor) then 2959 | begin 2960 | Xml.Attributes.Clear(); 2961 | Xml.Attributes.Add(ZETag_fo_color, ColorStr); 2962 | Xml.WriteEmptyTag(ZETag_style_text_properties, true, true); 2963 | end; 2964 | end; // _WriteTextProperties 2965 | 2966 | procedure _ParseFormat(); 2967 | var 2968 | i: integer; 2969 | _IsQuote: boolean; 2970 | ch: char; 2971 | _isDecimal: boolean; 2972 | 2973 | // Check digit 2974 | // INPUT 2975 | // isExtrazero: boolean - true = 0, false = # 2976 | procedure _CheckDigit(isExtrazero: boolean); 2977 | begin 2978 | if (_isSci) then 2979 | begin 2980 | inc(_exponentDigitsCount); 2981 | exit; 2982 | end; 2983 | 2984 | inc(_TotalDigitsCount); 2985 | inc(_currentpos); 2986 | 2987 | if (_isDecimal) then 2988 | begin 2989 | inc(_DecimalCount); 2990 | end 2991 | else 2992 | begin 2993 | inc(_IntDigitsCount); 2994 | if (isExtrazero) then 2995 | inc(_MinIntDigitsCount); 2996 | end; 2997 | end; // _CheckDigit 2998 | 2999 | // Calc symbols "?" for fraction numerator and denominator 3000 | // TODO: is it possible to use 0 or # in fraction as numerator or/and denominator? 3001 | procedure _CheckFractionDigit(); 3002 | begin 3003 | if (_isFraction) then 3004 | inc(_denomenatorDigitsCount) 3005 | else 3006 | inc(_numeratorDigitsCount); 3007 | end; // _CheckFractionDigit 3008 | 3009 | procedure _AddEmbebedText(isAdd: boolean); 3010 | begin 3011 | if (isAdd) then 3012 | begin 3013 | if ((_TotalDigitsCount > 0) or _isFirstText) then 3014 | begin 3015 | if (FEmbededTextCount >= FEmbededMaxCount) then 3016 | begin 3017 | inc(FEmbededMaxCount, 10); 3018 | SetLength(FEmbededTextArray, FEmbededMaxCount); 3019 | end; 3020 | FEmbededTextArray[FEmbededTextCount].Txt := s; 3021 | FEmbededTextArray[FEmbededTextCount].NumberPosition := _currentpos; 3022 | inc(FEmbededTextCount); 3023 | end 3024 | else 3025 | begin 3026 | _isFirstText := true; 3027 | _firstText := s; 3028 | end; 3029 | s := ''; 3030 | end; 3031 | end; // _AddEmbebedText 3032 | 3033 | procedure _ProgressPercent(); 3034 | begin 3035 | s := s + ch; 3036 | if ((not _isFirstText) and (_TotalDigitsCount = 0) and (FEmbededTextCount = 0)) then 3037 | begin 3038 | _isFirstText := true; 3039 | _firstText := s; 3040 | s := ''; 3041 | end 3042 | else if (i <> _txt_len) then 3043 | _AddEmbebedText(true); 3044 | end; // _ProgressPercent 3045 | 3046 | begin 3047 | s := ''; 3048 | _IsQuote := false; 3049 | _isDecimal := false; 3050 | i := 1; 3051 | _txt_len := length(FNumberFormat); 3052 | while (i <= _txt_len) do 3053 | begin 3054 | ch := FNumberFormat[i]; 3055 | 3056 | if ((ch = '\') and (not _IsQuote)) then 3057 | begin 3058 | inc(i); 3059 | if (i > _txt_len) then 3060 | break; 3061 | 3062 | s := FNumberFormat[i]; 3063 | _AddEmbebedText(true); 3064 | ch := #0; 3065 | end; 3066 | 3067 | if (ch = '"') then 3068 | begin 3069 | _AddEmbebedText(_IsQuote and (not _isDecimal)); 3070 | _IsQuote := not _IsQuote; 3071 | end; 3072 | 3073 | if (_IsQuote) then 3074 | begin 3075 | if (ch <> '"') then 3076 | s := s + ch 3077 | end 3078 | else 3079 | case (ch) of 3080 | '0': 3081 | _CheckDigit(true); 3082 | '#': 3083 | _CheckDigit(false); 3084 | '.': 3085 | _isDecimal := true; 3086 | '?': 3087 | _CheckFractionDigit(); 3088 | '/': 3089 | _isFraction := true; 3090 | 'E', 'e': 3091 | _isSci := true; 3092 | '+': 3093 | ; // ?? 3094 | '-': 3095 | ; // ?? 3096 | ' ': 3097 | ; 3098 | '%': 3099 | _ProgressPercent(); 3100 | end; 3101 | inc(i); 3102 | end; // while i 3103 | end; // _ParseFormat 3104 | 3105 | // 3106 | procedure _WriteNumberMain(); 3107 | var 3108 | i: integer; 3109 | procedure _FillMainAttrib(); 3110 | begin 3111 | Xml.Attributes.Clear(); 3112 | 3113 | if (_isFraction) then 3114 | if ((_numeratorDigitsCount <= 0) or (_denomenatorDigitsCount <= 0)) then 3115 | _isFraction := false; 3116 | 3117 | // TODO: it is trouble. For now ignore fraction and sci. 3118 | if (_isFraction and _isSci) then 3119 | begin 3120 | _isFraction := false; 3121 | _isSci := false; 3122 | end; 3123 | 3124 | if (_isFraction) then 3125 | begin 3126 | Xml.Attributes.Add(ZETag_number_min_numerator_digits, IntToStr(_numeratorDigitsCount)); 3127 | Xml.Attributes.Add(ZETag_number_min_denominator_digits, IntToStr(_denomenatorDigitsCount)); 3128 | end 3129 | else 3130 | begin 3131 | if (_DecimalCount > 0) then 3132 | Xml.Attributes.Add(ZETag_number_decimal_places, IntToStr(_DecimalCount)); 3133 | if (_isSci) then 3134 | Xml.Attributes.Add(ZETag_number_min_exponent_digits, IntToStr(_exponentDigitsCount)); 3135 | end; 3136 | Xml.Attributes.Add(ZETag_number_min_integer_digits, IntToStr(_MinIntDigitsCount)); 3137 | end; // _FillMainAttrib 3138 | 3139 | procedure _StartEmbededTextTag(); 3140 | begin 3141 | // Empty tag for: 3142 | // number:fraction 3143 | // number:scientific-number 3144 | 3145 | if (_isFraction) then 3146 | Xml.WriteEmptyTag(ZETag_number_fraction, true, true) 3147 | else if (_isSci) then 3148 | Xml.WriteEmptyTag(ZETag_number_scientific_number, true, true) 3149 | else 3150 | Xml.WriteTagNode(ZETag_number_number, true, true, false); 3151 | end; // _StartEmbededTextTag 3152 | 3153 | procedure _EndEmbededTextTag(); 3154 | begin 3155 | if ((not _isFraction) and (not _isSci)) then 3156 | Xml.WriteEndTagNode(); // number:number 3157 | end; // _EndEmbededTextTag 3158 | 3159 | // or 3160 | // or 3161 | // 3162 | procedure _WriteEmptyNumberTag(); 3163 | begin 3164 | if (_isFraction) then 3165 | Xml.WriteEmptyTag(ZETag_number_fraction, true, true) 3166 | else if (_isSci) then 3167 | Xml.WriteEmptyTag(ZETag_number_scientific_number, true, true) 3168 | else 3169 | Xml.WriteEmptyTag(ZETag_number_number, true, true); 3170 | end; // _WriteEmptyNumberTag 3171 | 3172 | begin 3173 | FEmbededTextCount := 0; 3174 | _DecimalCount := 0; 3175 | _currentpos := 0; 3176 | _IntDigitsCount := 0; 3177 | _TotalDigitsCount := 0; 3178 | _MinIntDigitsCount := 0; 3179 | _isFirstText := false; 3180 | _firstText := ''; 3181 | _numeratorDigitsCount := 0; 3182 | _denomenatorDigitsCount := 0; 3183 | _isFraction := false; 3184 | _isSci := false; 3185 | _exponentDigitsCount := 0; 3186 | 3187 | _ParseFormat(); 3188 | 3189 | if (_isFirstText) then 3190 | begin 3191 | Xml.Attributes.Clear(); 3192 | Xml.WriteTag(ZETag_number_text, _firstText, true, false, true); 3193 | end; 3194 | 3195 | _FillMainAttrib(); 3196 | 3197 | if (FEmbededTextCount > 0) then 3198 | begin 3199 | _StartEmbededTextTag(); 3200 | 3201 | // TODO: Is it possible to use embeded text for fraction and scientific formats? 3202 | if (not _isFraction) then 3203 | for i := 0 to FEmbededTextCount - 1 do 3204 | begin 3205 | Xml.Attributes.Clear(); 3206 | Xml.Attributes.Add(ZETag_number_position, IntToStr(_IntDigitsCount - FEmbededTextArray[i].NumberPosition)); 3207 | Xml.WriteTag(ZETag_number_embedded_text, FEmbededTextArray[i].Txt, true, false, true); 3208 | end; 3209 | 3210 | _EndEmbededTextTag(); 3211 | end 3212 | else 3213 | _WriteEmptyNumberTag(); 3214 | 3215 | if (s <> '') then 3216 | begin 3217 | Xml.Attributes.Clear(); 3218 | Xml.WriteTag(ZETag_number_text, s, true, false, true); 3219 | end; 3220 | end; // _WriteNumberMain 3221 | 3222 | begin 3223 | PrepareCommonStyleAttributes(Xml, AStyleName, isVolatile); 3224 | 3225 | if (NumProperties = ZE_NUMFORMAT_NUM_IS_PERCENTAGE) then 3226 | Xml.WriteTagNode(ZETag_number_percentage_style, true, true, false) 3227 | else if (NumProperties = ZE_NUMFORMAT_NUM_IS_CURRENCY) then 3228 | Xml.WriteTagNode(ZETag_number_currency_style, true, true, false) 3229 | else 3230 | Xml.WriteTagNode(ZETag_number_number_style, true, true, false); 3231 | 3232 | _WriteTextProperties(); 3233 | 3234 | _WriteNumberMain(); 3235 | 3236 | for i := 0 to FConditionsCount - 1 do 3237 | _WriteStyleMap(i); 3238 | 3239 | Xml.WriteEndTagNode(); // number:number-style 3240 | end; // WriteNumberStyle 3241 | 3242 | // Write number text style item ( ) 3243 | // INPUT 3244 | // const xml: TZsspXMLWriterH - xml 3245 | // const AStyleName: string - style name 3246 | // isVolatile: boolean - is volatile? (for now - ignore) 3247 | procedure TODSNumberFormatMapItem.WriteTextStyle(const Xml: TZsspXMLWriterH; const AStyleName: string; 3248 | isVolatile: boolean = false); 3249 | var 3250 | _isText: boolean; 3251 | begin 3252 | _isText := false; 3253 | PrepareCommonStyleAttributes(Xml, AStyleName, isVolatile); 3254 | 3255 | Xml.WriteTagNode(ZETag_number_text_style, true, true, false); 3256 | 3257 | Xml.Attributes.Clear(); 3258 | FNumberFormatParser.BeginRead(FNumberFormat); 3259 | 3260 | while (FNumberFormatParser.ReadSymbol()) do 3261 | begin 3262 | case (FNumberFormatParser.ReadedSymbolType) of 3263 | 0: 3264 | begin 3265 | if (FNumberFormatParser.ReadedSymbol = '@') then 3266 | begin 3267 | _isText := true; 3268 | Xml.WriteEmptyTag(ZETag_number_text_content, true, false); 3269 | end; 3270 | end; 3271 | 2, 3: 3272 | begin 3273 | Xml.WriteTag(ZETag_number_text, FNumberFormatParser.ReadedSymbol, true, false, true); 3274 | end; 3275 | end; // case 3276 | end; // while 3277 | 3278 | if (not _isText) then 3279 | Xml.WriteEmptyTag(ZETag_number_text_content, true, false); 3280 | 3281 | Xml.WriteEndTagNode(); // number:text-style 3282 | end; // WriteTextStyle 3283 | 3284 | function TODSNumberFormatMapItem.WriteDateTimeStyle(const Xml: TZsspXMLWriterH; const AStyleName: string; 3285 | isVolatile: boolean = false): integer; 3286 | var 3287 | s, _tagName: string; 3288 | procedure _WriteYear(var item: TZDateTimeProcessItem); 3289 | begin 3290 | if (item.Len > 2) then 3291 | Xml.Attributes.Add(ZETag_number_style, ZETag_long); 3292 | 3293 | Xml.WriteEmptyTag(ZETag_number_year, true, false); 3294 | end; // _WriteYear 3295 | 3296 | procedure _WriteMonth(var item: TZDateTimeProcessItem); 3297 | begin 3298 | if ((item.Len >= 4) or (item.Len = 2)) then 3299 | Xml.Attributes.Add(ZETag_number_style, ZETag_long); 3300 | 3301 | if (item.Len >= 3) then 3302 | Xml.Attributes.Add(ZETag_number_textual, 'true'); 3303 | 3304 | Xml.WriteEmptyTag(ZETag_number_month, true, false); 3305 | end; // _WriteMonth 3306 | 3307 | procedure _WriteDay(var item: TZDateTimeProcessItem); 3308 | begin 3309 | if (item.Len > 2) then 3310 | s := ZETag_number_day_of_week 3311 | else 3312 | s := ZETag_number_day; 3313 | 3314 | if ((item.Len >= 4) or (item.Len = 2)) then 3315 | Xml.Attributes.Add(ZETag_number_style, ZETag_long); 3316 | 3317 | Xml.WriteEmptyTag(s, true, false); 3318 | end; // _WriteDay 3319 | 3320 | procedure _WriteHour(var item: TZDateTimeProcessItem); 3321 | begin 3322 | if (item.Len >= 2) then 3323 | Xml.Attributes.Add(ZETag_number_style, ZETag_long); 3324 | 3325 | Xml.WriteEmptyTag(ZETag_number_hours, true, false); 3326 | end; // _WriteHour 3327 | 3328 | procedure _WriteMinute(var item: TZDateTimeProcessItem); 3329 | begin 3330 | if (item.Len >= 2) then 3331 | Xml.Attributes.Add(ZETag_number_style, ZETag_long); 3332 | 3333 | Xml.WriteEmptyTag(ZETag_number_minutes, true, false); 3334 | end; // _WriteMinute 3335 | 3336 | procedure _WriteSecond(var item: TZDateTimeProcessItem); 3337 | begin 3338 | if (item.Len >= 2) then 3339 | Xml.Attributes.Add(ZETag_number_style, ZETag_long); 3340 | 3341 | if (item.Settings > 0) then 3342 | Xml.Attributes.Add(ZETag_number_decimal_places, IntToStr(item.Settings)); 3343 | 3344 | Xml.WriteEmptyTag(ZETag_number_seconds, true, false); 3345 | end; // _WriteSecond 3346 | 3347 | procedure _WriteWeek(var item: TZDateTimeProcessItem); 3348 | begin 3349 | Xml.WriteEmptyTag(ZETag_number_week_of_year, true, false); 3350 | end; // _WriteWeek 3351 | 3352 | procedure _WriteQuarter(var item: TZDateTimeProcessItem); 3353 | begin 3354 | if (item.Len >= 2) then 3355 | Xml.Attributes.Add(ZETag_number_style, ZETag_long); 3356 | 3357 | Xml.WriteEmptyTag(ZETag_number_quarter, true, false); 3358 | end; // _WriteQuarter 3359 | 3360 | procedure _WriteEraYear(var item: TZDateTimeProcessItem); 3361 | begin 3362 | // TODO 3363 | (* 3364 | if (item.Len >= 2) then 3365 | xml.Attributes.Add(ZETag_number_style, ZETag_long); 3366 | 3367 | xml.WriteEmptyTag(ZETag_number_quarter, true, false); 3368 | *) 3369 | end; // _WriteEraYear 3370 | 3371 | procedure _WriteEraJap(var item: TZDateTimeProcessItem); 3372 | begin 3373 | if (item.Len >= 2) then 3374 | Xml.Attributes.Add(ZETag_number_style, ZETag_long); 3375 | 3376 | Xml.WriteEmptyTag(ZETag_number_era, true, false); 3377 | end; // _WriteEraJap 3378 | 3379 | procedure _WriteItems(); 3380 | var 3381 | i: integer; 3382 | begin 3383 | for i := 0 to FDateTimeODSFormatParser.FCount - 1 do 3384 | begin 3385 | Xml.Attributes.Clear(); 3386 | case (FDateTimeODSFormatParser.FItems[i].ItemType) of 3387 | ZE_DATETIME_ITEM_TEXT: 3388 | Xml.WriteTag(ZETag_number_text, FDateTimeODSFormatParser.FItems[i].TextValue, true, false, true); 3389 | ZE_DATETIME_ITEM_YEAR: 3390 | _WriteYear(FDateTimeODSFormatParser.FItems[i]); 3391 | ZE_DATETIME_ITEM_MONTH: 3392 | _WriteMonth(FDateTimeODSFormatParser.FItems[i]); 3393 | ZE_DATETIME_ITEM_DAY: 3394 | _WriteDay(FDateTimeODSFormatParser.FItems[i]); 3395 | ZE_DATETIME_ITEM_HOUR: 3396 | _WriteHour(FDateTimeODSFormatParser.FItems[i]); 3397 | ZE_DATETIME_ITEM_MINUTE: 3398 | _WriteMinute(FDateTimeODSFormatParser.FItems[i]); 3399 | ZE_DATETIME_ITEM_SECOND: 3400 | _WriteSecond(FDateTimeODSFormatParser.FItems[i]); 3401 | ZE_DATETIME_ITEM_WEEK: 3402 | _WriteWeek(FDateTimeODSFormatParser.FItems[i]); 3403 | ZE_DATETIME_ITEM_QUARTER: 3404 | _WriteQuarter(FDateTimeODSFormatParser.FItems[i]); 3405 | ZE_DATETIME_ITEM_ERA_JAP: 3406 | _WriteEraJap(FDateTimeODSFormatParser.FItems[i]); 3407 | ZE_DATETIME_ITEM_ERA_YEAR: 3408 | _WriteEraYear(FDateTimeODSFormatParser.FItems[i]); 3409 | ZE_DATETIME_ITEM_AMPM: 3410 | Xml.WriteEmptyTag(ZETag_number_am_pm, true, false); 3411 | end; // case 3412 | end; // for i 3413 | end; // _WriteItems 3414 | 3415 | function _GetAdditionalProperties(): integer; 3416 | var 3417 | i: integer; 3418 | begin 3419 | for i := 0 to FDateTimeODSFormatParser.FCount - 1 do 3420 | case (FDateTimeODSFormatParser.FItems[i].ItemType) of 3421 | ZE_DATETIME_ITEM_YEAR, ZE_DATETIME_ITEM_MONTH, ZE_DATETIME_ITEM_DAY, ZE_DATETIME_ITEM_WEEK, 3422 | ZE_DATETIME_ITEM_QUARTER, ZE_DATETIME_ITEM_ERA_JAP, ZE_DATETIME_ITEM_ERA_YEAR: 3423 | begin 3424 | Result := 0; 3425 | exit; 3426 | end; 3427 | end; // case 3428 | Result := ZE_NUMFORMAT_DATE_IS_ONLY_TIME; 3429 | end; // _GetAdditionalProperties 3430 | 3431 | begin 3432 | Result := 0; 3433 | FDateTimeODSFormatParser.TryToParseDateFormat(FNumberFormat, FNumberFormatParser); 3434 | FDateTimeODSFormatParser.DeleteRepeatedItems(); 3435 | 3436 | if (FDateTimeODSFormatParser.GetValidCount() > 0) then 3437 | begin 3438 | Result := _GetAdditionalProperties(); 3439 | 3440 | if (Result = 0) then 3441 | _tagName := ZETag_number_date_style 3442 | else 3443 | _tagName := ZETag_number_time_style; 3444 | 3445 | PrepareCommonStyleAttributes(Xml, AStyleName, isVolatile); 3446 | Xml.WriteTagNode(_tagName, true, true, false); 3447 | 3448 | _WriteItems(); 3449 | 3450 | Xml.WriteEndTagNode(); // number:date-style / number:time-style 3451 | end; 3452 | end; // WriteDateTimeStyle 3453 | 3454 | end. 3455 | -------------------------------------------------------------------------------- /source/Excel4Delphi.Utils.pas: -------------------------------------------------------------------------------- 1 | unit Excel4Delphi.Utils; 2 | 3 | interface 4 | 5 | uses 6 | System.SysUtils, System.UITypes, System.Types, System.Classes, System.Math, 7 | Excel4Delphi, Excel4Delphi.Xml, Excel4Delphi.Common; 8 | 9 | ///

10 | /// Сохраняет страницу TZWorkBook в поток в формате HTML 11 | ///

12 | function SaveXmlssToHtml(sheet: TZSheet; CodePageName: string = 'UTF-8'): string; 13 | 14 | implementation 15 | 16 | uses 17 | Excel4Delphi.NumberFormats, System.StrUtils, System.AnsiStrings; 18 | 19 | function SaveXmlssToHtml(sheet: TZSheet; CodePageName: string = 'UTF-8'): string; 20 | var 21 | Xml: TZsspXMLWriterH; 22 | i, j, t, l, r: integer; 23 | NumTopLeft, NumArea: integer; 24 | s, value, numformat: string; 25 | Att: TZAttributesH; 26 | max_width: Real; 27 | strArray: TArray; 28 | Stream: TStringStream; 29 | 30 | function HTMLStyleTable(name: string; const Style: TZStyle): string; 31 | var 32 | s: string; 33 | i, l: integer; 34 | begin 35 | result := #13#10 + ' .' + name + '{'#13#10; 36 | for i := 0 to 3 do 37 | begin 38 | s := 'border-'; 39 | l := 0; 40 | case i of 41 | 0: 42 | s := s + 'left:'; 43 | 1: 44 | s := s + 'top:'; 45 | 2: 46 | s := s + 'right:'; 47 | 3: 48 | s := s + 'bottom:'; 49 | end; 50 | s := s + '#' + ColorToHTMLHex(Style.Border[TZBordersPos(i)].Color); 51 | if Style.Border[TZBordersPos(i)].Weight <> 0 then 52 | s := s + ' ' + IntToStr(Style.Border[TZBordersPos(i)].Weight) + 'px' 53 | else 54 | inc(l); 55 | case Style.Border[TZBordersPos(i)].LineStyle of 56 | ZEContinuous: 57 | s := s + ' ' + 'solid'; 58 | ZEHair: 59 | s := s + ' ' + 'solid'; 60 | ZEDot: 61 | s := s + ' ' + 'dotted'; 62 | ZEDashDotDot: 63 | s := s + ' ' + 'dotted'; 64 | ZEDash: 65 | s := s + ' ' + 'dashed'; 66 | ZEDashDot: 67 | s := s + ' ' + 'dashed'; 68 | ZESlantDashDot: 69 | s := s + ' ' + 'dashed'; 70 | ZEDouble: 71 | s := s + ' ' + 'double'; 72 | else 73 | inc(l); 74 | end; 75 | s := s + ';'; 76 | if l <> 2 then 77 | result := result + s + #13#10; 78 | end; 79 | result := result + 'background:#' + ColorToHTMLHex(Style.BGColor) + ';}'; 80 | end; 81 | 82 | function HTMLStyleFont(name: string; const Style: TZStyle): string; 83 | begin 84 | result := #13#10 + ' .' + name + '{'#13#10; 85 | result := result + 'color:#' + ColorToHTMLHex(Style.Font.Color) + ';'; 86 | result := result + 'font-size:' + FloatToStr(Style.Font.Size, TFormatSettings.Invariant) + 'px;'; 87 | result := result + 'font-family:' + Style.Font.name + ';}'; 88 | end; 89 | 90 | begin 91 | result := ''; 92 | Stream := TStringStream.Create('', TEncoding.UTF8); 93 | Xml := TZsspXMLWriterH.Create(Stream); 94 | try 95 | Xml.TabLength := 1; 96 | // start 97 | Xml.Attributes.Clear(); 98 | Xml.WriteRaw 99 | ('', 100 | true, false); 101 | Xml.WriteTagNode('HTML', true, true, false); 102 | Xml.WriteTagNode('HEAD', true, true, false); 103 | Xml.WriteTag('TITLE', sheet.Title, true, false, false); 104 | 105 | // styles 106 | s := 'body {'; 107 | s := s + 'background:#' + ColorToHTMLHex(sheet.WorkBook.Styles.DefaultStyle.BGColor) + ';'; 108 | s := s + 'color:#' + ColorToHTMLHex(sheet.WorkBook.Styles.DefaultStyle.Font.Color) + ';'; 109 | s := s + 'font-size:' + FloatToStr(sheet.WorkBook.Styles.DefaultStyle.Font.Size, TFormatSettings.Invariant) + 'px;'; 110 | s := s + 'font-family:' + sheet.WorkBook.Styles.DefaultStyle.Font.name + ';}'; 111 | 112 | s := s + HTMLStyleTable('T19', sheet.WorkBook.Styles.DefaultStyle); 113 | s := s + HTMLStyleFont('F19', sheet.WorkBook.Styles.DefaultStyle); 114 | 115 | for i := 0 to sheet.WorkBook.Styles.Count - 1 do 116 | begin 117 | s := s + HTMLStyleTable('T' + IntToStr(i + 20), sheet.WorkBook.Styles[i]); 118 | s := s + HTMLStyleFont('F' + IntToStr(i + 20), sheet.WorkBook.Styles[i]); 119 | end; 120 | 121 | Xml.WriteTag('STYLE', s, true, true, false); 122 | Xml.Attributes.Add('HTTP-EQUIV', 'CONTENT-TYPE'); 123 | 124 | s := ''; 125 | if trim(CodePageName) > '' then 126 | s := '; CHARSET=' + CodePageName; 127 | 128 | Xml.Attributes.Add('CONTENT', 'TEXT/HTML' + s); 129 | Xml.WriteTag('META', '', true, false, false); 130 | Xml.WriteEndTagNode(); // HEAD 131 | 132 | max_width := 0.0; 133 | for i := 0 to sheet.ColCount - 1 do 134 | max_width := max_width + sheet.ColWidths[i]; 135 | 136 | // BODY 137 | Xml.Attributes.Clear(); 138 | Xml.WriteTagNode('BODY', true, true, false); 139 | 140 | // Table 141 | Xml.Attributes.Clear(); 142 | Xml.Attributes.Add('cellSpacing', '0'); 143 | Xml.Attributes.Add('border', '0'); 144 | Xml.Attributes.Add('width', FloatToStr(max_width).Replace(',', '.')); 145 | Xml.WriteTagNode('TABLE', true, true, false); 146 | 147 | Att := TZAttributesH.Create(); 148 | Att.Clear(); 149 | for i := 0 to sheet.RowCount - 1 do 150 | begin 151 | Xml.Attributes.Clear(); 152 | Xml.Attributes.Add('height', FloatToStr(sheet.RowHeights[i]).Replace(',', '.')); 153 | Xml.WriteTagNode('TR', true, true, true); 154 | Xml.Attributes.Clear(); 155 | for j := 0 to sheet.ColCount - 1 do 156 | begin 157 | NumTopLeft := sheet.MergeCells.InLeftTopCorner(j, i); 158 | NumArea := sheet.MergeCells.InMergeRange(j, i); 159 | // если ячейка входит в объединённые области и не является 160 | // верхней левой ячейкой в этой области - пропускаем её 161 | if not((NumArea >= 0) and (NumTopLeft = -1)) then 162 | begin 163 | Xml.Attributes.Clear(); 164 | if NumTopLeft >= 0 then 165 | begin 166 | t := sheet.MergeCells.Items[NumTopLeft].Right - sheet.MergeCells.Items[NumTopLeft].Left; 167 | if t > 0 then 168 | Xml.Attributes.Add('colspan', IntToStr(t + 1)); 169 | t := sheet.MergeCells.Items[NumTopLeft].Bottom - sheet.MergeCells.Items[NumTopLeft].Top; 170 | if t > 0 then 171 | Xml.Attributes.Add('rowspan', IntToStr(t + 1)); 172 | end; 173 | t := sheet.Cell[j, i].CellStyle; 174 | if sheet.WorkBook.Styles[t].Alignment.Horizontal = ZHCenter then 175 | Xml.Attributes.Add('align', 'center') 176 | else if sheet.WorkBook.Styles[t].Alignment.Horizontal = ZHRight then 177 | Xml.Attributes.Add('align', 'right') 178 | else if sheet.WorkBook.Styles[t].Alignment.Horizontal = ZHJustify then 179 | Xml.Attributes.Add('align', 'justify'); 180 | numformat := sheet.WorkBook.Styles[t].NumberFormat; 181 | Xml.Attributes.Add('class', 'T' + IntToStr(t + 20)); 182 | Xml.Attributes.Add('width', IntToStr(sheet.Columns[j].WidthPix) + 'px'); 183 | 184 | Xml.WriteTagNode('TD', true, false, false); 185 | Xml.Attributes.Clear(); 186 | Att.Clear(); 187 | Att.Add('class', 'F' + IntToStr(t + 20)); 188 | if TFontStyle.fsbold in sheet.WorkBook.Styles[t].Font.Style then 189 | Xml.WriteTagNode('B', false, false, false); 190 | if TFontStyle.fsItalic in sheet.WorkBook.Styles[t].Font.Style then 191 | Xml.WriteTagNode('I', false, false, false); 192 | if TFontStyle.fsUnderline in sheet.WorkBook.Styles[t].Font.Style then 193 | Xml.WriteTagNode('U', false, false, false); 194 | if TFontStyle.fsStrikeOut in sheet.WorkBook.Styles[t].Font.Style then 195 | Xml.WriteTagNode('S', false, false, false); 196 | 197 | l := Length(sheet.Cell[j, i].Href); 198 | if l > 0 then 199 | begin 200 | Xml.Attributes.Add('href', sheet.Cell[j, i].Href); 201 | // target? 202 | Xml.WriteTagNode('A', false, false, false); 203 | Xml.Attributes.Clear(); 204 | end; 205 | 206 | value := sheet.Cell[j, i].Data; 207 | 208 | // value := value.Replace(#13#10, '
'); 209 | case sheet.Cell[j, i].CellType of 210 | TZCellType.ZENumber: 211 | begin 212 | r := numformat.IndexOf('.'); 213 | if r > -1 then 214 | begin 215 | value := FloatToStrF(sheet.Cell[j, i].AsDouble, ffNumber, 12, 216 | Min(4, Max(0, numformat.Substring(r).Length - 1))); 217 | end 218 | else 219 | begin 220 | value := FloatToStr(sheet.Cell[j, i].AsDouble); 221 | end; 222 | end; 223 | TZCellType.ZEDateTime: 224 | begin 225 | // todo: make datetimeformat from cell NumberFormat 226 | value := FormatDateTime('dd.mm.yyyy', sheet.Cell[j, i].AsDateTime); 227 | end; 228 | end; 229 | strArray := value.Split([#13, #10], TStringSplitOptions.ExcludeEmpty); 230 | for r := 0 to Length(strArray) - 1 do 231 | begin 232 | if r > 0 then 233 | Xml.WriteTag('BR', ''); 234 | Xml.WriteTag('FONT', strArray[r], Att, false, false, true); 235 | end; 236 | 237 | if l > 0 then 238 | Xml.WriteEndTagNode(); // A 239 | 240 | if TFontStyle.fsbold in sheet.WorkBook.Styles[t].Font.Style then 241 | Xml.WriteEndTagNode(); // B 242 | if TFontStyle.fsItalic in sheet.WorkBook.Styles[t].Font.Style then 243 | Xml.WriteEndTagNode(); // I 244 | if TFontStyle.fsUnderline in sheet.WorkBook.Styles[t].Font.Style then 245 | Xml.WriteEndTagNode(); // U 246 | if TFontStyle.fsStrikeOut in sheet.WorkBook.Styles[t].Font.Style then 247 | Xml.WriteEndTagNode(); // S 248 | Xml.WriteEndTagNode(); // TD 249 | end; 250 | 251 | end; 252 | Xml.WriteEndTagNode(); // TR 253 | end; 254 | 255 | Xml.WriteEndTagNode(); // BODY 256 | Xml.WriteEndTagNode(); // HTML 257 | Xml.EndSaveTo(); 258 | result := Stream.DataString; 259 | FreeAndNil(Att); 260 | finally 261 | Xml.Free(); 262 | Stream.Free(); 263 | end; 264 | end; 265 | 266 | end. 267 | --------------------------------------------------------------------------------