DelphiZXIngQRCode.pas 98 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573
  1. unit DelphiZXingQRCode;
  2. // ZXing QRCode port to Delphi, by Debenu Pty Ltd (www.debenu.com)
  3. // Original copyright notice
  4. (*
  5. * Copyright 2008 ZXing authors
  6. *
  7. * Licensed under the Apache License, Version 2.0 (the "License");
  8. * you may not use this file except in compliance with the License.
  9. * You may obtain a copy of the License at
  10. *
  11. * http://www.apache.org/licenses/LICENSE-2.0
  12. *
  13. * Unless required by applicable law or agreed to in writing, software
  14. * distributed under the License is distributed on an "AS IS" BASIS,
  15. * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  16. * See the License for the specific language governing permissions and
  17. * limitations under the License.
  18. *)
  19. interface
  20. type
  21. TQRCodeEncoding = (qrAuto, qrNumeric, qrAlphanumeric, qrISO88591, qrUTF8NoBOM, qrUTF8BOM);
  22. T2DBooleanArray = array of array of Boolean;
  23. TDelphiZXingQRCode = class
  24. protected
  25. FData: WideString;
  26. FRows: Integer;
  27. FColumns: Integer;
  28. FEncoding: TQRCodeEncoding;
  29. FQuietZone: Integer;
  30. FElements: T2DBooleanArray;
  31. procedure SetEncoding(NewEncoding: TQRCodeEncoding);
  32. procedure SetData(const NewData: WideString);
  33. procedure SetQuietZone(NewQuietZone: Integer);
  34. function GetIsBlack(Row, Column: Integer): Boolean;
  35. procedure Update;
  36. public
  37. constructor Create;
  38. property Data: WideString read FData write SetData;
  39. property Encoding: TQRCodeEncoding read FEncoding write SetEncoding;
  40. property QuietZone: Integer read FQuietZone write SetQuietZone;
  41. property Rows: Integer read FRows;
  42. property Columns: Integer read FColumns;
  43. property IsBlack[Row, Column: Integer]: Boolean read GetIsBlack;
  44. end;
  45. implementation
  46. uses
  47. contnrs, Math, Classes;
  48. type
  49. TByteArray = array of Byte;
  50. T2DByteArray = array of array of Byte;
  51. TIntegerArray = array of Integer;
  52. const
  53. NUM_MASK_PATTERNS = 8;
  54. QUIET_ZONE_SIZE = 4;
  55. ALPHANUMERIC_TABLE: array[0..95] of Integer = (
  56. -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, // 0x00-0x0f
  57. -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, // 0x10-0x1f
  58. 36, -1, -1, -1, 37, 38, -1, -1, -1, -1, 39, 40, -1, 41, 42, 43, // 0x20-0x2f
  59. 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 44, -1, -1, -1, -1, -1, // 0x30-0x3f
  60. -1, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, // 0x40-0x4f
  61. 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1 // 0x50-0x5f
  62. );
  63. DEFAULT_BYTE_MODE_ENCODING = 'ISO-8859-1';
  64. POSITION_DETECTION_PATTERN: array[0..6, 0..6] of Integer = (
  65. (1, 1, 1, 1, 1, 1, 1),
  66. (1, 0, 0, 0, 0, 0, 1),
  67. (1, 0, 1, 1, 1, 0, 1),
  68. (1, 0, 1, 1, 1, 0, 1),
  69. (1, 0, 1, 1, 1, 0, 1),
  70. (1, 0, 0, 0, 0, 0, 1),
  71. (1, 1, 1, 1, 1, 1, 1));
  72. HORIZONTAL_SEPARATION_PATTERN: array[0..0, 0..7] of Integer = (
  73. (0, 0, 0, 0, 0, 0, 0, 0));
  74. VERTICAL_SEPARATION_PATTERN: array[0..6, 0..0] of Integer = (
  75. (0), (0), (0), (0), (0), (0), (0));
  76. POSITION_ADJUSTMENT_PATTERN: array[0..4, 0..4] of Integer = (
  77. (1, 1, 1, 1, 1),
  78. (1, 0, 0, 0, 1),
  79. (1, 0, 1, 0, 1),
  80. (1, 0, 0, 0, 1),
  81. (1, 1, 1, 1, 1));
  82. // From Appendix E. Table 1, JIS0510X:2004 (p 71). The table was double-checked by komatsu.
  83. POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE: array[0..39, 0..6] of Integer = (
  84. (-1, -1, -1, -1, -1, -1, -1), // Version 1
  85. ( 6, 18, -1, -1, -1, -1, -1), // Version 2
  86. ( 6, 22, -1, -1, -1, -1, -1), // Version 3
  87. ( 6, 26, -1, -1, -1, -1, -1), // Version 4
  88. ( 6, 30, -1, -1, -1, -1, -1), // Version 5
  89. ( 6, 34, -1, -1, -1, -1, -1), // Version 6
  90. ( 6, 22, 38, -1, -1, -1, -1), // Version 7
  91. ( 6, 24, 42, -1, -1, -1, -1), // Version 8
  92. ( 6, 26, 46, -1, -1, -1, -1), // Version 9
  93. ( 6, 28, 50, -1, -1, -1, -1), // Version 10
  94. ( 6, 30, 54, -1, -1, -1, -1), // Version 11
  95. ( 6, 32, 58, -1, -1, -1, -1), // Version 12
  96. ( 6, 34, 62, -1, -1, -1, -1), // Version 13
  97. ( 6, 26, 46, 66, -1, -1, -1), // Version 14
  98. ( 6, 26, 48, 70, -1, -1, -1), // Version 15
  99. ( 6, 26, 50, 74, -1, -1, -1), // Version 16
  100. ( 6, 30, 54, 78, -1, -1, -1), // Version 17
  101. ( 6, 30, 56, 82, -1, -1, -1), // Version 18
  102. ( 6, 30, 58, 86, -1, -1, -1), // Version 19
  103. ( 6, 34, 62, 90, -1, -1, -1), // Version 20
  104. ( 6, 28, 50, 72, 94, -1, -1), // Version 21
  105. ( 6, 26, 50, 74, 98, -1, -1), // Version 22
  106. ( 6, 30, 54, 78, 102, -1, -1), // Version 23
  107. ( 6, 28, 54, 80, 106, -1, -1), // Version 24
  108. ( 6, 32, 58, 84, 110, -1, -1), // Version 25
  109. ( 6, 30, 58, 86, 114, -1, -1), // Version 26
  110. ( 6, 34, 62, 90, 118, -1, -1), // Version 27
  111. ( 6, 26, 50, 74, 98, 122, -1), // Version 28
  112. ( 6, 30, 54, 78, 102, 126, -1), // Version 29
  113. ( 6, 26, 52, 78, 104, 130, -1), // Version 30
  114. ( 6, 30, 56, 82, 108, 134, -1), // Version 31
  115. ( 6, 34, 60, 86, 112, 138, -1), // Version 32
  116. ( 6, 30, 58, 86, 114, 142, -1), // Version 33
  117. ( 6, 34, 62, 90, 118, 146, -1), // Version 34
  118. ( 6, 30, 54, 78, 102, 126, 150), // Version 35
  119. ( 6, 24, 50, 76, 102, 128, 154), // Version 36
  120. ( 6, 28, 54, 80, 106, 132, 158), // Version 37
  121. ( 6, 32, 58, 84, 110, 136, 162), // Version 38
  122. ( 6, 26, 54, 82, 110, 138, 166), // Version 39
  123. ( 6, 30, 58, 86, 114, 142, 170) // Version 40
  124. );
  125. // Type info cells at the left top corner.
  126. TYPE_INFO_COORDINATES: array[0..14, 0..1] of Integer = (
  127. (8, 0),
  128. (8, 1),
  129. (8, 2),
  130. (8, 3),
  131. (8, 4),
  132. (8, 5),
  133. (8, 7),
  134. (8, 8),
  135. (7, 8),
  136. (5, 8),
  137. (4, 8),
  138. (3, 8),
  139. (2, 8),
  140. (1, 8),
  141. (0, 8)
  142. );
  143. // From Appendix D in JISX0510:2004 (p. 67)
  144. VERSION_INFO_POLY = $1f25; // 1 1111 0010 0101
  145. // From Appendix C in JISX0510:2004 (p.65).
  146. TYPE_INFO_POLY = $537;
  147. TYPE_INFO_MASK_PATTERN = $5412;
  148. VERSION_DECODE_INFO: array[0..33] of Integer = (
  149. $07C94, $085BC, $09A99, $0A4D3, $0BBF6,
  150. $0C762, $0D847, $0E60D, $0F928, $10B78,
  151. $1145D, $12A17, $13532, $149A6, $15683,
  152. $168C9, $177EC, $18EC4, $191E1, $1AFAB,
  153. $1B08E, $1CC1A, $1D33F, $1ED75, $1F250,
  154. $209D5, $216F0, $228BA, $2379F, $24B0B,
  155. $2542E, $26A64, $27541, $28C69);
  156. type
  157. TMode = (qmTerminator, qmNumeric, qmAlphanumeric, qmStructuredAppend,
  158. qmByte, qmECI, qmKanji, qmFNC1FirstPosition, qmFNC1SecondPosition,
  159. qmHanzi);
  160. const
  161. ModeCharacterCountBits: array[TMode] of array[0..2] of Integer = (
  162. (0, 0, 0), (10, 12, 14), (9, 11, 13), (0, 0, 0), (8, 16, 16),
  163. (0, 0, 0), (8, 10, 12), (0, 0, 0), (0, 0, 0), (8, 10, 12));
  164. ModeBits: array[TMode] of Integer = (0, 1, 2, 3, 4, 7, 8, 5, 9, 13);
  165. type
  166. TErrorCorrectionLevel = class
  167. private
  168. FBits: Integer;
  169. public
  170. procedure Assign(Source: TErrorCorrectionLevel);
  171. function Ordinal: Integer;
  172. property Bits: Integer read FBits;
  173. end;
  174. TECB = class
  175. private
  176. Count: Integer;
  177. DataCodewords: Integer;
  178. public
  179. constructor Create(Count, DataCodewords: Integer);
  180. function GetCount: Integer;
  181. function GetDataCodewords: Integer;
  182. end;
  183. TECBArray = array of TECB;
  184. TECBlocks = class
  185. private
  186. ECCodewordsPerBlock: Integer;
  187. ECBlocks: TECBArray;
  188. public
  189. constructor Create(ECCodewordsPerBlock: Integer; ECBlocks: TECB); overload;
  190. constructor Create(ECCodewordsPerBlock: Integer; ECBlocks1, ECBlocks2: TECB); overload;
  191. destructor Destroy; override;
  192. function GetTotalECCodewords: Integer;
  193. function GetNumBlocks: Integer;
  194. function GetECCodewordsPerBlock: Integer;
  195. function GetECBlocks: TECBArray;
  196. end;
  197. TByteMatrix = class
  198. protected
  199. Bytes: T2DByteArray;
  200. FWidth: Integer;
  201. FHeight: Integer;
  202. public
  203. constructor Create(Width, Height: Integer);
  204. function Get(X, Y: Integer): Integer;
  205. procedure SetBoolean(X, Y: Integer; Value: Boolean);
  206. procedure SetInteger(X, Y: Integer; Value: Integer);
  207. function GetArray: T2DByteArray;
  208. procedure Assign(Source: TByteMatrix);
  209. procedure Clear(Value: Byte);
  210. function Hash: AnsiString;
  211. property Width: Integer read FWidth;
  212. property Height: Integer read FHeight;
  213. end;
  214. TBitArray = class
  215. private
  216. Bits: array of Integer;
  217. Size: Integer;
  218. procedure EnsureCapacity(Size: Integer);
  219. public
  220. constructor Create; overload;
  221. constructor Create(Size: Integer); overload;
  222. function GetSizeInBytes: Integer;
  223. function GetSize: Integer;
  224. function Get(I: Integer): Boolean;
  225. procedure SetBit(Index: Integer);
  226. procedure AppendBit(Bit: Boolean);
  227. procedure AppendBits(Value, NumBits: Integer);
  228. procedure AppendBitArray(NewBitArray: TBitArray);
  229. procedure ToBytes(BitOffset: Integer; Source: TByteArray; Offset,
  230. NumBytes: Integer);
  231. procedure XorOperation(Other: TBitArray);
  232. end;
  233. TCharacterSetECI = class
  234. end;
  235. TVersion = class
  236. private
  237. VersionNumber: Integer;
  238. AlignmentPatternCenters: array of Integer;
  239. ECBlocks: array of TECBlocks;
  240. TotalCodewords: Integer;
  241. ECCodewords: Integer;
  242. public
  243. constructor Create(VersionNumber: Integer; AlignmentPatternCenters: array of Integer; ECBlocks1, ECBlocks2, ECBlocks3, ECBlocks4: TECBlocks);
  244. destructor Destroy; override;
  245. class function GetVersionForNumber(VersionNum: Integer): TVersion;
  246. class function ChooseVersion(NumInputBits: Integer; ecLevel: TErrorCorrectionLevel): TVersion;
  247. function GetTotalCodewords: Integer;
  248. function GetECBlocksForLevel(ECLevel: TErrorCorrectionLevel): TECBlocks;
  249. function GetDimensionForVersion: Integer;
  250. end;
  251. TMaskUtil = class
  252. public
  253. function GetDataMaskBit(MaskPattern, X, Y: Integer): Boolean;
  254. end;
  255. TQRCode = class
  256. private
  257. FMode: TMode;
  258. FECLevel: TErrorCorrectionLevel;
  259. FVersion: Integer;
  260. FMatrixWidth: Integer;
  261. FMaskPattern: Integer;
  262. FNumTotalBytes: Integer;
  263. FNumDataBytes: Integer;
  264. FNumECBytes: Integer;
  265. FNumRSBlocks: Integer;
  266. FMatrix: TByteMatrix;
  267. FQRCodeError: Boolean;
  268. public
  269. constructor Create;
  270. destructor Destroy; override;
  271. function At(X, Y: Integer): Integer;
  272. function IsValid: Boolean;
  273. function IsValidMaskPattern(MaskPattern: Integer): Boolean;
  274. procedure SetMatrix(NewMatrix: TByteMatrix);
  275. procedure SetECLevel(NewECLevel: TErrorCorrectionLevel);
  276. procedure SetAll(VersionNum, NumBytes, NumDataBytes, NumRSBlocks, NumECBytes, MatrixWidth: Integer);
  277. property QRCodeError: Boolean read FQRCodeError;
  278. property Mode: TMode read FMode write FMode;
  279. property Version: Integer read FVersion write FVersion;
  280. property NumDataBytes: Integer read FNumDataBytes;
  281. property NumTotalBytes: Integer read FNumTotalBytes;
  282. property NumRSBlocks: Integer read FNumRSBlocks;
  283. property MatrixWidth: Integer read FMatrixWidth;
  284. property MaskPattern: Integer read FMaskPattern write FMaskPattern;
  285. property ECLevel: TErrorCorrectionLevel read FECLevel;
  286. end;
  287. TMatrixUtil = class
  288. private
  289. FMatrixUtilError: Boolean;
  290. procedure ClearMatrix(Matrix: TByteMatrix);
  291. procedure EmbedBasicPatterns(Version: Integer; Matrix: TByteMatrix);
  292. procedure EmbedTypeInfo(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Matrix: TByteMatrix);
  293. procedure MaybeEmbedVersionInfo(Version: Integer; Matrix: TByteMatrix);
  294. procedure EmbedDataBits(DataBits: TBitArray; MaskPattern: Integer; Matrix: TByteMatrix);
  295. function FindMSBSet(Value: Integer): Integer;
  296. function CalculateBCHCode(Value, Poly: Integer): Integer;
  297. procedure MakeTypeInfoBits(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Bits: TBitArray);
  298. procedure MakeVersionInfoBits(Version: Integer; Bits: TBitArray);
  299. function IsEmpty(Value: Integer): Boolean;
  300. procedure EmbedTimingPatterns(Matrix: TByteMatrix);
  301. procedure EmbedDarkDotAtLeftBottomCorner(Matrix: TByteMatrix);
  302. procedure EmbedHorizontalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
  303. procedure EmbedVerticalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
  304. procedure EmbedPositionAdjustmentPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
  305. procedure EmbedPositionDetectionPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
  306. procedure EmbedPositionDetectionPatternsAndSeparators(Matrix: TByteMatrix);
  307. procedure MaybeEmbedPositionAdjustmentPatterns(Version: Integer; Matrix: TByteMatrix);
  308. public
  309. constructor Create;
  310. property MatrixUtilError: Boolean read FMatrixUtilError;
  311. procedure BuildMatrix(DataBits: TBitArray; ECLevel: TErrorCorrectionLevel; Version, MaskPattern: Integer; Matrix: TByteMatrix);
  312. end;
  313. function GetModeBits(Mode: TMode): Integer;
  314. begin
  315. Result := ModeBits[Mode];
  316. end;
  317. function GetModeCharacterCountBits(Mode: TMode; Version: TVersion): Integer;
  318. var
  319. Number: Integer;
  320. Offset: Integer;
  321. begin
  322. Number := Version.VersionNumber;
  323. if (Number <= 9) then
  324. begin
  325. Offset := 0;
  326. end else
  327. if (number <= 26) then
  328. begin
  329. Offset := 1;
  330. end else
  331. begin
  332. Offset := 2;
  333. end;
  334. Result := ModeCharacterCountBits[Mode][Offset];
  335. end;
  336. type
  337. TBlockPair = class
  338. private
  339. FDataBytes: TByteArray;
  340. FErrorCorrectionBytes: TByteArray;
  341. public
  342. constructor Create(BA1, BA2: TByteArray);
  343. function GetDataBytes: TByteArray;
  344. function GetErrorCorrectionBytes: TByteArray;
  345. end;
  346. TGenericGFPoly = class;
  347. TGenericGF = class
  348. private
  349. FExpTable: TIntegerArray;
  350. FLogTable: TIntegerArray;
  351. FZero: TGenericGFPoly;
  352. FOne: TGenericGFPoly;
  353. FSize: Integer;
  354. FPrimitive: Integer;
  355. FGeneratorBase: Integer;
  356. FInitialized: Boolean;
  357. FPolyList: array of TGenericGFPoly;
  358. procedure CheckInit;
  359. procedure Initialize;
  360. public
  361. class function CreateQRCodeField256: TGenericGF;
  362. class function AddOrSubtract(A, B: Integer): Integer;
  363. constructor Create(Primitive, Size, B: Integer);
  364. destructor Destroy; override;
  365. function GetZero: TGenericGFPoly;
  366. function Exp(A: Integer): Integer;
  367. function GetGeneratorBase: Integer;
  368. function Inverse(A: Integer): Integer;
  369. function Multiply(A, B: Integer): Integer;
  370. function BuildMonomial(Degree, Coefficient: Integer): TGenericGFPoly;
  371. end;
  372. TGenericGFPolyArray = array of TGenericGFPoly;
  373. TGenericGFPoly = class
  374. private
  375. FField: TGenericGF;
  376. FCoefficients: TIntegerArray;
  377. public
  378. constructor Create(AField: TGenericGF; ACoefficients: TIntegerArray);
  379. destructor Destroy; override;
  380. function Coefficients: TIntegerArray;
  381. function Multiply(Other: TGenericGFPoly): TGenericGFPoly;
  382. function MultiplyByMonomial(Degree, Coefficient: Integer): TGenericGFPoly;
  383. function Divide(Other: TGenericGFPoly): TGenericGFPolyArray;
  384. function GetCoefficients: TIntegerArray;
  385. function IsZero: Boolean;
  386. function GetCoefficient(Degree: Integer): Integer;
  387. function GetDegree: Integer;
  388. function AddOrSubtract(Other: TGenericGFPoly): TGenericGFPoly;
  389. end;
  390. TReedSolomonEncoder = class
  391. private
  392. FField: TGenericGF;
  393. FCachedGenerators: TObjectList;
  394. public
  395. constructor Create(AField: TGenericGF);
  396. destructor Destroy; override;
  397. procedure Encode(ToEncode: TIntegerArray; ECBytes: Integer);
  398. function BuildGenerator(Degree: Integer): TGenericGFPoly;
  399. end;
  400. TEncoder = class
  401. private
  402. FEncoderError: Boolean;
  403. function ApplyMaskPenaltyRule1Internal(Matrix: TByteMatrix;
  404. IsHorizontal: Boolean): Integer;
  405. function ChooseMode(const Content: WideString; var EncodeOptions: Integer): TMode; overload;
  406. function FilterContent(const Content: WideString; Mode: TMode; EncodeOptions: Integer): WideString;
  407. procedure Append8BitBytes(const Content: WideString; Bits: TBitArray; EncodeOptions: Integer);
  408. procedure AppendAlphanumericBytes(const Content: WideString;
  409. Bits: TBitArray);
  410. procedure AppendBytes(const Content: WideString; Mode: TMode;
  411. Bits: TBitArray; EncodeOptions: Integer);
  412. procedure AppendKanjiBytes(const Content: WideString; Bits: TBitArray);
  413. procedure AppendLengthInfo(NumLetters, VersionNum: Integer; Mode: TMode;
  414. Bits: TBitArray);
  415. procedure AppendModeInfo(Mode: TMode; Bits: TBitArray);
  416. procedure AppendNumericBytes(const Content: WideString; Bits: TBitArray);
  417. function ChooseMaskPattern(Bits: TBitArray; ECLevel: TErrorCorrectionLevel;
  418. Version: Integer; Matrix: TByteMatrix): Integer;
  419. function GenerateECBytes(DataBytes: TByteArray;
  420. NumECBytesInBlock: Integer): TByteArray;
  421. function GetAlphanumericCode(Code: Integer): Integer;
  422. procedure GetNumDataBytesAndNumECBytesForBlockID(NumTotalBytes,
  423. NumDataBytes, NumRSBlocks, BlockID: Integer; var NumDataBytesInBlock: TIntegerArray;
  424. var NumECBytesInBlock: TIntegerArray);
  425. procedure InterleaveWithECBytes(Bits: TBitArray; NumTotalBytes,
  426. NumDataBytes, NumRSBlocks: Integer; var Result: TBitArray);
  427. //function IsOnlyDoubleByteKanji(const Content: WideString): Boolean;
  428. procedure TerminateBits(NumDataBytes: Integer; var Bits: TBitArray);
  429. function CalculateMaskPenalty(Matrix: TByteMatrix): Integer;
  430. function ApplyMaskPenaltyRule1(Matrix: TByteMatrix): Integer;
  431. function ApplyMaskPenaltyRule2(Matrix: TByteMatrix): Integer;
  432. function ApplyMaskPenaltyRule3(Matrix: TByteMatrix): Integer;
  433. function ApplyMaskPenaltyRule4(Matrix: TByteMatrix): Integer;
  434. //procedure Encode(const Content: WideString; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode); overload;
  435. procedure Encode(const Content: WideString; EncodeOptions: Integer; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode);
  436. public
  437. constructor Create;
  438. property EncoderError: Boolean read FEncoderError;
  439. end;
  440. function TEncoder.ApplyMaskPenaltyRule1(Matrix: TByteMatrix): Integer;
  441. begin
  442. Result := ApplyMaskPenaltyRule1Internal(Matrix, True) +
  443. ApplyMaskPenaltyRule1Internal(Matrix, False);
  444. end;
  445. // Apply mask penalty rule 2 and return the penalty. Find 2x2 blocks with the same color and give
  446. // penalty to them.
  447. function TEncoder.ApplyMaskPenaltyRule2(Matrix: TByteMatrix): Integer;
  448. var
  449. Penalty: Integer;
  450. TheArray: T2DByteArray;
  451. Width: Integer;
  452. Height: Integer;
  453. X: Integer;
  454. Y: Integer;
  455. Value: Integer;
  456. begin
  457. Penalty := 0;
  458. TheArray := Matrix.GetArray;
  459. Width := Matrix.Width;
  460. Height := Matrix.Height;
  461. for Y := 0 to Height - 2 do
  462. begin
  463. for X := 0 to Width - 2 do
  464. begin
  465. Value := TheArray[Y][X];
  466. if ((Value = TheArray[Y][X + 1]) and (Value = TheArray[Y + 1][X]) and
  467. (Value = TheArray[Y + 1][X + 1])) then
  468. begin
  469. Inc(Penalty, 3);
  470. end;
  471. end;
  472. end;
  473. Result := Penalty;
  474. end;
  475. // Apply mask penalty rule 3 and return the penalty. Find consecutive cells of 00001011101 or
  476. // 10111010000, and give penalty to them. If we find patterns like 000010111010000, we give
  477. // penalties twice (i.e. 40 * 2).
  478. function TEncoder.ApplyMaskPenaltyRule3(Matrix: TByteMatrix): Integer;
  479. var
  480. Penalty: Integer;
  481. TheArray: T2DByteArray;
  482. Width: Integer;
  483. Height: Integer;
  484. X: Integer;
  485. Y: Integer;
  486. begin
  487. Penalty := 0;
  488. TheArray := Matrix.GetArray;
  489. Width := Matrix.Width;
  490. Height := Matrix.Height;
  491. for Y := 0 to Height - 1 do
  492. begin
  493. for X := 0 to Width - 1 do
  494. begin
  495. if ((X + 6 < Width) and
  496. (TheArray[Y][X] = 1) and
  497. (TheArray[Y][X + 1] = 0) and
  498. (TheArray[Y][X + 2] = 1) and
  499. (TheArray[Y][X + 3] = 1) and
  500. (TheArray[Y][X + 4] = 1) and
  501. (TheArray[Y][X + 5] = 0) and
  502. (TheArray[Y][X + 6] = 1) and
  503. (((X + 10 < Width) and
  504. (TheArray[Y][X + 7] = 0) and
  505. (TheArray[Y][X + 8] = 0) and
  506. (TheArray[Y][X + 9] = 0) and
  507. (TheArray[Y][X + 10] = 0)) or
  508. ((x - 4 >= 0) and
  509. (TheArray[Y][X - 1] = 0) and
  510. (TheArray[Y][X - 2] = 0) and
  511. (TheArray[Y][X - 3] = 0) and
  512. (TheArray[Y][X - 4] = 0)))) then
  513. begin
  514. Inc(Penalty, 40);
  515. end;
  516. if ((Y + 6 < Height) and
  517. (TheArray[Y][X] = 1) and
  518. (TheArray[Y + 1][X] = 0) and
  519. (TheArray[Y + 2][X] = 1) and
  520. (TheArray[Y + 3][X] = 1) and
  521. (TheArray[Y + 4][X] = 1) and
  522. (TheArray[Y + 5][X] = 0) and
  523. (TheArray[Y + 6][X] = 1) and
  524. (((Y + 10 < Height) and
  525. (TheArray[Y + 7][X] = 0) and
  526. (TheArray[Y + 8][X] = 0) and
  527. (TheArray[Y + 9][X] = 0) and
  528. (TheArray[Y + 10][X] = 0)) or
  529. ((Y - 4 >= 0) and
  530. (TheArray[Y - 1][X] = 0) and
  531. (TheArray[Y - 2][X] = 0) and
  532. (TheArray[Y - 3][X] = 0) and
  533. (TheArray[Y - 4][X] = 0)))) then
  534. begin
  535. Inc(Penalty, 40);
  536. end;
  537. end;
  538. end;
  539. Result := Penalty;
  540. end;
  541. // Apply mask penalty rule 4 and return the penalty. Calculate the ratio of dark cells and give
  542. // penalty if the ratio is far from 50%. It gives 10 penalty for 5% distance. Examples:
  543. // - 0% => 100
  544. // - 40% => 20
  545. // - 45% => 10
  546. // - 50% => 0
  547. // - 55% => 10
  548. // - 55% => 20
  549. // - 100% => 100
  550. function TEncoder.ApplyMaskPenaltyRule4(Matrix: TByteMatrix): Integer;
  551. var
  552. NumDarkCells: Integer;
  553. TheArray: T2DByteArray;
  554. Width: Integer;
  555. Height: Integer;
  556. NumTotalCells: Integer;
  557. DarkRatio: Double;
  558. X: Integer;
  559. Y: Integer;
  560. begin
  561. NumDarkCells := 0;
  562. TheArray := Matrix.GetArray;
  563. Width := Matrix.Width;
  564. Height := matrix.Height;
  565. for Y := 0 to Height - 1 do
  566. begin
  567. for X := 0 to Width - 1 do
  568. begin
  569. if (TheArray[Y][X] = 1) then
  570. begin
  571. Inc(NumDarkCells);
  572. end;
  573. end;
  574. end;
  575. numTotalCells := matrix.Height * Matrix.Width;
  576. DarkRatio := NumDarkCells / NumTotalCells;
  577. Result := Round(Abs((DarkRatio * 100 - 50)) / 50);
  578. end;
  579. // Helper function for applyMaskPenaltyRule1. We need this for doing this calculation in both
  580. // vertical and horizontal orders respectively.
  581. function TEncoder.ApplyMaskPenaltyRule1Internal(Matrix: TByteMatrix; IsHorizontal: Boolean): Integer;
  582. var
  583. Penalty: Integer;
  584. NumSameBitCells: Integer;
  585. PrevBit: Integer;
  586. TheArray: T2DByteArray;
  587. I: Integer;
  588. J: Integer;
  589. Bit: Integer;
  590. ILimit: Integer;
  591. JLimit: Integer;
  592. begin
  593. Penalty := 0;
  594. NumSameBitCells := 0;
  595. PrevBit := -1;
  596. // Horizontal mode:
  597. // for (int i = 0; i < matrix.height(); ++i) {
  598. // for (int j = 0; j < matrix.width(); ++j) {
  599. // int bit = matrix.get(i, j);
  600. // Vertical mode:
  601. // for (int i = 0; i < matrix.width(); ++i) {
  602. // for (int j = 0; j < matrix.height(); ++j) {
  603. // int bit = matrix.get(j, i);
  604. if (IsHorizontal) then
  605. begin
  606. ILimit := Matrix.Height;
  607. JLimit := Matrix.Width;
  608. end else
  609. begin
  610. ILimit := Matrix.Width;
  611. JLimit := Matrix.Height;
  612. end;
  613. TheArray := Matrix.GetArray;
  614. for I := 0 to ILimit - 1 do
  615. begin
  616. for J := 0 to JLimit - 1 do
  617. begin
  618. if (IsHorizontal) then
  619. begin
  620. Bit := TheArray[I][J];
  621. end else
  622. begin
  623. Bit := TheArray[J][I];
  624. end;
  625. if (Bit = PrevBit) then
  626. begin
  627. Inc(NumSameBitCells);
  628. // Found five repetitive cells with the same color (bit).
  629. // We'll give penalty of 3.
  630. if (NumSameBitCells = 5) then
  631. begin
  632. Inc(Penalty, 3);
  633. end else if (NumSameBitCells > 5) then
  634. begin
  635. // After five repetitive cells, we'll add the penalty one
  636. // by one.
  637. Inc(Penalty, 1);;
  638. end;
  639. end else
  640. begin
  641. NumSameBitCells := 1; // Include the cell itself.
  642. PrevBit := bit;
  643. end;
  644. end;
  645. NumSameBitCells := 0; // Clear at each row/column.
  646. end;
  647. Result := Penalty;
  648. end;
  649. { TQRCode }
  650. constructor TQRCode.Create;
  651. begin
  652. FMode := qmTerminator;
  653. FQRCodeError := False;
  654. FECLevel := nil;
  655. FVersion := -1;
  656. FMatrixWidth := -1;
  657. FMaskPattern := -1;
  658. FNumTotalBytes := -1;
  659. FNumDataBytes := -1;
  660. FNumECBytes := -1;
  661. FNumRSBlocks := -1;
  662. FMatrix := nil;
  663. end;
  664. destructor TQRCode.Destroy;
  665. begin
  666. if (Assigned(FECLevel)) then
  667. begin
  668. FECLevel.Free;
  669. end;
  670. if (Assigned(FMatrix)) then
  671. begin
  672. FMatrix.Free;
  673. end;
  674. inherited;
  675. end;
  676. function TQRCode.At(X, Y: Integer): Integer;
  677. var
  678. Value: Integer;
  679. begin
  680. // The value must be zero or one.
  681. Value := FMatrix.Get(X, Y);
  682. if (not ((Value = 0) or (Value = 1))) then
  683. begin
  684. FQRCodeError := True;
  685. end;
  686. Result := Value;
  687. end;
  688. function TQRCode.IsValid: Boolean;
  689. begin
  690. Result :=
  691. // First check if all version are not uninitialized.
  692. ((FECLevel <> nil) and
  693. (FVersion <> -1) and
  694. (FMatrixWidth <> -1) and
  695. (FMaskPattern <> -1) and
  696. (FNumTotalBytes <> -1) and
  697. (FNumDataBytes <> -1) and
  698. (FNumECBytes <> -1) and
  699. (FNumRSBlocks <> -1) and
  700. // Then check them in other ways..
  701. IsValidMaskPattern(FMaskPattern) and
  702. (FNumTotalBytes = FNumDataBytes + FNumECBytes) and
  703. // ByteMatrix stuff.
  704. (Assigned(FMatrix)) and
  705. (FMatrixWidth = FMatrix.Width) and
  706. // See 7.3.1 of JISX0510:2004 (Fp.5).
  707. (FMatrix.Width = FMatrix.Height)); // Must be square.
  708. end;
  709. function TQRCode.IsValidMaskPattern(MaskPattern: Integer): Boolean;
  710. begin
  711. Result := (MaskPattern >= 0) and (MaskPattern < NUM_MASK_PATTERNS);
  712. end;
  713. procedure TQRCode.SetMatrix(NewMatrix: TByteMatrix);
  714. begin
  715. if (Assigned(FMatrix)) then
  716. begin
  717. FMatrix.Free;
  718. FMatrix := nil;
  719. end;
  720. FMatrix := NewMatrix;
  721. end;
  722. procedure TQRCode.SetAll(VersionNum, NumBytes, NumDataBytes, NumRSBlocks,
  723. NumECBytes, MatrixWidth: Integer);
  724. begin
  725. FVersion := VersionNum;
  726. FNumTotalBytes := NumBytes;
  727. FNumDataBytes := NumDataBytes;
  728. FNumRSBlocks := NumRSBlocks;
  729. FNumECBytes := NumECBytes;
  730. FMatrixWidth := MatrixWidth;
  731. end;
  732. procedure TQRCode.SetECLevel(NewECLevel: TErrorCorrectionLevel);
  733. begin
  734. if (Assigned(FECLevel)) then
  735. begin
  736. FECLevel.Free;
  737. end;
  738. FECLevel := TErrorCorrectionLevel.Create;
  739. FECLevel.Assign(NewECLevel);
  740. end;
  741. { TByteMatrix }
  742. procedure TByteMatrix.Clear(Value: Byte);
  743. var
  744. X, Y: Integer;
  745. begin
  746. for Y := 0 to FHeight - 1 do
  747. begin
  748. for X := 0 to FWidth - 1 do
  749. begin
  750. Bytes[Y][X] := Value;
  751. end;
  752. end;
  753. end;
  754. constructor TByteMatrix.Create(Width, Height: Integer);
  755. var
  756. Y: Integer;
  757. X: Integer;
  758. begin
  759. FWidth := Width;
  760. FHeight := Height;
  761. SetLength(Bytes, Height);
  762. for Y := 0 to Height - 1 do
  763. begin
  764. SetLength(Bytes[Y], Width);
  765. for X := 0 to Width - 1 do
  766. begin
  767. Bytes[Y][X] := 0;
  768. end;
  769. end;
  770. end;
  771. function TByteMatrix.Get(X, Y: Integer): Integer;
  772. begin
  773. if (Bytes[Y][X] = 255) then Result := -1 else Result := Bytes[Y][X];
  774. end;
  775. function TByteMatrix.GetArray: T2DByteArray;
  776. begin
  777. Result := Bytes;
  778. end;
  779. function TByteMatrix.Hash: AnsiString;
  780. var
  781. X, Y: Integer;
  782. Counter: Integer;
  783. CC: Integer;
  784. begin
  785. Result := '';
  786. for Y := 0 to FHeight - 1 do
  787. begin
  788. Counter := 0;
  789. for X := 0 to FWidth - 1 do
  790. begin
  791. CC := Get(X, Y);
  792. if (CC = -1) then CC := 255;
  793. Counter := Counter + CC;
  794. end;
  795. Result := Result + AnsiChar((Counter mod 26) + 65);
  796. end;
  797. end;
  798. procedure TByteMatrix.SetBoolean(X, Y: Integer; Value: Boolean);
  799. begin
  800. Bytes[Y][X] := Byte(Value) and $FF;
  801. end;
  802. procedure TByteMatrix.SetInteger(X, Y, Value: Integer);
  803. begin
  804. Bytes[Y][X] := Value and $FF;
  805. end;
  806. procedure TByteMatrix.Assign(Source: TByteMatrix);
  807. var
  808. SourceLength: Integer;
  809. begin
  810. SourceLength := Length(Source.Bytes);
  811. SetLength(Bytes, SourceLength);
  812. if (SourceLength > 0) then
  813. begin
  814. Move(Source.Bytes[0], Bytes[0], SourceLength);
  815. end;
  816. FWidth := Source.Width;
  817. FHeight := Source.Height;
  818. end;
  819. { TEncoder }
  820. function TEncoder.CalculateMaskPenalty(Matrix: TByteMatrix): Integer;
  821. var
  822. Penalty: Integer;
  823. begin
  824. Penalty := 0;
  825. Inc(Penalty, ApplyMaskPenaltyRule1(Matrix));
  826. Inc(Penalty, ApplyMaskPenaltyRule2(Matrix));
  827. Inc(Penalty, ApplyMaskPenaltyRule3(Matrix));
  828. Inc(Penalty, ApplyMaskPenaltyRule4(Matrix));
  829. Result := Penalty;
  830. end;
  831. {procedure TEncoder.Encode(const Content: WideString; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode);
  832. begin
  833. Encode(Content, ECLevel, nil, QRCode);
  834. end;}
  835. procedure TEncoder.Encode(const Content: WideString; EncodeOptions: Integer; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode);
  836. var
  837. Mode: TMode;
  838. DataBits: TBitArray;
  839. FinalBits: TBitArray;
  840. HeaderBits: TBitArray;
  841. HeaderAndDataBits: TBitArray;
  842. Matrix: TByteMatrix;
  843. NumLetters: Integer;
  844. MatrixUtil: TMatrixUtil;
  845. BitsNeeded: Integer;
  846. ProvisionalBitsNeeded: Integer;
  847. ProvisionalVersion: TVersion;
  848. Version: TVersion;
  849. ECBlocks: TECBlocks;
  850. NumDataBytes: Integer;
  851. Dimension: Integer;
  852. FilteredContent: WideString;
  853. begin
  854. DataBits := TBitArray.Create;
  855. HeaderBits := TBitArray.Create;
  856. // Pick an encoding mode appropriate for the content. Note that this will not attempt to use
  857. // multiple modes / segments even if that were more efficient. Twould be nice.
  858. // Collect data within the main segment, separately, to count its size if needed. Don't add it to
  859. // main payload yet.
  860. Mode := ChooseMode(Content, EncodeOptions);
  861. FilteredContent := FilterContent(Content, Mode, EncodeOptions);
  862. AppendBytes(FilteredContent, Mode, DataBits, EncodeOptions);
  863. // (With ECI in place,) Write the mode marker
  864. AppendModeInfo(Mode, HeaderBits);
  865. // Hard part: need to know version to know how many bits length takes. But need to know how many
  866. // bits it takes to know version. First we take a guess at version by assuming version will be
  867. // the minimum, 1:
  868. ProvisionalVersion := TVersion.GetVersionForNumber(1);
  869. try
  870. ProvisionalBitsNeeded := HeaderBits.GetSize +
  871. GetModeCharacterCountBits(Mode, ProvisionalVersion) +
  872. DataBits.GetSize;
  873. finally
  874. ProvisionalVersion.Free;
  875. end;
  876. ProvisionalVersion := TVersion.ChooseVersion(ProvisionalBitsNeeded, ECLevel);
  877. try
  878. // Use that guess to calculate the right version. I am still not sure this works in 100% of cases.
  879. BitsNeeded := HeaderBits.GetSize +
  880. GetModeCharacterCountBits(Mode, ProvisionalVersion) +
  881. DataBits.GetSize;
  882. Version := TVersion.ChooseVersion(BitsNeeded, ECLevel);
  883. finally
  884. ProvisionalVersion.Free;
  885. end;
  886. HeaderAndDataBits := TBitArray.Create;
  887. FinalBits := TBitArray.Create;
  888. try
  889. HeaderAndDataBits.AppendBitArray(HeaderBits);
  890. // Find "length" of main segment and write it
  891. if (Mode = qmByte) then
  892. begin
  893. NumLetters := DataBits.GetSizeInBytes;
  894. end else
  895. begin
  896. NumLetters := Length(FilteredContent);
  897. end;
  898. AppendLengthInfo(NumLetters, Version.VersionNumber, Mode, HeaderAndDataBits);
  899. // Put data together into the overall payload
  900. HeaderAndDataBits.AppendBitArray(DataBits);
  901. ECBlocks := Version.GetECBlocksForLevel(ECLevel);
  902. NumDataBytes := Version.GetTotalCodewords - ECBlocks.GetTotalECCodewords;
  903. // Terminate the bits properly.
  904. TerminateBits(NumDataBytes, HeaderAndDataBits);
  905. // Interleave data bits with error correction code.
  906. InterleaveWithECBytes(HeaderAndDataBits, Version.GetTotalCodewords,
  907. NumDataBytes, ECBlocks.GetNumBlocks, FinalBits);
  908. // QRCode qrCode = new QRCode(); // This is passed in
  909. QRCode.SetECLevel(ECLevel);
  910. QRCode.Mode := Mode;
  911. QRCode.Version := Version.VersionNumber;
  912. // Choose the mask pattern and set to "qrCode".
  913. Dimension := Version.GetDimensionForVersion;
  914. Matrix := TByteMatrix.Create(Dimension, Dimension);
  915. QRCode.MaskPattern := ChooseMaskPattern(FinalBits, ECLevel, Version.VersionNumber, Matrix);
  916. Matrix.Free;
  917. Matrix := TByteMatrix.Create(Dimension, Dimension);
  918. // Build the matrix and set it to "qrCode".
  919. MatrixUtil := TMatrixUtil.Create;
  920. try
  921. MatrixUtil.BuildMatrix(FinalBits, QRCode.ECLevel, QRCode.Version,
  922. QRCode.MaskPattern, Matrix);
  923. finally
  924. MatrixUtil.Free;
  925. end;
  926. QRCode.SetMatrix(Matrix); // QRCode will free the matrix
  927. finally
  928. DataBits.Free;
  929. HeaderAndDataBits.Free;
  930. FinalBits.Free;
  931. HeaderBits.Free;
  932. Version.Free;
  933. end;
  934. end;
  935. function TEncoder.FilterContent(const Content: WideString; Mode: TMode;
  936. EncodeOptions: Integer): WideString;
  937. var
  938. X: Integer;
  939. CanAdd: Boolean;
  940. begin
  941. Result := '';
  942. for X := 1 to Length(Content) do
  943. begin
  944. CanAdd := False;
  945. if (Mode = qmNumeric) then
  946. begin
  947. CanAdd := (Content[X] >= '0') and (Content[X] <= '9');
  948. end else
  949. if (Mode = qmAlphanumeric) then
  950. begin
  951. CanAdd := GetAlphanumericCode(Ord(Content[X])) > 0;
  952. end else
  953. if (Mode = qmByte) then
  954. begin
  955. if (EncodeOptions = 3) then
  956. begin
  957. CanAdd := Ord(Content[X]) <= $FF;
  958. end else
  959. if ((EncodeOptions = 4) or (EncodeOptions = 5)) then
  960. begin
  961. CanAdd := True;
  962. end;
  963. end;
  964. if (CanAdd) then
  965. begin
  966. Result := Result + Content[X];
  967. end;
  968. end;
  969. end;
  970. // Return the code point of the table used in alphanumeric mode or
  971. // -1 if there is no corresponding code in the table.
  972. function TEncoder.GetAlphanumericCode(Code: Integer): Integer;
  973. begin
  974. if (Code < Length(ALPHANUMERIC_TABLE)) then
  975. begin
  976. Result := ALPHANUMERIC_TABLE[Code];
  977. end else
  978. begin
  979. Result := -1;
  980. end;
  981. end;
  982. // Choose the mode based on the content
  983. function TEncoder.ChooseMode(const Content: WideString; var EncodeOptions: Integer): TMode;
  984. var
  985. AllNumeric: Boolean;
  986. AllAlphanumeric: Boolean;
  987. AllISO: Boolean;
  988. I: Integer;
  989. C: WideChar;
  990. begin
  991. if (EncodeOptions = 0) then
  992. begin
  993. AllNumeric := Length(Content) > 0;
  994. I := 1;
  995. while (I <= Length(Content)) and (AllNumeric) do
  996. begin
  997. C := Content[I];
  998. if ((C < '0') or (C > '9')) then
  999. begin
  1000. AllNumeric := False;
  1001. end else
  1002. begin
  1003. Inc(I);
  1004. end;
  1005. end;
  1006. if (not AllNumeric) then
  1007. begin
  1008. AllAlphanumeric := Length(Content) > 0;
  1009. I := 1;
  1010. while (I <= Length(Content)) and (AllAlphanumeric) do
  1011. begin
  1012. C := Content[I];
  1013. if (GetAlphanumericCode(Ord(C)) < 0) then
  1014. begin
  1015. AllAlphanumeric := False;
  1016. end else
  1017. begin
  1018. Inc(I);
  1019. end;
  1020. end;
  1021. end else
  1022. begin
  1023. AllAlphanumeric := False;
  1024. end;
  1025. if (not AllAlphanumeric) then
  1026. begin
  1027. AllISO := Length(Content) > 0;
  1028. I := 1;
  1029. while (I <= Length(Content)) and (AllISO) do
  1030. begin
  1031. C := Content[I];
  1032. if (Ord(C) > $FF) then
  1033. begin
  1034. AllISO := False;
  1035. end else
  1036. begin
  1037. Inc(I);
  1038. end;
  1039. end;
  1040. end else
  1041. begin
  1042. AllISO := False;
  1043. end;
  1044. if (AllNumeric) then
  1045. begin
  1046. Result := qmNumeric;
  1047. end else
  1048. if (AllAlphanumeric) then
  1049. begin
  1050. Result := qmAlphanumeric;
  1051. end else
  1052. if (AllISO) then
  1053. begin
  1054. Result := qmByte;
  1055. EncodeOptions := 3;
  1056. end else
  1057. begin
  1058. Result := qmByte;
  1059. EncodeOptions := 4;
  1060. end;
  1061. end else
  1062. if (EncodeOptions = 1) then
  1063. begin
  1064. Result := qmNumeric;
  1065. end else
  1066. if (EncodeOptions = 2) then
  1067. begin
  1068. Result := qmAlphanumeric;
  1069. end else
  1070. begin
  1071. Result := qmByte;
  1072. end;
  1073. end;
  1074. constructor TEncoder.Create;
  1075. begin
  1076. FEncoderError := False;
  1077. end;
  1078. {function TEncoder.IsOnlyDoubleByteKanji(const Content: WideString): Boolean;
  1079. var
  1080. I: Integer;
  1081. Char1: Integer;
  1082. begin
  1083. Result := True;
  1084. I := 0;
  1085. while ((I < Length(Content)) and Result) do
  1086. begin
  1087. Char1 := Ord(Content[I + 1]);
  1088. if (((Char1 < $81) or (Char1 > $9F)) and ((Char1 < $E0) or (Char1 > $EB))) then
  1089. begin
  1090. Result := False;
  1091. end;
  1092. end;
  1093. end;}
  1094. function TEncoder.ChooseMaskPattern(Bits: TBitArray; ECLevel: TErrorCorrectionLevel; Version: Integer; Matrix: TByteMatrix): Integer;
  1095. var
  1096. MinPenalty: Integer;
  1097. BestMaskPattern: Integer;
  1098. MaskPattern: Integer;
  1099. MatrixUtil: TMatrixUtil;
  1100. Penalty: Integer;
  1101. begin
  1102. MinPenalty := MaxInt;
  1103. BestMaskPattern := -1;
  1104. // We try all mask patterns to choose the best one.
  1105. for MaskPattern := 0 to NUM_MASK_PATTERNS - 1 do
  1106. begin
  1107. MatrixUtil := TMatrixUtil.Create;
  1108. try
  1109. MatrixUtil.BuildMatrix(Bits, ECLevel, Version, MaskPattern, Matrix);
  1110. finally
  1111. MatrixUtil.Free;
  1112. end;
  1113. Penalty := CalculateMaskPenalty(Matrix);
  1114. if (Penalty < MinPenalty) then
  1115. begin
  1116. MinPenalty := Penalty;
  1117. BestMaskPattern := MaskPattern;
  1118. end;
  1119. end;
  1120. Result := BestMaskPattern;
  1121. end;
  1122. // Terminate bits as described in 8.4.8 and 8.4.9 of JISX0510:2004 (p.24).
  1123. procedure TEncoder.TerminateBits(NumDataBytes: Integer; var Bits: TBitArray);
  1124. var
  1125. Capacity: Integer;
  1126. I: Integer;
  1127. NumBitsInLastByte: Integer;
  1128. NumPaddingBytes: Integer;
  1129. begin
  1130. Capacity := NumDataBytes shl 3;
  1131. if (Bits.GetSize > Capacity) then
  1132. begin
  1133. FEncoderError := True;
  1134. Exit;
  1135. end;
  1136. I := 0;
  1137. while ((I < 4) and (Bits.GetSize < capacity)) do
  1138. begin
  1139. Bits.AppendBit(False);
  1140. Inc(I);
  1141. end;
  1142. // Append termination bits. See 8.4.8 of JISX0510:2004 (p.24) for details.
  1143. // If the last byte isn't 8-bit aligned, we'll add padding bits.
  1144. NumBitsInLastByte := Bits.GetSize and $07;
  1145. if (NumBitsInLastByte > 0) then
  1146. begin
  1147. for I := numBitsInLastByte to 7 do
  1148. begin
  1149. Bits.AppendBit(False);
  1150. end;
  1151. end;
  1152. // If we have more space, we'll fill the space with padding patterns defined in 8.4.9 (p.24).
  1153. NumPaddingBytes := NumDataBytes - Bits.GetSizeInBytes;
  1154. for I := 0 to NumPaddingBytes - 1 do
  1155. begin
  1156. if ((I and $01) = 0) then
  1157. begin
  1158. Bits.AppendBits($EC, 8);
  1159. end else
  1160. begin
  1161. Bits.AppendBits($11, 8);
  1162. end;
  1163. end;
  1164. if (Bits.GetSize <> Capacity) then
  1165. begin
  1166. FEncoderError := True;
  1167. end;
  1168. end;
  1169. // Get number of data bytes and number of error correction bytes for block id "blockID". Store
  1170. // the result in "numDataBytesInBlock", and "numECBytesInBlock". See table 12 in 8.5.1 of
  1171. // JISX0510:2004 (p.30)
  1172. procedure TEncoder.GetNumDataBytesAndNumECBytesForBlockID(NumTotalBytes, NumDataBytes,
  1173. NumRSBlocks, BlockID: Integer; var NumDataBytesInBlock: TIntegerArray;
  1174. var NumECBytesInBlock: TIntegerArray);
  1175. var
  1176. NumRSBlocksInGroup1: Integer;
  1177. NumRSBlocksInGroup2: Integer;
  1178. NumTotalBytesInGroup1: Integer;
  1179. NumTotalBytesInGroup2: Integer;
  1180. NumDataBytesInGroup1: Integer;
  1181. NumDataBytesInGroup2: Integer;
  1182. NumECBytesInGroup1: Integer;
  1183. NumECBytesInGroup2: Integer;
  1184. begin
  1185. if (BlockID >= NumRSBlocks) then
  1186. begin
  1187. FEncoderError := True;
  1188. Exit;
  1189. end;
  1190. // numRsBlocksInGroup2 = 196 % 5 = 1
  1191. NumRSBlocksInGroup2 := NumTotalBytes mod NumRSBlocks;
  1192. // numRsBlocksInGroup1 = 5 - 1 = 4
  1193. NumRSBlocksInGroup1 := NumRSBlocks - NumRSBlocksInGroup2;
  1194. // numTotalBytesInGroup1 = 196 / 5 = 39
  1195. NumTotalBytesInGroup1 := NumTotalBytes div NumRSBlocks;
  1196. // numTotalBytesInGroup2 = 39 + 1 = 40
  1197. NumTotalBytesInGroup2 := NumTotalBytesInGroup1 + 1;
  1198. // numDataBytesInGroup1 = 66 / 5 = 13
  1199. NumDataBytesInGroup1 := NumDataBytes div NumRSBlocks;
  1200. // numDataBytesInGroup2 = 13 + 1 = 14
  1201. NumDataBytesInGroup2 := NumDataBytesInGroup1 + 1;
  1202. // numEcBytesInGroup1 = 39 - 13 = 26
  1203. NumECBytesInGroup1 := NumTotalBytesInGroup1 - NumDataBytesInGroup1;
  1204. // numEcBytesInGroup2 = 40 - 14 = 26
  1205. NumECBytesInGroup2 := NumTotalBytesInGroup2 - NumDataBytesInGroup2;
  1206. // Sanity checks.
  1207. // 26 = 26
  1208. if (NumECBytesInGroup1 <> NumECBytesInGroup2) then
  1209. begin
  1210. FEncoderError := True;
  1211. Exit;
  1212. end;
  1213. // 5 = 4 + 1.
  1214. if (NumRSBlocks <> (NumRSBlocksInGroup1 + NumRSBlocksInGroup2)) then
  1215. begin
  1216. FEncoderError := True;
  1217. Exit;
  1218. end;
  1219. // 196 = (13 + 26) * 4 + (14 + 26) * 1
  1220. if (NumTotalBytes <>
  1221. ((NumDataBytesInGroup1 + NumECBytesInGroup1) * NumRsBlocksInGroup1) +
  1222. ((NumDataBytesInGroup2 + NumECBytesInGroup2) * NumRsBlocksInGroup2)) then
  1223. begin
  1224. FEncoderError := True;
  1225. Exit;
  1226. end;
  1227. if (BlockID < NumRSBlocksInGroup1) then
  1228. begin
  1229. NumDataBytesInBlock[0] := NumDataBytesInGroup1;
  1230. NumECBytesInBlock[0] := numECBytesInGroup1;
  1231. end else
  1232. begin
  1233. NumDataBytesInBlock[0] := NumDataBytesInGroup2;
  1234. NumECBytesInBlock[0] := numEcBytesInGroup2;
  1235. end;
  1236. end;
  1237. // Interleave "bits" with corresponding error correction bytes. On success, store the result in
  1238. // "result". The interleave rule is complicated. See 8.6 of JISX0510:2004 (p.37) for details.
  1239. procedure TEncoder.InterleaveWithECBytes(Bits: TBitArray; NumTotalBytes,
  1240. NumDataBytes, NumRSBlocks: Integer; var Result: TBitArray);
  1241. var
  1242. DataBytesOffset: Integer;
  1243. MaxNumDataBytes: Integer;
  1244. MaxNumECBytes: Integer;
  1245. Blocks: TObjectList;
  1246. NumDataBytesInBlock: TIntegerArray;
  1247. NumECBytesInBlock: TIntegerArray;
  1248. Size: Integer;
  1249. DataBytes: TByteArray;
  1250. ECBytes: TByteArray;
  1251. I, J: Integer;
  1252. BlockPair: TBlockPair;
  1253. begin
  1254. SetLength(ECBytes, 0);
  1255. // "bits" must have "getNumDataBytes" bytes of data.
  1256. if (Bits.GetSizeInBytes <> NumDataBytes) then
  1257. begin
  1258. FEncoderError := True;
  1259. Exit;
  1260. end;
  1261. // Step 1. Divide data bytes into blocks and generate error correction bytes for them. We'll
  1262. // store the divided data bytes blocks and error correction bytes blocks into "blocks".
  1263. DataBytesOffset := 0;
  1264. MaxNumDataBytes := 0;
  1265. MaxNumEcBytes := 0;
  1266. // Since, we know the number of reedsolmon blocks, we can initialize the vector with the number.
  1267. Blocks := TObjectList.Create(True);
  1268. try
  1269. Blocks.Capacity := NumRSBlocks;
  1270. for I := 0 to NumRSBlocks - 1 do
  1271. begin
  1272. SetLength(NumDataBytesInBlock, 1);
  1273. SetLength(NumECBytesInBlock, 1);
  1274. GetNumDataBytesAndNumECBytesForBlockID(
  1275. NumTotalBytes, NumDataBytes, NumRSBlocks, I,
  1276. NumDataBytesInBlock, NumEcBytesInBlock);
  1277. Size := NumDataBytesInBlock[0];
  1278. SetLength(DataBytes, Size);
  1279. Bits.ToBytes(8 * DataBytesOffset, DataBytes, 0, Size);
  1280. ECBytes := GenerateECBytes(DataBytes, NumEcBytesInBlock[0]);
  1281. BlockPair := TBlockPair.Create(DataBytes, ECBytes);
  1282. Blocks.Add(BlockPair);
  1283. MaxNumDataBytes := Max(MaxNumDataBytes, Size);
  1284. MaxNumECBytes := Max(MaxNumECBytes, Length(ECBytes));
  1285. Inc(DataBytesOffset, NumDataBytesInBlock[0]);
  1286. end;
  1287. if (NumDataBytes <> DataBytesOffset) then
  1288. begin
  1289. FEncoderError := True;
  1290. Exit;
  1291. end;
  1292. // First, place data blocks.
  1293. for I := 0 to MaxNumDataBytes - 1 do
  1294. begin
  1295. for J := 0 to Blocks.Count - 1 do
  1296. begin
  1297. DataBytes := TBlockPair(Blocks.Items[J]).GetDataBytes;
  1298. if (I < Length(DataBytes)) then
  1299. begin
  1300. Result.AppendBits(DataBytes[I], 8);
  1301. end;
  1302. end;
  1303. end;
  1304. // Then, place error correction blocks.
  1305. for I := 0 to MaxNumECBytes - 1 do
  1306. begin
  1307. for J := 0 to Blocks.Count - 1 do
  1308. begin
  1309. ECBytes := TBlockPair(Blocks.Items[J]).GetErrorCorrectionBytes;
  1310. if (I < Length(ECBytes)) then
  1311. begin
  1312. Result.AppendBits(ECBytes[I], 8);
  1313. end;
  1314. end;
  1315. end;
  1316. finally
  1317. Blocks.Free;
  1318. end;
  1319. if (numTotalBytes <> Result.GetSizeInBytes) then // Should be same.
  1320. begin
  1321. FEncoderError := True;
  1322. Exit;
  1323. end;
  1324. end;
  1325. function TEncoder.GenerateECBytes(DataBytes: TByteArray; NumECBytesInBlock: Integer): TByteArray;
  1326. var
  1327. NumDataBytes: Integer;
  1328. ToEncode: TIntegerArray;
  1329. ReedSolomonEncoder: TReedSolomonEncoder;
  1330. I: Integer;
  1331. ECBytes: TByteArray;
  1332. GenericGF: TGenericGF;
  1333. begin
  1334. NumDataBytes := Length(DataBytes);
  1335. SetLength(ToEncode, NumDataBytes + NumECBytesInBlock);
  1336. for I := 0 to NumDataBytes - 1 do
  1337. begin
  1338. ToEncode[I] := DataBytes[I] and $FF;
  1339. end;
  1340. GenericGF := TGenericGF.CreateQRCodeField256;
  1341. try
  1342. ReedSolomonEncoder := TReedSolomonEncoder.Create(GenericGF);
  1343. try
  1344. ReedSolomonEncoder.Encode(ToEncode, NumECBytesInBlock);
  1345. finally
  1346. ReedSolomonEncoder.Free;
  1347. end;
  1348. finally
  1349. GenericGF.Free;
  1350. end;
  1351. SetLength(ECBytes, NumECBytesInBlock);
  1352. for I := 0 to NumECBytesInBlock - 1 do
  1353. begin
  1354. ECBytes[I] := ToEncode[NumDataBytes + I];
  1355. end;
  1356. Result := ECBytes;
  1357. end;
  1358. // Append mode info. On success, store the result in "bits".
  1359. procedure TEncoder.AppendModeInfo(Mode: TMode; Bits: TBitArray);
  1360. begin
  1361. Bits.AppendBits(GetModeBits(Mode), 4);
  1362. end;
  1363. // Append length info. On success, store the result in "bits".
  1364. procedure TEncoder.AppendLengthInfo(NumLetters, VersionNum: Integer; Mode: TMode; Bits: TBitArray);
  1365. var
  1366. NumBits: Integer;
  1367. Version: TVersion;
  1368. begin
  1369. Version := TVersion.GetVersionForNumber(VersionNum);
  1370. try
  1371. NumBits := GetModeCharacterCountBits(Mode, Version);
  1372. finally
  1373. Version.Free;
  1374. end;
  1375. if (NumLetters > ((1 shl NumBits) - 1)) then
  1376. begin
  1377. FEncoderError := True;
  1378. Exit;
  1379. end;
  1380. Bits.AppendBits(NumLetters, NumBits);
  1381. end;
  1382. // Append "bytes" in "mode" mode (encoding) into "bits". On success, store the result in "bits".
  1383. procedure TEncoder.AppendBytes(const Content: WideString; Mode: TMode; Bits: TBitArray; EncodeOptions: Integer);
  1384. begin
  1385. if (Mode = qmNumeric) then
  1386. begin
  1387. AppendNumericBytes(Content, Bits);
  1388. end else
  1389. if (Mode = qmAlphanumeric) then
  1390. begin
  1391. AppendAlphanumericBytes(Content, Bits);
  1392. end else
  1393. if (Mode = qmByte) then
  1394. begin
  1395. Append8BitBytes(Content, Bits, EncodeOptions);
  1396. end else
  1397. if (Mode = qmKanji) then
  1398. begin
  1399. AppendKanjiBytes(Content, Bits);
  1400. end else
  1401. begin
  1402. FEncoderError := True;
  1403. Exit;
  1404. end;
  1405. end;
  1406. procedure TEncoder.AppendNumericBytes(const Content: WideString; Bits: TBitArray);
  1407. var
  1408. ContentLength: Integer;
  1409. I: Integer;
  1410. Num1: Integer;
  1411. Num2: Integer;
  1412. Num3: Integer;
  1413. begin
  1414. ContentLength := Length(Content);
  1415. I := 0;
  1416. while (I < ContentLength) do
  1417. begin
  1418. Num1 := Ord(Content[I + 0 + 1]) - Ord('0');
  1419. if (I + 2 < ContentLength) then
  1420. begin
  1421. // Encode three numeric letters in ten bits.
  1422. Num2 := Ord(Content[I + 1 + 1]) - Ord('0');
  1423. Num3 := Ord(Content[I + 2 + 1]) - Ord('0');
  1424. Bits.AppendBits(Num1 * 100 + Num2 * 10 + Num3, 10);
  1425. Inc(I, 3);
  1426. end else
  1427. if (I + 1 < ContentLength) then
  1428. begin
  1429. // Encode two numeric letters in seven bits.
  1430. Num2 := Ord(Content[I + 1 + 1]) - Ord('0');
  1431. Bits.AppendBits(Num1 * 10 + Num2, 7);
  1432. Inc(I, 2);
  1433. end else
  1434. begin
  1435. // Encode one numeric letter in four bits.
  1436. Bits.AppendBits(Num1, 4);
  1437. Inc(I);
  1438. end;
  1439. end;
  1440. end;
  1441. procedure TEncoder.AppendAlphanumericBytes(const Content: WideString; Bits: TBitArray);
  1442. var
  1443. ContentLength: Integer;
  1444. I: Integer;
  1445. Code1: Integer;
  1446. Code2: Integer;
  1447. begin
  1448. ContentLength := Length(Content);
  1449. I := 0;
  1450. while (I < ContentLength) do
  1451. begin
  1452. Code1 := GetAlphanumericCode(Ord(Content[I + 0 + 1]));
  1453. if (Code1 = -1) then
  1454. begin
  1455. FEncoderError := True;
  1456. Exit;
  1457. end;
  1458. if (I + 1 < ContentLength) then
  1459. begin
  1460. Code2 := GetAlphanumericCode(Ord(Content[I + 1 + 1]));
  1461. if (Code2 = -1) then
  1462. begin
  1463. FEncoderError := True;
  1464. Exit;
  1465. end;
  1466. // Encode two alphanumeric letters in 11 bits.
  1467. Bits.AppendBits(Code1 * 45 + Code2, 11);
  1468. Inc(I, 2);
  1469. end else
  1470. begin
  1471. // Encode one alphanumeric letter in six bits.
  1472. Bits.AppendBits(Code1, 6);
  1473. Inc(I);
  1474. end;
  1475. end;
  1476. end;
  1477. procedure TEncoder.Append8BitBytes(const Content: WideString; Bits: TBitArray; EncodeOptions: Integer);
  1478. var
  1479. Bytes: TByteArray;
  1480. I: Integer;
  1481. UTF8Version: AnsiString;
  1482. begin
  1483. SetLength(Bytes, 0);
  1484. if (EncodeOptions = 3) then
  1485. begin
  1486. SetLength(Bytes, Length(Content));
  1487. for I := 1 to Length(Content) do
  1488. begin
  1489. Bytes[I - 1] := Ord(Content[I]) and $FF;
  1490. end;
  1491. end else
  1492. if (EncodeOptions = 4) then
  1493. begin
  1494. // Add the UTF-8 BOM
  1495. UTF8Version := #$EF#$BB#$BF + UTF8Encode(Content);
  1496. SetLength(Bytes, Length(UTF8Version));
  1497. if (Length(UTF8Version) > 0) then
  1498. begin
  1499. Move(UTF8Version[1], Bytes[0], Length(UTF8Version));
  1500. end;
  1501. end else
  1502. if (EncodeOptions = 5) then
  1503. begin
  1504. // No BOM
  1505. UTF8Version := UTF8Encode(Content);
  1506. SetLength(Bytes, Length(UTF8Version));
  1507. if (Length(UTF8Version) > 0) then
  1508. begin
  1509. Move(UTF8Version[1], Bytes[0], Length(UTF8Version));
  1510. end;
  1511. end;
  1512. for I := 0 to Length(Bytes) - 1 do
  1513. begin
  1514. Bits.AppendBits(Bytes[I], 8);
  1515. end;
  1516. end;
  1517. procedure TEncoder.AppendKanjiBytes(const Content: WideString; Bits: TBitArray);
  1518. var
  1519. Bytes: TByteArray;
  1520. ByteLength: Integer;
  1521. I: Integer;
  1522. Byte1: Integer;
  1523. Byte2: Integer;
  1524. Code: Integer;
  1525. Subtracted: Integer;
  1526. Encoded: Integer;
  1527. begin
  1528. SetLength(Bytes, 0);
  1529. try
  1530. except
  1531. FEncoderError := True;
  1532. Exit;
  1533. end;
  1534. ByteLength := Length(Bytes);
  1535. I := 0;
  1536. while (I < ByteLength) do
  1537. begin
  1538. Byte1 := Bytes[I] and $FF;
  1539. Byte2 := Bytes[I + 1] and $FF;
  1540. Code := (Byte1 shl 8) or Byte2;
  1541. Subtracted := -1;
  1542. if ((Code >= $8140) and (Code <= $9ffc)) then
  1543. begin
  1544. Subtracted := Code - $8140;
  1545. end else
  1546. if ((Code >= $e040) and (Code <= $ebbf)) then
  1547. begin
  1548. Subtracted := Code - $c140;
  1549. end;
  1550. if (Subtracted = -1) then
  1551. begin
  1552. FEncoderError := True;
  1553. Exit;
  1554. end;
  1555. Encoded := ((Subtracted shr 8) * $c0) + (Subtracted and $ff);
  1556. Bits.AppendBits(Encoded, 13);
  1557. Inc(I, 2);
  1558. end;
  1559. end;
  1560. procedure TMatrixUtil.ClearMatrix(Matrix: TByteMatrix);
  1561. begin
  1562. Matrix.Clear(Byte(-1));
  1563. end;
  1564. constructor TMatrixUtil.Create;
  1565. begin
  1566. FMatrixUtilError := False;
  1567. end;
  1568. // Build 2D matrix of QR Code from "dataBits" with "ecLevel", "version" and "getMaskPattern". On
  1569. // success, store the result in "matrix" and return true.
  1570. procedure TMatrixUtil.BuildMatrix(DataBits: TBitArray; ECLevel: TErrorCorrectionLevel;
  1571. Version, MaskPattern: Integer; Matrix: TByteMatrix);
  1572. begin
  1573. ClearMatrix(Matrix);
  1574. EmbedBasicPatterns(Version, Matrix);
  1575. // Type information appear with any version.
  1576. EmbedTypeInfo(ECLevel, MaskPattern, Matrix);
  1577. // Version info appear if version >= 7.
  1578. MaybeEmbedVersionInfo(Version, Matrix);
  1579. // Data should be embedded at end.
  1580. EmbedDataBits(DataBits, MaskPattern, Matrix);
  1581. end;
  1582. // Embed basic patterns. On success, modify the matrix and return true.
  1583. // The basic patterns are:
  1584. // - Position detection patterns
  1585. // - Timing patterns
  1586. // - Dark dot at the left bottom corner
  1587. // - Position adjustment patterns, if need be
  1588. procedure TMatrixUtil.EmbedBasicPatterns(Version: Integer; Matrix: TByteMatrix);
  1589. begin
  1590. // Let's get started with embedding big squares at corners.
  1591. EmbedPositionDetectionPatternsAndSeparators(Matrix);
  1592. // Then, embed the dark dot at the left bottom corner.
  1593. EmbedDarkDotAtLeftBottomCorner(Matrix);
  1594. // Position adjustment patterns appear if version >= 2.
  1595. MaybeEmbedPositionAdjustmentPatterns(Version, Matrix);
  1596. // Timing patterns should be embedded after position adj. patterns.
  1597. EmbedTimingPatterns(Matrix);
  1598. end;
  1599. // Embed type information. On success, modify the matrix.
  1600. procedure TMatrixUtil.EmbedTypeInfo(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Matrix: TByteMatrix);
  1601. var
  1602. TypeInfoBits: TBitArray;
  1603. I: Integer;
  1604. Bit: Boolean;
  1605. X1, Y1: Integer;
  1606. X2, Y2: Integer;
  1607. begin
  1608. TypeInfoBits := TBitArray.Create;
  1609. try
  1610. MakeTypeInfoBits(ECLevel, MaskPattern, TypeInfoBits);
  1611. for I := 0 to TypeInfoBits.GetSize - 1 do
  1612. begin
  1613. // Place bits in LSB to MSB order. LSB (least significant bit) is the last value in
  1614. // "typeInfoBits".
  1615. Bit := TypeInfoBits.Get(TypeInfoBits.GetSize - 1 - I);
  1616. // Type info bits at the left top corner. See 8.9 of JISX0510:2004 (p.46).
  1617. X1 := TYPE_INFO_COORDINATES[I][0];
  1618. Y1 := TYPE_INFO_COORDINATES[I][1];
  1619. Matrix.SetBoolean(X1, Y1, Bit);
  1620. if (I < 8) then
  1621. begin
  1622. // Right top corner.
  1623. X2 := Matrix.Width - I - 1;
  1624. Y2 := 8;
  1625. Matrix.SetBoolean(X2, Y2, Bit);
  1626. end else
  1627. begin
  1628. // Left bottom corner.
  1629. X2 := 8;
  1630. Y2 := Matrix.Height - 7 + (I - 8);
  1631. Matrix.SetBoolean(X2, Y2, Bit);
  1632. end;
  1633. end;
  1634. finally
  1635. TypeInfoBits.Free;
  1636. end;
  1637. end;
  1638. // Embed version information if need be. On success, modify the matrix and return true.
  1639. // See 8.10 of JISX0510:2004 (p.47) for how to embed version information.
  1640. procedure TMatrixUtil.MaybeEmbedVersionInfo(Version: Integer; Matrix: TByteMatrix);
  1641. var
  1642. VersionInfoBits: TBitArray;
  1643. I, J: Integer;
  1644. BitIndex: Integer;
  1645. Bit: Boolean;
  1646. begin
  1647. if (Version < 7) then
  1648. begin
  1649. Exit; // Don't need version info.
  1650. end;
  1651. VersionInfoBits := TBitArray.Create;
  1652. try
  1653. MakeVersionInfoBits(Version, VersionInfoBits);
  1654. BitIndex := 6 * 3 - 1; // It will decrease from 17 to 0.
  1655. for I := 0 to 5 do
  1656. begin
  1657. for J := 0 to 2 do
  1658. begin
  1659. // Place bits in LSB (least significant bit) to MSB order.
  1660. Bit := VersionInfoBits.Get(BitIndex);
  1661. Dec(BitIndex);
  1662. // Left bottom corner.
  1663. Matrix.SetBoolean(I, Matrix.Height - 11 + J, Bit);
  1664. // Right bottom corner.
  1665. Matrix.SetBoolean(Matrix.Height - 11 + J, I, bit);
  1666. end;
  1667. end;
  1668. finally
  1669. VersionInfoBits.Free;
  1670. end;
  1671. end;
  1672. // Embed "dataBits" using "getMaskPattern". On success, modify the matrix and return true.
  1673. // For debugging purposes, it skips masking process if "getMaskPattern" is -1.
  1674. // See 8.7 of JISX0510:2004 (p.38) for how to embed data bits.
  1675. procedure TMatrixUtil.EmbedDataBits(DataBits: TBitArray; MaskPattern: Integer; Matrix: TByteMatrix);
  1676. var
  1677. BitIndex: Integer;
  1678. Direction: Integer;
  1679. X, Y, I, XX: Integer;
  1680. Bit: Boolean;
  1681. MaskUtil: TMaskUtil;
  1682. begin
  1683. MaskUtil := TMaskUtil.Create;
  1684. try
  1685. bitIndex := 0;
  1686. direction := -1;
  1687. // Start from the right bottom cell.
  1688. X := Matrix.Width - 1;
  1689. Y := Matrix.Height - 1;
  1690. while (X > 0) do
  1691. begin
  1692. // Skip the vertical timing pattern.
  1693. if (X = 6) then
  1694. begin
  1695. Dec(X, 1);
  1696. end;
  1697. while ((Y >= 0) and (y < Matrix.Height)) do
  1698. begin
  1699. for I := 0 to 1 do
  1700. begin
  1701. XX := X - I;
  1702. // Skip the cell if it's not empty.
  1703. if (not IsEmpty(Matrix.Get(XX, Y))) then
  1704. begin
  1705. Continue;
  1706. end;
  1707. if (BitIndex < DataBits.GetSize) then
  1708. begin
  1709. Bit := DataBits.Get(BitIndex);
  1710. Inc(BitIndex);
  1711. end else
  1712. begin
  1713. // Padding bit. If there is no bit left, we'll fill the left cells with 0, as described
  1714. // in 8.4.9 of JISX0510:2004 (p. 24).
  1715. Bit := False;
  1716. end;
  1717. // Skip masking if mask_pattern is -1.
  1718. if (MaskPattern <> -1) then
  1719. begin
  1720. if (MaskUtil.GetDataMaskBit(MaskPattern, XX, Y)) then
  1721. begin
  1722. Bit := not Bit;
  1723. end;
  1724. end;
  1725. Matrix.SetBoolean(XX, Y, Bit);
  1726. end;
  1727. Inc(Y, Direction);
  1728. end;
  1729. Direction := -Direction; // Reverse the direction.
  1730. Inc(Y, Direction);
  1731. Dec(X, 2); // Move to the left.
  1732. end;
  1733. finally
  1734. MaskUtil.Free;
  1735. end;
  1736. // All bits should be consumed.
  1737. if (BitIndex <> DataBits.GetSize()) then
  1738. begin
  1739. FMatrixUtilError := True;
  1740. Exit;
  1741. end;
  1742. end;
  1743. // Return the position of the most significant bit set (to one) in the "value". The most
  1744. // significant bit is position 32. If there is no bit set, return 0. Examples:
  1745. // - findMSBSet(0) => 0
  1746. // - findMSBSet(1) => 1
  1747. // - findMSBSet(255) => 8
  1748. function TMatrixUtil.FindMSBSet(Value: Integer): Integer;
  1749. var
  1750. NumDigits: Integer;
  1751. begin
  1752. NumDigits := 0;
  1753. while (Value <> 0) do
  1754. begin
  1755. Value := Value shr 1;
  1756. Inc(NumDigits);
  1757. end;
  1758. Result := NumDigits;
  1759. end;
  1760. // Calculate BCH (Bose-Chaudhuri-Hocquenghem) code for "value" using polynomial "poly". The BCH
  1761. // code is used for encoding type information and version information.
  1762. // Example: Calculation of version information of 7.
  1763. // f(x) is created from 7.
  1764. // - 7 = 000111 in 6 bits
  1765. // - f(x) = x^2 + x^1 + x^0
  1766. // g(x) is given by the standard (p. 67)
  1767. // - g(x) = x^12 + x^11 + x^10 + x^9 + x^8 + x^5 + x^2 + 1
  1768. // Multiply f(x) by x^(18 - 6)
  1769. // - f'(x) = f(x) * x^(18 - 6)
  1770. // - f'(x) = x^14 + x^13 + x^12
  1771. // Calculate the remainder of f'(x) / g(x)
  1772. // x^2
  1773. // __________________________________________________
  1774. // g(x) )x^14 + x^13 + x^12
  1775. // x^14 + x^13 + x^12 + x^11 + x^10 + x^7 + x^4 + x^2
  1776. // --------------------------------------------------
  1777. // x^11 + x^10 + x^7 + x^4 + x^2
  1778. //
  1779. // The remainder is x^11 + x^10 + x^7 + x^4 + x^2
  1780. // Encode it in binary: 110010010100
  1781. // The return value is 0xc94 (1100 1001 0100)
  1782. //
  1783. // Since all coefficients in the polynomials are 1 or 0, we can do the calculation by bit
  1784. // operations. We don't care if cofficients are positive or negative.
  1785. function TMatrixUtil.CalculateBCHCode(Value, Poly: Integer): Integer;
  1786. var
  1787. MSBSetInPoly: Integer;
  1788. begin
  1789. // If poly is "1 1111 0010 0101" (version info poly), msbSetInPoly is 13. We'll subtract 1
  1790. // from 13 to make it 12.
  1791. MSBSetInPoly := FindMSBSet(Poly);
  1792. Value := Value shl (MSBSetInPoly - 1);
  1793. // Do the division business using exclusive-or operations.
  1794. while (FindMSBSet(Value) >= MSBSetInPoly) do
  1795. begin
  1796. Value := Value xor (Poly shl (FindMSBSet(Value) - MSBSetInPoly));
  1797. end;
  1798. // Now the "value" is the remainder (i.e. the BCH code)
  1799. Result := Value;
  1800. end;
  1801. // Make bit vector of type information. On success, store the result in "bits" and return true.
  1802. // Encode error correction level and mask pattern. See 8.9 of
  1803. // JISX0510:2004 (p.45) for details.
  1804. procedure TMatrixUtil.MakeTypeInfoBits(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Bits: TBitArray);
  1805. var
  1806. TypeInfo: Integer;
  1807. BCHCode: Integer;
  1808. MaskBits: TBitArray;
  1809. begin
  1810. if ((MaskPattern >= 0) and (MaskPattern < NUM_MASK_PATTERNS)) then
  1811. begin
  1812. TypeInfo := (ECLevel.Bits shl 3) or MaskPattern;
  1813. Bits.AppendBits(TypeInfo, 5);
  1814. BCHCode := CalculateBCHCode(TypeInfo, TYPE_INFO_POLY);
  1815. Bits.AppendBits(BCHCode, 10);
  1816. MaskBits := TBitArray.Create;
  1817. try
  1818. MaskBits.AppendBits(TYPE_INFO_MASK_PATTERN, 15);
  1819. Bits.XorOperation(MaskBits);
  1820. finally
  1821. MaskBits.Free;
  1822. end;
  1823. if (Bits.GetSize <> 15) then // Just in case.
  1824. begin
  1825. FMatrixUtilError := True;
  1826. Exit;
  1827. end;
  1828. end;
  1829. end;
  1830. // Make bit vector of version information. On success, store the result in "bits" and return true.
  1831. // See 8.10 of JISX0510:2004 (p.45) for details.
  1832. procedure TMatrixUtil.MakeVersionInfoBits(Version: Integer; Bits: TBitArray);
  1833. var
  1834. BCHCode: Integer;
  1835. begin
  1836. Bits.AppendBits(Version, 6);
  1837. BCHCode := CalculateBCHCode(Version, VERSION_INFO_POLY);
  1838. Bits.AppendBits(BCHCode, 12);
  1839. if (Bits.GetSize() <> 18) then
  1840. begin
  1841. FMatrixUtilError := True;
  1842. Exit;
  1843. end;
  1844. end;
  1845. // Check if "value" is empty.
  1846. function TMatrixUtil.IsEmpty(Value: Integer): Boolean;
  1847. begin
  1848. Result := (Value = -1);
  1849. end;
  1850. procedure TMatrixUtil.EmbedTimingPatterns(Matrix: TByteMatrix);
  1851. var
  1852. I: Integer;
  1853. Bit: Integer;
  1854. begin
  1855. // -8 is for skipping position detection patterns (size 7), and two horizontal/vertical
  1856. // separation patterns (size 1). Thus, 8 = 7 + 1.
  1857. for I := 8 to Matrix.Width - 9 do
  1858. begin
  1859. Bit := (I + 1) mod 2;
  1860. // Horizontal line.
  1861. if (IsEmpty(Matrix.Get(I, 6))) then
  1862. begin
  1863. Matrix.SetInteger(I, 6, Bit);
  1864. end;
  1865. // Vertical line.
  1866. if (IsEmpty(Matrix.Get(6, I))) then
  1867. begin
  1868. Matrix.SetInteger(6, I, Bit);
  1869. end;
  1870. end;
  1871. end;
  1872. // Embed the lonely dark dot at left bottom corner. JISX0510:2004 (p.46)
  1873. procedure TMatrixUtil.EmbedDarkDotAtLeftBottomCorner(Matrix: TByteMatrix);
  1874. begin
  1875. if (Matrix.Get(8, Matrix.Height - 8) = 0) then
  1876. begin
  1877. FMatrixUtilError := True;
  1878. Exit;
  1879. end;
  1880. Matrix.SetInteger(8, Matrix.Height - 8, 1);
  1881. end;
  1882. procedure TMatrixUtil.EmbedHorizontalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
  1883. var
  1884. X: Integer;
  1885. begin
  1886. // We know the width and height.
  1887. for X := 0 to 7 do
  1888. begin
  1889. if (not IsEmpty(Matrix.Get(XStart + X, YStart))) then
  1890. begin
  1891. FMatrixUtilError := True;
  1892. Exit;
  1893. end;
  1894. Matrix.SetInteger(XStart + X, YStart, HORIZONTAL_SEPARATION_PATTERN[0][X]);
  1895. end;
  1896. end;
  1897. procedure TMatrixUtil.EmbedVerticalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
  1898. var
  1899. Y: Integer;
  1900. begin
  1901. // We know the width and height.
  1902. for Y := 0 to 6 do
  1903. begin
  1904. if (not IsEmpty(Matrix.Get(XStart, YStart + Y))) then
  1905. begin
  1906. FMatrixUtilError := True;
  1907. Exit;
  1908. end;
  1909. Matrix.SetInteger(XStart, YStart + Y, VERTICAL_SEPARATION_PATTERN[Y][0]);
  1910. end;
  1911. end;
  1912. // Note that we cannot unify the function with embedPositionDetectionPattern() despite they are
  1913. // almost identical, since we cannot write a function that takes 2D arrays in different sizes in
  1914. // C/C++. We should live with the fact.
  1915. procedure TMatrixUtil.EmbedPositionAdjustmentPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
  1916. var
  1917. X, Y: Integer;
  1918. begin
  1919. // We know the width and height.
  1920. for Y := 0 to 4 do
  1921. begin
  1922. for X := 0 to 4 do
  1923. begin
  1924. if (not IsEmpty(Matrix.Get(XStart + X, YStart + Y))) then
  1925. begin
  1926. FMatrixUtilError := True;
  1927. Exit;
  1928. end;
  1929. Matrix.SetInteger(XStart + X, YStart + Y, POSITION_ADJUSTMENT_PATTERN[Y][X]);
  1930. end;
  1931. end;
  1932. end;
  1933. procedure TMatrixUtil.EmbedPositionDetectionPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
  1934. var
  1935. X, Y: Integer;
  1936. begin
  1937. // We know the width and height.
  1938. for Y := 0 to 6 do
  1939. begin
  1940. for X := 0 to 6 do
  1941. begin
  1942. if (not IsEmpty(Matrix.Get(XStart + X, YStart + Y))) then
  1943. begin
  1944. FMatrixUtilError := True;
  1945. Exit;
  1946. end;
  1947. Matrix.SetInteger(XStart + X, YStart + Y, POSITION_DETECTION_PATTERN[Y][X]);
  1948. end;
  1949. end;
  1950. end;
  1951. // Embed position detection patterns and surrounding vertical/horizontal separators.
  1952. procedure TMatrixUtil.EmbedPositionDetectionPatternsAndSeparators(Matrix: TByteMatrix);
  1953. var
  1954. PDPWidth: Integer;
  1955. HSPWidth: Integer;
  1956. VSPSize: Integer;
  1957. begin
  1958. // Embed three big squares at corners.
  1959. PDPWidth := Length(POSITION_DETECTION_PATTERN[0]);
  1960. // Left top corner.
  1961. EmbedPositionDetectionPattern(0, 0, Matrix);
  1962. // Right top corner.
  1963. EmbedPositionDetectionPattern(Matrix.Width - PDPWidth, 0, Matrix);
  1964. // Left bottom corner.
  1965. EmbedPositionDetectionPattern(0, Matrix.Width- PDPWidth, Matrix);
  1966. // Embed horizontal separation patterns around the squares.
  1967. HSPWidth := Length(HORIZONTAL_SEPARATION_PATTERN[0]);
  1968. // Left top corner.
  1969. EmbedHorizontalSeparationPattern(0, HSPWidth - 1, Matrix);
  1970. // Right top corner.
  1971. EmbedHorizontalSeparationPattern(Matrix.Width - HSPWidth,
  1972. HSPWidth - 1, Matrix);
  1973. // Left bottom corner.
  1974. EmbedHorizontalSeparationPattern(0, Matrix.Width - HSPWidth, Matrix);
  1975. // Embed vertical separation patterns around the squares.
  1976. VSPSize := Length(VERTICAL_SEPARATION_PATTERN);
  1977. // Left top corner.
  1978. EmbedVerticalSeparationPattern(VSPSize, 0, Matrix);
  1979. // Right top corner.
  1980. EmbedVerticalSeparationPattern(Matrix.Height - VSPSize - 1, 0, Matrix);
  1981. // Left bottom corner.
  1982. EmbedVerticalSeparationPattern(VSPSize, Matrix.Height - VSPSize, Matrix);
  1983. end;
  1984. // Embed position adjustment patterns if need be.
  1985. procedure TMatrixUtil.MaybeEmbedPositionAdjustmentPatterns(Version: Integer; Matrix: TByteMatrix);
  1986. var
  1987. Index: Integer;
  1988. Coordinates: array of Integer;
  1989. NumCoordinates: Integer;
  1990. X, Y, I, J: Integer;
  1991. begin
  1992. if (Version >= 2) then
  1993. begin
  1994. Index := Version - 1;
  1995. NumCoordinates := Length(POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE[Index]);
  1996. SetLength(Coordinates, NumCoordinates);
  1997. Move(POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE[Index][0], Coordinates[0], NumCoordinates * SizeOf(Integer));
  1998. for I := 0 to NumCoordinates - 1 do
  1999. begin
  2000. for J := 0 to NumCoordinates - 1 do
  2001. begin
  2002. Y := Coordinates[I];
  2003. X := Coordinates[J];
  2004. if ((X = -1) or (Y = -1)) then
  2005. begin
  2006. Continue;
  2007. end;
  2008. // If the cell is unset, we embed the position adjustment pattern here.
  2009. if (IsEmpty(Matrix.Get(X, Y))) then
  2010. begin
  2011. // -2 is necessary since the x/y coordinates point to the center of the pattern, not the
  2012. // left top corner.
  2013. EmbedPositionAdjustmentPattern(X - 2, Y - 2, Matrix);
  2014. end;
  2015. end;
  2016. end;
  2017. end;
  2018. end;
  2019. { TBitArray }
  2020. procedure TBitArray.AppendBits(Value, NumBits: Integer);
  2021. var
  2022. NumBitsLeft: Integer;
  2023. begin
  2024. if ((NumBits < 0) or (NumBits > 32)) then
  2025. begin
  2026. end;
  2027. EnsureCapacity(Size + NumBits);
  2028. for NumBitsLeft := NumBits downto 1 do
  2029. begin
  2030. AppendBit(((Value shr (NumBitsLeft - 1)) and $01) = 1);
  2031. end;
  2032. end;
  2033. constructor TBitArray.Create(Size: Integer);
  2034. begin
  2035. Size := Size;
  2036. SetLength(Bits, (Size + 31) shr 5);
  2037. end;
  2038. constructor TBitArray.Create;
  2039. begin
  2040. Size := 0;
  2041. SetLength(Bits, 1);
  2042. end;
  2043. function TBitArray.Get(I: Integer): Boolean;
  2044. begin
  2045. Result := (Bits[I shr 5] and (1 shl (I and $1F))) <> 0;
  2046. end;
  2047. function TBitArray.GetSize: Integer;
  2048. begin
  2049. Result := Size;
  2050. end;
  2051. function TBitArray.GetSizeInBytes: Integer;
  2052. begin
  2053. Result := (Size + 7) shr 3;
  2054. end;
  2055. procedure TBitArray.SetBit(Index: Integer);
  2056. begin
  2057. Bits[Index shr 5] := Bits[Index shr 5] or (1 shl (Index and $1F));
  2058. end;
  2059. procedure TBitArray.AppendBit(Bit: Boolean);
  2060. begin
  2061. EnsureCapacity(Size + 1);
  2062. if (Bit) then
  2063. begin
  2064. Bits[Size shr 5] := Bits[Size shr 5] or (1 shl (Size and $1F));
  2065. end;
  2066. Inc(Size);
  2067. end;
  2068. procedure TBitArray.ToBytes(BitOffset: Integer; Source: TByteArray; Offset,
  2069. NumBytes: Integer);
  2070. var
  2071. I: Integer;
  2072. J: Integer;
  2073. TheByte: Integer;
  2074. begin
  2075. for I := 0 to NumBytes - 1 do
  2076. begin
  2077. TheByte := 0;
  2078. for J := 0 to 7 do
  2079. begin
  2080. if (Get(BitOffset)) then
  2081. begin
  2082. TheByte := TheByte or (1 shl (7 - J));
  2083. end;
  2084. Inc(BitOffset);
  2085. end;
  2086. Source[Offset + I] := TheByte;
  2087. end;
  2088. end;
  2089. procedure TBitArray.XorOperation(Other: TBitArray);
  2090. var
  2091. I: Integer;
  2092. begin
  2093. if (Length(Bits) = Length(Other.Bits)) then
  2094. begin
  2095. for I := 0 to Length(Bits) - 1 do
  2096. begin
  2097. // The last byte could be incomplete (i.e. not have 8 bits in
  2098. // it) but there is no problem since 0 XOR 0 == 0.
  2099. Bits[I] := Bits[I] xor Other.Bits[I];
  2100. end;
  2101. end;
  2102. end;
  2103. procedure TBitArray.AppendBitArray(NewBitArray: TBitArray);
  2104. var
  2105. OtherSize: Integer;
  2106. I: Integer;
  2107. begin
  2108. OtherSize := NewBitArray.GetSize;
  2109. EnsureCapacity(Size + OtherSize);
  2110. for I := 0 to OtherSize - 1 do
  2111. begin
  2112. AppendBit(NewBitArray.Get(I));
  2113. end;
  2114. end;
  2115. procedure TBitArray.EnsureCapacity(Size: Integer);
  2116. begin
  2117. if (Size > (Length(Bits) shl 5)) then
  2118. begin
  2119. SetLength(Bits, Size);
  2120. end;
  2121. end;
  2122. { TErrorCorrectionLevel }
  2123. procedure TErrorCorrectionLevel.Assign(Source: TErrorCorrectionLevel);
  2124. begin
  2125. Self.FBits := Source.FBits;
  2126. end;
  2127. function TErrorCorrectionLevel.Ordinal: Integer;
  2128. begin
  2129. Result := 0;
  2130. end;
  2131. { TVersion }
  2132. class function TVersion.ChooseVersion(NumInputBits: Integer;
  2133. ECLevel: TErrorCorrectionLevel): TVersion;
  2134. var
  2135. VersionNum: Integer;
  2136. Version: TVersion;
  2137. NumBytes: Integer;
  2138. ECBlocks: TECBlocks;
  2139. NumECBytes: Integer;
  2140. NumDataBytes: Integer;
  2141. TotalInputBytes: Integer;
  2142. begin
  2143. Result := nil;
  2144. // In the following comments, we use numbers of Version 7-H.
  2145. for VersionNum := 1 to 40 do
  2146. begin
  2147. Version := TVersion.GetVersionForNumber(VersionNum);
  2148. // numBytes = 196
  2149. NumBytes := Version.GetTotalCodewords;
  2150. // getNumECBytes = 130
  2151. ECBlocks := Version.GetECBlocksForLevel(ECLevel);
  2152. NumECBytes := ECBlocks.GetTotalECCodewords;
  2153. // getNumDataBytes = 196 - 130 = 66
  2154. NumDataBytes := NumBytes - NumECBytes;
  2155. TotalInputBytes := (NumInputBits + 7) div 8;
  2156. if (numDataBytes >= totalInputBytes) then
  2157. begin
  2158. Result := Version;
  2159. Exit;
  2160. end else
  2161. begin
  2162. Version.Free;
  2163. end;
  2164. end;
  2165. end;
  2166. constructor TVersion.Create(VersionNumber: Integer;
  2167. AlignmentPatternCenters: array of Integer; ECBlocks1, ECBlocks2, ECBlocks3,
  2168. ECBlocks4: TECBlocks);
  2169. var
  2170. Total: Integer;
  2171. ECBlock: TECB;
  2172. ECBArray: TECBArray;
  2173. I: Integer;
  2174. begin
  2175. Self.VersionNumber := VersionNumber;
  2176. SetLength(Self.AlignmentPatternCenters, Length(AlignmentPatternCenters));
  2177. if (Length(AlignmentPatternCenters) > 0) then
  2178. begin
  2179. Move(AlignmentPatternCenters[0], Self.AlignmentPatternCenters[0],
  2180. Length(AlignmentPatternCenters) * SizeOf(Integer));
  2181. end;
  2182. SetLength(ECBlocks, 4);
  2183. ECBlocks[0] := ECBlocks1;
  2184. ECBlocks[1] := ECBlocks2;
  2185. ECBlocks[2] := ECBlocks3;
  2186. ECBlocks[3] := ECBlocks4;
  2187. Total := 0;
  2188. ECCodewords := ECBlocks1.GetECCodewordsPerBlock;
  2189. ECBArray := ECBlocks1.GetECBlocks;
  2190. for I := 0 to Length(ECBArray) - 1 do
  2191. begin
  2192. ECBlock := ECBArray[I];
  2193. Inc(Total, ECBlock.GetCount * (ECBlock.GetDataCodewords + ECCodewords));
  2194. end;
  2195. TotalCodewords := Total;
  2196. end;
  2197. destructor TVersion.Destroy;
  2198. var
  2199. X: Integer;
  2200. begin
  2201. for X := 0 to Length(ECBlocks) - 1 do
  2202. begin
  2203. ECBlocks[X].Free;
  2204. end;
  2205. inherited;
  2206. end;
  2207. function TVersion.GetDimensionForVersion: Integer;
  2208. begin
  2209. Result := 17 + 4 * VersionNumber;
  2210. end;
  2211. function TVersion.GetECBlocksForLevel(ECLevel: TErrorCorrectionLevel): TECBlocks;
  2212. begin
  2213. Result := ECBlocks[ECLevel.Ordinal];
  2214. end;
  2215. function TVersion.GetTotalCodewords: Integer;
  2216. begin
  2217. Result := TotalCodewords;
  2218. end;
  2219. class function TVersion.GetVersionForNumber(VersionNum: Integer): TVersion;
  2220. begin
  2221. if (VersionNum = 1) then
  2222. begin
  2223. Result := TVersion.Create(1, [],
  2224. TECBlocks.Create(7, TECB.Create(1, 19)),
  2225. TECBlocks.Create(10, TECB.Create(1, 16)),
  2226. TECBlocks.Create(13, TECB.Create(1, 13)),
  2227. TECBlocks.Create(17, TECB.Create(1, 9)));
  2228. end else
  2229. if (VersionNum = 2) then
  2230. begin
  2231. Result := TVersion.Create(2, [6, 18],
  2232. TECBlocks.Create(10, TECB.Create(1, 34)),
  2233. TECBlocks.Create(16, TECB.Create(1, 28)),
  2234. TECBlocks.Create(22, TECB.Create(1, 22)),
  2235. TECBlocks.Create(28, TECB.Create(1, 16)));
  2236. end else
  2237. if (VersionNum = 3) then
  2238. begin
  2239. Result := TVersion.Create(3, [6, 22],
  2240. TECBlocks.Create(15, TECB.Create(1, 55)),
  2241. TECBlocks.Create(26, TECB.Create(1, 44)),
  2242. TECBlocks.Create(18, TECB.Create(2, 17)),
  2243. TECBlocks.Create(22, TECB.Create(2, 13)));
  2244. end else
  2245. if (VersionNum = 4) then
  2246. begin
  2247. Result := TVersion.Create(4, [6, 26],
  2248. TECBlocks.Create(20, TECB.Create(1, 80)),
  2249. TECBlocks.Create(18, TECB.Create(2, 32)),
  2250. TECBlocks.Create(26, TECB.Create(2, 24)),
  2251. TECBlocks.Create(16, TECB.Create(4, 9)));
  2252. end else
  2253. if (VersionNum = 5) then
  2254. begin
  2255. Result := TVersion.Create(5, [6, 30],
  2256. TECBlocks.Create(26, TECB.Create(1, 108)),
  2257. TECBlocks.Create(24, TECB.Create(2, 43)),
  2258. TECBlocks.Create(18, TECB.Create(2, 15),
  2259. TECB.Create(2, 16)),
  2260. TECBlocks.Create(22, TECB.Create(2, 11),
  2261. TECB.Create(2, 12)));
  2262. end else
  2263. if (VersionNum = 6) then
  2264. begin
  2265. Result := TVersion.Create(6, [6, 34],
  2266. TECBlocks.Create(18, TECB.Create(2, 68)),
  2267. TECBlocks.Create(16, TECB.Create(4, 27)),
  2268. TECBlocks.Create(24, TECB.Create(4, 19)),
  2269. TECBlocks.Create(28, TECB.Create(4, 15)));
  2270. end else
  2271. if (VersionNum = 7) then
  2272. begin
  2273. Result := TVersion.Create(7, [6, 22, 38],
  2274. TECBlocks.Create(20, TECB.Create(2, 78)),
  2275. TECBlocks.Create(18, TECB.Create(4, 31)),
  2276. TECBlocks.Create(18, TECB.Create(2, 14),
  2277. TECB.Create(4, 15)),
  2278. TECBlocks.Create(26, TECB.Create(4, 13),
  2279. TECB.Create(1, 14)));
  2280. end else
  2281. if (VersionNum = 8) then
  2282. begin
  2283. Result := TVersion.Create(8, [6, 24, 42],
  2284. TECBlocks.Create(24, TECB.Create(2, 97)),
  2285. TECBlocks.Create(22, TECB.Create(2, 38),
  2286. TECB.Create(2, 39)),
  2287. TECBlocks.Create(22, TECB.Create(4, 18),
  2288. TECB.Create(2, 19)),
  2289. TECBlocks.Create(26, TECB.Create(4, 14),
  2290. TECB.Create(2, 15)));
  2291. end else
  2292. if (VersionNum = 9) then
  2293. begin
  2294. Result := TVersion.Create(9, [6, 26, 46],
  2295. TECBlocks.Create(30, TECB.Create(2, 116)),
  2296. TECBlocks.Create(22, TECB.Create(3, 36),
  2297. TECB.Create(2, 37)),
  2298. TECBlocks.Create(20, TECB.Create(4, 16),
  2299. TECB.Create(4, 17)),
  2300. TECBlocks.Create(24, TECB.Create(4, 12),
  2301. TECB.Create(4, 13)));
  2302. end else
  2303. if (VersionNum = 10) then
  2304. begin
  2305. Result := TVersion.Create(10, [6, 28, 50],
  2306. TECBlocks.Create(18, TECB.Create(2, 68),
  2307. TECB.Create(2, 69)),
  2308. TECBlocks.Create(26, TECB.Create(4, 43),
  2309. TECB.Create(1, 44)),
  2310. TECBlocks.Create(24, TECB.Create(6, 19),
  2311. TECB.Create(2, 20)),
  2312. TECBlocks.Create(28, TECB.Create(6, 15),
  2313. TECB.Create(2, 16)));
  2314. end else
  2315. if (VersionNum = 11) then
  2316. begin
  2317. Result := TVersion.Create(11, [6, 30, 54],
  2318. TECBlocks.Create(20, TECB.Create(4, 81)),
  2319. TECBlocks.Create(30, TECB.Create(1, 50),
  2320. TECB.Create(4, 51)),
  2321. TECBlocks.Create(28, TECB.Create(4, 22),
  2322. TECB.Create(4, 23)),
  2323. TECBlocks.Create(24, TECB.Create(3, 12),
  2324. TECB.Create(8, 13)));
  2325. end else
  2326. if (VersionNum = 12) then
  2327. begin
  2328. Result := TVersion.Create(12, [6, 32, 58],
  2329. TECBlocks.Create(24, TECB.Create(2, 92),
  2330. TECB.Create(2, 93)),
  2331. TECBlocks.Create(22, TECB.Create(6, 36),
  2332. TECB.Create(2, 37)),
  2333. TECBlocks.Create(26, TECB.Create(4, 20),
  2334. TECB.Create(6, 21)),
  2335. TECBlocks.Create(28, TECB.Create(7, 14),
  2336. TECB.Create(4, 15)));
  2337. end else
  2338. if (VersionNum = 13) then
  2339. begin
  2340. Result := TVersion.Create(13, [6, 34, 62],
  2341. TECBlocks.Create(26, TECB.Create(4, 107)),
  2342. TECBlocks.Create(22, TECB.Create(8, 37),
  2343. TECB.Create(1, 38)),
  2344. TECBlocks.Create(24, TECB.Create(8, 20),
  2345. TECB.Create(4, 21)),
  2346. TECBlocks.Create(22, TECB.Create(12, 11),
  2347. TECB.Create(4, 12)));
  2348. end else
  2349. if (VersionNum = 14) then
  2350. begin
  2351. Result := TVersion.Create(14, [6, 26, 46, 66],
  2352. TECBlocks.Create(30, TECB.Create(3, 115),
  2353. TECB.Create(1, 116)),
  2354. TECBlocks.Create(24, TECB.Create(4, 40),
  2355. TECB.Create(5, 41)),
  2356. TECBlocks.Create(20, TECB.Create(11, 16),
  2357. TECB.Create(5, 17)),
  2358. TECBlocks.Create(24, TECB.Create(11, 12),
  2359. TECB.Create(5, 13)));
  2360. end else
  2361. if (VersionNum = 15) then
  2362. begin
  2363. Result := TVersion.Create(15, [6, 26, 48, 70],
  2364. TECBlocks.Create(22, TECB.Create(5, 87),
  2365. TECB.Create(1, 88)),
  2366. TECBlocks.Create(24, TECB.Create(5, 41),
  2367. TECB.Create(5, 42)),
  2368. TECBlocks.Create(30, TECB.Create(5, 24),
  2369. TECB.Create(7, 25)),
  2370. TECBlocks.Create(24, TECB.Create(11, 12),
  2371. TECB.Create(7, 13)));
  2372. end else
  2373. if (VersionNum = 16) then
  2374. begin
  2375. Result := TVersion.Create(16, [6, 26, 50, 74],
  2376. TECBlocks.Create(24, TECB.Create(5, 98),
  2377. TECB.Create(1, 99)),
  2378. TECBlocks.Create(28, TECB.Create(7, 45),
  2379. TECB.Create(3, 46)),
  2380. TECBlocks.Create(24, TECB.Create(15, 19),
  2381. TECB.Create(2, 20)),
  2382. TECBlocks.Create(30, TECB.Create(3, 15),
  2383. TECB.Create(13, 16)));
  2384. end else
  2385. if (VersionNum = 17) then
  2386. begin
  2387. Result := TVersion.Create(17, [6, 30, 54, 78],
  2388. TECBlocks.Create(28, TECB.Create(1, 107),
  2389. TECB.Create(5, 108)),
  2390. TECBlocks.Create(28, TECB.Create(10, 46),
  2391. TECB.Create(1, 47)),
  2392. TECBlocks.Create(28, TECB.Create(1, 22),
  2393. TECB.Create(15, 23)),
  2394. TECBlocks.Create(28, TECB.Create(2, 14),
  2395. TECB.Create(17, 15)));
  2396. end else
  2397. if (VersionNum = 18) then
  2398. begin
  2399. Result := TVersion.Create(18, [6, 30, 56, 82],
  2400. TECBlocks.Create(30, TECB.Create(5, 120),
  2401. TECB.Create(1, 121)),
  2402. TECBlocks.Create(26, TECB.Create(9, 43),
  2403. TECB.Create(4, 44)),
  2404. TECBlocks.Create(28, TECB.Create(17, 22),
  2405. TECB.Create(1, 23)),
  2406. TECBlocks.Create(28, TECB.Create(2, 14),
  2407. TECB.Create(19, 15)));
  2408. end else
  2409. if (VersionNum = 19) then
  2410. begin
  2411. Result := TVersion.Create(19, [6, 30, 58, 86],
  2412. TECBlocks.Create(28, TECB.Create(3, 113),
  2413. TECB.Create(4, 114)),
  2414. TECBlocks.Create(26, TECB.Create(3, 44),
  2415. TECB.Create(11, 45)),
  2416. TECBlocks.Create(26, TECB.Create(17, 21),
  2417. TECB.Create(4, 22)),
  2418. TECBlocks.Create(26, TECB.Create(9, 13),
  2419. TECB.Create(16, 14)));
  2420. end else
  2421. if (VersionNum = 20) then
  2422. begin
  2423. Result := TVersion.Create(20, [6, 34, 62, 90],
  2424. TECBlocks.Create(28, TECB.Create(3, 107),
  2425. TECB.Create(5, 108)),
  2426. TECBlocks.Create(26, TECB.Create(3, 41),
  2427. TECB.Create(13, 42)),
  2428. TECBlocks.Create(30, TECB.Create(15, 24),
  2429. TECB.Create(5, 25)),
  2430. TECBlocks.Create(28, TECB.Create(15, 15),
  2431. TECB.Create(10, 16)));
  2432. end else
  2433. if (VersionNum = 21) then
  2434. begin
  2435. Result := TVersion.Create(21, [6, 28, 50, 72, 94],
  2436. TECBlocks.Create(28, TECB.Create(4, 116),
  2437. TECB.Create(4, 117)),
  2438. TECBlocks.Create(26, TECB.Create(17, 42)),
  2439. TECBlocks.Create(28, TECB.Create(17, 22),
  2440. TECB.Create(6, 23)),
  2441. TECBlocks.Create(30, TECB.Create(19, 16),
  2442. TECB.Create(6, 17)));
  2443. end else
  2444. if (VersionNum = 22) then
  2445. begin
  2446. Result := TVersion.Create(22, [6, 26, 50, 74, 98],
  2447. TECBlocks.Create(28, TECB.Create(2, 111),
  2448. TECB.Create(7, 112)),
  2449. TECBlocks.Create(28, TECB.Create(17, 46)),
  2450. TECBlocks.Create(30, TECB.Create(7, 24),
  2451. TECB.Create(16, 25)),
  2452. TECBlocks.Create(24, TECB.Create(34, 13)));
  2453. end else
  2454. if (VersionNum = 23) then
  2455. begin
  2456. Result := TVersion.Create(23, [6, 30, 54, 78, 102],
  2457. TECBlocks.Create(30, TECB.Create(4, 121),
  2458. TECB.Create(5, 122)),
  2459. TECBlocks.Create(28, TECB.Create(4, 47),
  2460. TECB.Create(14, 48)),
  2461. TECBlocks.Create(30, TECB.Create(11, 24),
  2462. TECB.Create(14, 25)),
  2463. TECBlocks.Create(30, TECB.Create(16, 15),
  2464. TECB.Create(14, 16)));
  2465. end else
  2466. if (VersionNum = 24) then
  2467. begin
  2468. Result := TVersion.Create(24, [6, 28, 54, 80, 106],
  2469. TECBlocks.Create(30, TECB.Create(6, 117),
  2470. TECB.Create(4, 118)),
  2471. TECBlocks.Create(28, TECB.Create(6, 45),
  2472. TECB.Create(14, 46)),
  2473. TECBlocks.Create(30, TECB.Create(11, 24),
  2474. TECB.Create(16, 25)),
  2475. TECBlocks.Create(30, TECB.Create(30, 16),
  2476. TECB.Create(2, 17)));
  2477. end else
  2478. if (VersionNum = 25) then
  2479. begin
  2480. Result := TVersion.Create(25, [6, 32, 58, 84, 110],
  2481. TECBlocks.Create(26, TECB.Create(8, 106),
  2482. TECB.Create(4, 107)),
  2483. TECBlocks.Create(28, TECB.Create(8, 47),
  2484. TECB.Create(13, 48)),
  2485. TECBlocks.Create(30, TECB.Create(7, 24),
  2486. TECB.Create(22, 25)),
  2487. TECBlocks.Create(30, TECB.Create(22, 15),
  2488. TECB.Create(13, 16)));
  2489. end else
  2490. if (VersionNum = 26) then
  2491. begin
  2492. Result := TVersion.Create(26, [6, 30, 58, 86, 114],
  2493. TECBlocks.Create(28, TECB.Create(10, 114),
  2494. TECB.Create(2, 115)),
  2495. TECBlocks.Create(28, TECB.Create(19, 46),
  2496. TECB.Create(4, 47)),
  2497. TECBlocks.Create(28, TECB.Create(28, 22),
  2498. TECB.Create(6, 23)),
  2499. TECBlocks.Create(30, TECB.Create(33, 16),
  2500. TECB.Create(4, 17)));
  2501. end else
  2502. if (VersionNum = 27) then
  2503. begin
  2504. Result := TVersion.Create(27, [6, 34, 62, 90, 118],
  2505. TECBlocks.Create(30, TECB.Create(8, 122),
  2506. TECB.Create(4, 123)),
  2507. TECBlocks.Create(28, TECB.Create(22, 45),
  2508. TECB.Create(3, 46)),
  2509. TECBlocks.Create(30, TECB.Create(8, 23),
  2510. TECB.Create(26, 24)),
  2511. TECBlocks.Create(30, TECB.Create(12, 15),
  2512. TECB.Create(28, 16)));
  2513. end else
  2514. if (VersionNum = 28) then
  2515. begin
  2516. Result := TVersion.Create(28, [6, 26, 50, 74, 98, 122],
  2517. TECBlocks.Create(30, TECB.Create(3, 117),
  2518. TECB.Create(10, 118)),
  2519. TECBlocks.Create(28, TECB.Create(3, 45),
  2520. TECB.Create(23, 46)),
  2521. TECBlocks.Create(30, TECB.Create(4, 24),
  2522. TECB.Create(31, 25)),
  2523. TECBlocks.Create(30, TECB.Create(11, 15),
  2524. TECB.Create(31, 16)));
  2525. end else
  2526. if (VersionNum = 29) then
  2527. begin
  2528. Result := TVersion.Create(29, [6, 30, 54, 78, 102, 126],
  2529. TECBlocks.Create(30, TECB.Create(7, 116),
  2530. TECB.Create(7, 117)),
  2531. TECBlocks.Create(28, TECB.Create(21, 45),
  2532. TECB.Create(7, 46)),
  2533. TECBlocks.Create(30, TECB.Create(1, 23),
  2534. TECB.Create(37, 24)),
  2535. TECBlocks.Create(30, TECB.Create(19, 15),
  2536. TECB.Create(26, 16)));
  2537. end else
  2538. if (VersionNum = 30) then
  2539. begin
  2540. Result := TVersion.Create(30, [6, 26, 52, 78, 104, 130],
  2541. TECBlocks.Create(30, TECB.Create(5, 115),
  2542. TECB.Create(10, 116)),
  2543. TECBlocks.Create(28, TECB.Create(19, 47),
  2544. TECB.Create(10, 48)),
  2545. TECBlocks.Create(30, TECB.Create(15, 24),
  2546. TECB.Create(25, 25)),
  2547. TECBlocks.Create(30, TECB.Create(23, 15),
  2548. TECB.Create(25, 16)));
  2549. end else
  2550. if (VersionNum = 31) then
  2551. begin
  2552. Result := TVersion.Create(31, [6, 30, 56, 82, 108, 134],
  2553. TECBlocks.Create(30, TECB.Create(13, 115),
  2554. TECB.Create(3, 116)),
  2555. TECBlocks.Create(28, TECB.Create(2, 46),
  2556. TECB.Create(29, 47)),
  2557. TECBlocks.Create(30, TECB.Create(42, 24),
  2558. TECB.Create(1, 25)),
  2559. TECBlocks.Create(30, TECB.Create(23, 15),
  2560. TECB.Create(28, 16)));
  2561. end else
  2562. if (VersionNum = 32) then
  2563. begin
  2564. Result := TVersion.Create(32, [6, 34, 60, 86, 112, 138],
  2565. TECBlocks.Create(30, TECB.Create(17, 115)),
  2566. TECBlocks.Create(28, TECB.Create(10, 46),
  2567. TECB.Create(23, 47)),
  2568. TECBlocks.Create(30, TECB.Create(10, 24),
  2569. TECB.Create(35, 25)),
  2570. TECBlocks.Create(30, TECB.Create(19, 15),
  2571. TECB.Create(35, 16)));
  2572. end else
  2573. if (VersionNum = 33) then
  2574. begin
  2575. Result := TVersion.Create(33, [6, 30, 58, 86, 114, 142],
  2576. TECBlocks.Create(30, TECB.Create(17, 115),
  2577. TECB.Create(1, 116)),
  2578. TECBlocks.Create(28, TECB.Create(14, 46),
  2579. TECB.Create(21, 47)),
  2580. TECBlocks.Create(30, TECB.Create(29, 24),
  2581. TECB.Create(19, 25)),
  2582. TECBlocks.Create(30, TECB.Create(11, 15),
  2583. TECB.Create(46, 16)));
  2584. end else
  2585. if (VersionNum = 34) then
  2586. begin
  2587. Result := TVersion.Create(34, [6, 34, 62, 90, 118, 146],
  2588. TECBlocks.Create(30, TECB.Create(13, 115),
  2589. TECB.Create(6, 116)),
  2590. TECBlocks.Create(28, TECB.Create(14, 46),
  2591. TECB.Create(23, 47)),
  2592. TECBlocks.Create(30, TECB.Create(44, 24),
  2593. TECB.Create(7, 25)),
  2594. TECBlocks.Create(30, TECB.Create(59, 16),
  2595. TECB.Create(1, 17)));
  2596. end else
  2597. if (VersionNum = 35) then
  2598. begin
  2599. Result := TVersion.Create(35, [6, 30, 54, 78, 102, 126, 150],
  2600. TECBlocks.Create(30, TECB.Create(12, 121),
  2601. TECB.Create(7, 122)),
  2602. TECBlocks.Create(28, TECB.Create(12, 47),
  2603. TECB.Create(26, 48)),
  2604. TECBlocks.Create(30, TECB.Create(39, 24),
  2605. TECB.Create(14, 25)),
  2606. TECBlocks.Create(30, TECB.Create(22, 15),
  2607. TECB.Create(41, 16)));
  2608. end else
  2609. if (VersionNum = 36) then
  2610. begin
  2611. Result := TVersion.Create(36, [6, 24, 50, 76, 102, 128, 154],
  2612. TECBlocks.Create(30, TECB.Create(6, 121),
  2613. TECB.Create(14, 122)),
  2614. TECBlocks.Create(28, TECB.Create(6, 47),
  2615. TECB.Create(34, 48)),
  2616. TECBlocks.Create(30, TECB.Create(46, 24),
  2617. TECB.Create(10, 25)),
  2618. TECBlocks.Create(30, TECB.Create(2, 15),
  2619. TECB.Create(64, 16)));
  2620. end else
  2621. if (VersionNum = 37) then
  2622. begin
  2623. Result := TVersion.Create(37, [6, 28, 54, 80, 106, 132, 158],
  2624. TECBlocks.Create(30, TECB.Create(17, 122),
  2625. TECB.Create(4, 123)),
  2626. TECBlocks.Create(28, TECB.Create(29, 46),
  2627. TECB.Create(14, 47)),
  2628. TECBlocks.Create(30, TECB.Create(49, 24),
  2629. TECB.Create(10, 25)),
  2630. TECBlocks.Create(30, TECB.Create(24, 15),
  2631. TECB.Create(46, 16)));
  2632. end else
  2633. if (VersionNum = 38) then
  2634. begin
  2635. Result := TVersion.Create(38, [6, 32, 58, 84, 110, 136, 162],
  2636. TECBlocks.Create(30, TECB.Create(4, 122),
  2637. TECB.Create(18, 123)),
  2638. TECBlocks.Create(28, TECB.Create(13, 46),
  2639. TECB.Create(32, 47)),
  2640. TECBlocks.Create(30, TECB.Create(48, 24),
  2641. TECB.Create(14, 25)),
  2642. TECBlocks.Create(30, TECB.Create(42, 15),
  2643. TECB.Create(32, 16)));
  2644. end else
  2645. if (VersionNum = 39) then
  2646. begin
  2647. Result := TVersion.Create(39, [6, 26, 54, 82, 110, 138, 166],
  2648. TECBlocks.Create(30, TECB.Create(20, 117),
  2649. TECB.Create(4, 118)),
  2650. TECBlocks.Create(28, TECB.Create(40, 47),
  2651. TECB.Create(7, 48)),
  2652. TECBlocks.Create(30, TECB.Create(43, 24),
  2653. TECB.Create(22, 25)),
  2654. TECBlocks.Create(30, TECB.Create(10, 15),
  2655. TECB.Create(67, 16)));
  2656. end else
  2657. if (VersionNum = 40) then
  2658. begin
  2659. Result := TVersion.Create(40, [6, 30, 58, 86, 114, 142, 170],
  2660. TECBlocks.Create(30, TECB.Create(19, 118),
  2661. TECB.Create(6, 119)),
  2662. TECBlocks.Create(28, TECB.Create(18, 47),
  2663. TECB.Create(31, 48)),
  2664. TECBlocks.Create(30, TECB.Create(34, 24),
  2665. TECB.Create(34, 25)),
  2666. TECBlocks.Create(30, TECB.Create(20, 15),
  2667. TECB.Create(61, 16)));
  2668. end else
  2669. begin
  2670. Result := nil;
  2671. end;
  2672. end;
  2673. { TMaskUtil }
  2674. // Return the mask bit for "getMaskPattern" at "x" and "y". See 8.8 of JISX0510:2004 for mask
  2675. // pattern conditions.
  2676. function TMaskUtil.GetDataMaskBit(MaskPattern, X, Y: Integer): Boolean;
  2677. var
  2678. Intermediate: Integer;
  2679. Temp: Integer;
  2680. begin
  2681. Intermediate := 0;
  2682. if ((MaskPattern >= 0) and (MaskPattern < NUM_MASK_PATTERNS)) then
  2683. begin
  2684. case (maskPattern) of
  2685. 0: Intermediate := (Y + X) and 1;
  2686. 1: Intermediate := Y and 1;
  2687. 2: Intermediate := X mod 3;
  2688. 3: Intermediate := (Y + X) mod 3;
  2689. 4: Intermediate := ((y shr 1) + (X div 3)) and 1;
  2690. 5:
  2691. begin
  2692. Temp := Y * X;
  2693. Intermediate := (Temp and 1) + (Temp mod 3);
  2694. end;
  2695. 6:
  2696. begin
  2697. Temp := Y * X;
  2698. Intermediate := ((Temp and 1) + (Temp mod 3)) and 1;
  2699. end;
  2700. 7:
  2701. begin
  2702. Temp := Y * X;
  2703. Intermediate := ((temp mod 3) + ((Y + X) and 1)) and 1;
  2704. end;
  2705. end;
  2706. end;
  2707. Result := Intermediate = 0;
  2708. end;
  2709. { TECBlocks }
  2710. constructor TECBlocks.Create(ECCodewordsPerBlock: Integer; ECBlocks: TECB);
  2711. begin
  2712. Self.ECCodewordsPerBlock := ECCodewordsPerBlock;
  2713. SetLength(Self.ECBlocks, 1);
  2714. Self.ECBlocks[0] := ECBlocks;
  2715. end;
  2716. constructor TECBlocks.Create(ECCodewordsPerBlock: Integer; ECBlocks1,
  2717. ECBlocks2: TECB);
  2718. begin
  2719. Self.ECCodewordsPerBlock := ECCodewordsPerBlock;
  2720. SetLength(Self.ECBlocks, 2);
  2721. ECBlocks[0] := ECBlocks1;
  2722. ECBlocks[1] := ECBlocks2;
  2723. end;
  2724. destructor TECBlocks.Destroy;
  2725. var
  2726. X: Integer;
  2727. begin
  2728. for X := 0 to Length(ECBlocks) - 1 do
  2729. begin
  2730. ECBlocks[X].Free;
  2731. end;
  2732. inherited;
  2733. end;
  2734. function TECBlocks.GetECBlocks: TECBArray;
  2735. begin
  2736. Result := ECBlocks;
  2737. end;
  2738. function TECBlocks.GetECCodewordsPerBlock: Integer;
  2739. begin
  2740. Result := ECCodewordsPerBlock;
  2741. end;
  2742. function TECBlocks.GetNumBlocks: Integer;
  2743. var
  2744. Total: Integer;
  2745. I: Integer;
  2746. begin
  2747. Total := 0;
  2748. for I := 0 to Length(ECBlocks) - 1 do
  2749. begin
  2750. Inc(Total, ECBlocks[I].GetCount);
  2751. end;
  2752. Result := Total;
  2753. end;
  2754. function TECBlocks.GetTotalECCodewords: Integer;
  2755. begin
  2756. Result := ECCodewordsPerBlock * GetNumBlocks;
  2757. end;
  2758. { TBlockPair }
  2759. constructor TBlockPair.Create(BA1, BA2: TByteArray);
  2760. begin
  2761. FDataBytes := BA1;
  2762. FErrorCorrectionBytes := BA2;
  2763. end;
  2764. function TBlockPair.GetDataBytes: TByteArray;
  2765. begin
  2766. Result := FDataBytes;
  2767. end;
  2768. function TBlockPair.GetErrorCorrectionBytes: TByteArray;
  2769. begin
  2770. Result := FErrorCorrectionBytes;
  2771. end;
  2772. { TReedSolomonEncoder }
  2773. function TReedSolomonEncoder.BuildGenerator(Degree: Integer): TGenericGFPoly;
  2774. var
  2775. LastGenerator: TGenericGFPoly;
  2776. NextGenerator: TGenericGFPoly;
  2777. Poly: TGenericGFPoly;
  2778. D: Integer;
  2779. CA: TIntegerArray;
  2780. begin
  2781. if (Degree >= FCachedGenerators.Count) then
  2782. begin
  2783. LastGenerator := TGenericGFPoly(FCachedGenerators[FCachedGenerators.Count - 1]);
  2784. for D := FCachedGenerators.Count to Degree do
  2785. begin
  2786. SetLength(CA, 2);
  2787. CA[0] := 1;
  2788. CA[1] := FField.Exp(D - 1 + FField.GetGeneratorBase);
  2789. Poly := TGenericGFPoly.Create(FField, CA);
  2790. NextGenerator := LastGenerator.Multiply(Poly);
  2791. FCachedGenerators.Add(NextGenerator);
  2792. LastGenerator := NextGenerator;
  2793. end;
  2794. end;
  2795. Result := TGenericGFPoly(FCachedGenerators[Degree]);
  2796. end;
  2797. constructor TReedSolomonEncoder.Create(AField: TGenericGF);
  2798. var
  2799. GenericGFPoly: TGenericGFPoly;
  2800. IntArray: TIntegerArray;
  2801. begin
  2802. FField := AField;
  2803. // Contents of FCachedGenerators will be freed by FGenericGF.Destroy
  2804. FCachedGenerators := TObjectList.Create(False);
  2805. SetLength(IntArray, 1);
  2806. IntArray[0] := 1;
  2807. GenericGFPoly := TGenericGFPoly.Create(AField, IntArray);
  2808. FCachedGenerators.Add(GenericGFPoly);
  2809. end;
  2810. destructor TReedSolomonEncoder.Destroy;
  2811. begin
  2812. FCachedGenerators.Free;
  2813. inherited;
  2814. end;
  2815. procedure TReedSolomonEncoder.Encode(ToEncode: TIntegerArray; ECBytes: Integer);
  2816. var
  2817. DataBytes: Integer;
  2818. Generator: TGenericGFPoly;
  2819. InfoCoefficients: TIntegerArray;
  2820. Info: TGenericGFPoly;
  2821. Remainder: TGenericGFPoly;
  2822. Coefficients: TIntegerArray;
  2823. NumZeroCoefficients: Integer;
  2824. I: Integer;
  2825. begin
  2826. SetLength(Coefficients, 0);
  2827. if (ECBytes > 0) then
  2828. begin
  2829. DataBytes := Length(ToEncode) - ECBytes;
  2830. if (DataBytes > 0) then
  2831. begin
  2832. Generator := BuildGenerator(ECBytes);
  2833. SetLength(InfoCoefficients, DataBytes);
  2834. InfoCoefficients := Copy(ToEncode, 0, DataBytes);
  2835. Info := TGenericGFPoly.Create(FField, InfoCoefficients);
  2836. Info := Info.MultiplyByMonomial(ECBytes, 1);
  2837. Remainder := Info.Divide(Generator)[1];
  2838. Coefficients := Remainder.GetCoefficients;
  2839. NumZeroCoefficients := ECBytes - Length(Coefficients);
  2840. for I := 0 to NumZeroCoefficients - 1 do
  2841. begin
  2842. ToEncode[DataBytes + I] := 0;
  2843. end;
  2844. Move(Coefficients[0], ToEncode[DataBytes + NumZeroCoefficients], Length(Coefficients) * SizeOf(Integer));
  2845. end;
  2846. end;
  2847. end;
  2848. { TECB }
  2849. constructor TECB.Create(Count, DataCodewords: Integer);
  2850. begin
  2851. Self.Count := Count;
  2852. Self.DataCodewords := DataCodewords;
  2853. end;
  2854. function TECB.GetCount: Integer;
  2855. begin
  2856. Result := Count;
  2857. end;
  2858. function TECB.GetDataCodewords: Integer;
  2859. begin
  2860. Result := DataCodewords;
  2861. end;
  2862. { TGenericGFPoly }
  2863. function TGenericGFPoly.AddOrSubtract(Other: TGenericGFPoly): TGenericGFPoly;
  2864. var
  2865. SmallerCoefficients: TIntegerArray;
  2866. LargerCoefficients: TIntegerArray;
  2867. Temp: TIntegerArray;
  2868. SumDiff: TIntegerArray;
  2869. LengthDiff: Integer;
  2870. I: Integer;
  2871. begin
  2872. SetLength(SmallerCoefficients, 0);
  2873. SetLength(LargerCoefficients, 0);
  2874. SetLength(Temp, 0);
  2875. SetLength(SumDiff, 0);
  2876. Result := nil;
  2877. if (Assigned(Other)) then
  2878. begin
  2879. if (FField = Other.FField) then
  2880. begin
  2881. if (IsZero) then
  2882. begin
  2883. Result := Other;
  2884. Exit;
  2885. end;
  2886. if (Other.IsZero) then
  2887. begin
  2888. Result := Self;
  2889. Exit;
  2890. end;
  2891. SmallerCoefficients := FCoefficients;
  2892. LargerCoefficients := Other.Coefficients;
  2893. if (Length(SmallerCoefficients) > Length(LargerCoefficients)) then
  2894. begin
  2895. Temp := smallerCoefficients;
  2896. SmallerCoefficients := LargerCoefficients;
  2897. LargerCoefficients := temp;
  2898. end;
  2899. SetLength(SumDiff, Length(LargerCoefficients));
  2900. LengthDiff := Length(LargerCoefficients) - Length(SmallerCoefficients);
  2901. // Copy high-order terms only found in higher-degree polynomial's coefficients
  2902. if (LengthDiff > 0) then
  2903. begin
  2904. //SumDiff := Copy(LargerCoefficients, 0, LengthDiff);
  2905. Move(LargerCoefficients[0], SumDiff[0], LengthDiff * SizeOf(Integer));
  2906. end;
  2907. for I := LengthDiff to Length(LargerCoefficients) - 1 do
  2908. begin
  2909. SumDiff[I] := TGenericGF.AddOrSubtract(SmallerCoefficients[I - LengthDiff], LargerCoefficients[I]);
  2910. end;
  2911. Result := TGenericGFPoly.Create(FField, SumDiff);
  2912. end;
  2913. end;
  2914. end;
  2915. function TGenericGFPoly.Coefficients: TIntegerArray;
  2916. begin
  2917. Result := FCoefficients;
  2918. end;
  2919. constructor TGenericGFPoly.Create(AField: TGenericGF;
  2920. ACoefficients: TIntegerArray);
  2921. var
  2922. CoefficientsLength: Integer;
  2923. FirstNonZero: Integer;
  2924. begin
  2925. FField := AField;
  2926. SetLength(FField.FPolyList, Length(FField.FPolyList) + 1);
  2927. FField.FPolyList[Length(FField.FPolyList) - 1] := Self;
  2928. CoefficientsLength := Length(ACoefficients);
  2929. if ((CoefficientsLength > 1) and (ACoefficients[0] = 0)) then
  2930. begin
  2931. // Leading term must be non-zero for anything except the constant polynomial "0"
  2932. FirstNonZero := 1;
  2933. while ((FirstNonZero < CoefficientsLength) and (ACoefficients[FirstNonZero] = 0)) do
  2934. begin
  2935. Inc(FirstNonZero);
  2936. end;
  2937. if (FirstNonZero = CoefficientsLength) then
  2938. begin
  2939. FCoefficients := AField.GetZero.Coefficients;
  2940. end else
  2941. begin
  2942. SetLength(FCoefficients, CoefficientsLength - FirstNonZero);
  2943. FCoefficients := Copy(ACoefficients, FirstNonZero, Length(FCoefficients));
  2944. end;
  2945. end else
  2946. begin
  2947. FCoefficients := ACoefficients;
  2948. end;
  2949. end;
  2950. destructor TGenericGFPoly.Destroy;
  2951. begin
  2952. Self.FField := FField;
  2953. inherited;
  2954. end;
  2955. function TGenericGFPoly.Divide(Other: TGenericGFPoly): TGenericGFPolyArray;
  2956. var
  2957. Quotient: TGenericGFPoly;
  2958. Remainder: TGenericGFPoly;
  2959. DenominatorLeadingTerm: Integer;
  2960. InverseDenominatorLeadingTerm: integer;
  2961. DegreeDifference: Integer;
  2962. Scale: Integer;
  2963. Term: TGenericGFPoly;
  2964. IterationQuotient: TGenericGFPoly;
  2965. begin
  2966. SetLength(Result, 0);
  2967. if ((FField = Other.FField) and (not Other.IsZero)) then
  2968. begin
  2969. Quotient := FField.GetZero;
  2970. Remainder := Self;
  2971. DenominatorLeadingTerm := Other.GetCoefficient(Other.GetDegree);
  2972. InverseDenominatorLeadingTerm := FField.Inverse(DenominatorLeadingTerm);
  2973. while ((Remainder.GetDegree >= Other.GetDegree) and (not Remainder.IsZero)) do
  2974. begin
  2975. DegreeDifference := Remainder.GetDegree - Other.GetDegree;
  2976. Scale := FField.Multiply(Remainder.GetCoefficient(Remainder.GetDegree), InverseDenominatorLeadingTerm);
  2977. Term := Other.MultiplyByMonomial(DegreeDifference, Scale);
  2978. IterationQuotient := FField.BuildMonomial(degreeDifference, scale);
  2979. Quotient := Quotient.AddOrSubtract(IterationQuotient);
  2980. Remainder := Remainder.AddOrSubtract(Term);
  2981. end;
  2982. SetLength(Result, 2);
  2983. Result[0] := Quotient;
  2984. Result[1] := Remainder;
  2985. end;
  2986. end;
  2987. function TGenericGFPoly.GetCoefficient(Degree: Integer): Integer;
  2988. begin
  2989. Result := FCoefficients[Length(FCoefficients) - 1 - Degree];
  2990. end;
  2991. function TGenericGFPoly.GetCoefficients: TIntegerArray;
  2992. begin
  2993. Result := FCoefficients;
  2994. end;
  2995. function TGenericGFPoly.GetDegree: Integer;
  2996. begin
  2997. Result := Length(FCoefficients) - 1;
  2998. end;
  2999. function TGenericGFPoly.IsZero: Boolean;
  3000. begin
  3001. Result := FCoefficients[0] = 0;
  3002. end;
  3003. function TGenericGFPoly.Multiply(Other: TGenericGFPoly): TGenericGFPoly;
  3004. var
  3005. ACoefficients: TIntegerArray;
  3006. BCoefficients: TIntegerArray;
  3007. Product: TIntegerArray;
  3008. ALength: Integer;
  3009. BLength: Integer;
  3010. I: Integer;
  3011. J: Integer;
  3012. ACoeff: Integer;
  3013. begin
  3014. SetLength(ACoefficients, 0);
  3015. SetLength(BCoefficients, 0);
  3016. Result := nil;
  3017. if (FField = Other.FField) then
  3018. begin
  3019. if (IsZero or Other.IsZero) then
  3020. begin
  3021. Result := FField.GetZero;
  3022. Exit;
  3023. end;
  3024. ACoefficients := FCoefficients;
  3025. ALength := Length(ACoefficients);
  3026. BCoefficients := Other.Coefficients;
  3027. BLength := Length(BCoefficients);
  3028. SetLength(Product, aLength + bLength - 1);
  3029. for I := 0 to ALength - 1 do
  3030. begin
  3031. ACoeff := ACoefficients[I];
  3032. for J := 0 to BLength - 1 do
  3033. begin
  3034. Product[I + J] := TGenericGF.AddOrSubtract(Product[I + J],
  3035. FField.Multiply(ACoeff, BCoefficients[J]));
  3036. end;
  3037. end;
  3038. Result := TGenericGFPoly.Create(FField, Product);
  3039. end;
  3040. end;
  3041. function TGenericGFPoly.MultiplyByMonomial(Degree,
  3042. Coefficient: Integer): TGenericGFPoly;
  3043. var
  3044. I: Integer;
  3045. Size: Integer;
  3046. Product: TIntegerArray;
  3047. begin
  3048. Result := nil;
  3049. if (Degree >= 0) then
  3050. begin
  3051. if (Coefficient = 0) then
  3052. begin
  3053. Result := FField.GetZero;
  3054. Exit;
  3055. end;
  3056. Size := Length(Coefficients);
  3057. SetLength(Product, Size + Degree);
  3058. for I := 0 to Size - 1 do
  3059. begin
  3060. Product[I] := FField.Multiply(FCoefficients[I], Coefficient);
  3061. end;
  3062. Result := TGenericGFPoly.Create(FField, Product);
  3063. end;
  3064. end;
  3065. { TGenericGF }
  3066. class function TGenericGF.AddOrSubtract(A, B: Integer): Integer;
  3067. begin
  3068. Result := A xor B;
  3069. end;
  3070. function TGenericGF.BuildMonomial(Degree, Coefficient: Integer): TGenericGFPoly;
  3071. var
  3072. Coefficients: TIntegerArray;
  3073. begin
  3074. CheckInit();
  3075. if (Degree >= 0) then
  3076. begin
  3077. if (Coefficient = 0) then
  3078. begin
  3079. Result := FZero;
  3080. Exit;
  3081. end;
  3082. SetLength(Coefficients, Degree + 1);
  3083. Coefficients[0] := Coefficient;
  3084. Result := TGenericGFPoly.Create(Self, Coefficients);
  3085. end else
  3086. begin
  3087. Result := nil;
  3088. end;
  3089. end;
  3090. procedure TGenericGF.CheckInit;
  3091. begin
  3092. if (not FInitialized) then
  3093. begin
  3094. Initialize;
  3095. end;
  3096. end;
  3097. constructor TGenericGF.Create(Primitive, Size, B: Integer);
  3098. begin
  3099. FInitialized := False;
  3100. FPrimitive := Primitive;
  3101. FSize := Size;
  3102. FGeneratorBase := B;
  3103. if (FSize < 0) then
  3104. begin
  3105. Initialize;
  3106. end;
  3107. end;
  3108. class function TGenericGF.CreateQRCodeField256: TGenericGF;
  3109. begin
  3110. Result := TGenericGF.Create($011D, 256, 0);
  3111. end;
  3112. destructor TGenericGF.Destroy;
  3113. var
  3114. X: Integer;
  3115. Y: Integer;
  3116. begin
  3117. for X := 0 to Length(FPolyList) - 1 do
  3118. begin
  3119. if (Assigned(FPolyList[X])) then
  3120. begin
  3121. for Y := X + 1 to Length(FPolyList) - 1 do
  3122. begin
  3123. if (FPolyList[Y] = FPolyList[X]) then
  3124. begin
  3125. FPolyList[Y] := nil;
  3126. end;
  3127. end;
  3128. FPolyList[X].Free;
  3129. end;
  3130. end;
  3131. inherited;
  3132. end;
  3133. function TGenericGF.Exp(A: Integer): Integer;
  3134. begin
  3135. CheckInit;
  3136. Result := FExpTable[A];
  3137. end;
  3138. function TGenericGF.GetGeneratorBase: Integer;
  3139. begin
  3140. Result := FGeneratorBase;
  3141. end;
  3142. function TGenericGF.GetZero: TGenericGFPoly;
  3143. begin
  3144. CheckInit;
  3145. Result := FZero;
  3146. end;
  3147. procedure TGenericGF.Initialize;
  3148. var
  3149. X: Integer;
  3150. I: Integer;
  3151. CA: TIntegerArray;
  3152. begin
  3153. SetLength(FExpTable, FSize);
  3154. SetLength(FLogTable, FSize);
  3155. X := 1;
  3156. for I := 0 to FSize - 1 do
  3157. begin
  3158. FExpTable[I] := x;
  3159. X := X shl 1; // x = x * 2; we're assuming the generator alpha is 2
  3160. if (X >= FSize) then
  3161. begin
  3162. X := X xor FPrimitive;
  3163. X := X and (FSize - 1);
  3164. end;
  3165. end;
  3166. for I := 0 to FSize - 2 do
  3167. begin
  3168. FLogTable[FExpTable[I]] := I;
  3169. end;
  3170. // logTable[0] == 0 but this should never be used
  3171. SetLength(CA, 1);
  3172. CA[0] := 0;
  3173. FZero := TGenericGFPoly.Create(Self, CA);
  3174. SetLength(CA, 1);
  3175. CA[0] := 1;
  3176. FOne := TGenericGFPoly.Create(Self, CA);
  3177. FInitialized := True;
  3178. end;
  3179. function TGenericGF.Inverse(A: Integer): Integer;
  3180. begin
  3181. CheckInit;
  3182. if (a <> 0) then
  3183. begin
  3184. Result := FExpTable[FSize - FLogTable[A] - 1];
  3185. end else
  3186. begin
  3187. Result := 0;
  3188. end;
  3189. end;
  3190. function TGenericGF.Multiply(A, B: Integer): Integer;
  3191. begin
  3192. CheckInit;
  3193. if ((A <> 0) and (B <> 0)) then
  3194. begin
  3195. Result := FExpTable[(FLogTable[A] + FLogTable[B]) mod (FSize - 1)];
  3196. end else
  3197. begin
  3198. Result := 0;
  3199. end;
  3200. end;
  3201. function GenerateQRCode(const Input: WideString; EncodeOptions: Integer): T2DBooleanArray;
  3202. var
  3203. Encoder: TEncoder;
  3204. Level: TErrorCorrectionLevel;
  3205. QRCode: TQRCode;
  3206. X: Integer;
  3207. Y: Integer;
  3208. begin
  3209. Level := TErrorCorrectionLevel.Create;
  3210. Level.FBits := 1;
  3211. Encoder := TEncoder.Create;
  3212. QRCode := TQRCode.Create;
  3213. try
  3214. Encoder.Encode(Input, EncodeOptions, Level, QRCode);
  3215. if (Assigned(QRCode.FMatrix)) then
  3216. begin
  3217. SetLength(Result, QRCode.FMatrix.FHeight);
  3218. for Y := 0 to QRCode.FMatrix.FHeight - 1 do
  3219. begin
  3220. SetLength(Result[Y], QRCode.FMatrix.FWidth);
  3221. for X := 0 to QRCode.FMatrix.FWidth - 1 do
  3222. begin
  3223. Result[Y][X] := QRCode.FMatrix.Get(Y, X) = 1;
  3224. end;
  3225. end;
  3226. end;
  3227. finally
  3228. QRCode.Free;
  3229. Encoder.Free;
  3230. Level.Free;
  3231. end;
  3232. end;
  3233. { TDelphiZXingQRCode }
  3234. constructor TDelphiZXingQRCode.Create;
  3235. begin
  3236. FData := '';
  3237. FEncoding := qrAuto;
  3238. FQuietZone := 4;
  3239. FRows := 0;
  3240. FColumns := 0;
  3241. end;
  3242. function TDelphiZXingQRCode.GetIsBlack(Row, Column: Integer): Boolean;
  3243. begin
  3244. Dec(Row, FQuietZone);
  3245. Dec(Column, FQuietZone);
  3246. if ((Row >= 0) and (Column >= 0) and (Row < (FRows - FQuietZone * 2)) and (Column < (FColumns - FQuietZone * 2))) then
  3247. begin
  3248. Result := FElements[Column, Row];
  3249. end else
  3250. begin
  3251. Result := False;
  3252. end;
  3253. end;
  3254. procedure TDelphiZXingQRCode.SetData(const NewData: WideString);
  3255. begin
  3256. if (FData <> NewData) then
  3257. begin
  3258. FData := NewData;
  3259. Update;
  3260. end;
  3261. end;
  3262. procedure TDelphiZXingQRCode.SetEncoding(NewEncoding: TQRCodeEncoding);
  3263. begin
  3264. if (FEncoding <> NewEncoding) then
  3265. begin
  3266. FEncoding := NewEncoding;
  3267. Update;
  3268. end;
  3269. end;
  3270. procedure TDelphiZXingQRCode.SetQuietZone(NewQuietZone: Integer);
  3271. begin
  3272. if ((FQuietZone <> NewQuietZone) and (NewQuietZone >= 0) and (NewQuietZone <= 100)) then
  3273. begin
  3274. FQuietZone := NewQuietZone;
  3275. Update;
  3276. end;
  3277. end;
  3278. procedure TDelphiZXingQRCode.Update;
  3279. begin
  3280. FElements := GenerateQRCode(FData, Ord(FEncoding));
  3281. FRows := Length(FElements) + FQuietZone * 2;
  3282. FColumns := FRows;
  3283. end;
  3284. end.