├── .gitattributes ├── .gitignore ├── LICENSE.md ├── README.md ├── Source └── DelphiZXIngQRCode.pas └── TestApp ├── DelphiZXingQRCodeTestApp.dpr ├── DelphiZXingQRCodeTestApp.dproj ├── DelphiZXingQRCodeTestApp.res ├── DelphiZXingQRCodeTestAppMainForm.dfm └── DelphiZXingQRCodeTestAppMainForm.pas /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | 4 | # Custom for Visual Studio 5 | *.cs diff=csharp 6 | *.sln merge=union 7 | *.csproj merge=union 8 | *.vbproj merge=union 9 | *.fsproj merge=union 10 | *.dbproj merge=union 11 | 12 | # Standard to msysgit 13 | *.doc diff=astextplain 14 | *.DOC diff=astextplain 15 | *.docx diff=astextplain 16 | *.DOCX diff=astextplain 17 | *.dot diff=astextplain 18 | *.DOT diff=astextplain 19 | *.pdf diff=astextplain 20 | *.PDF diff=astextplain 21 | *.rtf diff=astextplain 22 | *.RTF diff=astextplain 23 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | ################# 2 | ## Eclipse 3 | ################# 4 | 5 | *.pydevproject 6 | .project 7 | .metadata 8 | bin/ 9 | tmp/ 10 | *.tmp 11 | *.bak 12 | *.swp 13 | *~.nib 14 | local.properties 15 | .classpath 16 | .settings/ 17 | .loadpath 18 | 19 | # External tool builders 20 | .externalToolBuilders/ 21 | 22 | # Locally stored "Eclipse launch configurations" 23 | *.launch 24 | 25 | # CDT-specific 26 | .cproject 27 | 28 | # PDT-specific 29 | .buildpath 30 | 31 | 32 | ################# 33 | ## Visual Studio 34 | ################# 35 | 36 | ## Ignore Visual Studio temporary files, build results, and 37 | ## files generated by popular Visual Studio add-ons. 38 | 39 | # User-specific files 40 | *.suo 41 | *.user 42 | *.sln.docstates 43 | 44 | # Build results 45 | 46 | [Dd]ebug/ 47 | [Rr]elease/ 48 | x64/ 49 | build/ 50 | [Bb]in/ 51 | [Oo]bj/ 52 | 53 | # MSTest test Results 54 | [Tt]est[Rr]esult*/ 55 | [Bb]uild[Ll]og.* 56 | 57 | *_i.c 58 | *_p.c 59 | *.ilk 60 | *.meta 61 | *.obj 62 | *.pch 63 | *.pdb 64 | *.pgc 65 | *.pgd 66 | *.rsp 67 | *.sbr 68 | *.tlb 69 | *.tli 70 | *.tlh 71 | *.tmp 72 | *.tmp_proj 73 | *.log 74 | *.vspscc 75 | *.vssscc 76 | .builds 77 | *.pidb 78 | *.log 79 | *.scc 80 | 81 | # Visual C++ cache files 82 | ipch/ 83 | *.aps 84 | *.ncb 85 | *.opensdf 86 | *.sdf 87 | *.cachefile 88 | 89 | # Visual Studio profiler 90 | *.psess 91 | *.vsp 92 | *.vspx 93 | 94 | # Guidance Automation Toolkit 95 | *.gpState 96 | 97 | # ReSharper is a .NET coding add-in 98 | _ReSharper*/ 99 | *.[Rr]e[Ss]harper 100 | 101 | # TeamCity is a build add-in 102 | _TeamCity* 103 | 104 | # DotCover is a Code Coverage Tool 105 | *.dotCover 106 | 107 | # NCrunch 108 | *.ncrunch* 109 | .*crunch*.local.xml 110 | 111 | # Installshield output folder 112 | [Ee]xpress/ 113 | 114 | # DocProject is a documentation generator add-in 115 | DocProject/buildhelp/ 116 | DocProject/Help/*.HxT 117 | DocProject/Help/*.HxC 118 | DocProject/Help/*.hhc 119 | DocProject/Help/*.hhk 120 | DocProject/Help/*.hhp 121 | DocProject/Help/Html2 122 | DocProject/Help/html 123 | 124 | # Click-Once directory 125 | publish/ 126 | 127 | # Publish Web Output 128 | *.Publish.xml 129 | *.pubxml 130 | 131 | # NuGet Packages Directory 132 | ## TODO: If you have NuGet Package Restore enabled, uncomment the next line 133 | #packages/ 134 | 135 | # Windows Azure Build Output 136 | csx 137 | *.build.csdef 138 | 139 | # Windows Store app package directory 140 | AppPackages/ 141 | 142 | # Others 143 | sql/ 144 | *.Cache 145 | ClientBin/ 146 | [Ss]tyle[Cc]op.* 147 | ~$* 148 | *~ 149 | *.dbmdl 150 | *.[Pp]ublish.xml 151 | *.pfx 152 | *.publishsettings 153 | 154 | # RIA/Silverlight projects 155 | Generated_Code/ 156 | 157 | # Backup & report files from converting an old project file to a newer 158 | # Visual Studio version. Backup files are not needed, because we have git ;-) 159 | _UpgradeReport_Files/ 160 | Backup*/ 161 | UpgradeLog*.XML 162 | UpgradeLog*.htm 163 | 164 | # SQL Server files 165 | App_Data/*.mdf 166 | App_Data/*.ldf 167 | 168 | ############# 169 | ## Windows detritus 170 | ############# 171 | 172 | # Windows image file caches 173 | Thumbs.db 174 | ehthumbs.db 175 | 176 | # Folder config file 177 | Desktop.ini 178 | 179 | # Recycle Bin used on file shares 180 | $RECYCLE.BIN/ 181 | 182 | # Mac crap 183 | .DS_Store 184 | 185 | 186 | ############# 187 | ## Python 188 | ############# 189 | 190 | *.py[co] 191 | 192 | # Packages 193 | *.egg 194 | *.egg-info 195 | dist/ 196 | build/ 197 | eggs/ 198 | parts/ 199 | var/ 200 | sdist/ 201 | develop-eggs/ 202 | .installed.cfg 203 | 204 | # Installer logs 205 | pip-log.txt 206 | 207 | # Unit test / coverage reports 208 | .coverage 209 | .tox 210 | 211 | #Translations 212 | *.mo 213 | 214 | #Mr Developer 215 | .mr.developer.cfg 216 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "{}" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright {yyyy} {name of copyright owner} 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | 203 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | DelphiZXingQRCode 2 | ================= 3 | 4 | DelphiZXingQRCode is a Delphi port of the QR Code functionality from ZXing, an open source 5 | barcode image processing library. The code was ported to Delphi by Senior Debenu Developer, 6 | Kevin Newman. The port retains the original Apache License (v2.0). 7 | 8 | DelphiZXingQRCode Project 9 | 10 | http://www.debenu.com/open-source/delphizxingqrcode-open-source-delphi-qr-code-generator/ 11 | 12 | ZXing 13 | 14 | https://github.com/zxing/zxing 15 | 16 | # Getting Started # 17 | 18 | A sample Delphi project is provided in the TestApp folder to demonstrate how to use DelphiZXingQRCode. 19 | Simply add the DelphiZXIngQRCode.pas to the DelphiZXingQRCodeTestApp Delphi project and compile. 20 | 21 | [Provided by Debenu] 22 | -------------------------------------------------------------------------------- /Source/DelphiZXIngQRCode.pas: -------------------------------------------------------------------------------- 1 | unit DelphiZXingQRCode; 2 | 3 | // ZXing QRCode port to Delphi, by Debenu Pty Ltd (www.debenu.com) 4 | 5 | // Original copyright notice 6 | (* 7 | * Copyright 2008 ZXing authors 8 | * 9 | * Licensed under the Apache License, Version 2.0 (the "License"); 10 | * you may not use this file except in compliance with the License. 11 | * You may obtain a copy of the License at 12 | * 13 | * http://www.apache.org/licenses/LICENSE-2.0 14 | * 15 | * Unless required by applicable law or agreed to in writing, software 16 | * distributed under the License is distributed on an "AS IS" BASIS, 17 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 18 | * See the License for the specific language governing permissions and 19 | * limitations under the License. 20 | *) 21 | 22 | interface 23 | 24 | type 25 | TQRCodeEncoding = (qrAuto, qrNumeric, qrAlphanumeric, qrISO88591, qrUTF8NoBOM, qrUTF8BOM); 26 | T2DBooleanArray = array of array of Boolean; 27 | 28 | TDelphiZXingQRCode = class 29 | protected 30 | FData: WideString; 31 | FRows: Integer; 32 | FColumns: Integer; 33 | FEncoding: TQRCodeEncoding; 34 | FQuietZone: Integer; 35 | FElements: T2DBooleanArray; 36 | procedure SetEncoding(NewEncoding: TQRCodeEncoding); 37 | procedure SetData(const NewData: WideString); 38 | procedure SetQuietZone(NewQuietZone: Integer); 39 | function GetIsBlack(Row, Column: Integer): Boolean; 40 | procedure Update; 41 | public 42 | constructor Create; 43 | property Data: WideString read FData write SetData; 44 | property Encoding: TQRCodeEncoding read FEncoding write SetEncoding; 45 | property QuietZone: Integer read FQuietZone write SetQuietZone; 46 | property Rows: Integer read FRows; 47 | property Columns: Integer read FColumns; 48 | property IsBlack[Row, Column: Integer]: Boolean read GetIsBlack; 49 | end; 50 | 51 | implementation 52 | 53 | uses 54 | contnrs, Math, Classes; 55 | 56 | type 57 | TByteArray = array of Byte; 58 | T2DByteArray = array of array of Byte; 59 | TIntegerArray = array of Integer; 60 | 61 | const 62 | NUM_MASK_PATTERNS = 8; 63 | 64 | QUIET_ZONE_SIZE = 4; 65 | 66 | ALPHANUMERIC_TABLE: array[0..95] of Integer = ( 67 | -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, // 0x00-0x0f 68 | -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, // 0x10-0x1f 69 | 36, -1, -1, -1, 37, 38, -1, -1, -1, -1, 39, 40, -1, 41, 42, 43, // 0x20-0x2f 70 | 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 44, -1, -1, -1, -1, -1, // 0x30-0x3f 71 | -1, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, // 0x40-0x4f 72 | 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1 // 0x50-0x5f 73 | ); 74 | 75 | DEFAULT_BYTE_MODE_ENCODING = 'ISO-8859-1'; 76 | 77 | POSITION_DETECTION_PATTERN: array[0..6, 0..6] of Integer = ( 78 | (1, 1, 1, 1, 1, 1, 1), 79 | (1, 0, 0, 0, 0, 0, 1), 80 | (1, 0, 1, 1, 1, 0, 1), 81 | (1, 0, 1, 1, 1, 0, 1), 82 | (1, 0, 1, 1, 1, 0, 1), 83 | (1, 0, 0, 0, 0, 0, 1), 84 | (1, 1, 1, 1, 1, 1, 1)); 85 | 86 | HORIZONTAL_SEPARATION_PATTERN: array[0..0, 0..7] of Integer = ( 87 | (0, 0, 0, 0, 0, 0, 0, 0)); 88 | 89 | VERTICAL_SEPARATION_PATTERN: array[0..6, 0..0] of Integer = ( 90 | (0), (0), (0), (0), (0), (0), (0)); 91 | 92 | POSITION_ADJUSTMENT_PATTERN: array[0..4, 0..4] of Integer = ( 93 | (1, 1, 1, 1, 1), 94 | (1, 0, 0, 0, 1), 95 | (1, 0, 1, 0, 1), 96 | (1, 0, 0, 0, 1), 97 | (1, 1, 1, 1, 1)); 98 | 99 | // From Appendix E. Table 1, JIS0510X:2004 (p 71). The table was double-checked by komatsu. 100 | POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE: array[0..39, 0..6] of Integer = ( 101 | (-1, -1, -1, -1, -1, -1, -1), // Version 1 102 | ( 6, 18, -1, -1, -1, -1, -1), // Version 2 103 | ( 6, 22, -1, -1, -1, -1, -1), // Version 3 104 | ( 6, 26, -1, -1, -1, -1, -1), // Version 4 105 | ( 6, 30, -1, -1, -1, -1, -1), // Version 5 106 | ( 6, 34, -1, -1, -1, -1, -1), // Version 6 107 | ( 6, 22, 38, -1, -1, -1, -1), // Version 7 108 | ( 6, 24, 42, -1, -1, -1, -1), // Version 8 109 | ( 6, 26, 46, -1, -1, -1, -1), // Version 9 110 | ( 6, 28, 50, -1, -1, -1, -1), // Version 10 111 | ( 6, 30, 54, -1, -1, -1, -1), // Version 11 112 | ( 6, 32, 58, -1, -1, -1, -1), // Version 12 113 | ( 6, 34, 62, -1, -1, -1, -1), // Version 13 114 | ( 6, 26, 46, 66, -1, -1, -1), // Version 14 115 | ( 6, 26, 48, 70, -1, -1, -1), // Version 15 116 | ( 6, 26, 50, 74, -1, -1, -1), // Version 16 117 | ( 6, 30, 54, 78, -1, -1, -1), // Version 17 118 | ( 6, 30, 56, 82, -1, -1, -1), // Version 18 119 | ( 6, 30, 58, 86, -1, -1, -1), // Version 19 120 | ( 6, 34, 62, 90, -1, -1, -1), // Version 20 121 | ( 6, 28, 50, 72, 94, -1, -1), // Version 21 122 | ( 6, 26, 50, 74, 98, -1, -1), // Version 22 123 | ( 6, 30, 54, 78, 102, -1, -1), // Version 23 124 | ( 6, 28, 54, 80, 106, -1, -1), // Version 24 125 | ( 6, 32, 58, 84, 110, -1, -1), // Version 25 126 | ( 6, 30, 58, 86, 114, -1, -1), // Version 26 127 | ( 6, 34, 62, 90, 118, -1, -1), // Version 27 128 | ( 6, 26, 50, 74, 98, 122, -1), // Version 28 129 | ( 6, 30, 54, 78, 102, 126, -1), // Version 29 130 | ( 6, 26, 52, 78, 104, 130, -1), // Version 30 131 | ( 6, 30, 56, 82, 108, 134, -1), // Version 31 132 | ( 6, 34, 60, 86, 112, 138, -1), // Version 32 133 | ( 6, 30, 58, 86, 114, 142, -1), // Version 33 134 | ( 6, 34, 62, 90, 118, 146, -1), // Version 34 135 | ( 6, 30, 54, 78, 102, 126, 150), // Version 35 136 | ( 6, 24, 50, 76, 102, 128, 154), // Version 36 137 | ( 6, 28, 54, 80, 106, 132, 158), // Version 37 138 | ( 6, 32, 58, 84, 110, 136, 162), // Version 38 139 | ( 6, 26, 54, 82, 110, 138, 166), // Version 39 140 | ( 6, 30, 58, 86, 114, 142, 170) // Version 40 141 | ); 142 | 143 | // Type info cells at the left top corner. 144 | TYPE_INFO_COORDINATES: array[0..14, 0..1] of Integer = ( 145 | (8, 0), 146 | (8, 1), 147 | (8, 2), 148 | (8, 3), 149 | (8, 4), 150 | (8, 5), 151 | (8, 7), 152 | (8, 8), 153 | (7, 8), 154 | (5, 8), 155 | (4, 8), 156 | (3, 8), 157 | (2, 8), 158 | (1, 8), 159 | (0, 8) 160 | ); 161 | 162 | // From Appendix D in JISX0510:2004 (p. 67) 163 | VERSION_INFO_POLY = $1f25; // 1 1111 0010 0101 164 | 165 | // From Appendix C in JISX0510:2004 (p.65). 166 | TYPE_INFO_POLY = $537; 167 | TYPE_INFO_MASK_PATTERN = $5412; 168 | 169 | 170 | VERSION_DECODE_INFO: array[0..33] of Integer = ( 171 | 172 | $07C94, $085BC, $09A99, $0A4D3, $0BBF6, 173 | $0C762, $0D847, $0E60D, $0F928, $10B78, 174 | $1145D, $12A17, $13532, $149A6, $15683, 175 | $168C9, $177EC, $18EC4, $191E1, $1AFAB, 176 | $1B08E, $1CC1A, $1D33F, $1ED75, $1F250, 177 | $209D5, $216F0, $228BA, $2379F, $24B0B, 178 | $2542E, $26A64, $27541, $28C69); 179 | 180 | type 181 | TMode = (qmTerminator, qmNumeric, qmAlphanumeric, qmStructuredAppend, 182 | qmByte, qmECI, qmKanji, qmFNC1FirstPosition, qmFNC1SecondPosition, 183 | qmHanzi); 184 | 185 | const 186 | ModeCharacterCountBits: array[TMode] of array[0..2] of Integer = ( 187 | (0, 0, 0), (10, 12, 14), (9, 11, 13), (0, 0, 0), (8, 16, 16), 188 | (0, 0, 0), (8, 10, 12), (0, 0, 0), (0, 0, 0), (8, 10, 12)); 189 | 190 | ModeBits: array[TMode] of Integer = (0, 1, 2, 3, 4, 7, 8, 5, 9, 13); 191 | 192 | type 193 | TErrorCorrectionLevel = class 194 | private 195 | FBits: Integer; 196 | public 197 | procedure Assign(Source: TErrorCorrectionLevel); 198 | function Ordinal: Integer; 199 | property Bits: Integer read FBits; 200 | end; 201 | 202 | TECB = class 203 | private 204 | Count: Integer; 205 | DataCodewords: Integer; 206 | public 207 | constructor Create(Count, DataCodewords: Integer); 208 | function GetCount: Integer; 209 | function GetDataCodewords: Integer; 210 | end; 211 | 212 | TECBArray = array of TECB; 213 | 214 | TECBlocks = class 215 | private 216 | ECCodewordsPerBlock: Integer; 217 | ECBlocks: TECBArray; 218 | public 219 | constructor Create(ECCodewordsPerBlock: Integer; ECBlocks: TECB); overload; 220 | constructor Create(ECCodewordsPerBlock: Integer; ECBlocks1, ECBlocks2: TECB); overload; 221 | destructor Destroy; override; 222 | function GetTotalECCodewords: Integer; 223 | function GetNumBlocks: Integer; 224 | function GetECCodewordsPerBlock: Integer; 225 | function GetECBlocks: TECBArray; 226 | end; 227 | 228 | TByteMatrix = class 229 | protected 230 | Bytes: T2DByteArray; 231 | FWidth: Integer; 232 | FHeight: Integer; 233 | public 234 | constructor Create(Width, Height: Integer); 235 | function Get(X, Y: Integer): Integer; 236 | procedure SetBoolean(X, Y: Integer; Value: Boolean); 237 | procedure SetInteger(X, Y: Integer; Value: Integer); 238 | function GetArray: T2DByteArray; 239 | procedure Assign(Source: TByteMatrix); 240 | procedure Clear(Value: Byte); 241 | function Hash: AnsiString; 242 | property Width: Integer read FWidth; 243 | property Height: Integer read FHeight; 244 | end; 245 | 246 | TBitArray = class 247 | private 248 | Bits: array of Integer; 249 | Size: Integer; 250 | procedure EnsureCapacity(Size: Integer); 251 | public 252 | constructor Create; overload; 253 | constructor Create(Size: Integer); overload; 254 | function GetSizeInBytes: Integer; 255 | function GetSize: Integer; 256 | function Get(I: Integer): Boolean; 257 | procedure SetBit(Index: Integer); 258 | procedure AppendBit(Bit: Boolean); 259 | procedure AppendBits(Value, NumBits: Integer); 260 | procedure AppendBitArray(NewBitArray: TBitArray); 261 | procedure ToBytes(BitOffset: Integer; Source: TByteArray; Offset, 262 | NumBytes: Integer); 263 | procedure XorOperation(Other: TBitArray); 264 | end; 265 | 266 | TCharacterSetECI = class 267 | 268 | end; 269 | 270 | TVersion = class 271 | private 272 | VersionNumber: Integer; 273 | AlignmentPatternCenters: array of Integer; 274 | ECBlocks: array of TECBlocks; 275 | TotalCodewords: Integer; 276 | ECCodewords: Integer; 277 | public 278 | constructor Create(VersionNumber: Integer; AlignmentPatternCenters: array of Integer; ECBlocks1, ECBlocks2, ECBlocks3, ECBlocks4: TECBlocks); 279 | destructor Destroy; override; 280 | class function GetVersionForNumber(VersionNum: Integer): TVersion; 281 | class function ChooseVersion(NumInputBits: Integer; ecLevel: TErrorCorrectionLevel): TVersion; 282 | function GetTotalCodewords: Integer; 283 | function GetECBlocksForLevel(ECLevel: TErrorCorrectionLevel): TECBlocks; 284 | function GetDimensionForVersion: Integer; 285 | end; 286 | 287 | TMaskUtil = class 288 | public 289 | function GetDataMaskBit(MaskPattern, X, Y: Integer): Boolean; 290 | end; 291 | 292 | TQRCode = class 293 | private 294 | FMode: TMode; 295 | FECLevel: TErrorCorrectionLevel; 296 | FVersion: Integer; 297 | FMatrixWidth: Integer; 298 | FMaskPattern: Integer; 299 | FNumTotalBytes: Integer; 300 | FNumDataBytes: Integer; 301 | FNumECBytes: Integer; 302 | FNumRSBlocks: Integer; 303 | FMatrix: TByteMatrix; 304 | FQRCodeError: Boolean; 305 | public 306 | constructor Create; 307 | destructor Destroy; override; 308 | function At(X, Y: Integer): Integer; 309 | function IsValid: Boolean; 310 | function IsValidMaskPattern(MaskPattern: Integer): Boolean; 311 | procedure SetMatrix(NewMatrix: TByteMatrix); 312 | procedure SetECLevel(NewECLevel: TErrorCorrectionLevel); 313 | procedure SetAll(VersionNum, NumBytes, NumDataBytes, NumRSBlocks, NumECBytes, MatrixWidth: Integer); 314 | property QRCodeError: Boolean read FQRCodeError; 315 | property Mode: TMode read FMode write FMode; 316 | property Version: Integer read FVersion write FVersion; 317 | property NumDataBytes: Integer read FNumDataBytes; 318 | property NumTotalBytes: Integer read FNumTotalBytes; 319 | property NumRSBlocks: Integer read FNumRSBlocks; 320 | property MatrixWidth: Integer read FMatrixWidth; 321 | property MaskPattern: Integer read FMaskPattern write FMaskPattern; 322 | property ECLevel: TErrorCorrectionLevel read FECLevel; 323 | end; 324 | 325 | TMatrixUtil = class 326 | 327 | private 328 | FMatrixUtilError: Boolean; 329 | procedure ClearMatrix(Matrix: TByteMatrix); 330 | 331 | procedure EmbedBasicPatterns(Version: Integer; Matrix: TByteMatrix); 332 | procedure EmbedTypeInfo(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Matrix: TByteMatrix); 333 | procedure MaybeEmbedVersionInfo(Version: Integer; Matrix: TByteMatrix); 334 | procedure EmbedDataBits(DataBits: TBitArray; MaskPattern: Integer; Matrix: TByteMatrix); 335 | function FindMSBSet(Value: Integer): Integer; 336 | function CalculateBCHCode(Value, Poly: Integer): Integer; 337 | procedure MakeTypeInfoBits(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Bits: TBitArray); 338 | procedure MakeVersionInfoBits(Version: Integer; Bits: TBitArray); 339 | function IsEmpty(Value: Integer): Boolean; 340 | procedure EmbedTimingPatterns(Matrix: TByteMatrix); 341 | procedure EmbedDarkDotAtLeftBottomCorner(Matrix: TByteMatrix); 342 | procedure EmbedHorizontalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix); 343 | procedure EmbedVerticalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix); 344 | procedure EmbedPositionAdjustmentPattern(XStart, YStart: Integer; Matrix: TByteMatrix); 345 | procedure EmbedPositionDetectionPattern(XStart, YStart: Integer; Matrix: TByteMatrix); 346 | procedure EmbedPositionDetectionPatternsAndSeparators(Matrix: TByteMatrix); 347 | procedure MaybeEmbedPositionAdjustmentPatterns(Version: Integer; Matrix: TByteMatrix); 348 | public 349 | constructor Create; 350 | property MatrixUtilError: Boolean read FMatrixUtilError; 351 | procedure BuildMatrix(DataBits: TBitArray; ECLevel: TErrorCorrectionLevel; Version, MaskPattern: Integer; Matrix: TByteMatrix); 352 | end; 353 | 354 | function GetModeBits(Mode: TMode): Integer; 355 | begin 356 | Result := ModeBits[Mode]; 357 | end; 358 | 359 | function GetModeCharacterCountBits(Mode: TMode; Version: TVersion): Integer; 360 | var 361 | Number: Integer; 362 | Offset: Integer; 363 | begin 364 | Number := Version.VersionNumber; 365 | 366 | if (Number <= 9) then 367 | begin 368 | Offset := 0; 369 | end else 370 | if (number <= 26) then 371 | begin 372 | Offset := 1; 373 | end else 374 | begin 375 | Offset := 2; 376 | end; 377 | Result := ModeCharacterCountBits[Mode][Offset]; 378 | end; 379 | 380 | type 381 | TBlockPair = class 382 | private 383 | FDataBytes: TByteArray; 384 | FErrorCorrectionBytes: TByteArray; 385 | public 386 | constructor Create(BA1, BA2: TByteArray); 387 | function GetDataBytes: TByteArray; 388 | function GetErrorCorrectionBytes: TByteArray; 389 | end; 390 | 391 | TGenericGFPoly = class; 392 | 393 | TGenericGF = class 394 | private 395 | FExpTable: TIntegerArray; 396 | FLogTable: TIntegerArray; 397 | FZero: TGenericGFPoly; 398 | FOne: TGenericGFPoly; 399 | FSize: Integer; 400 | FPrimitive: Integer; 401 | FGeneratorBase: Integer; 402 | FInitialized: Boolean; 403 | FPolyList: array of TGenericGFPoly; 404 | 405 | procedure CheckInit; 406 | procedure Initialize; 407 | public 408 | class function CreateQRCodeField256: TGenericGF; 409 | class function AddOrSubtract(A, B: Integer): Integer; 410 | constructor Create(Primitive, Size, B: Integer); 411 | destructor Destroy; override; 412 | function GetZero: TGenericGFPoly; 413 | function Exp(A: Integer): Integer; 414 | function GetGeneratorBase: Integer; 415 | function Inverse(A: Integer): Integer; 416 | function Multiply(A, B: Integer): Integer; 417 | function BuildMonomial(Degree, Coefficient: Integer): TGenericGFPoly; 418 | end; 419 | 420 | TGenericGFPolyArray = array of TGenericGFPoly; 421 | TGenericGFPoly = class 422 | private 423 | FField: TGenericGF; 424 | FCoefficients: TIntegerArray; 425 | public 426 | constructor Create(AField: TGenericGF; ACoefficients: TIntegerArray); 427 | destructor Destroy; override; 428 | function Coefficients: TIntegerArray; 429 | function Multiply(Other: TGenericGFPoly): TGenericGFPoly; 430 | function MultiplyByMonomial(Degree, Coefficient: Integer): TGenericGFPoly; 431 | function Divide(Other: TGenericGFPoly): TGenericGFPolyArray; 432 | function GetCoefficients: TIntegerArray; 433 | function IsZero: Boolean; 434 | function GetCoefficient(Degree: Integer): Integer; 435 | function GetDegree: Integer; 436 | function AddOrSubtract(Other: TGenericGFPoly): TGenericGFPoly; 437 | end; 438 | 439 | TReedSolomonEncoder = class 440 | private 441 | FField: TGenericGF; 442 | FCachedGenerators: TObjectList; 443 | public 444 | constructor Create(AField: TGenericGF); 445 | destructor Destroy; override; 446 | procedure Encode(ToEncode: TIntegerArray; ECBytes: Integer); 447 | function BuildGenerator(Degree: Integer): TGenericGFPoly; 448 | end; 449 | 450 | TEncoder = class 451 | private 452 | FEncoderError: Boolean; 453 | 454 | function ApplyMaskPenaltyRule1Internal(Matrix: TByteMatrix; 455 | IsHorizontal: Boolean): Integer; 456 | function ChooseMode(const Content: WideString; var EncodeOptions: Integer): TMode; overload; 457 | function FilterContent(const Content: WideString; Mode: TMode; EncodeOptions: Integer): WideString; 458 | procedure Append8BitBytes(const Content: WideString; Bits: TBitArray; EncodeOptions: Integer); 459 | 460 | procedure AppendAlphanumericBytes(const Content: WideString; 461 | Bits: TBitArray); 462 | procedure AppendBytes(const Content: WideString; Mode: TMode; 463 | Bits: TBitArray; EncodeOptions: Integer); 464 | procedure AppendKanjiBytes(const Content: WideString; Bits: TBitArray); 465 | procedure AppendLengthInfo(NumLetters, VersionNum: Integer; Mode: TMode; 466 | Bits: TBitArray); 467 | procedure AppendModeInfo(Mode: TMode; Bits: TBitArray); 468 | procedure AppendNumericBytes(const Content: WideString; Bits: TBitArray); 469 | function ChooseMaskPattern(Bits: TBitArray; ECLevel: TErrorCorrectionLevel; 470 | Version: Integer; Matrix: TByteMatrix): Integer; 471 | function GenerateECBytes(DataBytes: TByteArray; 472 | 473 | NumECBytesInBlock: Integer): TByteArray; 474 | function GetAlphanumericCode(Code: Integer): Integer; 475 | procedure GetNumDataBytesAndNumECBytesForBlockID(NumTotalBytes, 476 | NumDataBytes, NumRSBlocks, BlockID: Integer; var NumDataBytesInBlock: TIntegerArray; 477 | var NumECBytesInBlock: TIntegerArray); 478 | procedure InterleaveWithECBytes(Bits: TBitArray; NumTotalBytes, 479 | NumDataBytes, NumRSBlocks: Integer; var Result: TBitArray); 480 | //function IsOnlyDoubleByteKanji(const Content: WideString): Boolean; 481 | procedure TerminateBits(NumDataBytes: Integer; var Bits: TBitArray); 482 | function CalculateMaskPenalty(Matrix: TByteMatrix): Integer; 483 | function ApplyMaskPenaltyRule1(Matrix: TByteMatrix): Integer; 484 | function ApplyMaskPenaltyRule2(Matrix: TByteMatrix): Integer; 485 | function ApplyMaskPenaltyRule3(Matrix: TByteMatrix): Integer; 486 | function ApplyMaskPenaltyRule4(Matrix: TByteMatrix): Integer; 487 | //procedure Encode(const Content: WideString; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode); overload; 488 | procedure Encode(const Content: WideString; EncodeOptions: Integer; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode); 489 | public 490 | constructor Create; 491 | property EncoderError: Boolean read FEncoderError; 492 | end; 493 | 494 | function TEncoder.ApplyMaskPenaltyRule1(Matrix: TByteMatrix): Integer; 495 | begin 496 | Result := ApplyMaskPenaltyRule1Internal(Matrix, True) + 497 | ApplyMaskPenaltyRule1Internal(Matrix, False); 498 | end; 499 | 500 | // Apply mask penalty rule 2 and return the penalty. Find 2x2 blocks with the same color and give 501 | // penalty to them. 502 | function TEncoder.ApplyMaskPenaltyRule2(Matrix: TByteMatrix): Integer; 503 | var 504 | Penalty: Integer; 505 | TheArray: T2DByteArray; 506 | Width: Integer; 507 | Height: Integer; 508 | X: Integer; 509 | Y: Integer; 510 | Value: Integer; 511 | begin 512 | Penalty := 0; 513 | TheArray := Matrix.GetArray; 514 | Width := Matrix.Width; 515 | Height := Matrix.Height; 516 | for Y := 0 to Height - 2 do 517 | begin 518 | for X := 0 to Width - 2 do 519 | begin 520 | Value := TheArray[Y][X]; 521 | if ((Value = TheArray[Y][X + 1]) and (Value = TheArray[Y + 1][X]) and 522 | (Value = TheArray[Y + 1][X + 1])) then 523 | begin 524 | Inc(Penalty, 3); 525 | end; 526 | end; 527 | end; 528 | Result := Penalty; 529 | end; 530 | 531 | // Apply mask penalty rule 3 and return the penalty. Find consecutive cells of 00001011101 or 532 | // 10111010000, and give penalty to them. If we find patterns like 000010111010000, we give 533 | // penalties twice (i.e. 40 * 2). 534 | function TEncoder.ApplyMaskPenaltyRule3(Matrix: TByteMatrix): Integer; 535 | var 536 | Penalty: Integer; 537 | TheArray: T2DByteArray; 538 | Width: Integer; 539 | Height: Integer; 540 | X: Integer; 541 | Y: Integer; 542 | begin 543 | Penalty := 0; 544 | TheArray := Matrix.GetArray; 545 | Width := Matrix.Width; 546 | Height := Matrix.Height; 547 | for Y := 0 to Height - 1 do 548 | begin 549 | for X := 0 to Width - 1 do 550 | begin 551 | if ((X + 6 < Width) and 552 | (TheArray[Y][X] = 1) and 553 | (TheArray[Y][X + 1] = 0) and 554 | (TheArray[Y][X + 2] = 1) and 555 | (TheArray[Y][X + 3] = 1) and 556 | (TheArray[Y][X + 4] = 1) and 557 | (TheArray[Y][X + 5] = 0) and 558 | (TheArray[Y][X + 6] = 1) and 559 | (((X + 10 < Width) and 560 | (TheArray[Y][X + 7] = 0) and 561 | (TheArray[Y][X + 8] = 0) and 562 | (TheArray[Y][X + 9] = 0) and 563 | (TheArray[Y][X + 10] = 0)) or 564 | ((x - 4 >= 0) and 565 | (TheArray[Y][X - 1] = 0) and 566 | (TheArray[Y][X - 2] = 0) and 567 | (TheArray[Y][X - 3] = 0) and 568 | (TheArray[Y][X - 4] = 0)))) then 569 | begin 570 | Inc(Penalty, 40); 571 | end; 572 | if ((Y + 6 < Height) and 573 | (TheArray[Y][X] = 1) and 574 | (TheArray[Y + 1][X] = 0) and 575 | (TheArray[Y + 2][X] = 1) and 576 | (TheArray[Y + 3][X] = 1) and 577 | (TheArray[Y + 4][X] = 1) and 578 | (TheArray[Y + 5][X] = 0) and 579 | (TheArray[Y + 6][X] = 1) and 580 | (((Y + 10 < Height) and 581 | (TheArray[Y + 7][X] = 0) and 582 | (TheArray[Y + 8][X] = 0) and 583 | (TheArray[Y + 9][X] = 0) and 584 | (TheArray[Y + 10][X] = 0)) or 585 | ((Y - 4 >= 0) and 586 | (TheArray[Y - 1][X] = 0) and 587 | (TheArray[Y - 2][X] = 0) and 588 | (TheArray[Y - 3][X] = 0) and 589 | (TheArray[Y - 4][X] = 0)))) then 590 | begin 591 | Inc(Penalty, 40); 592 | end; 593 | end; 594 | end; 595 | Result := Penalty; 596 | end; 597 | 598 | // Apply mask penalty rule 4 and return the penalty. Calculate the ratio of dark cells and give 599 | // penalty if the ratio is far from 50%. It gives 10 penalty for 5% distance. Examples: 600 | // - 0% => 100 601 | // - 40% => 20 602 | // - 45% => 10 603 | // - 50% => 0 604 | // - 55% => 10 605 | // - 55% => 20 606 | // - 100% => 100 607 | function TEncoder.ApplyMaskPenaltyRule4(Matrix: TByteMatrix): Integer; 608 | var 609 | NumDarkCells: Integer; 610 | TheArray: T2DByteArray; 611 | Width: Integer; 612 | Height: Integer; 613 | NumTotalCells: Integer; 614 | DarkRatio: Double; 615 | X: Integer; 616 | Y: Integer; 617 | begin 618 | NumDarkCells := 0; 619 | TheArray := Matrix.GetArray; 620 | Width := Matrix.Width; 621 | Height := matrix.Height; 622 | for Y := 0 to Height - 1 do 623 | begin 624 | for X := 0 to Width - 1 do 625 | begin 626 | if (TheArray[Y][X] = 1) then 627 | begin 628 | Inc(NumDarkCells); 629 | end; 630 | end; 631 | end; 632 | numTotalCells := matrix.Height * Matrix.Width; 633 | DarkRatio := NumDarkCells / NumTotalCells; 634 | Result := Round(Abs((DarkRatio * 100 - 50)) / 50); 635 | end; 636 | 637 | // Helper function for applyMaskPenaltyRule1. We need this for doing this calculation in both 638 | // vertical and horizontal orders respectively. 639 | function TEncoder.ApplyMaskPenaltyRule1Internal(Matrix: TByteMatrix; IsHorizontal: Boolean): Integer; 640 | var 641 | Penalty: Integer; 642 | NumSameBitCells: Integer; 643 | PrevBit: Integer; 644 | TheArray: T2DByteArray; 645 | I: Integer; 646 | J: Integer; 647 | Bit: Integer; 648 | ILimit: Integer; 649 | JLimit: Integer; 650 | begin 651 | Penalty := 0; 652 | NumSameBitCells := 0; 653 | PrevBit := -1; 654 | // Horizontal mode: 655 | // for (int i = 0; i < matrix.height(); ++i) { 656 | // for (int j = 0; j < matrix.width(); ++j) { 657 | // int bit = matrix.get(i, j); 658 | // Vertical mode: 659 | // for (int i = 0; i < matrix.width(); ++i) { 660 | // for (int j = 0; j < matrix.height(); ++j) { 661 | // int bit = matrix.get(j, i); 662 | if (IsHorizontal) then 663 | begin 664 | ILimit := Matrix.Height; 665 | JLimit := Matrix.Width; 666 | end else 667 | begin 668 | ILimit := Matrix.Width; 669 | JLimit := Matrix.Height; 670 | end; 671 | TheArray := Matrix.GetArray; 672 | 673 | for I := 0 to ILimit - 1 do 674 | begin 675 | for J := 0 to JLimit - 1 do 676 | begin 677 | if (IsHorizontal) then 678 | begin 679 | Bit := TheArray[I][J]; 680 | end else 681 | begin 682 | Bit := TheArray[J][I]; 683 | end; 684 | if (Bit = PrevBit) then 685 | begin 686 | Inc(NumSameBitCells); 687 | // Found five repetitive cells with the same color (bit). 688 | // We'll give penalty of 3. 689 | if (NumSameBitCells = 5) then 690 | begin 691 | Inc(Penalty, 3); 692 | end else if (NumSameBitCells > 5) then 693 | begin 694 | // After five repetitive cells, we'll add the penalty one 695 | // by one. 696 | Inc(Penalty, 1);; 697 | end; 698 | end else 699 | begin 700 | NumSameBitCells := 1; // Include the cell itself. 701 | PrevBit := bit; 702 | end; 703 | end; 704 | NumSameBitCells := 0; // Clear at each row/column. 705 | end; 706 | Result := Penalty; 707 | end; 708 | 709 | { TQRCode } 710 | 711 | constructor TQRCode.Create; 712 | begin 713 | FMode := qmTerminator; 714 | FQRCodeError := False; 715 | FECLevel := nil; 716 | FVersion := -1; 717 | FMatrixWidth := -1; 718 | FMaskPattern := -1; 719 | FNumTotalBytes := -1; 720 | FNumDataBytes := -1; 721 | FNumECBytes := -1; 722 | FNumRSBlocks := -1; 723 | FMatrix := nil; 724 | end; 725 | 726 | destructor TQRCode.Destroy; 727 | begin 728 | if (Assigned(FECLevel)) then 729 | begin 730 | FECLevel.Free; 731 | end; 732 | if (Assigned(FMatrix)) then 733 | begin 734 | FMatrix.Free; 735 | end; 736 | inherited; 737 | end; 738 | 739 | function TQRCode.At(X, Y: Integer): Integer; 740 | var 741 | Value: Integer; 742 | begin 743 | // The value must be zero or one. 744 | Value := FMatrix.Get(X, Y); 745 | if (not ((Value = 0) or (Value = 1))) then 746 | begin 747 | FQRCodeError := True; 748 | end; 749 | Result := Value; 750 | end; 751 | 752 | function TQRCode.IsValid: Boolean; 753 | begin 754 | Result := 755 | // First check if all version are not uninitialized. 756 | ((FECLevel <> nil) and 757 | (FVersion <> -1) and 758 | (FMatrixWidth <> -1) and 759 | (FMaskPattern <> -1) and 760 | (FNumTotalBytes <> -1) and 761 | (FNumDataBytes <> -1) and 762 | (FNumECBytes <> -1) and 763 | (FNumRSBlocks <> -1) and 764 | // Then check them in other ways.. 765 | IsValidMaskPattern(FMaskPattern) and 766 | (FNumTotalBytes = FNumDataBytes + FNumECBytes) and 767 | // ByteMatrix stuff. 768 | (Assigned(FMatrix)) and 769 | (FMatrixWidth = FMatrix.Width) and 770 | // See 7.3.1 of JISX0510:2004 (Fp.5). 771 | (FMatrix.Width = FMatrix.Height)); // Must be square. 772 | end; 773 | 774 | function TQRCode.IsValidMaskPattern(MaskPattern: Integer): Boolean; 775 | begin 776 | Result := (MaskPattern >= 0) and (MaskPattern < NUM_MASK_PATTERNS); 777 | end; 778 | 779 | procedure TQRCode.SetMatrix(NewMatrix: TByteMatrix); 780 | begin 781 | if (Assigned(FMatrix)) then 782 | begin 783 | FMatrix.Free; 784 | FMatrix := nil; 785 | end; 786 | FMatrix := NewMatrix; 787 | end; 788 | 789 | procedure TQRCode.SetAll(VersionNum, NumBytes, NumDataBytes, NumRSBlocks, 790 | NumECBytes, MatrixWidth: Integer); 791 | begin 792 | FVersion := VersionNum; 793 | FNumTotalBytes := NumBytes; 794 | FNumDataBytes := NumDataBytes; 795 | FNumRSBlocks := NumRSBlocks; 796 | FNumECBytes := NumECBytes; 797 | FMatrixWidth := MatrixWidth; 798 | end; 799 | 800 | procedure TQRCode.SetECLevel(NewECLevel: TErrorCorrectionLevel); 801 | begin 802 | if (Assigned(FECLevel)) then 803 | begin 804 | FECLevel.Free; 805 | end; 806 | FECLevel := TErrorCorrectionLevel.Create; 807 | FECLevel.Assign(NewECLevel); 808 | end; 809 | 810 | { TByteMatrix } 811 | 812 | procedure TByteMatrix.Clear(Value: Byte); 813 | var 814 | X, Y: Integer; 815 | begin 816 | for Y := 0 to FHeight - 1 do 817 | begin 818 | for X := 0 to FWidth - 1 do 819 | begin 820 | Bytes[Y][X] := Value; 821 | end; 822 | end; 823 | end; 824 | 825 | constructor TByteMatrix.Create(Width, Height: Integer); 826 | var 827 | Y: Integer; 828 | X: Integer; 829 | begin 830 | FWidth := Width; 831 | FHeight := Height; 832 | SetLength(Bytes, Height); 833 | for Y := 0 to Height - 1 do 834 | begin 835 | SetLength(Bytes[Y], Width); 836 | for X := 0 to Width - 1 do 837 | begin 838 | Bytes[Y][X] := 0; 839 | end; 840 | end; 841 | end; 842 | 843 | function TByteMatrix.Get(X, Y: Integer): Integer; 844 | begin 845 | if (Bytes[Y][X] = 255) then Result := -1 else Result := Bytes[Y][X]; 846 | end; 847 | 848 | function TByteMatrix.GetArray: T2DByteArray; 849 | begin 850 | Result := Bytes; 851 | end; 852 | 853 | function TByteMatrix.Hash: AnsiString; 854 | var 855 | X, Y: Integer; 856 | Counter: Integer; 857 | CC: Integer; 858 | begin 859 | Result := ''; 860 | for Y := 0 to FHeight - 1 do 861 | begin 862 | Counter := 0; 863 | for X := 0 to FWidth - 1 do 864 | begin 865 | CC := Get(X, Y); 866 | if (CC = -1) then CC := 255; 867 | Counter := Counter + CC; 868 | end; 869 | Result := Result + AnsiChar((Counter mod 26) + 65); 870 | end; 871 | end; 872 | 873 | procedure TByteMatrix.SetBoolean(X, Y: Integer; Value: Boolean); 874 | begin 875 | Bytes[Y][X] := Byte(Value) and $FF; 876 | end; 877 | 878 | procedure TByteMatrix.SetInteger(X, Y, Value: Integer); 879 | begin 880 | Bytes[Y][X] := Value and $FF; 881 | end; 882 | 883 | procedure TByteMatrix.Assign(Source: TByteMatrix); 884 | var 885 | SourceLength: Integer; 886 | begin 887 | SourceLength := Length(Source.Bytes); 888 | SetLength(Bytes, SourceLength); 889 | if (SourceLength > 0) then 890 | begin 891 | Move(Source.Bytes[0], Bytes[0], SourceLength); 892 | end; 893 | FWidth := Source.Width; 894 | FHeight := Source.Height; 895 | end; 896 | 897 | { TEncoder } 898 | 899 | function TEncoder.CalculateMaskPenalty(Matrix: TByteMatrix): Integer; 900 | var 901 | Penalty: Integer; 902 | begin 903 | Penalty := 0; 904 | Inc(Penalty, ApplyMaskPenaltyRule1(Matrix)); 905 | Inc(Penalty, ApplyMaskPenaltyRule2(Matrix)); 906 | Inc(Penalty, ApplyMaskPenaltyRule3(Matrix)); 907 | Inc(Penalty, ApplyMaskPenaltyRule4(Matrix)); 908 | Result := Penalty; 909 | end; 910 | 911 | {procedure TEncoder.Encode(const Content: WideString; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode); 912 | begin 913 | Encode(Content, ECLevel, nil, QRCode); 914 | end;} 915 | 916 | procedure TEncoder.Encode(const Content: WideString; EncodeOptions: Integer; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode); 917 | var 918 | Mode: TMode; 919 | DataBits: TBitArray; 920 | FinalBits: TBitArray; 921 | HeaderBits: TBitArray; 922 | HeaderAndDataBits: TBitArray; 923 | Matrix: TByteMatrix; 924 | NumLetters: Integer; 925 | MatrixUtil: TMatrixUtil; 926 | BitsNeeded: Integer; 927 | ProvisionalBitsNeeded: Integer; 928 | ProvisionalVersion: TVersion; 929 | Version: TVersion; 930 | ECBlocks: TECBlocks; 931 | NumDataBytes: Integer; 932 | Dimension: Integer; 933 | FilteredContent: WideString; 934 | begin 935 | DataBits := TBitArray.Create; 936 | HeaderBits := TBitArray.Create; 937 | 938 | // Pick an encoding mode appropriate for the content. Note that this will not attempt to use 939 | // multiple modes / segments even if that were more efficient. Twould be nice. 940 | // Collect data within the main segment, separately, to count its size if needed. Don't add it to 941 | // main payload yet. 942 | 943 | Mode := ChooseMode(Content, EncodeOptions); 944 | FilteredContent := FilterContent(Content, Mode, EncodeOptions); 945 | AppendBytes(FilteredContent, Mode, DataBits, EncodeOptions); 946 | 947 | // (With ECI in place,) Write the mode marker 948 | AppendModeInfo(Mode, HeaderBits); 949 | 950 | // Hard part: need to know version to know how many bits length takes. But need to know how many 951 | // bits it takes to know version. First we take a guess at version by assuming version will be 952 | // the minimum, 1: 953 | ProvisionalVersion := TVersion.GetVersionForNumber(1); 954 | try 955 | ProvisionalBitsNeeded := HeaderBits.GetSize + 956 | GetModeCharacterCountBits(Mode, ProvisionalVersion) + 957 | DataBits.GetSize; 958 | finally 959 | ProvisionalVersion.Free; 960 | end; 961 | 962 | ProvisionalVersion := TVersion.ChooseVersion(ProvisionalBitsNeeded, ECLevel); 963 | try 964 | // Use that guess to calculate the right version. I am still not sure this works in 100% of cases. 965 | BitsNeeded := HeaderBits.GetSize + 966 | GetModeCharacterCountBits(Mode, ProvisionalVersion) + 967 | DataBits.GetSize; 968 | Version := TVersion.ChooseVersion(BitsNeeded, ECLevel); 969 | finally 970 | ProvisionalVersion.Free; 971 | end; 972 | 973 | HeaderAndDataBits := TBitArray.Create; 974 | FinalBits := TBitArray.Create; 975 | try 976 | HeaderAndDataBits.AppendBitArray(HeaderBits); 977 | 978 | // Find "length" of main segment and write it 979 | if (Mode = qmByte) then 980 | begin 981 | NumLetters := DataBits.GetSizeInBytes; 982 | end else 983 | begin 984 | NumLetters := Length(FilteredContent); 985 | end; 986 | AppendLengthInfo(NumLetters, Version.VersionNumber, Mode, HeaderAndDataBits); 987 | // Put data together into the overall payload 988 | HeaderAndDataBits.AppendBitArray(DataBits); 989 | 990 | ECBlocks := Version.GetECBlocksForLevel(ECLevel); 991 | NumDataBytes := Version.GetTotalCodewords - ECBlocks.GetTotalECCodewords; 992 | 993 | // Terminate the bits properly. 994 | TerminateBits(NumDataBytes, HeaderAndDataBits); 995 | 996 | // Interleave data bits with error correction code. 997 | InterleaveWithECBytes(HeaderAndDataBits, Version.GetTotalCodewords, 998 | NumDataBytes, ECBlocks.GetNumBlocks, FinalBits); 999 | 1000 | // QRCode qrCode = new QRCode(); // This is passed in 1001 | 1002 | 1003 | QRCode.SetECLevel(ECLevel); 1004 | QRCode.Mode := Mode; 1005 | QRCode.Version := Version.VersionNumber; 1006 | 1007 | // Choose the mask pattern and set to "qrCode". 1008 | Dimension := Version.GetDimensionForVersion; 1009 | Matrix := TByteMatrix.Create(Dimension, Dimension); 1010 | 1011 | QRCode.MaskPattern := ChooseMaskPattern(FinalBits, ECLevel, Version.VersionNumber, Matrix); 1012 | 1013 | Matrix.Free; 1014 | Matrix := TByteMatrix.Create(Dimension, Dimension); 1015 | 1016 | // Build the matrix and set it to "qrCode". 1017 | MatrixUtil := TMatrixUtil.Create; 1018 | try 1019 | MatrixUtil.BuildMatrix(FinalBits, QRCode.ECLevel, QRCode.Version, 1020 | QRCode.MaskPattern, Matrix); 1021 | finally 1022 | MatrixUtil.Free; 1023 | end; 1024 | 1025 | QRCode.SetMatrix(Matrix); // QRCode will free the matrix 1026 | finally 1027 | DataBits.Free; 1028 | HeaderAndDataBits.Free; 1029 | FinalBits.Free; 1030 | HeaderBits.Free; 1031 | Version.Free; 1032 | end; 1033 | end; 1034 | 1035 | function TEncoder.FilterContent(const Content: WideString; Mode: TMode; 1036 | EncodeOptions: Integer): WideString; 1037 | var 1038 | X: Integer; 1039 | CanAdd: Boolean; 1040 | begin 1041 | Result := ''; 1042 | for X := 1 to Length(Content) do 1043 | begin 1044 | CanAdd := False; 1045 | if (Mode = qmNumeric) then 1046 | begin 1047 | CanAdd := (Content[X] >= '0') and (Content[X] <= '9'); 1048 | end else 1049 | if (Mode = qmAlphanumeric) then 1050 | begin 1051 | CanAdd := GetAlphanumericCode(Ord(Content[X])) > 0; 1052 | end else 1053 | if (Mode = qmByte) then 1054 | begin 1055 | if (EncodeOptions = 3) then 1056 | begin 1057 | CanAdd := Ord(Content[X]) <= $FF; 1058 | end else 1059 | if ((EncodeOptions = 4) or (EncodeOptions = 5)) then 1060 | begin 1061 | CanAdd := True; 1062 | end; 1063 | end; 1064 | if (CanAdd) then 1065 | begin 1066 | Result := Result + Content[X]; 1067 | end; 1068 | end; 1069 | end; 1070 | 1071 | // Return the code point of the table used in alphanumeric mode or 1072 | // -1 if there is no corresponding code in the table. 1073 | function TEncoder.GetAlphanumericCode(Code: Integer): Integer; 1074 | begin 1075 | if (Code < Length(ALPHANUMERIC_TABLE)) then 1076 | begin 1077 | Result := ALPHANUMERIC_TABLE[Code]; 1078 | end else 1079 | begin 1080 | Result := -1; 1081 | end; 1082 | end; 1083 | 1084 | // Choose the mode based on the content 1085 | function TEncoder.ChooseMode(const Content: WideString; var EncodeOptions: Integer): TMode; 1086 | var 1087 | AllNumeric: Boolean; 1088 | AllAlphanumeric: Boolean; 1089 | AllISO: Boolean; 1090 | I: Integer; 1091 | C: WideChar; 1092 | begin 1093 | if (EncodeOptions = 0) then 1094 | begin 1095 | AllNumeric := Length(Content) > 0; 1096 | I := 1; 1097 | while (I <= Length(Content)) and (AllNumeric) do 1098 | begin 1099 | C := Content[I]; 1100 | if ((C < '0') or (C > '9')) then 1101 | begin 1102 | AllNumeric := False; 1103 | end else 1104 | begin 1105 | Inc(I); 1106 | end; 1107 | end; 1108 | 1109 | if (not AllNumeric) then 1110 | begin 1111 | AllAlphanumeric := Length(Content) > 0; 1112 | I := 1; 1113 | while (I <= Length(Content)) and (AllAlphanumeric) do 1114 | begin 1115 | C := Content[I]; 1116 | if (GetAlphanumericCode(Ord(C)) < 0) then 1117 | begin 1118 | AllAlphanumeric := False; 1119 | end else 1120 | begin 1121 | Inc(I); 1122 | end; 1123 | end; 1124 | end else 1125 | begin 1126 | AllAlphanumeric := False; 1127 | end; 1128 | 1129 | if (not AllAlphanumeric) then 1130 | begin 1131 | AllISO := Length(Content) > 0; 1132 | I := 1; 1133 | while (I <= Length(Content)) and (AllISO) do 1134 | begin 1135 | C := Content[I]; 1136 | if (Ord(C) > $FF) then 1137 | begin 1138 | AllISO := False; 1139 | end else 1140 | begin 1141 | Inc(I); 1142 | end; 1143 | end; 1144 | end else 1145 | begin 1146 | AllISO := False; 1147 | end; 1148 | 1149 | if (AllNumeric) then 1150 | begin 1151 | Result := qmNumeric; 1152 | end else 1153 | if (AllAlphanumeric) then 1154 | begin 1155 | Result := qmAlphanumeric; 1156 | end else 1157 | if (AllISO) then 1158 | begin 1159 | Result := qmByte; 1160 | EncodeOptions := 3; 1161 | end else 1162 | begin 1163 | Result := qmByte; 1164 | EncodeOptions := 4; 1165 | end; 1166 | end else 1167 | if (EncodeOptions = 1) then 1168 | begin 1169 | Result := qmNumeric; 1170 | end else 1171 | if (EncodeOptions = 2) then 1172 | begin 1173 | Result := qmAlphanumeric; 1174 | end else 1175 | begin 1176 | Result := qmByte; 1177 | end; 1178 | end; 1179 | 1180 | constructor TEncoder.Create; 1181 | begin 1182 | FEncoderError := False; 1183 | end; 1184 | 1185 | {function TEncoder.IsOnlyDoubleByteKanji(const Content: WideString): Boolean; 1186 | var 1187 | I: Integer; 1188 | Char1: Integer; 1189 | begin 1190 | Result := True; 1191 | I := 0; 1192 | while ((I < Length(Content)) and Result) do 1193 | begin 1194 | Char1 := Ord(Content[I + 1]); 1195 | if (((Char1 < $81) or (Char1 > $9F)) and ((Char1 < $E0) or (Char1 > $EB))) then 1196 | begin 1197 | Result := False; 1198 | end; 1199 | end; 1200 | end;} 1201 | 1202 | function TEncoder.ChooseMaskPattern(Bits: TBitArray; ECLevel: TErrorCorrectionLevel; Version: Integer; Matrix: TByteMatrix): Integer; 1203 | var 1204 | MinPenalty: Integer; 1205 | BestMaskPattern: Integer; 1206 | MaskPattern: Integer; 1207 | MatrixUtil: TMatrixUtil; 1208 | Penalty: Integer; 1209 | begin 1210 | MinPenalty := MaxInt; 1211 | BestMaskPattern := -1; 1212 | 1213 | // We try all mask patterns to choose the best one. 1214 | for MaskPattern := 0 to NUM_MASK_PATTERNS - 1 do 1215 | begin 1216 | MatrixUtil := TMatrixUtil.Create; 1217 | try 1218 | MatrixUtil.BuildMatrix(Bits, ECLevel, Version, MaskPattern, Matrix); 1219 | finally 1220 | MatrixUtil.Free; 1221 | end; 1222 | Penalty := CalculateMaskPenalty(Matrix); 1223 | if (Penalty < MinPenalty) then 1224 | begin 1225 | MinPenalty := Penalty; 1226 | BestMaskPattern := MaskPattern; 1227 | end; 1228 | end; 1229 | 1230 | Result := BestMaskPattern; 1231 | end; 1232 | 1233 | // Terminate bits as described in 8.4.8 and 8.4.9 of JISX0510:2004 (p.24). 1234 | procedure TEncoder.TerminateBits(NumDataBytes: Integer; var Bits: TBitArray); 1235 | var 1236 | Capacity: Integer; 1237 | I: Integer; 1238 | NumBitsInLastByte: Integer; 1239 | NumPaddingBytes: Integer; 1240 | begin 1241 | Capacity := NumDataBytes shl 3; 1242 | if (Bits.GetSize > Capacity) then 1243 | begin 1244 | FEncoderError := True; 1245 | Exit; 1246 | end; 1247 | I := 0; 1248 | while ((I < 4) and (Bits.GetSize < capacity)) do 1249 | begin 1250 | Bits.AppendBit(False); 1251 | Inc(I); 1252 | end; 1253 | 1254 | // Append termination bits. See 8.4.8 of JISX0510:2004 (p.24) for details. 1255 | // If the last byte isn't 8-bit aligned, we'll add padding bits. 1256 | NumBitsInLastByte := Bits.GetSize and $07; 1257 | if (NumBitsInLastByte > 0) then 1258 | begin 1259 | for I := numBitsInLastByte to 7 do 1260 | begin 1261 | Bits.AppendBit(False); 1262 | end; 1263 | end; 1264 | 1265 | // If we have more space, we'll fill the space with padding patterns defined in 8.4.9 (p.24). 1266 | NumPaddingBytes := NumDataBytes - Bits.GetSizeInBytes; 1267 | for I := 0 to NumPaddingBytes - 1 do 1268 | begin 1269 | if ((I and $01) = 0) then 1270 | begin 1271 | Bits.AppendBits($EC, 8); 1272 | end else 1273 | begin 1274 | Bits.AppendBits($11, 8); 1275 | end; 1276 | end; 1277 | if (Bits.GetSize <> Capacity) then 1278 | begin 1279 | FEncoderError := True; 1280 | end; 1281 | end; 1282 | 1283 | // Get number of data bytes and number of error correction bytes for block id "blockID". Store 1284 | // the result in "numDataBytesInBlock", and "numECBytesInBlock". See table 12 in 8.5.1 of 1285 | // JISX0510:2004 (p.30) 1286 | procedure TEncoder.GetNumDataBytesAndNumECBytesForBlockID(NumTotalBytes, NumDataBytes, 1287 | NumRSBlocks, BlockID: Integer; var NumDataBytesInBlock: TIntegerArray; 1288 | var NumECBytesInBlock: TIntegerArray); 1289 | var 1290 | NumRSBlocksInGroup1: Integer; 1291 | NumRSBlocksInGroup2: Integer; 1292 | NumTotalBytesInGroup1: Integer; 1293 | NumTotalBytesInGroup2: Integer; 1294 | NumDataBytesInGroup1: Integer; 1295 | NumDataBytesInGroup2: Integer; 1296 | NumECBytesInGroup1: Integer; 1297 | NumECBytesInGroup2: Integer; 1298 | begin 1299 | if (BlockID >= NumRSBlocks) then 1300 | begin 1301 | FEncoderError := True; 1302 | Exit; 1303 | end; 1304 | // numRsBlocksInGroup2 = 196 % 5 = 1 1305 | NumRSBlocksInGroup2 := NumTotalBytes mod NumRSBlocks; 1306 | // numRsBlocksInGroup1 = 5 - 1 = 4 1307 | NumRSBlocksInGroup1 := NumRSBlocks - NumRSBlocksInGroup2; 1308 | // numTotalBytesInGroup1 = 196 / 5 = 39 1309 | NumTotalBytesInGroup1 := NumTotalBytes div NumRSBlocks; 1310 | // numTotalBytesInGroup2 = 39 + 1 = 40 1311 | NumTotalBytesInGroup2 := NumTotalBytesInGroup1 + 1; 1312 | // numDataBytesInGroup1 = 66 / 5 = 13 1313 | NumDataBytesInGroup1 := NumDataBytes div NumRSBlocks; 1314 | // numDataBytesInGroup2 = 13 + 1 = 14 1315 | NumDataBytesInGroup2 := NumDataBytesInGroup1 + 1; 1316 | // numEcBytesInGroup1 = 39 - 13 = 26 1317 | NumECBytesInGroup1 := NumTotalBytesInGroup1 - NumDataBytesInGroup1; 1318 | // numEcBytesInGroup2 = 40 - 14 = 26 1319 | NumECBytesInGroup2 := NumTotalBytesInGroup2 - NumDataBytesInGroup2; 1320 | // Sanity checks. 1321 | // 26 = 26 1322 | if (NumECBytesInGroup1 <> NumECBytesInGroup2) then 1323 | begin 1324 | FEncoderError := True; 1325 | Exit; 1326 | end; 1327 | // 5 = 4 + 1. 1328 | if (NumRSBlocks <> (NumRSBlocksInGroup1 + NumRSBlocksInGroup2)) then 1329 | begin 1330 | FEncoderError := True; 1331 | Exit; 1332 | end; 1333 | // 196 = (13 + 26) * 4 + (14 + 26) * 1 1334 | if (NumTotalBytes <> 1335 | ((NumDataBytesInGroup1 + NumECBytesInGroup1) * NumRsBlocksInGroup1) + 1336 | ((NumDataBytesInGroup2 + NumECBytesInGroup2) * NumRsBlocksInGroup2)) then 1337 | begin 1338 | FEncoderError := True; 1339 | Exit; 1340 | end; 1341 | 1342 | if (BlockID < NumRSBlocksInGroup1) then 1343 | begin 1344 | NumDataBytesInBlock[0] := NumDataBytesInGroup1; 1345 | NumECBytesInBlock[0] := numECBytesInGroup1; 1346 | end else 1347 | begin 1348 | NumDataBytesInBlock[0] := NumDataBytesInGroup2; 1349 | NumECBytesInBlock[0] := numEcBytesInGroup2; 1350 | end; 1351 | end; 1352 | 1353 | // Interleave "bits" with corresponding error correction bytes. On success, store the result in 1354 | // "result". The interleave rule is complicated. See 8.6 of JISX0510:2004 (p.37) for details. 1355 | procedure TEncoder.InterleaveWithECBytes(Bits: TBitArray; NumTotalBytes, 1356 | NumDataBytes, NumRSBlocks: Integer; var Result: TBitArray); 1357 | var 1358 | DataBytesOffset: Integer; 1359 | MaxNumDataBytes: Integer; 1360 | MaxNumECBytes: Integer; 1361 | Blocks: TObjectList; 1362 | NumDataBytesInBlock: TIntegerArray; 1363 | NumECBytesInBlock: TIntegerArray; 1364 | Size: Integer; 1365 | DataBytes: TByteArray; 1366 | ECBytes: TByteArray; 1367 | I, J: Integer; 1368 | BlockPair: TBlockPair; 1369 | begin 1370 | SetLength(ECBytes, 0); 1371 | 1372 | // "bits" must have "getNumDataBytes" bytes of data. 1373 | if (Bits.GetSizeInBytes <> NumDataBytes) then 1374 | begin 1375 | FEncoderError := True; 1376 | Exit; 1377 | end; 1378 | 1379 | // Step 1. Divide data bytes into blocks and generate error correction bytes for them. We'll 1380 | // store the divided data bytes blocks and error correction bytes blocks into "blocks". 1381 | DataBytesOffset := 0; 1382 | MaxNumDataBytes := 0; 1383 | MaxNumEcBytes := 0; 1384 | 1385 | // Since, we know the number of reedsolmon blocks, we can initialize the vector with the number. 1386 | Blocks := TObjectList.Create(True); 1387 | try 1388 | Blocks.Capacity := NumRSBlocks; 1389 | 1390 | for I := 0 to NumRSBlocks - 1 do 1391 | begin 1392 | SetLength(NumDataBytesInBlock, 1); 1393 | SetLength(NumECBytesInBlock, 1); 1394 | GetNumDataBytesAndNumECBytesForBlockID( 1395 | NumTotalBytes, NumDataBytes, NumRSBlocks, I, 1396 | NumDataBytesInBlock, NumEcBytesInBlock); 1397 | 1398 | Size := NumDataBytesInBlock[0]; 1399 | SetLength(DataBytes, Size); 1400 | Bits.ToBytes(8 * DataBytesOffset, DataBytes, 0, Size); 1401 | ECBytes := GenerateECBytes(DataBytes, NumEcBytesInBlock[0]); 1402 | BlockPair := TBlockPair.Create(DataBytes, ECBytes); 1403 | Blocks.Add(BlockPair); 1404 | 1405 | MaxNumDataBytes := Max(MaxNumDataBytes, Size); 1406 | MaxNumECBytes := Max(MaxNumECBytes, Length(ECBytes)); 1407 | Inc(DataBytesOffset, NumDataBytesInBlock[0]); 1408 | end; 1409 | if (NumDataBytes <> DataBytesOffset) then 1410 | begin 1411 | FEncoderError := True; 1412 | Exit; 1413 | end; 1414 | 1415 | // First, place data blocks. 1416 | for I := 0 to MaxNumDataBytes - 1 do 1417 | begin 1418 | for J := 0 to Blocks.Count - 1 do 1419 | begin 1420 | DataBytes := TBlockPair(Blocks.Items[J]).GetDataBytes; 1421 | if (I < Length(DataBytes)) then 1422 | begin 1423 | Result.AppendBits(DataBytes[I], 8); 1424 | end; 1425 | end; 1426 | end; 1427 | // Then, place error correction blocks. 1428 | for I := 0 to MaxNumECBytes - 1 do 1429 | begin 1430 | for J := 0 to Blocks.Count - 1 do 1431 | begin 1432 | ECBytes := TBlockPair(Blocks.Items[J]).GetErrorCorrectionBytes; 1433 | if (I < Length(ECBytes)) then 1434 | begin 1435 | Result.AppendBits(ECBytes[I], 8); 1436 | end; 1437 | end; 1438 | end; 1439 | finally 1440 | Blocks.Free; 1441 | end; 1442 | if (numTotalBytes <> Result.GetSizeInBytes) then // Should be same. 1443 | begin 1444 | FEncoderError := True; 1445 | Exit; 1446 | end; 1447 | end; 1448 | 1449 | function TEncoder.GenerateECBytes(DataBytes: TByteArray; NumECBytesInBlock: Integer): TByteArray; 1450 | var 1451 | NumDataBytes: Integer; 1452 | ToEncode: TIntegerArray; 1453 | ReedSolomonEncoder: TReedSolomonEncoder; 1454 | I: Integer; 1455 | ECBytes: TByteArray; 1456 | GenericGF: TGenericGF; 1457 | begin 1458 | NumDataBytes := Length(DataBytes); 1459 | SetLength(ToEncode, NumDataBytes + NumECBytesInBlock); 1460 | 1461 | for I := 0 to NumDataBytes - 1 do 1462 | begin 1463 | ToEncode[I] := DataBytes[I] and $FF; 1464 | end; 1465 | 1466 | GenericGF := TGenericGF.CreateQRCodeField256; 1467 | try 1468 | ReedSolomonEncoder := TReedSolomonEncoder.Create(GenericGF); 1469 | try 1470 | ReedSolomonEncoder.Encode(ToEncode, NumECBytesInBlock); 1471 | finally 1472 | ReedSolomonEncoder.Free; 1473 | end; 1474 | finally 1475 | GenericGF.Free; 1476 | end; 1477 | 1478 | SetLength(ECBytes, NumECBytesInBlock); 1479 | for I := 0 to NumECBytesInBlock - 1 do 1480 | begin 1481 | ECBytes[I] := ToEncode[NumDataBytes + I]; 1482 | end; 1483 | 1484 | Result := ECBytes; 1485 | end; 1486 | 1487 | // Append mode info. On success, store the result in "bits". 1488 | procedure TEncoder.AppendModeInfo(Mode: TMode; Bits: TBitArray); 1489 | begin 1490 | Bits.AppendBits(GetModeBits(Mode), 4); 1491 | end; 1492 | 1493 | // Append length info. On success, store the result in "bits". 1494 | procedure TEncoder.AppendLengthInfo(NumLetters, VersionNum: Integer; Mode: TMode; Bits: TBitArray); 1495 | var 1496 | NumBits: Integer; 1497 | Version: TVersion; 1498 | begin 1499 | Version := TVersion.GetVersionForNumber(VersionNum); 1500 | try 1501 | NumBits := GetModeCharacterCountBits(Mode, Version); 1502 | finally 1503 | Version.Free; 1504 | end; 1505 | 1506 | if (NumLetters > ((1 shl NumBits) - 1)) then 1507 | begin 1508 | FEncoderError := True; 1509 | Exit; 1510 | end; 1511 | 1512 | Bits.AppendBits(NumLetters, NumBits); 1513 | end; 1514 | 1515 | // Append "bytes" in "mode" mode (encoding) into "bits". On success, store the result in "bits". 1516 | procedure TEncoder.AppendBytes(const Content: WideString; Mode: TMode; Bits: TBitArray; EncodeOptions: Integer); 1517 | begin 1518 | if (Mode = qmNumeric) then 1519 | begin 1520 | AppendNumericBytes(Content, Bits); 1521 | end else 1522 | if (Mode = qmAlphanumeric) then 1523 | begin 1524 | AppendAlphanumericBytes(Content, Bits); 1525 | end else 1526 | if (Mode = qmByte) then 1527 | begin 1528 | Append8BitBytes(Content, Bits, EncodeOptions); 1529 | end else 1530 | if (Mode = qmKanji) then 1531 | begin 1532 | AppendKanjiBytes(Content, Bits); 1533 | end else 1534 | begin 1535 | FEncoderError := True; 1536 | Exit; 1537 | end; 1538 | end; 1539 | 1540 | procedure TEncoder.AppendNumericBytes(const Content: WideString; Bits: TBitArray); 1541 | var 1542 | ContentLength: Integer; 1543 | I: Integer; 1544 | Num1: Integer; 1545 | Num2: Integer; 1546 | Num3: Integer; 1547 | begin 1548 | ContentLength := Length(Content); 1549 | I := 0; 1550 | while (I < ContentLength) do 1551 | begin 1552 | Num1 := Ord(Content[I + 0 + 1]) - Ord('0'); 1553 | if (I + 2 < ContentLength) then 1554 | begin 1555 | // Encode three numeric letters in ten bits. 1556 | Num2 := Ord(Content[I + 1 + 1]) - Ord('0'); 1557 | Num3 := Ord(Content[I + 2 + 1]) - Ord('0'); 1558 | Bits.AppendBits(Num1 * 100 + Num2 * 10 + Num3, 10); 1559 | Inc(I, 3); 1560 | end else 1561 | if (I + 1 < ContentLength) then 1562 | begin 1563 | // Encode two numeric letters in seven bits. 1564 | Num2 := Ord(Content[I + 1 + 1]) - Ord('0'); 1565 | Bits.AppendBits(Num1 * 10 + Num2, 7); 1566 | Inc(I, 2); 1567 | end else 1568 | begin 1569 | // Encode one numeric letter in four bits. 1570 | Bits.AppendBits(Num1, 4); 1571 | Inc(I); 1572 | end; 1573 | end; 1574 | end; 1575 | 1576 | procedure TEncoder.AppendAlphanumericBytes(const Content: WideString; Bits: TBitArray); 1577 | var 1578 | ContentLength: Integer; 1579 | I: Integer; 1580 | Code1: Integer; 1581 | Code2: Integer; 1582 | begin 1583 | ContentLength := Length(Content); 1584 | I := 0; 1585 | while (I < ContentLength) do 1586 | begin 1587 | Code1 := GetAlphanumericCode(Ord(Content[I + 0 + 1])); 1588 | if (Code1 = -1) then 1589 | begin 1590 | FEncoderError := True; 1591 | Exit; 1592 | end; 1593 | if (I + 1 < ContentLength) then 1594 | begin 1595 | Code2 := GetAlphanumericCode(Ord(Content[I + 1 + 1])); 1596 | if (Code2 = -1) then 1597 | begin 1598 | FEncoderError := True; 1599 | Exit; 1600 | end; 1601 | // Encode two alphanumeric letters in 11 bits. 1602 | Bits.AppendBits(Code1 * 45 + Code2, 11); 1603 | Inc(I, 2); 1604 | end else 1605 | begin 1606 | // Encode one alphanumeric letter in six bits. 1607 | Bits.AppendBits(Code1, 6); 1608 | Inc(I); 1609 | end; 1610 | end; 1611 | end; 1612 | 1613 | procedure TEncoder.Append8BitBytes(const Content: WideString; Bits: TBitArray; EncodeOptions: Integer); 1614 | var 1615 | Bytes: TByteArray; 1616 | I: Integer; 1617 | UTF8Version: AnsiString; 1618 | begin 1619 | SetLength(Bytes, 0); 1620 | if (EncodeOptions = 3) then 1621 | begin 1622 | SetLength(Bytes, Length(Content)); 1623 | for I := 1 to Length(Content) do 1624 | begin 1625 | Bytes[I - 1] := Ord(Content[I]) and $FF; 1626 | end; 1627 | end else 1628 | if (EncodeOptions = 4) then 1629 | begin 1630 | // Add the UTF-8 BOM 1631 | UTF8Version := #$EF#$BB#$BF + UTF8Encode(Content); 1632 | SetLength(Bytes, Length(UTF8Version)); 1633 | if (Length(UTF8Version) > 0) then 1634 | begin 1635 | Move(UTF8Version[1], Bytes[0], Length(UTF8Version)); 1636 | end; 1637 | end else 1638 | if (EncodeOptions = 5) then 1639 | begin 1640 | // No BOM 1641 | UTF8Version := UTF8Encode(Content); 1642 | SetLength(Bytes, Length(UTF8Version)); 1643 | if (Length(UTF8Version) > 0) then 1644 | begin 1645 | Move(UTF8Version[1], Bytes[0], Length(UTF8Version)); 1646 | end; 1647 | end; 1648 | for I := 0 to Length(Bytes) - 1 do 1649 | begin 1650 | Bits.AppendBits(Bytes[I], 8); 1651 | end; 1652 | end; 1653 | 1654 | procedure TEncoder.AppendKanjiBytes(const Content: WideString; Bits: TBitArray); 1655 | var 1656 | Bytes: TByteArray; 1657 | ByteLength: Integer; 1658 | I: Integer; 1659 | Byte1: Integer; 1660 | Byte2: Integer; 1661 | Code: Integer; 1662 | Subtracted: Integer; 1663 | Encoded: Integer; 1664 | begin 1665 | SetLength(Bytes, 0); 1666 | try 1667 | 1668 | except 1669 | FEncoderError := True; 1670 | Exit; 1671 | end; 1672 | 1673 | ByteLength := Length(Bytes); 1674 | I := 0; 1675 | while (I < ByteLength) do 1676 | begin 1677 | Byte1 := Bytes[I] and $FF; 1678 | Byte2 := Bytes[I + 1] and $FF; 1679 | Code := (Byte1 shl 8) or Byte2; 1680 | Subtracted := -1; 1681 | if ((Code >= $8140) and (Code <= $9ffc)) then 1682 | begin 1683 | Subtracted := Code - $8140; 1684 | end else 1685 | if ((Code >= $e040) and (Code <= $ebbf)) then 1686 | begin 1687 | Subtracted := Code - $c140; 1688 | end; 1689 | if (Subtracted = -1) then 1690 | begin 1691 | FEncoderError := True; 1692 | Exit; 1693 | end; 1694 | Encoded := ((Subtracted shr 8) * $c0) + (Subtracted and $ff); 1695 | Bits.AppendBits(Encoded, 13); 1696 | Inc(I, 2); 1697 | end; 1698 | end; 1699 | 1700 | procedure TMatrixUtil.ClearMatrix(Matrix: TByteMatrix); 1701 | begin 1702 | Matrix.Clear(Byte(-1)); 1703 | end; 1704 | 1705 | constructor TMatrixUtil.Create; 1706 | begin 1707 | FMatrixUtilError := False; 1708 | end; 1709 | 1710 | // Build 2D matrix of QR Code from "dataBits" with "ecLevel", "version" and "getMaskPattern". On 1711 | // success, store the result in "matrix" and return true. 1712 | procedure TMatrixUtil.BuildMatrix(DataBits: TBitArray; ECLevel: TErrorCorrectionLevel; 1713 | Version, MaskPattern: Integer; Matrix: TByteMatrix); 1714 | begin 1715 | ClearMatrix(Matrix); 1716 | EmbedBasicPatterns(Version, Matrix); 1717 | 1718 | // Type information appear with any version. 1719 | EmbedTypeInfo(ECLevel, MaskPattern, Matrix); 1720 | 1721 | // Version info appear if version >= 7. 1722 | MaybeEmbedVersionInfo(Version, Matrix); 1723 | 1724 | // Data should be embedded at end. 1725 | EmbedDataBits(DataBits, MaskPattern, Matrix); 1726 | end; 1727 | 1728 | // Embed basic patterns. On success, modify the matrix and return true. 1729 | // The basic patterns are: 1730 | // - Position detection patterns 1731 | // - Timing patterns 1732 | // - Dark dot at the left bottom corner 1733 | // - Position adjustment patterns, if need be 1734 | procedure TMatrixUtil.EmbedBasicPatterns(Version: Integer; Matrix: TByteMatrix); 1735 | begin 1736 | // Let's get started with embedding big squares at corners. 1737 | EmbedPositionDetectionPatternsAndSeparators(Matrix); 1738 | 1739 | // Then, embed the dark dot at the left bottom corner. 1740 | EmbedDarkDotAtLeftBottomCorner(Matrix); 1741 | 1742 | // Position adjustment patterns appear if version >= 2. 1743 | MaybeEmbedPositionAdjustmentPatterns(Version, Matrix); 1744 | 1745 | // Timing patterns should be embedded after position adj. patterns. 1746 | EmbedTimingPatterns(Matrix); 1747 | end; 1748 | 1749 | // Embed type information. On success, modify the matrix. 1750 | procedure TMatrixUtil.EmbedTypeInfo(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Matrix: TByteMatrix); 1751 | var 1752 | TypeInfoBits: TBitArray; 1753 | I: Integer; 1754 | Bit: Boolean; 1755 | X1, Y1: Integer; 1756 | X2, Y2: Integer; 1757 | begin 1758 | TypeInfoBits := TBitArray.Create; 1759 | try 1760 | MakeTypeInfoBits(ECLevel, MaskPattern, TypeInfoBits); 1761 | 1762 | for I := 0 to TypeInfoBits.GetSize - 1 do 1763 | begin 1764 | // Place bits in LSB to MSB order. LSB (least significant bit) is the last value in 1765 | // "typeInfoBits". 1766 | Bit := TypeInfoBits.Get(TypeInfoBits.GetSize - 1 - I); 1767 | 1768 | // Type info bits at the left top corner. See 8.9 of JISX0510:2004 (p.46). 1769 | X1 := TYPE_INFO_COORDINATES[I][0]; 1770 | Y1 := TYPE_INFO_COORDINATES[I][1]; 1771 | Matrix.SetBoolean(X1, Y1, Bit); 1772 | 1773 | if (I < 8) then 1774 | begin 1775 | // Right top corner. 1776 | X2 := Matrix.Width - I - 1; 1777 | Y2 := 8; 1778 | Matrix.SetBoolean(X2, Y2, Bit); 1779 | end else 1780 | begin 1781 | // Left bottom corner. 1782 | X2 := 8; 1783 | Y2 := Matrix.Height - 7 + (I - 8); 1784 | Matrix.SetBoolean(X2, Y2, Bit); 1785 | end; 1786 | end; 1787 | finally 1788 | TypeInfoBits.Free; 1789 | end; 1790 | end; 1791 | 1792 | // Embed version information if need be. On success, modify the matrix and return true. 1793 | // See 8.10 of JISX0510:2004 (p.47) for how to embed version information. 1794 | procedure TMatrixUtil.MaybeEmbedVersionInfo(Version: Integer; Matrix: TByteMatrix); 1795 | var 1796 | VersionInfoBits: TBitArray; 1797 | I, J: Integer; 1798 | BitIndex: Integer; 1799 | Bit: Boolean; 1800 | begin 1801 | if (Version < 7) then 1802 | begin 1803 | Exit; // Don't need version info. 1804 | end; 1805 | 1806 | VersionInfoBits := TBitArray.Create; 1807 | try 1808 | MakeVersionInfoBits(Version, VersionInfoBits); 1809 | 1810 | BitIndex := 6 * 3 - 1; // It will decrease from 17 to 0. 1811 | for I := 0 to 5 do 1812 | begin 1813 | for J := 0 to 2 do 1814 | begin 1815 | // Place bits in LSB (least significant bit) to MSB order. 1816 | Bit := VersionInfoBits.Get(BitIndex); 1817 | Dec(BitIndex); 1818 | // Left bottom corner. 1819 | Matrix.SetBoolean(I, Matrix.Height - 11 + J, Bit); 1820 | // Right bottom corner. 1821 | Matrix.SetBoolean(Matrix.Height - 11 + J, I, bit); 1822 | end; 1823 | end; 1824 | finally 1825 | VersionInfoBits.Free; 1826 | end; 1827 | end; 1828 | 1829 | // Embed "dataBits" using "getMaskPattern". On success, modify the matrix and return true. 1830 | // For debugging purposes, it skips masking process if "getMaskPattern" is -1. 1831 | // See 8.7 of JISX0510:2004 (p.38) for how to embed data bits. 1832 | procedure TMatrixUtil.EmbedDataBits(DataBits: TBitArray; MaskPattern: Integer; Matrix: TByteMatrix); 1833 | var 1834 | BitIndex: Integer; 1835 | Direction: Integer; 1836 | X, Y, I, XX: Integer; 1837 | Bit: Boolean; 1838 | MaskUtil: TMaskUtil; 1839 | begin 1840 | MaskUtil := TMaskUtil.Create; 1841 | try 1842 | bitIndex := 0; 1843 | direction := -1; 1844 | // Start from the right bottom cell. 1845 | X := Matrix.Width - 1; 1846 | Y := Matrix.Height - 1; 1847 | while (X > 0) do 1848 | begin 1849 | // Skip the vertical timing pattern. 1850 | if (X = 6) then 1851 | begin 1852 | Dec(X, 1); 1853 | end; 1854 | while ((Y >= 0) and (y < Matrix.Height)) do 1855 | begin 1856 | for I := 0 to 1 do 1857 | begin 1858 | XX := X - I; 1859 | // Skip the cell if it's not empty. 1860 | if (not IsEmpty(Matrix.Get(XX, Y))) then 1861 | begin 1862 | Continue; 1863 | end; 1864 | 1865 | if (BitIndex < DataBits.GetSize) then 1866 | begin 1867 | Bit := DataBits.Get(BitIndex); 1868 | Inc(BitIndex); 1869 | end else 1870 | begin 1871 | // Padding bit. If there is no bit left, we'll fill the left cells with 0, as described 1872 | // in 8.4.9 of JISX0510:2004 (p. 24). 1873 | Bit := False; 1874 | end; 1875 | 1876 | // Skip masking if mask_pattern is -1. 1877 | if (MaskPattern <> -1) then 1878 | begin 1879 | if (MaskUtil.GetDataMaskBit(MaskPattern, XX, Y)) then 1880 | begin 1881 | Bit := not Bit; 1882 | end; 1883 | end; 1884 | Matrix.SetBoolean(XX, Y, Bit); 1885 | end; 1886 | Inc(Y, Direction); 1887 | end; 1888 | Direction := -Direction; // Reverse the direction. 1889 | Inc(Y, Direction); 1890 | Dec(X, 2); // Move to the left. 1891 | end; 1892 | finally 1893 | MaskUtil.Free; 1894 | end; 1895 | 1896 | // All bits should be consumed. 1897 | if (BitIndex <> DataBits.GetSize()) then 1898 | begin 1899 | FMatrixUtilError := True; 1900 | Exit; 1901 | end; 1902 | end; 1903 | 1904 | // Return the position of the most significant bit set (to one) in the "value". The most 1905 | // significant bit is position 32. If there is no bit set, return 0. Examples: 1906 | // - findMSBSet(0) => 0 1907 | // - findMSBSet(1) => 1 1908 | // - findMSBSet(255) => 8 1909 | function TMatrixUtil.FindMSBSet(Value: Integer): Integer; 1910 | var 1911 | NumDigits: Integer; 1912 | begin 1913 | NumDigits := 0; 1914 | while (Value <> 0) do 1915 | begin 1916 | Value := Value shr 1; 1917 | Inc(NumDigits); 1918 | end; 1919 | Result := NumDigits; 1920 | end; 1921 | 1922 | // Calculate BCH (Bose-Chaudhuri-Hocquenghem) code for "value" using polynomial "poly". The BCH 1923 | // code is used for encoding type information and version information. 1924 | // Example: Calculation of version information of 7. 1925 | // f(x) is created from 7. 1926 | // - 7 = 000111 in 6 bits 1927 | // - f(x) = x^2 + x^1 + x^0 1928 | // g(x) is given by the standard (p. 67) 1929 | // - g(x) = x^12 + x^11 + x^10 + x^9 + x^8 + x^5 + x^2 + 1 1930 | // Multiply f(x) by x^(18 - 6) 1931 | // - f'(x) = f(x) * x^(18 - 6) 1932 | // - f'(x) = x^14 + x^13 + x^12 1933 | // Calculate the remainder of f'(x) / g(x) 1934 | // x^2 1935 | // __________________________________________________ 1936 | // g(x) )x^14 + x^13 + x^12 1937 | // x^14 + x^13 + x^12 + x^11 + x^10 + x^7 + x^4 + x^2 1938 | // -------------------------------------------------- 1939 | // x^11 + x^10 + x^7 + x^4 + x^2 1940 | // 1941 | // The remainder is x^11 + x^10 + x^7 + x^4 + x^2 1942 | // Encode it in binary: 110010010100 1943 | // The return value is 0xc94 (1100 1001 0100) 1944 | // 1945 | // Since all coefficients in the polynomials are 1 or 0, we can do the calculation by bit 1946 | // operations. We don't care if cofficients are positive or negative. 1947 | function TMatrixUtil.CalculateBCHCode(Value, Poly: Integer): Integer; 1948 | var 1949 | MSBSetInPoly: Integer; 1950 | begin 1951 | // If poly is "1 1111 0010 0101" (version info poly), msbSetInPoly is 13. We'll subtract 1 1952 | // from 13 to make it 12. 1953 | MSBSetInPoly := FindMSBSet(Poly); 1954 | Value := Value shl (MSBSetInPoly - 1); 1955 | // Do the division business using exclusive-or operations. 1956 | while (FindMSBSet(Value) >= MSBSetInPoly) do 1957 | begin 1958 | Value := Value xor (Poly shl (FindMSBSet(Value) - MSBSetInPoly)); 1959 | end; 1960 | // Now the "value" is the remainder (i.e. the BCH code) 1961 | Result := Value; 1962 | end; 1963 | 1964 | // Make bit vector of type information. On success, store the result in "bits" and return true. 1965 | // Encode error correction level and mask pattern. See 8.9 of 1966 | // JISX0510:2004 (p.45) for details. 1967 | procedure TMatrixUtil.MakeTypeInfoBits(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Bits: TBitArray); 1968 | var 1969 | TypeInfo: Integer; 1970 | BCHCode: Integer; 1971 | MaskBits: TBitArray; 1972 | begin 1973 | if ((MaskPattern >= 0) and (MaskPattern < NUM_MASK_PATTERNS)) then 1974 | begin 1975 | TypeInfo := (ECLevel.Bits shl 3) or MaskPattern; 1976 | Bits.AppendBits(TypeInfo, 5); 1977 | 1978 | BCHCode := CalculateBCHCode(TypeInfo, TYPE_INFO_POLY); 1979 | Bits.AppendBits(BCHCode, 10); 1980 | 1981 | MaskBits := TBitArray.Create; 1982 | try 1983 | MaskBits.AppendBits(TYPE_INFO_MASK_PATTERN, 15); 1984 | Bits.XorOperation(MaskBits); 1985 | finally 1986 | MaskBits.Free; 1987 | end; 1988 | 1989 | if (Bits.GetSize <> 15) then // Just in case. 1990 | begin 1991 | FMatrixUtilError := True; 1992 | Exit; 1993 | end; 1994 | end; 1995 | end; 1996 | 1997 | // Make bit vector of version information. On success, store the result in "bits" and return true. 1998 | // See 8.10 of JISX0510:2004 (p.45) for details. 1999 | procedure TMatrixUtil.MakeVersionInfoBits(Version: Integer; Bits: TBitArray); 2000 | var 2001 | BCHCode: Integer; 2002 | begin 2003 | Bits.AppendBits(Version, 6); 2004 | BCHCode := CalculateBCHCode(Version, VERSION_INFO_POLY); 2005 | Bits.AppendBits(BCHCode, 12); 2006 | 2007 | if (Bits.GetSize() <> 18) then 2008 | begin 2009 | FMatrixUtilError := True; 2010 | Exit; 2011 | end; 2012 | end; 2013 | 2014 | // Check if "value" is empty. 2015 | function TMatrixUtil.IsEmpty(Value: Integer): Boolean; 2016 | begin 2017 | Result := (Value = -1); 2018 | end; 2019 | 2020 | procedure TMatrixUtil.EmbedTimingPatterns(Matrix: TByteMatrix); 2021 | var 2022 | I: Integer; 2023 | Bit: Integer; 2024 | begin 2025 | // -8 is for skipping position detection patterns (size 7), and two horizontal/vertical 2026 | // separation patterns (size 1). Thus, 8 = 7 + 1. 2027 | for I := 8 to Matrix.Width - 9 do 2028 | begin 2029 | Bit := (I + 1) mod 2; 2030 | // Horizontal line. 2031 | if (IsEmpty(Matrix.Get(I, 6))) then 2032 | begin 2033 | Matrix.SetInteger(I, 6, Bit); 2034 | end; 2035 | // Vertical line. 2036 | if (IsEmpty(Matrix.Get(6, I))) then 2037 | begin 2038 | Matrix.SetInteger(6, I, Bit); 2039 | end; 2040 | end; 2041 | end; 2042 | 2043 | // Embed the lonely dark dot at left bottom corner. JISX0510:2004 (p.46) 2044 | procedure TMatrixUtil.EmbedDarkDotAtLeftBottomCorner(Matrix: TByteMatrix); 2045 | begin 2046 | if (Matrix.Get(8, Matrix.Height - 8) = 0) then 2047 | begin 2048 | FMatrixUtilError := True; 2049 | Exit; 2050 | end; 2051 | Matrix.SetInteger(8, Matrix.Height - 8, 1); 2052 | end; 2053 | 2054 | procedure TMatrixUtil.EmbedHorizontalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix); 2055 | var 2056 | X: Integer; 2057 | begin 2058 | // We know the width and height. 2059 | for X := 0 to 7 do 2060 | begin 2061 | if (not IsEmpty(Matrix.Get(XStart + X, YStart))) then 2062 | begin 2063 | FMatrixUtilError := True; 2064 | Exit; 2065 | end; 2066 | Matrix.SetInteger(XStart + X, YStart, HORIZONTAL_SEPARATION_PATTERN[0][X]); 2067 | end; 2068 | end; 2069 | 2070 | procedure TMatrixUtil.EmbedVerticalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix); 2071 | var 2072 | Y: Integer; 2073 | begin 2074 | // We know the width and height. 2075 | for Y := 0 to 6 do 2076 | begin 2077 | if (not IsEmpty(Matrix.Get(XStart, YStart + Y))) then 2078 | begin 2079 | FMatrixUtilError := True; 2080 | Exit; 2081 | end; 2082 | Matrix.SetInteger(XStart, YStart + Y, VERTICAL_SEPARATION_PATTERN[Y][0]); 2083 | end; 2084 | end; 2085 | 2086 | // Note that we cannot unify the function with embedPositionDetectionPattern() despite they are 2087 | // almost identical, since we cannot write a function that takes 2D arrays in different sizes in 2088 | // C/C++. We should live with the fact. 2089 | procedure TMatrixUtil.EmbedPositionAdjustmentPattern(XStart, YStart: Integer; Matrix: TByteMatrix); 2090 | var 2091 | X, Y: Integer; 2092 | begin 2093 | // We know the width and height. 2094 | for Y := 0 to 4 do 2095 | begin 2096 | for X := 0 to 4 do 2097 | begin 2098 | if (not IsEmpty(Matrix.Get(XStart + X, YStart + Y))) then 2099 | begin 2100 | FMatrixUtilError := True; 2101 | Exit; 2102 | end; 2103 | Matrix.SetInteger(XStart + X, YStart + Y, POSITION_ADJUSTMENT_PATTERN[Y][X]); 2104 | end; 2105 | end; 2106 | end; 2107 | 2108 | procedure TMatrixUtil.EmbedPositionDetectionPattern(XStart, YStart: Integer; Matrix: TByteMatrix); 2109 | var 2110 | X, Y: Integer; 2111 | begin 2112 | // We know the width and height. 2113 | for Y := 0 to 6 do 2114 | begin 2115 | for X := 0 to 6 do 2116 | begin 2117 | if (not IsEmpty(Matrix.Get(XStart + X, YStart + Y))) then 2118 | begin 2119 | FMatrixUtilError := True; 2120 | Exit; 2121 | end; 2122 | Matrix.SetInteger(XStart + X, YStart + Y, POSITION_DETECTION_PATTERN[Y][X]); 2123 | end; 2124 | end; 2125 | end; 2126 | 2127 | // Embed position detection patterns and surrounding vertical/horizontal separators. 2128 | procedure TMatrixUtil.EmbedPositionDetectionPatternsAndSeparators(Matrix: TByteMatrix); 2129 | var 2130 | PDPWidth: Integer; 2131 | HSPWidth: Integer; 2132 | VSPSize: Integer; 2133 | begin 2134 | // Embed three big squares at corners. 2135 | PDPWidth := Length(POSITION_DETECTION_PATTERN[0]); 2136 | // Left top corner. 2137 | EmbedPositionDetectionPattern(0, 0, Matrix); 2138 | // Right top corner. 2139 | EmbedPositionDetectionPattern(Matrix.Width - PDPWidth, 0, Matrix); 2140 | // Left bottom corner. 2141 | EmbedPositionDetectionPattern(0, Matrix.Width- PDPWidth, Matrix); 2142 | 2143 | // Embed horizontal separation patterns around the squares. 2144 | HSPWidth := Length(HORIZONTAL_SEPARATION_PATTERN[0]); 2145 | // Left top corner. 2146 | EmbedHorizontalSeparationPattern(0, HSPWidth - 1, Matrix); 2147 | // Right top corner. 2148 | EmbedHorizontalSeparationPattern(Matrix.Width - HSPWidth, 2149 | HSPWidth - 1, Matrix); 2150 | // Left bottom corner. 2151 | EmbedHorizontalSeparationPattern(0, Matrix.Width - HSPWidth, Matrix); 2152 | 2153 | // Embed vertical separation patterns around the squares. 2154 | VSPSize := Length(VERTICAL_SEPARATION_PATTERN); 2155 | // Left top corner. 2156 | EmbedVerticalSeparationPattern(VSPSize, 0, Matrix); 2157 | // Right top corner. 2158 | EmbedVerticalSeparationPattern(Matrix.Height - VSPSize - 1, 0, Matrix); 2159 | // Left bottom corner. 2160 | EmbedVerticalSeparationPattern(VSPSize, Matrix.Height - VSPSize, Matrix); 2161 | end; 2162 | 2163 | // Embed position adjustment patterns if need be. 2164 | procedure TMatrixUtil.MaybeEmbedPositionAdjustmentPatterns(Version: Integer; Matrix: TByteMatrix); 2165 | var 2166 | Index: Integer; 2167 | Coordinates: array of Integer; 2168 | NumCoordinates: Integer; 2169 | X, Y, I, J: Integer; 2170 | begin 2171 | if (Version >= 2) then 2172 | begin 2173 | Index := Version - 1; 2174 | NumCoordinates := Length(POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE[Index]); 2175 | SetLength(Coordinates, NumCoordinates); 2176 | Move(POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE[Index][0], Coordinates[0], NumCoordinates * SizeOf(Integer)); 2177 | for I := 0 to NumCoordinates - 1 do 2178 | begin 2179 | for J := 0 to NumCoordinates - 1 do 2180 | begin 2181 | Y := Coordinates[I]; 2182 | X := Coordinates[J]; 2183 | if ((X = -1) or (Y = -1)) then 2184 | begin 2185 | Continue; 2186 | end; 2187 | // If the cell is unset, we embed the position adjustment pattern here. 2188 | if (IsEmpty(Matrix.Get(X, Y))) then 2189 | begin 2190 | // -2 is necessary since the x/y coordinates point to the center of the pattern, not the 2191 | // left top corner. 2192 | EmbedPositionAdjustmentPattern(X - 2, Y - 2, Matrix); 2193 | end; 2194 | end; 2195 | end; 2196 | end; 2197 | end; 2198 | 2199 | 2200 | { TBitArray } 2201 | 2202 | 2203 | procedure TBitArray.AppendBits(Value, NumBits: Integer); 2204 | var 2205 | NumBitsLeft: Integer; 2206 | begin 2207 | if ((NumBits < 0) or (NumBits > 32)) then 2208 | begin 2209 | 2210 | end; 2211 | EnsureCapacity(Size + NumBits); 2212 | for NumBitsLeft := NumBits downto 1 do 2213 | begin 2214 | AppendBit(((Value shr (NumBitsLeft - 1)) and $01) = 1); 2215 | end; 2216 | end; 2217 | 2218 | constructor TBitArray.Create(Size: Integer); 2219 | 2220 | begin 2221 | Size := Size; 2222 | SetLength(Bits, (Size + 31) shr 5); 2223 | end; 2224 | 2225 | constructor TBitArray.Create; 2226 | begin 2227 | Size := 0; 2228 | SetLength(Bits, 1); 2229 | end; 2230 | 2231 | function TBitArray.Get(I: Integer): Boolean; 2232 | begin 2233 | Result := (Bits[I shr 5] and (1 shl (I and $1F))) <> 0; 2234 | end; 2235 | 2236 | function TBitArray.GetSize: Integer; 2237 | begin 2238 | Result := Size; 2239 | end; 2240 | 2241 | function TBitArray.GetSizeInBytes: Integer; 2242 | begin 2243 | Result := (Size + 7) shr 3; 2244 | end; 2245 | 2246 | procedure TBitArray.SetBit(Index: Integer); 2247 | begin 2248 | Bits[Index shr 5] := Bits[Index shr 5] or (1 shl (Index and $1F)); 2249 | end; 2250 | 2251 | procedure TBitArray.AppendBit(Bit: Boolean); 2252 | begin 2253 | EnsureCapacity(Size + 1); 2254 | if (Bit) then 2255 | begin 2256 | Bits[Size shr 5] := Bits[Size shr 5] or (1 shl (Size and $1F)); 2257 | end; 2258 | Inc(Size); 2259 | end; 2260 | 2261 | procedure TBitArray.ToBytes(BitOffset: Integer; Source: TByteArray; Offset, 2262 | NumBytes: Integer); 2263 | var 2264 | I: Integer; 2265 | J: Integer; 2266 | TheByte: Integer; 2267 | begin 2268 | for I := 0 to NumBytes - 1 do 2269 | begin 2270 | TheByte := 0; 2271 | for J := 0 to 7 do 2272 | begin 2273 | if (Get(BitOffset)) then 2274 | begin 2275 | TheByte := TheByte or (1 shl (7 - J)); 2276 | end; 2277 | Inc(BitOffset); 2278 | end; 2279 | Source[Offset + I] := TheByte; 2280 | end; 2281 | end; 2282 | 2283 | procedure TBitArray.XorOperation(Other: TBitArray); 2284 | var 2285 | I: Integer; 2286 | begin 2287 | if (Length(Bits) = Length(Other.Bits)) then 2288 | begin 2289 | for I := 0 to Length(Bits) - 1 do 2290 | begin 2291 | // The last byte could be incomplete (i.e. not have 8 bits in 2292 | // it) but there is no problem since 0 XOR 0 == 0. 2293 | Bits[I] := Bits[I] xor Other.Bits[I]; 2294 | end; 2295 | end; 2296 | end; 2297 | 2298 | procedure TBitArray.AppendBitArray(NewBitArray: TBitArray); 2299 | var 2300 | OtherSize: Integer; 2301 | I: Integer; 2302 | begin 2303 | OtherSize := NewBitArray.GetSize; 2304 | EnsureCapacity(Size + OtherSize); 2305 | for I := 0 to OtherSize - 1 do 2306 | begin 2307 | AppendBit(NewBitArray.Get(I)); 2308 | end; 2309 | end; 2310 | 2311 | procedure TBitArray.EnsureCapacity(Size: Integer); 2312 | begin 2313 | if (Size > (Length(Bits) shl 5)) then 2314 | begin 2315 | SetLength(Bits, Size); 2316 | end; 2317 | end; 2318 | 2319 | { TErrorCorrectionLevel } 2320 | 2321 | procedure TErrorCorrectionLevel.Assign(Source: TErrorCorrectionLevel); 2322 | begin 2323 | Self.FBits := Source.FBits; 2324 | end; 2325 | 2326 | function TErrorCorrectionLevel.Ordinal: Integer; 2327 | begin 2328 | Result := 0; 2329 | end; 2330 | 2331 | { TVersion } 2332 | 2333 | class function TVersion.ChooseVersion(NumInputBits: Integer; 2334 | ECLevel: TErrorCorrectionLevel): TVersion; 2335 | var 2336 | VersionNum: Integer; 2337 | Version: TVersion; 2338 | NumBytes: Integer; 2339 | ECBlocks: TECBlocks; 2340 | NumECBytes: Integer; 2341 | NumDataBytes: Integer; 2342 | TotalInputBytes: Integer; 2343 | begin 2344 | Result := nil; 2345 | // In the following comments, we use numbers of Version 7-H. 2346 | for VersionNum := 1 to 40 do 2347 | begin 2348 | Version := TVersion.GetVersionForNumber(VersionNum); 2349 | 2350 | // numBytes = 196 2351 | NumBytes := Version.GetTotalCodewords; 2352 | // getNumECBytes = 130 2353 | ECBlocks := Version.GetECBlocksForLevel(ECLevel); 2354 | NumECBytes := ECBlocks.GetTotalECCodewords; 2355 | // getNumDataBytes = 196 - 130 = 66 2356 | NumDataBytes := NumBytes - NumECBytes; 2357 | TotalInputBytes := (NumInputBits + 7) div 8; 2358 | 2359 | if (numDataBytes >= totalInputBytes) then 2360 | begin 2361 | Result := Version; 2362 | Exit; 2363 | end else 2364 | begin 2365 | Version.Free; 2366 | end; 2367 | end; 2368 | end; 2369 | 2370 | constructor TVersion.Create(VersionNumber: Integer; 2371 | AlignmentPatternCenters: array of Integer; ECBlocks1, ECBlocks2, ECBlocks3, 2372 | ECBlocks4: TECBlocks); 2373 | var 2374 | Total: Integer; 2375 | ECBlock: TECB; 2376 | ECBArray: TECBArray; 2377 | I: Integer; 2378 | begin 2379 | Self.VersionNumber := VersionNumber; 2380 | SetLength(Self.AlignmentPatternCenters, Length(AlignmentPatternCenters)); 2381 | if (Length(AlignmentPatternCenters) > 0) then 2382 | begin 2383 | Move(AlignmentPatternCenters[0], Self.AlignmentPatternCenters[0], 2384 | Length(AlignmentPatternCenters) * SizeOf(Integer)); 2385 | end; 2386 | SetLength(ECBlocks, 4); 2387 | ECBlocks[0] := ECBlocks1; 2388 | ECBlocks[1] := ECBlocks2; 2389 | ECBlocks[2] := ECBlocks3; 2390 | ECBlocks[3] := ECBlocks4; 2391 | Total := 0; 2392 | ECCodewords := ECBlocks1.GetECCodewordsPerBlock; 2393 | ECBArray := ECBlocks1.GetECBlocks; 2394 | for I := 0 to Length(ECBArray) - 1 do 2395 | begin 2396 | ECBlock := ECBArray[I]; 2397 | Inc(Total, ECBlock.GetCount * (ECBlock.GetDataCodewords + ECCodewords)); 2398 | end; 2399 | TotalCodewords := Total; 2400 | end; 2401 | 2402 | destructor TVersion.Destroy; 2403 | var 2404 | X: Integer; 2405 | begin 2406 | for X := 0 to Length(ECBlocks) - 1 do 2407 | begin 2408 | ECBlocks[X].Free; 2409 | end; 2410 | inherited; 2411 | end; 2412 | 2413 | function TVersion.GetDimensionForVersion: Integer; 2414 | begin 2415 | Result := 17 + 4 * VersionNumber; 2416 | end; 2417 | 2418 | function TVersion.GetECBlocksForLevel(ECLevel: TErrorCorrectionLevel): TECBlocks; 2419 | begin 2420 | Result := ECBlocks[ECLevel.Ordinal]; 2421 | end; 2422 | 2423 | function TVersion.GetTotalCodewords: Integer; 2424 | begin 2425 | Result := TotalCodewords; 2426 | end; 2427 | 2428 | class function TVersion.GetVersionForNumber(VersionNum: Integer): TVersion; 2429 | begin 2430 | if (VersionNum = 1) then 2431 | begin 2432 | Result := TVersion.Create(1, [], 2433 | TECBlocks.Create(7, TECB.Create(1, 19)), 2434 | TECBlocks.Create(10, TECB.Create(1, 16)), 2435 | TECBlocks.Create(13, TECB.Create(1, 13)), 2436 | TECBlocks.Create(17, TECB.Create(1, 9))); 2437 | end else 2438 | if (VersionNum = 2) then 2439 | begin 2440 | Result := TVersion.Create(2, [6, 18], 2441 | TECBlocks.Create(10, TECB.Create(1, 34)), 2442 | TECBlocks.Create(16, TECB.Create(1, 28)), 2443 | TECBlocks.Create(22, TECB.Create(1, 22)), 2444 | TECBlocks.Create(28, TECB.Create(1, 16))); 2445 | end else 2446 | if (VersionNum = 3) then 2447 | begin 2448 | Result := TVersion.Create(3, [6, 22], 2449 | TECBlocks.Create(15, TECB.Create(1, 55)), 2450 | TECBlocks.Create(26, TECB.Create(1, 44)), 2451 | TECBlocks.Create(18, TECB.Create(2, 17)), 2452 | TECBlocks.Create(22, TECB.Create(2, 13))); 2453 | end else 2454 | if (VersionNum = 4) then 2455 | begin 2456 | Result := TVersion.Create(4, [6, 26], 2457 | TECBlocks.Create(20, TECB.Create(1, 80)), 2458 | TECBlocks.Create(18, TECB.Create(2, 32)), 2459 | TECBlocks.Create(26, TECB.Create(2, 24)), 2460 | TECBlocks.Create(16, TECB.Create(4, 9))); 2461 | end else 2462 | if (VersionNum = 5) then 2463 | begin 2464 | Result := TVersion.Create(5, [6, 30], 2465 | TECBlocks.Create(26, TECB.Create(1, 108)), 2466 | TECBlocks.Create(24, TECB.Create(2, 43)), 2467 | TECBlocks.Create(18, TECB.Create(2, 15), 2468 | TECB.Create(2, 16)), 2469 | TECBlocks.Create(22, TECB.Create(2, 11), 2470 | TECB.Create(2, 12))); 2471 | end else 2472 | if (VersionNum = 6) then 2473 | begin 2474 | Result := TVersion.Create(6, [6, 34], 2475 | TECBlocks.Create(18, TECB.Create(2, 68)), 2476 | TECBlocks.Create(16, TECB.Create(4, 27)), 2477 | TECBlocks.Create(24, TECB.Create(4, 19)), 2478 | TECBlocks.Create(28, TECB.Create(4, 15))); 2479 | end else 2480 | if (VersionNum = 7) then 2481 | begin 2482 | Result := TVersion.Create(7, [6, 22, 38], 2483 | TECBlocks.Create(20, TECB.Create(2, 78)), 2484 | TECBlocks.Create(18, TECB.Create(4, 31)), 2485 | TECBlocks.Create(18, TECB.Create(2, 14), 2486 | TECB.Create(4, 15)), 2487 | TECBlocks.Create(26, TECB.Create(4, 13), 2488 | TECB.Create(1, 14))); 2489 | end else 2490 | if (VersionNum = 8) then 2491 | begin 2492 | Result := TVersion.Create(8, [6, 24, 42], 2493 | TECBlocks.Create(24, TECB.Create(2, 97)), 2494 | TECBlocks.Create(22, TECB.Create(2, 38), 2495 | TECB.Create(2, 39)), 2496 | TECBlocks.Create(22, TECB.Create(4, 18), 2497 | TECB.Create(2, 19)), 2498 | TECBlocks.Create(26, TECB.Create(4, 14), 2499 | TECB.Create(2, 15))); 2500 | end else 2501 | if (VersionNum = 9) then 2502 | begin 2503 | Result := TVersion.Create(9, [6, 26, 46], 2504 | TECBlocks.Create(30, TECB.Create(2, 116)), 2505 | TECBlocks.Create(22, TECB.Create(3, 36), 2506 | TECB.Create(2, 37)), 2507 | TECBlocks.Create(20, TECB.Create(4, 16), 2508 | TECB.Create(4, 17)), 2509 | TECBlocks.Create(24, TECB.Create(4, 12), 2510 | TECB.Create(4, 13))); 2511 | end else 2512 | if (VersionNum = 10) then 2513 | begin 2514 | Result := TVersion.Create(10, [6, 28, 50], 2515 | TECBlocks.Create(18, TECB.Create(2, 68), 2516 | TECB.Create(2, 69)), 2517 | TECBlocks.Create(26, TECB.Create(4, 43), 2518 | TECB.Create(1, 44)), 2519 | TECBlocks.Create(24, TECB.Create(6, 19), 2520 | TECB.Create(2, 20)), 2521 | TECBlocks.Create(28, TECB.Create(6, 15), 2522 | TECB.Create(2, 16))); 2523 | end else 2524 | if (VersionNum = 11) then 2525 | begin 2526 | Result := TVersion.Create(11, [6, 30, 54], 2527 | TECBlocks.Create(20, TECB.Create(4, 81)), 2528 | TECBlocks.Create(30, TECB.Create(1, 50), 2529 | TECB.Create(4, 51)), 2530 | TECBlocks.Create(28, TECB.Create(4, 22), 2531 | TECB.Create(4, 23)), 2532 | TECBlocks.Create(24, TECB.Create(3, 12), 2533 | TECB.Create(8, 13))); 2534 | end else 2535 | if (VersionNum = 12) then 2536 | begin 2537 | Result := TVersion.Create(12, [6, 32, 58], 2538 | TECBlocks.Create(24, TECB.Create(2, 92), 2539 | TECB.Create(2, 93)), 2540 | TECBlocks.Create(22, TECB.Create(6, 36), 2541 | TECB.Create(2, 37)), 2542 | TECBlocks.Create(26, TECB.Create(4, 20), 2543 | TECB.Create(6, 21)), 2544 | TECBlocks.Create(28, TECB.Create(7, 14), 2545 | TECB.Create(4, 15))); 2546 | end else 2547 | if (VersionNum = 13) then 2548 | begin 2549 | Result := TVersion.Create(13, [6, 34, 62], 2550 | TECBlocks.Create(26, TECB.Create(4, 107)), 2551 | TECBlocks.Create(22, TECB.Create(8, 37), 2552 | TECB.Create(1, 38)), 2553 | TECBlocks.Create(24, TECB.Create(8, 20), 2554 | TECB.Create(4, 21)), 2555 | TECBlocks.Create(22, TECB.Create(12, 11), 2556 | TECB.Create(4, 12))); 2557 | end else 2558 | if (VersionNum = 14) then 2559 | begin 2560 | Result := TVersion.Create(14, [6, 26, 46, 66], 2561 | TECBlocks.Create(30, TECB.Create(3, 115), 2562 | TECB.Create(1, 116)), 2563 | TECBlocks.Create(24, TECB.Create(4, 40), 2564 | TECB.Create(5, 41)), 2565 | TECBlocks.Create(20, TECB.Create(11, 16), 2566 | TECB.Create(5, 17)), 2567 | TECBlocks.Create(24, TECB.Create(11, 12), 2568 | TECB.Create(5, 13))); 2569 | end else 2570 | if (VersionNum = 15) then 2571 | begin 2572 | Result := TVersion.Create(15, [6, 26, 48, 70], 2573 | TECBlocks.Create(22, TECB.Create(5, 87), 2574 | TECB.Create(1, 88)), 2575 | TECBlocks.Create(24, TECB.Create(5, 41), 2576 | TECB.Create(5, 42)), 2577 | TECBlocks.Create(30, TECB.Create(5, 24), 2578 | TECB.Create(7, 25)), 2579 | TECBlocks.Create(24, TECB.Create(11, 12), 2580 | TECB.Create(7, 13))); 2581 | end else 2582 | if (VersionNum = 16) then 2583 | begin 2584 | Result := TVersion.Create(16, [6, 26, 50, 74], 2585 | TECBlocks.Create(24, TECB.Create(5, 98), 2586 | TECB.Create(1, 99)), 2587 | TECBlocks.Create(28, TECB.Create(7, 45), 2588 | TECB.Create(3, 46)), 2589 | TECBlocks.Create(24, TECB.Create(15, 19), 2590 | TECB.Create(2, 20)), 2591 | TECBlocks.Create(30, TECB.Create(3, 15), 2592 | TECB.Create(13, 16))); 2593 | end else 2594 | if (VersionNum = 17) then 2595 | begin 2596 | Result := TVersion.Create(17, [6, 30, 54, 78], 2597 | TECBlocks.Create(28, TECB.Create(1, 107), 2598 | TECB.Create(5, 108)), 2599 | TECBlocks.Create(28, TECB.Create(10, 46), 2600 | TECB.Create(1, 47)), 2601 | TECBlocks.Create(28, TECB.Create(1, 22), 2602 | TECB.Create(15, 23)), 2603 | TECBlocks.Create(28, TECB.Create(2, 14), 2604 | TECB.Create(17, 15))); 2605 | end else 2606 | if (VersionNum = 18) then 2607 | begin 2608 | Result := TVersion.Create(18, [6, 30, 56, 82], 2609 | TECBlocks.Create(30, TECB.Create(5, 120), 2610 | TECB.Create(1, 121)), 2611 | TECBlocks.Create(26, TECB.Create(9, 43), 2612 | TECB.Create(4, 44)), 2613 | TECBlocks.Create(28, TECB.Create(17, 22), 2614 | TECB.Create(1, 23)), 2615 | TECBlocks.Create(28, TECB.Create(2, 14), 2616 | TECB.Create(19, 15))); 2617 | end else 2618 | if (VersionNum = 19) then 2619 | begin 2620 | Result := TVersion.Create(19, [6, 30, 58, 86], 2621 | TECBlocks.Create(28, TECB.Create(3, 113), 2622 | TECB.Create(4, 114)), 2623 | TECBlocks.Create(26, TECB.Create(3, 44), 2624 | TECB.Create(11, 45)), 2625 | TECBlocks.Create(26, TECB.Create(17, 21), 2626 | TECB.Create(4, 22)), 2627 | TECBlocks.Create(26, TECB.Create(9, 13), 2628 | TECB.Create(16, 14))); 2629 | end else 2630 | if (VersionNum = 20) then 2631 | begin 2632 | Result := TVersion.Create(20, [6, 34, 62, 90], 2633 | TECBlocks.Create(28, TECB.Create(3, 107), 2634 | TECB.Create(5, 108)), 2635 | TECBlocks.Create(26, TECB.Create(3, 41), 2636 | TECB.Create(13, 42)), 2637 | TECBlocks.Create(30, TECB.Create(15, 24), 2638 | TECB.Create(5, 25)), 2639 | TECBlocks.Create(28, TECB.Create(15, 15), 2640 | TECB.Create(10, 16))); 2641 | end else 2642 | if (VersionNum = 21) then 2643 | begin 2644 | Result := TVersion.Create(21, [6, 28, 50, 72, 94], 2645 | TECBlocks.Create(28, TECB.Create(4, 116), 2646 | TECB.Create(4, 117)), 2647 | TECBlocks.Create(26, TECB.Create(17, 42)), 2648 | TECBlocks.Create(28, TECB.Create(17, 22), 2649 | TECB.Create(6, 23)), 2650 | TECBlocks.Create(30, TECB.Create(19, 16), 2651 | TECB.Create(6, 17))); 2652 | end else 2653 | if (VersionNum = 22) then 2654 | begin 2655 | Result := TVersion.Create(22, [6, 26, 50, 74, 98], 2656 | TECBlocks.Create(28, TECB.Create(2, 111), 2657 | TECB.Create(7, 112)), 2658 | TECBlocks.Create(28, TECB.Create(17, 46)), 2659 | TECBlocks.Create(30, TECB.Create(7, 24), 2660 | TECB.Create(16, 25)), 2661 | TECBlocks.Create(24, TECB.Create(34, 13))); 2662 | end else 2663 | if (VersionNum = 23) then 2664 | begin 2665 | Result := TVersion.Create(23, [6, 30, 54, 78, 102], 2666 | TECBlocks.Create(30, TECB.Create(4, 121), 2667 | TECB.Create(5, 122)), 2668 | TECBlocks.Create(28, TECB.Create(4, 47), 2669 | TECB.Create(14, 48)), 2670 | TECBlocks.Create(30, TECB.Create(11, 24), 2671 | TECB.Create(14, 25)), 2672 | TECBlocks.Create(30, TECB.Create(16, 15), 2673 | TECB.Create(14, 16))); 2674 | end else 2675 | if (VersionNum = 24) then 2676 | begin 2677 | Result := TVersion.Create(24, [6, 28, 54, 80, 106], 2678 | TECBlocks.Create(30, TECB.Create(6, 117), 2679 | TECB.Create(4, 118)), 2680 | TECBlocks.Create(28, TECB.Create(6, 45), 2681 | TECB.Create(14, 46)), 2682 | TECBlocks.Create(30, TECB.Create(11, 24), 2683 | TECB.Create(16, 25)), 2684 | TECBlocks.Create(30, TECB.Create(30, 16), 2685 | TECB.Create(2, 17))); 2686 | end else 2687 | if (VersionNum = 25) then 2688 | begin 2689 | Result := TVersion.Create(25, [6, 32, 58, 84, 110], 2690 | TECBlocks.Create(26, TECB.Create(8, 106), 2691 | TECB.Create(4, 107)), 2692 | TECBlocks.Create(28, TECB.Create(8, 47), 2693 | TECB.Create(13, 48)), 2694 | TECBlocks.Create(30, TECB.Create(7, 24), 2695 | TECB.Create(22, 25)), 2696 | TECBlocks.Create(30, TECB.Create(22, 15), 2697 | TECB.Create(13, 16))); 2698 | end else 2699 | if (VersionNum = 26) then 2700 | begin 2701 | Result := TVersion.Create(26, [6, 30, 58, 86, 114], 2702 | TECBlocks.Create(28, TECB.Create(10, 114), 2703 | TECB.Create(2, 115)), 2704 | TECBlocks.Create(28, TECB.Create(19, 46), 2705 | TECB.Create(4, 47)), 2706 | TECBlocks.Create(28, TECB.Create(28, 22), 2707 | TECB.Create(6, 23)), 2708 | TECBlocks.Create(30, TECB.Create(33, 16), 2709 | TECB.Create(4, 17))); 2710 | end else 2711 | if (VersionNum = 27) then 2712 | begin 2713 | Result := TVersion.Create(27, [6, 34, 62, 90, 118], 2714 | TECBlocks.Create(30, TECB.Create(8, 122), 2715 | TECB.Create(4, 123)), 2716 | TECBlocks.Create(28, TECB.Create(22, 45), 2717 | TECB.Create(3, 46)), 2718 | TECBlocks.Create(30, TECB.Create(8, 23), 2719 | TECB.Create(26, 24)), 2720 | TECBlocks.Create(30, TECB.Create(12, 15), 2721 | TECB.Create(28, 16))); 2722 | end else 2723 | if (VersionNum = 28) then 2724 | begin 2725 | Result := TVersion.Create(28, [6, 26, 50, 74, 98, 122], 2726 | TECBlocks.Create(30, TECB.Create(3, 117), 2727 | TECB.Create(10, 118)), 2728 | TECBlocks.Create(28, TECB.Create(3, 45), 2729 | TECB.Create(23, 46)), 2730 | TECBlocks.Create(30, TECB.Create(4, 24), 2731 | TECB.Create(31, 25)), 2732 | TECBlocks.Create(30, TECB.Create(11, 15), 2733 | TECB.Create(31, 16))); 2734 | end else 2735 | if (VersionNum = 29) then 2736 | begin 2737 | Result := TVersion.Create(29, [6, 30, 54, 78, 102, 126], 2738 | TECBlocks.Create(30, TECB.Create(7, 116), 2739 | TECB.Create(7, 117)), 2740 | TECBlocks.Create(28, TECB.Create(21, 45), 2741 | TECB.Create(7, 46)), 2742 | TECBlocks.Create(30, TECB.Create(1, 23), 2743 | TECB.Create(37, 24)), 2744 | TECBlocks.Create(30, TECB.Create(19, 15), 2745 | TECB.Create(26, 16))); 2746 | end else 2747 | if (VersionNum = 30) then 2748 | begin 2749 | Result := TVersion.Create(30, [6, 26, 52, 78, 104, 130], 2750 | TECBlocks.Create(30, TECB.Create(5, 115), 2751 | TECB.Create(10, 116)), 2752 | TECBlocks.Create(28, TECB.Create(19, 47), 2753 | TECB.Create(10, 48)), 2754 | TECBlocks.Create(30, TECB.Create(15, 24), 2755 | TECB.Create(25, 25)), 2756 | TECBlocks.Create(30, TECB.Create(23, 15), 2757 | TECB.Create(25, 16))); 2758 | end else 2759 | if (VersionNum = 31) then 2760 | begin 2761 | Result := TVersion.Create(31, [6, 30, 56, 82, 108, 134], 2762 | TECBlocks.Create(30, TECB.Create(13, 115), 2763 | TECB.Create(3, 116)), 2764 | TECBlocks.Create(28, TECB.Create(2, 46), 2765 | TECB.Create(29, 47)), 2766 | TECBlocks.Create(30, TECB.Create(42, 24), 2767 | TECB.Create(1, 25)), 2768 | TECBlocks.Create(30, TECB.Create(23, 15), 2769 | TECB.Create(28, 16))); 2770 | end else 2771 | if (VersionNum = 32) then 2772 | begin 2773 | Result := TVersion.Create(32, [6, 34, 60, 86, 112, 138], 2774 | TECBlocks.Create(30, TECB.Create(17, 115)), 2775 | TECBlocks.Create(28, TECB.Create(10, 46), 2776 | TECB.Create(23, 47)), 2777 | TECBlocks.Create(30, TECB.Create(10, 24), 2778 | TECB.Create(35, 25)), 2779 | TECBlocks.Create(30, TECB.Create(19, 15), 2780 | TECB.Create(35, 16))); 2781 | end else 2782 | if (VersionNum = 33) then 2783 | begin 2784 | Result := TVersion.Create(33, [6, 30, 58, 86, 114, 142], 2785 | TECBlocks.Create(30, TECB.Create(17, 115), 2786 | TECB.Create(1, 116)), 2787 | TECBlocks.Create(28, TECB.Create(14, 46), 2788 | TECB.Create(21, 47)), 2789 | TECBlocks.Create(30, TECB.Create(29, 24), 2790 | TECB.Create(19, 25)), 2791 | TECBlocks.Create(30, TECB.Create(11, 15), 2792 | TECB.Create(46, 16))); 2793 | end else 2794 | if (VersionNum = 34) then 2795 | begin 2796 | Result := TVersion.Create(34, [6, 34, 62, 90, 118, 146], 2797 | TECBlocks.Create(30, TECB.Create(13, 115), 2798 | TECB.Create(6, 116)), 2799 | TECBlocks.Create(28, TECB.Create(14, 46), 2800 | TECB.Create(23, 47)), 2801 | TECBlocks.Create(30, TECB.Create(44, 24), 2802 | TECB.Create(7, 25)), 2803 | TECBlocks.Create(30, TECB.Create(59, 16), 2804 | TECB.Create(1, 17))); 2805 | end else 2806 | if (VersionNum = 35) then 2807 | begin 2808 | Result := TVersion.Create(35, [6, 30, 54, 78, 102, 126, 150], 2809 | TECBlocks.Create(30, TECB.Create(12, 121), 2810 | TECB.Create(7, 122)), 2811 | TECBlocks.Create(28, TECB.Create(12, 47), 2812 | TECB.Create(26, 48)), 2813 | TECBlocks.Create(30, TECB.Create(39, 24), 2814 | TECB.Create(14, 25)), 2815 | TECBlocks.Create(30, TECB.Create(22, 15), 2816 | TECB.Create(41, 16))); 2817 | end else 2818 | if (VersionNum = 36) then 2819 | begin 2820 | Result := TVersion.Create(36, [6, 24, 50, 76, 102, 128, 154], 2821 | TECBlocks.Create(30, TECB.Create(6, 121), 2822 | TECB.Create(14, 122)), 2823 | TECBlocks.Create(28, TECB.Create(6, 47), 2824 | TECB.Create(34, 48)), 2825 | TECBlocks.Create(30, TECB.Create(46, 24), 2826 | TECB.Create(10, 25)), 2827 | TECBlocks.Create(30, TECB.Create(2, 15), 2828 | TECB.Create(64, 16))); 2829 | end else 2830 | if (VersionNum = 37) then 2831 | begin 2832 | Result := TVersion.Create(37, [6, 28, 54, 80, 106, 132, 158], 2833 | TECBlocks.Create(30, TECB.Create(17, 122), 2834 | TECB.Create(4, 123)), 2835 | TECBlocks.Create(28, TECB.Create(29, 46), 2836 | TECB.Create(14, 47)), 2837 | TECBlocks.Create(30, TECB.Create(49, 24), 2838 | TECB.Create(10, 25)), 2839 | TECBlocks.Create(30, TECB.Create(24, 15), 2840 | TECB.Create(46, 16))); 2841 | end else 2842 | if (VersionNum = 38) then 2843 | begin 2844 | Result := TVersion.Create(38, [6, 32, 58, 84, 110, 136, 162], 2845 | TECBlocks.Create(30, TECB.Create(4, 122), 2846 | TECB.Create(18, 123)), 2847 | TECBlocks.Create(28, TECB.Create(13, 46), 2848 | TECB.Create(32, 47)), 2849 | TECBlocks.Create(30, TECB.Create(48, 24), 2850 | TECB.Create(14, 25)), 2851 | TECBlocks.Create(30, TECB.Create(42, 15), 2852 | TECB.Create(32, 16))); 2853 | end else 2854 | if (VersionNum = 39) then 2855 | begin 2856 | Result := TVersion.Create(39, [6, 26, 54, 82, 110, 138, 166], 2857 | TECBlocks.Create(30, TECB.Create(20, 117), 2858 | TECB.Create(4, 118)), 2859 | TECBlocks.Create(28, TECB.Create(40, 47), 2860 | TECB.Create(7, 48)), 2861 | TECBlocks.Create(30, TECB.Create(43, 24), 2862 | TECB.Create(22, 25)), 2863 | TECBlocks.Create(30, TECB.Create(10, 15), 2864 | TECB.Create(67, 16))); 2865 | end else 2866 | if (VersionNum = 40) then 2867 | begin 2868 | Result := TVersion.Create(40, [6, 30, 58, 86, 114, 142, 170], 2869 | TECBlocks.Create(30, TECB.Create(19, 118), 2870 | TECB.Create(6, 119)), 2871 | TECBlocks.Create(28, TECB.Create(18, 47), 2872 | TECB.Create(31, 48)), 2873 | TECBlocks.Create(30, TECB.Create(34, 24), 2874 | TECB.Create(34, 25)), 2875 | TECBlocks.Create(30, TECB.Create(20, 15), 2876 | TECB.Create(61, 16))); 2877 | end else 2878 | begin 2879 | Result := nil; 2880 | end; 2881 | end; 2882 | 2883 | { TMaskUtil } 2884 | 2885 | // Return the mask bit for "getMaskPattern" at "x" and "y". See 8.8 of JISX0510:2004 for mask 2886 | // pattern conditions. 2887 | function TMaskUtil.GetDataMaskBit(MaskPattern, X, Y: Integer): Boolean; 2888 | var 2889 | Intermediate: Integer; 2890 | Temp: Integer; 2891 | begin 2892 | Intermediate := 0; 2893 | if ((MaskPattern >= 0) and (MaskPattern < NUM_MASK_PATTERNS)) then 2894 | begin 2895 | case (maskPattern) of 2896 | 0: Intermediate := (Y + X) and 1; 2897 | 1: Intermediate := Y and 1; 2898 | 2: Intermediate := X mod 3; 2899 | 3: Intermediate := (Y + X) mod 3; 2900 | 4: Intermediate := ((y shr 1) + (X div 3)) and 1; 2901 | 5: 2902 | begin 2903 | Temp := Y * X; 2904 | Intermediate := (Temp and 1) + (Temp mod 3); 2905 | end; 2906 | 6: 2907 | begin 2908 | Temp := Y * X; 2909 | Intermediate := ((Temp and 1) + (Temp mod 3)) and 1; 2910 | end; 2911 | 7: 2912 | begin 2913 | Temp := Y * X; 2914 | Intermediate := ((temp mod 3) + ((Y + X) and 1)) and 1; 2915 | end; 2916 | end; 2917 | end; 2918 | Result := Intermediate = 0; 2919 | end; 2920 | 2921 | { TECBlocks } 2922 | 2923 | constructor TECBlocks.Create(ECCodewordsPerBlock: Integer; ECBlocks: TECB); 2924 | begin 2925 | Self.ECCodewordsPerBlock := ECCodewordsPerBlock; 2926 | SetLength(Self.ECBlocks, 1); 2927 | Self.ECBlocks[0] := ECBlocks; 2928 | end; 2929 | 2930 | constructor TECBlocks.Create(ECCodewordsPerBlock: Integer; ECBlocks1, 2931 | ECBlocks2: TECB); 2932 | begin 2933 | Self.ECCodewordsPerBlock := ECCodewordsPerBlock; 2934 | SetLength(Self.ECBlocks, 2); 2935 | ECBlocks[0] := ECBlocks1; 2936 | ECBlocks[1] := ECBlocks2; 2937 | end; 2938 | 2939 | destructor TECBlocks.Destroy; 2940 | var 2941 | X: Integer; 2942 | begin 2943 | for X := 0 to Length(ECBlocks) - 1 do 2944 | begin 2945 | ECBlocks[X].Free; 2946 | end; 2947 | inherited; 2948 | end; 2949 | 2950 | function TECBlocks.GetECBlocks: TECBArray; 2951 | begin 2952 | Result := ECBlocks; 2953 | end; 2954 | 2955 | function TECBlocks.GetECCodewordsPerBlock: Integer; 2956 | begin 2957 | Result := ECCodewordsPerBlock; 2958 | end; 2959 | 2960 | function TECBlocks.GetNumBlocks: Integer; 2961 | var 2962 | Total: Integer; 2963 | I: Integer; 2964 | begin 2965 | Total := 0; 2966 | for I := 0 to Length(ECBlocks) - 1 do 2967 | begin 2968 | Inc(Total, ECBlocks[I].GetCount); 2969 | end; 2970 | Result := Total; 2971 | end; 2972 | 2973 | function TECBlocks.GetTotalECCodewords: Integer; 2974 | begin 2975 | Result := ECCodewordsPerBlock * GetNumBlocks; 2976 | end; 2977 | 2978 | { TBlockPair } 2979 | 2980 | constructor TBlockPair.Create(BA1, BA2: TByteArray); 2981 | begin 2982 | FDataBytes := BA1; 2983 | FErrorCorrectionBytes := BA2; 2984 | end; 2985 | 2986 | function TBlockPair.GetDataBytes: TByteArray; 2987 | begin 2988 | Result := FDataBytes; 2989 | end; 2990 | 2991 | function TBlockPair.GetErrorCorrectionBytes: TByteArray; 2992 | begin 2993 | Result := FErrorCorrectionBytes; 2994 | end; 2995 | 2996 | { TReedSolomonEncoder } 2997 | 2998 | function TReedSolomonEncoder.BuildGenerator(Degree: Integer): TGenericGFPoly; 2999 | var 3000 | LastGenerator: TGenericGFPoly; 3001 | NextGenerator: TGenericGFPoly; 3002 | Poly: TGenericGFPoly; 3003 | D: Integer; 3004 | CA: TIntegerArray; 3005 | begin 3006 | if (Degree >= FCachedGenerators.Count) then 3007 | begin 3008 | LastGenerator := TGenericGFPoly(FCachedGenerators[FCachedGenerators.Count - 1]); 3009 | 3010 | for D := FCachedGenerators.Count to Degree do 3011 | begin 3012 | SetLength(CA, 2); 3013 | CA[0] := 1; 3014 | CA[1] := FField.Exp(D - 1 + FField.GetGeneratorBase); 3015 | Poly := TGenericGFPoly.Create(FField, CA); 3016 | NextGenerator := LastGenerator.Multiply(Poly); 3017 | FCachedGenerators.Add(NextGenerator); 3018 | LastGenerator := NextGenerator; 3019 | end; 3020 | end; 3021 | Result := TGenericGFPoly(FCachedGenerators[Degree]); 3022 | end; 3023 | 3024 | constructor TReedSolomonEncoder.Create(AField: TGenericGF); 3025 | var 3026 | GenericGFPoly: TGenericGFPoly; 3027 | IntArray: TIntegerArray; 3028 | begin 3029 | FField := AField; 3030 | 3031 | // Contents of FCachedGenerators will be freed by FGenericGF.Destroy 3032 | FCachedGenerators := TObjectList.Create(False); 3033 | 3034 | SetLength(IntArray, 1); 3035 | IntArray[0] := 1; 3036 | GenericGFPoly := TGenericGFPoly.Create(AField, IntArray); 3037 | FCachedGenerators.Add(GenericGFPoly); 3038 | end; 3039 | 3040 | destructor TReedSolomonEncoder.Destroy; 3041 | begin 3042 | FCachedGenerators.Free; 3043 | inherited; 3044 | end; 3045 | 3046 | procedure TReedSolomonEncoder.Encode(ToEncode: TIntegerArray; ECBytes: Integer); 3047 | var 3048 | DataBytes: Integer; 3049 | Generator: TGenericGFPoly; 3050 | InfoCoefficients: TIntegerArray; 3051 | Info: TGenericGFPoly; 3052 | Remainder: TGenericGFPoly; 3053 | Coefficients: TIntegerArray; 3054 | NumZeroCoefficients: Integer; 3055 | I: Integer; 3056 | begin 3057 | SetLength(Coefficients, 0); 3058 | if (ECBytes > 0) then 3059 | begin 3060 | DataBytes := Length(ToEncode) - ECBytes; 3061 | if (DataBytes > 0) then 3062 | begin 3063 | Generator := BuildGenerator(ECBytes); 3064 | SetLength(InfoCoefficients, DataBytes); 3065 | InfoCoefficients := Copy(ToEncode, 0, DataBytes); 3066 | Info := TGenericGFPoly.Create(FField, InfoCoefficients); 3067 | Info := Info.MultiplyByMonomial(ECBytes, 1); 3068 | Remainder := Info.Divide(Generator)[1]; 3069 | Coefficients := Remainder.GetCoefficients; 3070 | NumZeroCoefficients := ECBytes - Length(Coefficients); 3071 | for I := 0 to NumZeroCoefficients - 1 do 3072 | begin 3073 | ToEncode[DataBytes + I] := 0; 3074 | end; 3075 | Move(Coefficients[0], ToEncode[DataBytes + NumZeroCoefficients], Length(Coefficients) * SizeOf(Integer)); 3076 | end; 3077 | end; 3078 | end; 3079 | 3080 | { TECB } 3081 | 3082 | constructor TECB.Create(Count, DataCodewords: Integer); 3083 | begin 3084 | Self.Count := Count; 3085 | Self.DataCodewords := DataCodewords; 3086 | end; 3087 | 3088 | function TECB.GetCount: Integer; 3089 | begin 3090 | Result := Count; 3091 | end; 3092 | 3093 | function TECB.GetDataCodewords: Integer; 3094 | begin 3095 | Result := DataCodewords; 3096 | end; 3097 | 3098 | { TGenericGFPoly } 3099 | 3100 | function TGenericGFPoly.AddOrSubtract(Other: TGenericGFPoly): TGenericGFPoly; 3101 | var 3102 | SmallerCoefficients: TIntegerArray; 3103 | LargerCoefficients: TIntegerArray; 3104 | Temp: TIntegerArray; 3105 | SumDiff: TIntegerArray; 3106 | LengthDiff: Integer; 3107 | I: Integer; 3108 | begin 3109 | SetLength(SmallerCoefficients, 0); 3110 | SetLength(LargerCoefficients, 0); 3111 | SetLength(Temp, 0); 3112 | SetLength(SumDiff, 0); 3113 | 3114 | Result := nil; 3115 | if (Assigned(Other)) then 3116 | begin 3117 | if (FField = Other.FField) then 3118 | begin 3119 | if (IsZero) then 3120 | begin 3121 | Result := Other; 3122 | Exit; 3123 | end; 3124 | 3125 | if (Other.IsZero) then 3126 | begin 3127 | Result := Self; 3128 | Exit; 3129 | end; 3130 | 3131 | SmallerCoefficients := FCoefficients; 3132 | LargerCoefficients := Other.Coefficients; 3133 | if (Length(SmallerCoefficients) > Length(LargerCoefficients)) then 3134 | begin 3135 | Temp := smallerCoefficients; 3136 | SmallerCoefficients := LargerCoefficients; 3137 | LargerCoefficients := temp; 3138 | end; 3139 | SetLength(SumDiff, Length(LargerCoefficients)); 3140 | LengthDiff := Length(LargerCoefficients) - Length(SmallerCoefficients); 3141 | 3142 | // Copy high-order terms only found in higher-degree polynomial's coefficients 3143 | if (LengthDiff > 0) then 3144 | begin 3145 | //SumDiff := Copy(LargerCoefficients, 0, LengthDiff); 3146 | Move(LargerCoefficients[0], SumDiff[0], LengthDiff * SizeOf(Integer)); 3147 | end; 3148 | 3149 | for I := LengthDiff to Length(LargerCoefficients) - 1 do 3150 | begin 3151 | SumDiff[I] := TGenericGF.AddOrSubtract(SmallerCoefficients[I - LengthDiff], LargerCoefficients[I]); 3152 | end; 3153 | 3154 | Result := TGenericGFPoly.Create(FField, SumDiff); 3155 | end; 3156 | end; 3157 | end; 3158 | 3159 | function TGenericGFPoly.Coefficients: TIntegerArray; 3160 | begin 3161 | Result := FCoefficients; 3162 | end; 3163 | 3164 | constructor TGenericGFPoly.Create(AField: TGenericGF; 3165 | ACoefficients: TIntegerArray); 3166 | var 3167 | CoefficientsLength: Integer; 3168 | FirstNonZero: Integer; 3169 | begin 3170 | FField := AField; 3171 | SetLength(FField.FPolyList, Length(FField.FPolyList) + 1); 3172 | FField.FPolyList[Length(FField.FPolyList) - 1] := Self; 3173 | CoefficientsLength := Length(ACoefficients); 3174 | if ((CoefficientsLength > 1) and (ACoefficients[0] = 0)) then 3175 | begin 3176 | // Leading term must be non-zero for anything except the constant polynomial "0" 3177 | FirstNonZero := 1; 3178 | while ((FirstNonZero < CoefficientsLength) and (ACoefficients[FirstNonZero] = 0)) do 3179 | begin 3180 | Inc(FirstNonZero); 3181 | end; 3182 | 3183 | if (FirstNonZero = CoefficientsLength) then 3184 | begin 3185 | FCoefficients := AField.GetZero.Coefficients; 3186 | end else 3187 | begin 3188 | SetLength(FCoefficients, CoefficientsLength - FirstNonZero); 3189 | FCoefficients := Copy(ACoefficients, FirstNonZero, Length(FCoefficients)); 3190 | end; 3191 | end else 3192 | begin 3193 | FCoefficients := ACoefficients; 3194 | end; 3195 | end; 3196 | 3197 | destructor TGenericGFPoly.Destroy; 3198 | begin 3199 | Self.FField := FField; 3200 | inherited; 3201 | end; 3202 | 3203 | function TGenericGFPoly.Divide(Other: TGenericGFPoly): TGenericGFPolyArray; 3204 | var 3205 | Quotient: TGenericGFPoly; 3206 | Remainder: TGenericGFPoly; 3207 | DenominatorLeadingTerm: Integer; 3208 | InverseDenominatorLeadingTerm: integer; 3209 | DegreeDifference: Integer; 3210 | Scale: Integer; 3211 | Term: TGenericGFPoly; 3212 | IterationQuotient: TGenericGFPoly; 3213 | begin 3214 | SetLength(Result, 0); 3215 | if ((FField = Other.FField) and (not Other.IsZero)) then 3216 | begin 3217 | 3218 | Quotient := FField.GetZero; 3219 | Remainder := Self; 3220 | 3221 | DenominatorLeadingTerm := Other.GetCoefficient(Other.GetDegree); 3222 | InverseDenominatorLeadingTerm := FField.Inverse(DenominatorLeadingTerm); 3223 | 3224 | while ((Remainder.GetDegree >= Other.GetDegree) and (not Remainder.IsZero)) do 3225 | begin 3226 | DegreeDifference := Remainder.GetDegree - Other.GetDegree; 3227 | Scale := FField.Multiply(Remainder.GetCoefficient(Remainder.GetDegree), InverseDenominatorLeadingTerm); 3228 | Term := Other.MultiplyByMonomial(DegreeDifference, Scale); 3229 | IterationQuotient := FField.BuildMonomial(degreeDifference, scale); 3230 | Quotient := Quotient.AddOrSubtract(IterationQuotient); 3231 | Remainder := Remainder.AddOrSubtract(Term); 3232 | end; 3233 | 3234 | SetLength(Result, 2); 3235 | Result[0] := Quotient; 3236 | Result[1] := Remainder; 3237 | end; 3238 | end; 3239 | 3240 | function TGenericGFPoly.GetCoefficient(Degree: Integer): Integer; 3241 | begin 3242 | Result := FCoefficients[Length(FCoefficients) - 1 - Degree]; 3243 | end; 3244 | 3245 | function TGenericGFPoly.GetCoefficients: TIntegerArray; 3246 | begin 3247 | Result := FCoefficients; 3248 | end; 3249 | 3250 | function TGenericGFPoly.GetDegree: Integer; 3251 | begin 3252 | Result := Length(FCoefficients) - 1; 3253 | end; 3254 | 3255 | function TGenericGFPoly.IsZero: Boolean; 3256 | begin 3257 | Result := FCoefficients[0] = 0; 3258 | end; 3259 | 3260 | function TGenericGFPoly.Multiply(Other: TGenericGFPoly): TGenericGFPoly; 3261 | var 3262 | ACoefficients: TIntegerArray; 3263 | BCoefficients: TIntegerArray; 3264 | Product: TIntegerArray; 3265 | ALength: Integer; 3266 | BLength: Integer; 3267 | I: Integer; 3268 | J: Integer; 3269 | ACoeff: Integer; 3270 | begin 3271 | SetLength(ACoefficients, 0); 3272 | SetLength(BCoefficients, 0); 3273 | Result := nil; 3274 | 3275 | if (FField = Other.FField) then 3276 | begin 3277 | if (IsZero or Other.IsZero) then 3278 | begin 3279 | Result := FField.GetZero; 3280 | Exit; 3281 | end; 3282 | 3283 | ACoefficients := FCoefficients; 3284 | ALength := Length(ACoefficients); 3285 | BCoefficients := Other.Coefficients; 3286 | BLength := Length(BCoefficients); 3287 | SetLength(Product, aLength + bLength - 1); 3288 | for I := 0 to ALength - 1 do 3289 | begin 3290 | ACoeff := ACoefficients[I]; 3291 | for J := 0 to BLength - 1 do 3292 | begin 3293 | Product[I + J] := TGenericGF.AddOrSubtract(Product[I + J], 3294 | FField.Multiply(ACoeff, BCoefficients[J])); 3295 | end; 3296 | end; 3297 | Result := TGenericGFPoly.Create(FField, Product); 3298 | end; 3299 | end; 3300 | 3301 | function TGenericGFPoly.MultiplyByMonomial(Degree, 3302 | Coefficient: Integer): TGenericGFPoly; 3303 | var 3304 | I: Integer; 3305 | Size: Integer; 3306 | Product: TIntegerArray; 3307 | begin 3308 | Result := nil; 3309 | if (Degree >= 0) then 3310 | begin 3311 | if (Coefficient = 0) then 3312 | begin 3313 | Result := FField.GetZero; 3314 | Exit; 3315 | end; 3316 | Size := Length(Coefficients); 3317 | SetLength(Product, Size + Degree); 3318 | for I := 0 to Size - 1 do 3319 | begin 3320 | Product[I] := FField.Multiply(FCoefficients[I], Coefficient); 3321 | end; 3322 | Result := TGenericGFPoly.Create(FField, Product); 3323 | end; 3324 | end; 3325 | 3326 | { TGenericGF } 3327 | 3328 | class function TGenericGF.AddOrSubtract(A, B: Integer): Integer; 3329 | begin 3330 | Result := A xor B; 3331 | end; 3332 | 3333 | function TGenericGF.BuildMonomial(Degree, Coefficient: Integer): TGenericGFPoly; 3334 | var 3335 | Coefficients: TIntegerArray; 3336 | begin 3337 | CheckInit(); 3338 | 3339 | if (Degree >= 0) then 3340 | begin 3341 | if (Coefficient = 0) then 3342 | begin 3343 | Result := FZero; 3344 | Exit; 3345 | end; 3346 | SetLength(Coefficients, Degree + 1); 3347 | Coefficients[0] := Coefficient; 3348 | Result := TGenericGFPoly.Create(Self, Coefficients); 3349 | end else 3350 | begin 3351 | Result := nil; 3352 | end; 3353 | end; 3354 | 3355 | procedure TGenericGF.CheckInit; 3356 | begin 3357 | if (not FInitialized) then 3358 | begin 3359 | Initialize; 3360 | end; 3361 | end; 3362 | 3363 | constructor TGenericGF.Create(Primitive, Size, B: Integer); 3364 | begin 3365 | FInitialized := False; 3366 | FPrimitive := Primitive; 3367 | FSize := Size; 3368 | FGeneratorBase := B; 3369 | if (FSize < 0) then 3370 | begin 3371 | Initialize; 3372 | end; 3373 | end; 3374 | 3375 | class function TGenericGF.CreateQRCodeField256: TGenericGF; 3376 | begin 3377 | Result := TGenericGF.Create($011D, 256, 0); 3378 | end; 3379 | 3380 | destructor TGenericGF.Destroy; 3381 | var 3382 | X: Integer; 3383 | Y: Integer; 3384 | begin 3385 | for X := 0 to Length(FPolyList) - 1 do 3386 | begin 3387 | if (Assigned(FPolyList[X])) then 3388 | begin 3389 | for Y := X + 1 to Length(FPolyList) - 1 do 3390 | begin 3391 | if (FPolyList[Y] = FPolyList[X]) then 3392 | begin 3393 | FPolyList[Y] := nil; 3394 | end; 3395 | end; 3396 | FPolyList[X].Free; 3397 | end; 3398 | end; 3399 | inherited; 3400 | end; 3401 | 3402 | function TGenericGF.Exp(A: Integer): Integer; 3403 | begin 3404 | CheckInit; 3405 | Result := FExpTable[A]; 3406 | end; 3407 | 3408 | function TGenericGF.GetGeneratorBase: Integer; 3409 | begin 3410 | Result := FGeneratorBase; 3411 | end; 3412 | 3413 | function TGenericGF.GetZero: TGenericGFPoly; 3414 | begin 3415 | CheckInit; 3416 | Result := FZero; 3417 | end; 3418 | 3419 | procedure TGenericGF.Initialize; 3420 | var 3421 | X: Integer; 3422 | I: Integer; 3423 | CA: TIntegerArray; 3424 | begin 3425 | SetLength(FExpTable, FSize); 3426 | SetLength(FLogTable, FSize); 3427 | X := 1; 3428 | for I := 0 to FSize - 1 do 3429 | begin 3430 | FExpTable[I] := x; 3431 | X := X shl 1; // x = x * 2; we're assuming the generator alpha is 2 3432 | if (X >= FSize) then 3433 | begin 3434 | X := X xor FPrimitive; 3435 | X := X and (FSize - 1); 3436 | end; 3437 | end; 3438 | 3439 | for I := 0 to FSize - 2 do 3440 | begin 3441 | FLogTable[FExpTable[I]] := I; 3442 | end; 3443 | 3444 | // logTable[0] == 0 but this should never be used 3445 | 3446 | SetLength(CA, 1); 3447 | CA[0] := 0; 3448 | FZero := TGenericGFPoly.Create(Self, CA); 3449 | 3450 | SetLength(CA, 1); 3451 | CA[0] := 1; 3452 | FOne := TGenericGFPoly.Create(Self, CA); 3453 | 3454 | FInitialized := True; 3455 | end; 3456 | 3457 | function TGenericGF.Inverse(A: Integer): Integer; 3458 | begin 3459 | CheckInit; 3460 | 3461 | if (a <> 0) then 3462 | begin 3463 | Result := FExpTable[FSize - FLogTable[A] - 1]; 3464 | end else 3465 | begin 3466 | Result := 0; 3467 | end; 3468 | end; 3469 | 3470 | function TGenericGF.Multiply(A, B: Integer): Integer; 3471 | begin 3472 | CheckInit; 3473 | if ((A <> 0) and (B <> 0)) then 3474 | begin 3475 | Result := FExpTable[(FLogTable[A] + FLogTable[B]) mod (FSize - 1)]; 3476 | end else 3477 | begin 3478 | Result := 0; 3479 | end; 3480 | end; 3481 | 3482 | function GenerateQRCode(const Input: WideString; EncodeOptions: Integer): T2DBooleanArray; 3483 | var 3484 | Encoder: TEncoder; 3485 | Level: TErrorCorrectionLevel; 3486 | QRCode: TQRCode; 3487 | X: Integer; 3488 | Y: Integer; 3489 | begin 3490 | Level := TErrorCorrectionLevel.Create; 3491 | Level.FBits := 1; 3492 | Encoder := TEncoder.Create; 3493 | QRCode := TQRCode.Create; 3494 | try 3495 | Encoder.Encode(Input, EncodeOptions, Level, QRCode); 3496 | if (Assigned(QRCode.FMatrix)) then 3497 | begin 3498 | SetLength(Result, QRCode.FMatrix.FHeight); 3499 | for Y := 0 to QRCode.FMatrix.FHeight - 1 do 3500 | begin 3501 | SetLength(Result[Y], QRCode.FMatrix.FWidth); 3502 | for X := 0 to QRCode.FMatrix.FWidth - 1 do 3503 | begin 3504 | Result[Y][X] := QRCode.FMatrix.Get(Y, X) = 1; 3505 | end; 3506 | end; 3507 | end; 3508 | finally 3509 | QRCode.Free; 3510 | Encoder.Free; 3511 | Level.Free; 3512 | end; 3513 | end; 3514 | 3515 | { TDelphiZXingQRCode } 3516 | 3517 | constructor TDelphiZXingQRCode.Create; 3518 | begin 3519 | FData := ''; 3520 | FEncoding := qrAuto; 3521 | FQuietZone := 4; 3522 | FRows := 0; 3523 | FColumns := 0; 3524 | end; 3525 | 3526 | function TDelphiZXingQRCode.GetIsBlack(Row, Column: Integer): Boolean; 3527 | begin 3528 | Dec(Row, FQuietZone); 3529 | Dec(Column, FQuietZone); 3530 | if ((Row >= 0) and (Column >= 0) and (Row < (FRows - FQuietZone * 2)) and (Column < (FColumns - FQuietZone * 2))) then 3531 | begin 3532 | Result := FElements[Column, Row]; 3533 | end else 3534 | begin 3535 | Result := False; 3536 | end; 3537 | end; 3538 | 3539 | procedure TDelphiZXingQRCode.SetData(const NewData: WideString); 3540 | begin 3541 | if (FData <> NewData) then 3542 | begin 3543 | FData := NewData; 3544 | Update; 3545 | end; 3546 | end; 3547 | 3548 | procedure TDelphiZXingQRCode.SetEncoding(NewEncoding: TQRCodeEncoding); 3549 | begin 3550 | if (FEncoding <> NewEncoding) then 3551 | begin 3552 | FEncoding := NewEncoding; 3553 | Update; 3554 | end; 3555 | end; 3556 | 3557 | procedure TDelphiZXingQRCode.SetQuietZone(NewQuietZone: Integer); 3558 | begin 3559 | if ((FQuietZone <> NewQuietZone) and (NewQuietZone >= 0) and (NewQuietZone <= 100)) then 3560 | begin 3561 | FQuietZone := NewQuietZone; 3562 | Update; 3563 | end; 3564 | end; 3565 | 3566 | procedure TDelphiZXingQRCode.Update; 3567 | begin 3568 | FElements := GenerateQRCode(FData, Ord(FEncoding)); 3569 | FRows := Length(FElements) + FQuietZone * 2; 3570 | FColumns := FRows; 3571 | end; 3572 | 3573 | end. -------------------------------------------------------------------------------- /TestApp/DelphiZXingQRCodeTestApp.dpr: -------------------------------------------------------------------------------- 1 | program DelphiZXingQRCodeTestApp; 2 | 3 | uses 4 | Vcl.Forms, 5 | DelphiZXingQRCodeTestAppMainForm in 'DelphiZXingQRCodeTestAppMainForm.pas' {Form1}; 6 | 7 | {$R *.res} 8 | 9 | begin 10 | Application.Initialize; 11 | Application.MainFormOnTaskbar := True; 12 | Application.CreateForm(TForm1, Form1); 13 | Application.Run; 14 | end. 15 | -------------------------------------------------------------------------------- /TestApp/DelphiZXingQRCodeTestApp.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {9B95C818-479B-45EB-917E-C5AC561D7C60} 4 | 13.4 5 | VCL 6 | DelphiZXingQRCodeTestApp.dpr 7 | True 8 | Debug 9 | Win32 10 | 1 11 | Application 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_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | ..\Source\;$(DCC_UnitSearchPath) 44 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 45 | None 46 | 7177 47 | bindcompfmx;dsnap;fmx;rtl;dbrtl;fmxase;bindcomp;fmxobj;xmlrtl;fmxdae;bindengine;$(DCC_UsePackage) 48 | $(BDS)\bin\delphi_PROJECTICON.ico 49 | System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) 50 | .\$(Platform)\$(Config) 51 | .\$(Platform)\$(Config) 52 | false 53 | false 54 | false 55 | false 56 | false 57 | 58 | 59 | bindcompvcl;vcltouch;VclSmp;vcl;dsnapcon;vclx;vclimg;vclactnband;vcldb;vcldsnap;$(DCC_UsePackage) 60 | 61 | 62 | bindcompvcl;vcltouch;vcldbx;VclSmp;vcl;IndyCore;IndySystem;dsnapcon;DelphiAdobeReaderActiveX;vclx;svnui;svn;vclimg;fmi;IndyProtocols;bdertl;vclactnband;vcldb;vcldsnap;$(DCC_UsePackage) 63 | true 64 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 65 | 1033 66 | $(BDS)\bin\default_app.manifest 67 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 68 | 69 | 70 | DEBUG;$(DCC_Define) 71 | false 72 | true 73 | true 74 | true 75 | 76 | 77 | true 78 | 1033 79 | false 80 | 81 | 82 | false 83 | RELEASE;$(DCC_Define) 84 | 0 85 | false 86 | 87 | 88 | 89 | MainSource 90 | 91 | 92 |
Form1
93 | dfm 94 | 95 | 96 | Cfg_2 97 | Base 98 | 99 | 100 | Base 101 | 102 | 103 | Cfg_1 104 | Base 105 | 106 | 107 | 108 | Delphi.Personality.12 109 | 110 | 111 | 112 | 113 | False 114 | False 115 | 1 116 | 0 117 | 0 118 | 0 119 | False 120 | False 121 | False 122 | False 123 | False 124 | 7177 125 | 1252 126 | 127 | 128 | 129 | 130 | 1.0.0.0 131 | 132 | 133 | 134 | 135 | 136 | 1.0.0.0 137 | 138 | 139 | 140 | DelphiZXingQRCodeTestApp.dpr 141 | 142 | 143 | CodeSite Express 5.1 144 | 145 | 146 | 147 | 148 | False 149 | True 150 | 151 | 152 | 12 153 | 154 | 155 | 156 | 157 | -------------------------------------------------------------------------------- /TestApp/DelphiZXingQRCodeTestApp.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/foxitsoftware/DelphiZXingQRCode/7753eb6d4924b1d5cc97fcc179a85362db688995/TestApp/DelphiZXingQRCodeTestApp.res -------------------------------------------------------------------------------- /TestApp/DelphiZXingQRCodeTestAppMainForm.dfm: -------------------------------------------------------------------------------- 1 | object Form1: TForm1 2 | Left = 0 3 | Top = 0 4 | Caption = 'Delphi port of ZXing QRCode' 5 | ClientHeight = 282 6 | ClientWidth = 534 7 | Color = clBtnFace 8 | Constraints.MinHeight = 320 9 | Constraints.MinWidth = 550 10 | Font.Charset = DEFAULT_CHARSET 11 | Font.Color = clWindowText 12 | Font.Height = -11 13 | Font.Name = 'Tahoma' 14 | Font.Style = [] 15 | OldCreateOrder = False 16 | OnCreate = FormCreate 17 | OnDestroy = FormDestroy 18 | DesignSize = ( 19 | 534 20 | 282) 21 | PixelsPerInch = 96 22 | TextHeight = 13 23 | object Label1: TLabel 24 | Left = 8 25 | Top = 13 26 | Width = 22 27 | Height = 13 28 | Caption = 'Text' 29 | end 30 | object Label2: TLabel 31 | Left = 8 32 | Top = 69 33 | Width = 43 34 | Height = 13 35 | Caption = 'Encoding' 36 | end 37 | object Label3: TLabel 38 | Left = 184 39 | Top = 69 40 | Width = 52 41 | Height = 13 42 | Caption = 'Quiet zone' 43 | end 44 | object Label4: TLabel 45 | Left = 296 46 | Top = 13 47 | Width = 38 48 | Height = 13 49 | Caption = 'Preview' 50 | end 51 | object PaintBox1: TPaintBox 52 | Left = 296 53 | Top = 32 54 | Width = 230 55 | Height = 242 56 | Anchors = [akLeft, akTop, akRight, akBottom] 57 | OnPaint = PaintBox1Paint 58 | ExplicitWidth = 331 59 | ExplicitHeight = 260 60 | end 61 | object edtText: TEdit 62 | Left = 8 63 | Top = 32 64 | Width = 265 65 | Height = 21 66 | TabOrder = 0 67 | Text = 'Hello world' 68 | OnChange = edtTextChange 69 | end 70 | object cmbEncoding: TComboBox 71 | Left = 8 72 | Top = 88 73 | Width = 145 74 | Height = 21 75 | Style = csDropDownList 76 | ItemIndex = 0 77 | TabOrder = 1 78 | Text = 'Auto' 79 | OnChange = cmbEncodingChange 80 | Items.Strings = ( 81 | 'Auto' 82 | 'Numeric' 83 | 'Alphanumeric' 84 | 'ISO-8859-1' 85 | 'UTF-8 without BOM' 86 | 'UTF-8 with BOM') 87 | end 88 | object edtQuietZone: TEdit 89 | Left = 184 90 | Top = 88 91 | Width = 89 92 | Height = 21 93 | TabOrder = 2 94 | Text = '4' 95 | OnChange = edtQuietZoneChange 96 | end 97 | end 98 | -------------------------------------------------------------------------------- /TestApp/DelphiZXingQRCodeTestAppMainForm.pas: -------------------------------------------------------------------------------- 1 | unit DelphiZXingQRCodeTestAppMainForm; 2 | 3 | // Demo app for ZXing QRCode port to Delphi, by Debenu Pty Ltd (www.debenu.com) 4 | // Need a PDF SDK? Checkout Debenu Quick PDF Library: http://www.debenu.com/products/development/debenu-pdf-library/ 5 | 6 | interface 7 | 8 | uses 9 | Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 10 | Vcl.Controls, Vcl.Forms, Vcl.Dialogs, DelphiZXingQRCode, Vcl.ExtCtrls, 11 | Vcl.StdCtrls; 12 | 13 | type 14 | TForm1 = class(TForm) 15 | edtText: TEdit; 16 | Label1: TLabel; 17 | cmbEncoding: TComboBox; 18 | Label2: TLabel; 19 | Label3: TLabel; 20 | edtQuietZone: TEdit; 21 | Label4: TLabel; 22 | PaintBox1: TPaintBox; 23 | procedure FormDestroy(Sender: TObject); 24 | procedure FormCreate(Sender: TObject); 25 | procedure PaintBox1Paint(Sender: TObject); 26 | procedure edtTextChange(Sender: TObject); 27 | procedure cmbEncodingChange(Sender: TObject); 28 | procedure edtQuietZoneChange(Sender: TObject); 29 | private 30 | QRCodeBitmap: TBitmap; 31 | public 32 | procedure Update; 33 | end; 34 | 35 | var 36 | Form1: TForm1; 37 | 38 | implementation 39 | 40 | {$R *.dfm} 41 | 42 | procedure TForm1.cmbEncodingChange(Sender: TObject); 43 | begin 44 | Update; 45 | end; 46 | 47 | procedure TForm1.edtQuietZoneChange(Sender: TObject); 48 | begin 49 | Update; 50 | end; 51 | 52 | procedure TForm1.edtTextChange(Sender: TObject); 53 | begin 54 | Update; 55 | end; 56 | 57 | procedure TForm1.FormCreate(Sender: TObject); 58 | begin 59 | QRCodeBitmap := TBitmap.Create; 60 | Update; 61 | end; 62 | 63 | procedure TForm1.FormDestroy(Sender: TObject); 64 | begin 65 | QRCodeBitmap.Free; 66 | end; 67 | 68 | procedure TForm1.PaintBox1Paint(Sender: TObject); 69 | var 70 | Scale: Double; 71 | begin 72 | PaintBox1.Canvas.Brush.Color := clWhite; 73 | PaintBox1.Canvas.FillRect(Rect(0, 0, PaintBox1.Width, PaintBox1.Height)); 74 | if ((QRCodeBitmap.Width > 0) and (QRCodeBitmap.Height > 0)) then 75 | begin 76 | if (PaintBox1.Width < PaintBox1.Height) then 77 | begin 78 | Scale := PaintBox1.Width / QRCodeBitmap.Width; 79 | end else 80 | begin 81 | Scale := PaintBox1.Height / QRCodeBitmap.Height; 82 | end; 83 | PaintBox1.Canvas.StretchDraw(Rect(0, 0, Trunc(Scale * QRCodeBitmap.Width), Trunc(Scale * QRCodeBitmap.Height)), QRCodeBitmap); 84 | end; 85 | end; 86 | 87 | procedure TForm1.Update; 88 | var 89 | QRCode: TDelphiZXingQRCode; 90 | Row, Column: Integer; 91 | begin 92 | QRCode := TDelphiZXingQRCode.Create; 93 | try 94 | QRCode.Data := edtText.Text; 95 | QRCode.Encoding := TQRCodeEncoding(cmbEncoding.ItemIndex); 96 | QRCode.QuietZone := StrToIntDef(edtQuietZone.Text, 4); 97 | QRCodeBitmap.SetSize(QRCode.Rows, QRCode.Columns); 98 | for Row := 0 to QRCode.Rows - 1 do 99 | begin 100 | for Column := 0 to QRCode.Columns - 1 do 101 | begin 102 | if (QRCode.IsBlack[Row, Column]) then 103 | begin 104 | QRCodeBitmap.Canvas.Pixels[Column, Row] := clBlack; 105 | end else 106 | begin 107 | QRCodeBitmap.Canvas.Pixels[Column, Row] := clWhite; 108 | end; 109 | end; 110 | end; 111 | finally 112 | QRCode.Free; 113 | end; 114 | PaintBox1.Repaint; 115 | end; 116 | 117 | end. 118 | --------------------------------------------------------------------------------