| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573 |
- unit DelphiZXingQRCode;
- // ZXing QRCode port to Delphi, by Debenu Pty Ltd (www.debenu.com)
- // Original copyright notice
- (*
- * Copyright 2008 ZXing authors
- *
- * Licensed under the Apache License, Version 2.0 (the "License");
- * you may not use this file except in compliance with the License.
- * You may obtain a copy of the License at
- *
- * http://www.apache.org/licenses/LICENSE-2.0
- *
- * Unless required by applicable law or agreed to in writing, software
- * distributed under the License is distributed on an "AS IS" BASIS,
- * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- * See the License for the specific language governing permissions and
- * limitations under the License.
- *)
- interface
- type
- TQRCodeEncoding = (qrAuto, qrNumeric, qrAlphanumeric, qrISO88591, qrUTF8NoBOM, qrUTF8BOM);
- T2DBooleanArray = array of array of Boolean;
- TDelphiZXingQRCode = class
- protected
- FData: WideString;
- FRows: Integer;
- FColumns: Integer;
- FEncoding: TQRCodeEncoding;
- FQuietZone: Integer;
- FElements: T2DBooleanArray;
- procedure SetEncoding(NewEncoding: TQRCodeEncoding);
- procedure SetData(const NewData: WideString);
- procedure SetQuietZone(NewQuietZone: Integer);
- function GetIsBlack(Row, Column: Integer): Boolean;
- procedure Update;
- public
- constructor Create;
- property Data: WideString read FData write SetData;
- property Encoding: TQRCodeEncoding read FEncoding write SetEncoding;
- property QuietZone: Integer read FQuietZone write SetQuietZone;
- property Rows: Integer read FRows;
- property Columns: Integer read FColumns;
- property IsBlack[Row, Column: Integer]: Boolean read GetIsBlack;
- end;
- implementation
- uses
- contnrs, Math, Classes;
- type
- TByteArray = array of Byte;
- T2DByteArray = array of array of Byte;
- TIntegerArray = array of Integer;
- const
- NUM_MASK_PATTERNS = 8;
- QUIET_ZONE_SIZE = 4;
- ALPHANUMERIC_TABLE: array[0..95] of Integer = (
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, // 0x00-0x0f
- -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, // 0x10-0x1f
- 36, -1, -1, -1, 37, 38, -1, -1, -1, -1, 39, 40, -1, 41, 42, 43, // 0x20-0x2f
- 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 44, -1, -1, -1, -1, -1, // 0x30-0x3f
- -1, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, // 0x40-0x4f
- 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1 // 0x50-0x5f
- );
- DEFAULT_BYTE_MODE_ENCODING = 'ISO-8859-1';
- POSITION_DETECTION_PATTERN: array[0..6, 0..6] of Integer = (
- (1, 1, 1, 1, 1, 1, 1),
- (1, 0, 0, 0, 0, 0, 1),
- (1, 0, 1, 1, 1, 0, 1),
- (1, 0, 1, 1, 1, 0, 1),
- (1, 0, 1, 1, 1, 0, 1),
- (1, 0, 0, 0, 0, 0, 1),
- (1, 1, 1, 1, 1, 1, 1));
- HORIZONTAL_SEPARATION_PATTERN: array[0..0, 0..7] of Integer = (
- (0, 0, 0, 0, 0, 0, 0, 0));
- VERTICAL_SEPARATION_PATTERN: array[0..6, 0..0] of Integer = (
- (0), (0), (0), (0), (0), (0), (0));
- POSITION_ADJUSTMENT_PATTERN: array[0..4, 0..4] of Integer = (
- (1, 1, 1, 1, 1),
- (1, 0, 0, 0, 1),
- (1, 0, 1, 0, 1),
- (1, 0, 0, 0, 1),
- (1, 1, 1, 1, 1));
- // From Appendix E. Table 1, JIS0510X:2004 (p 71). The table was double-checked by komatsu.
- POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE: array[0..39, 0..6] of Integer = (
- (-1, -1, -1, -1, -1, -1, -1), // Version 1
- ( 6, 18, -1, -1, -1, -1, -1), // Version 2
- ( 6, 22, -1, -1, -1, -1, -1), // Version 3
- ( 6, 26, -1, -1, -1, -1, -1), // Version 4
- ( 6, 30, -1, -1, -1, -1, -1), // Version 5
- ( 6, 34, -1, -1, -1, -1, -1), // Version 6
- ( 6, 22, 38, -1, -1, -1, -1), // Version 7
- ( 6, 24, 42, -1, -1, -1, -1), // Version 8
- ( 6, 26, 46, -1, -1, -1, -1), // Version 9
- ( 6, 28, 50, -1, -1, -1, -1), // Version 10
- ( 6, 30, 54, -1, -1, -1, -1), // Version 11
- ( 6, 32, 58, -1, -1, -1, -1), // Version 12
- ( 6, 34, 62, -1, -1, -1, -1), // Version 13
- ( 6, 26, 46, 66, -1, -1, -1), // Version 14
- ( 6, 26, 48, 70, -1, -1, -1), // Version 15
- ( 6, 26, 50, 74, -1, -1, -1), // Version 16
- ( 6, 30, 54, 78, -1, -1, -1), // Version 17
- ( 6, 30, 56, 82, -1, -1, -1), // Version 18
- ( 6, 30, 58, 86, -1, -1, -1), // Version 19
- ( 6, 34, 62, 90, -1, -1, -1), // Version 20
- ( 6, 28, 50, 72, 94, -1, -1), // Version 21
- ( 6, 26, 50, 74, 98, -1, -1), // Version 22
- ( 6, 30, 54, 78, 102, -1, -1), // Version 23
- ( 6, 28, 54, 80, 106, -1, -1), // Version 24
- ( 6, 32, 58, 84, 110, -1, -1), // Version 25
- ( 6, 30, 58, 86, 114, -1, -1), // Version 26
- ( 6, 34, 62, 90, 118, -1, -1), // Version 27
- ( 6, 26, 50, 74, 98, 122, -1), // Version 28
- ( 6, 30, 54, 78, 102, 126, -1), // Version 29
- ( 6, 26, 52, 78, 104, 130, -1), // Version 30
- ( 6, 30, 56, 82, 108, 134, -1), // Version 31
- ( 6, 34, 60, 86, 112, 138, -1), // Version 32
- ( 6, 30, 58, 86, 114, 142, -1), // Version 33
- ( 6, 34, 62, 90, 118, 146, -1), // Version 34
- ( 6, 30, 54, 78, 102, 126, 150), // Version 35
- ( 6, 24, 50, 76, 102, 128, 154), // Version 36
- ( 6, 28, 54, 80, 106, 132, 158), // Version 37
- ( 6, 32, 58, 84, 110, 136, 162), // Version 38
- ( 6, 26, 54, 82, 110, 138, 166), // Version 39
- ( 6, 30, 58, 86, 114, 142, 170) // Version 40
- );
- // Type info cells at the left top corner.
- TYPE_INFO_COORDINATES: array[0..14, 0..1] of Integer = (
- (8, 0),
- (8, 1),
- (8, 2),
- (8, 3),
- (8, 4),
- (8, 5),
- (8, 7),
- (8, 8),
- (7, 8),
- (5, 8),
- (4, 8),
- (3, 8),
- (2, 8),
- (1, 8),
- (0, 8)
- );
- // From Appendix D in JISX0510:2004 (p. 67)
- VERSION_INFO_POLY = $1f25; // 1 1111 0010 0101
- // From Appendix C in JISX0510:2004 (p.65).
- TYPE_INFO_POLY = $537;
- TYPE_INFO_MASK_PATTERN = $5412;
- VERSION_DECODE_INFO: array[0..33] of Integer = (
- $07C94, $085BC, $09A99, $0A4D3, $0BBF6,
- $0C762, $0D847, $0E60D, $0F928, $10B78,
- $1145D, $12A17, $13532, $149A6, $15683,
- $168C9, $177EC, $18EC4, $191E1, $1AFAB,
- $1B08E, $1CC1A, $1D33F, $1ED75, $1F250,
- $209D5, $216F0, $228BA, $2379F, $24B0B,
- $2542E, $26A64, $27541, $28C69);
- type
- TMode = (qmTerminator, qmNumeric, qmAlphanumeric, qmStructuredAppend,
- qmByte, qmECI, qmKanji, qmFNC1FirstPosition, qmFNC1SecondPosition,
- qmHanzi);
- const
- ModeCharacterCountBits: array[TMode] of array[0..2] of Integer = (
- (0, 0, 0), (10, 12, 14), (9, 11, 13), (0, 0, 0), (8, 16, 16),
- (0, 0, 0), (8, 10, 12), (0, 0, 0), (0, 0, 0), (8, 10, 12));
- ModeBits: array[TMode] of Integer = (0, 1, 2, 3, 4, 7, 8, 5, 9, 13);
- type
- TErrorCorrectionLevel = class
- private
- FBits: Integer;
- public
- procedure Assign(Source: TErrorCorrectionLevel);
- function Ordinal: Integer;
- property Bits: Integer read FBits;
- end;
- TECB = class
- private
- Count: Integer;
- DataCodewords: Integer;
- public
- constructor Create(Count, DataCodewords: Integer);
- function GetCount: Integer;
- function GetDataCodewords: Integer;
- end;
- TECBArray = array of TECB;
- TECBlocks = class
- private
- ECCodewordsPerBlock: Integer;
- ECBlocks: TECBArray;
- public
- constructor Create(ECCodewordsPerBlock: Integer; ECBlocks: TECB); overload;
- constructor Create(ECCodewordsPerBlock: Integer; ECBlocks1, ECBlocks2: TECB); overload;
- destructor Destroy; override;
- function GetTotalECCodewords: Integer;
- function GetNumBlocks: Integer;
- function GetECCodewordsPerBlock: Integer;
- function GetECBlocks: TECBArray;
- end;
- TByteMatrix = class
- protected
- Bytes: T2DByteArray;
- FWidth: Integer;
- FHeight: Integer;
- public
- constructor Create(Width, Height: Integer);
- function Get(X, Y: Integer): Integer;
- procedure SetBoolean(X, Y: Integer; Value: Boolean);
- procedure SetInteger(X, Y: Integer; Value: Integer);
- function GetArray: T2DByteArray;
- procedure Assign(Source: TByteMatrix);
- procedure Clear(Value: Byte);
- function Hash: AnsiString;
- property Width: Integer read FWidth;
- property Height: Integer read FHeight;
- end;
- TBitArray = class
- private
- Bits: array of Integer;
- Size: Integer;
- procedure EnsureCapacity(Size: Integer);
- public
- constructor Create; overload;
- constructor Create(Size: Integer); overload;
- function GetSizeInBytes: Integer;
- function GetSize: Integer;
- function Get(I: Integer): Boolean;
- procedure SetBit(Index: Integer);
- procedure AppendBit(Bit: Boolean);
- procedure AppendBits(Value, NumBits: Integer);
- procedure AppendBitArray(NewBitArray: TBitArray);
- procedure ToBytes(BitOffset: Integer; Source: TByteArray; Offset,
- NumBytes: Integer);
- procedure XorOperation(Other: TBitArray);
- end;
- TCharacterSetECI = class
- end;
- TVersion = class
- private
- VersionNumber: Integer;
- AlignmentPatternCenters: array of Integer;
- ECBlocks: array of TECBlocks;
- TotalCodewords: Integer;
- ECCodewords: Integer;
- public
- constructor Create(VersionNumber: Integer; AlignmentPatternCenters: array of Integer; ECBlocks1, ECBlocks2, ECBlocks3, ECBlocks4: TECBlocks);
- destructor Destroy; override;
- class function GetVersionForNumber(VersionNum: Integer): TVersion;
- class function ChooseVersion(NumInputBits: Integer; ecLevel: TErrorCorrectionLevel): TVersion;
- function GetTotalCodewords: Integer;
- function GetECBlocksForLevel(ECLevel: TErrorCorrectionLevel): TECBlocks;
- function GetDimensionForVersion: Integer;
- end;
- TMaskUtil = class
- public
- function GetDataMaskBit(MaskPattern, X, Y: Integer): Boolean;
- end;
- TQRCode = class
- private
- FMode: TMode;
- FECLevel: TErrorCorrectionLevel;
- FVersion: Integer;
- FMatrixWidth: Integer;
- FMaskPattern: Integer;
- FNumTotalBytes: Integer;
- FNumDataBytes: Integer;
- FNumECBytes: Integer;
- FNumRSBlocks: Integer;
- FMatrix: TByteMatrix;
- FQRCodeError: Boolean;
- public
- constructor Create;
- destructor Destroy; override;
- function At(X, Y: Integer): Integer;
- function IsValid: Boolean;
- function IsValidMaskPattern(MaskPattern: Integer): Boolean;
- procedure SetMatrix(NewMatrix: TByteMatrix);
- procedure SetECLevel(NewECLevel: TErrorCorrectionLevel);
- procedure SetAll(VersionNum, NumBytes, NumDataBytes, NumRSBlocks, NumECBytes, MatrixWidth: Integer);
- property QRCodeError: Boolean read FQRCodeError;
- property Mode: TMode read FMode write FMode;
- property Version: Integer read FVersion write FVersion;
- property NumDataBytes: Integer read FNumDataBytes;
- property NumTotalBytes: Integer read FNumTotalBytes;
- property NumRSBlocks: Integer read FNumRSBlocks;
- property MatrixWidth: Integer read FMatrixWidth;
- property MaskPattern: Integer read FMaskPattern write FMaskPattern;
- property ECLevel: TErrorCorrectionLevel read FECLevel;
- end;
- TMatrixUtil = class
- private
- FMatrixUtilError: Boolean;
- procedure ClearMatrix(Matrix: TByteMatrix);
- procedure EmbedBasicPatterns(Version: Integer; Matrix: TByteMatrix);
- procedure EmbedTypeInfo(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Matrix: TByteMatrix);
- procedure MaybeEmbedVersionInfo(Version: Integer; Matrix: TByteMatrix);
- procedure EmbedDataBits(DataBits: TBitArray; MaskPattern: Integer; Matrix: TByteMatrix);
- function FindMSBSet(Value: Integer): Integer;
- function CalculateBCHCode(Value, Poly: Integer): Integer;
- procedure MakeTypeInfoBits(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Bits: TBitArray);
- procedure MakeVersionInfoBits(Version: Integer; Bits: TBitArray);
- function IsEmpty(Value: Integer): Boolean;
- procedure EmbedTimingPatterns(Matrix: TByteMatrix);
- procedure EmbedDarkDotAtLeftBottomCorner(Matrix: TByteMatrix);
- procedure EmbedHorizontalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
- procedure EmbedVerticalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
- procedure EmbedPositionAdjustmentPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
- procedure EmbedPositionDetectionPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
- procedure EmbedPositionDetectionPatternsAndSeparators(Matrix: TByteMatrix);
- procedure MaybeEmbedPositionAdjustmentPatterns(Version: Integer; Matrix: TByteMatrix);
- public
- constructor Create;
- property MatrixUtilError: Boolean read FMatrixUtilError;
- procedure BuildMatrix(DataBits: TBitArray; ECLevel: TErrorCorrectionLevel; Version, MaskPattern: Integer; Matrix: TByteMatrix);
- end;
- function GetModeBits(Mode: TMode): Integer;
- begin
- Result := ModeBits[Mode];
- end;
- function GetModeCharacterCountBits(Mode: TMode; Version: TVersion): Integer;
- var
- Number: Integer;
- Offset: Integer;
- begin
- Number := Version.VersionNumber;
- if (Number <= 9) then
- begin
- Offset := 0;
- end else
- if (number <= 26) then
- begin
- Offset := 1;
- end else
- begin
- Offset := 2;
- end;
- Result := ModeCharacterCountBits[Mode][Offset];
- end;
- type
- TBlockPair = class
- private
- FDataBytes: TByteArray;
- FErrorCorrectionBytes: TByteArray;
- public
- constructor Create(BA1, BA2: TByteArray);
- function GetDataBytes: TByteArray;
- function GetErrorCorrectionBytes: TByteArray;
- end;
- TGenericGFPoly = class;
- TGenericGF = class
- private
- FExpTable: TIntegerArray;
- FLogTable: TIntegerArray;
- FZero: TGenericGFPoly;
- FOne: TGenericGFPoly;
- FSize: Integer;
- FPrimitive: Integer;
- FGeneratorBase: Integer;
- FInitialized: Boolean;
- FPolyList: array of TGenericGFPoly;
- procedure CheckInit;
- procedure Initialize;
- public
- class function CreateQRCodeField256: TGenericGF;
- class function AddOrSubtract(A, B: Integer): Integer;
- constructor Create(Primitive, Size, B: Integer);
- destructor Destroy; override;
- function GetZero: TGenericGFPoly;
- function Exp(A: Integer): Integer;
- function GetGeneratorBase: Integer;
- function Inverse(A: Integer): Integer;
- function Multiply(A, B: Integer): Integer;
- function BuildMonomial(Degree, Coefficient: Integer): TGenericGFPoly;
- end;
- TGenericGFPolyArray = array of TGenericGFPoly;
- TGenericGFPoly = class
- private
- FField: TGenericGF;
- FCoefficients: TIntegerArray;
- public
- constructor Create(AField: TGenericGF; ACoefficients: TIntegerArray);
- destructor Destroy; override;
- function Coefficients: TIntegerArray;
- function Multiply(Other: TGenericGFPoly): TGenericGFPoly;
- function MultiplyByMonomial(Degree, Coefficient: Integer): TGenericGFPoly;
- function Divide(Other: TGenericGFPoly): TGenericGFPolyArray;
- function GetCoefficients: TIntegerArray;
- function IsZero: Boolean;
- function GetCoefficient(Degree: Integer): Integer;
- function GetDegree: Integer;
- function AddOrSubtract(Other: TGenericGFPoly): TGenericGFPoly;
- end;
- TReedSolomonEncoder = class
- private
- FField: TGenericGF;
- FCachedGenerators: TObjectList;
- public
- constructor Create(AField: TGenericGF);
- destructor Destroy; override;
- procedure Encode(ToEncode: TIntegerArray; ECBytes: Integer);
- function BuildGenerator(Degree: Integer): TGenericGFPoly;
- end;
- TEncoder = class
- private
- FEncoderError: Boolean;
- function ApplyMaskPenaltyRule1Internal(Matrix: TByteMatrix;
- IsHorizontal: Boolean): Integer;
- function ChooseMode(const Content: WideString; var EncodeOptions: Integer): TMode; overload;
- function FilterContent(const Content: WideString; Mode: TMode; EncodeOptions: Integer): WideString;
- procedure Append8BitBytes(const Content: WideString; Bits: TBitArray; EncodeOptions: Integer);
- procedure AppendAlphanumericBytes(const Content: WideString;
- Bits: TBitArray);
- procedure AppendBytes(const Content: WideString; Mode: TMode;
- Bits: TBitArray; EncodeOptions: Integer);
- procedure AppendKanjiBytes(const Content: WideString; Bits: TBitArray);
- procedure AppendLengthInfo(NumLetters, VersionNum: Integer; Mode: TMode;
- Bits: TBitArray);
- procedure AppendModeInfo(Mode: TMode; Bits: TBitArray);
- procedure AppendNumericBytes(const Content: WideString; Bits: TBitArray);
- function ChooseMaskPattern(Bits: TBitArray; ECLevel: TErrorCorrectionLevel;
- Version: Integer; Matrix: TByteMatrix): Integer;
- function GenerateECBytes(DataBytes: TByteArray;
- NumECBytesInBlock: Integer): TByteArray;
- function GetAlphanumericCode(Code: Integer): Integer;
- procedure GetNumDataBytesAndNumECBytesForBlockID(NumTotalBytes,
- NumDataBytes, NumRSBlocks, BlockID: Integer; var NumDataBytesInBlock: TIntegerArray;
- var NumECBytesInBlock: TIntegerArray);
- procedure InterleaveWithECBytes(Bits: TBitArray; NumTotalBytes,
- NumDataBytes, NumRSBlocks: Integer; var Result: TBitArray);
- //function IsOnlyDoubleByteKanji(const Content: WideString): Boolean;
- procedure TerminateBits(NumDataBytes: Integer; var Bits: TBitArray);
- function CalculateMaskPenalty(Matrix: TByteMatrix): Integer;
- function ApplyMaskPenaltyRule1(Matrix: TByteMatrix): Integer;
- function ApplyMaskPenaltyRule2(Matrix: TByteMatrix): Integer;
- function ApplyMaskPenaltyRule3(Matrix: TByteMatrix): Integer;
- function ApplyMaskPenaltyRule4(Matrix: TByteMatrix): Integer;
- //procedure Encode(const Content: WideString; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode); overload;
- procedure Encode(const Content: WideString; EncodeOptions: Integer; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode);
- public
- constructor Create;
- property EncoderError: Boolean read FEncoderError;
- end;
- function TEncoder.ApplyMaskPenaltyRule1(Matrix: TByteMatrix): Integer;
- begin
- Result := ApplyMaskPenaltyRule1Internal(Matrix, True) +
- ApplyMaskPenaltyRule1Internal(Matrix, False);
- end;
- // Apply mask penalty rule 2 and return the penalty. Find 2x2 blocks with the same color and give
- // penalty to them.
- function TEncoder.ApplyMaskPenaltyRule2(Matrix: TByteMatrix): Integer;
- var
- Penalty: Integer;
- TheArray: T2DByteArray;
- Width: Integer;
- Height: Integer;
- X: Integer;
- Y: Integer;
- Value: Integer;
- begin
- Penalty := 0;
- TheArray := Matrix.GetArray;
- Width := Matrix.Width;
- Height := Matrix.Height;
- for Y := 0 to Height - 2 do
- begin
- for X := 0 to Width - 2 do
- begin
- Value := TheArray[Y][X];
- if ((Value = TheArray[Y][X + 1]) and (Value = TheArray[Y + 1][X]) and
- (Value = TheArray[Y + 1][X + 1])) then
- begin
- Inc(Penalty, 3);
- end;
- end;
- end;
- Result := Penalty;
- end;
- // Apply mask penalty rule 3 and return the penalty. Find consecutive cells of 00001011101 or
- // 10111010000, and give penalty to them. If we find patterns like 000010111010000, we give
- // penalties twice (i.e. 40 * 2).
- function TEncoder.ApplyMaskPenaltyRule3(Matrix: TByteMatrix): Integer;
- var
- Penalty: Integer;
- TheArray: T2DByteArray;
- Width: Integer;
- Height: Integer;
- X: Integer;
- Y: Integer;
- begin
- Penalty := 0;
- TheArray := Matrix.GetArray;
- Width := Matrix.Width;
- Height := Matrix.Height;
- for Y := 0 to Height - 1 do
- begin
- for X := 0 to Width - 1 do
- begin
- if ((X + 6 < Width) and
- (TheArray[Y][X] = 1) and
- (TheArray[Y][X + 1] = 0) and
- (TheArray[Y][X + 2] = 1) and
- (TheArray[Y][X + 3] = 1) and
- (TheArray[Y][X + 4] = 1) and
- (TheArray[Y][X + 5] = 0) and
- (TheArray[Y][X + 6] = 1) and
- (((X + 10 < Width) and
- (TheArray[Y][X + 7] = 0) and
- (TheArray[Y][X + 8] = 0) and
- (TheArray[Y][X + 9] = 0) and
- (TheArray[Y][X + 10] = 0)) or
- ((x - 4 >= 0) and
- (TheArray[Y][X - 1] = 0) and
- (TheArray[Y][X - 2] = 0) and
- (TheArray[Y][X - 3] = 0) and
- (TheArray[Y][X - 4] = 0)))) then
- begin
- Inc(Penalty, 40);
- end;
- if ((Y + 6 < Height) and
- (TheArray[Y][X] = 1) and
- (TheArray[Y + 1][X] = 0) and
- (TheArray[Y + 2][X] = 1) and
- (TheArray[Y + 3][X] = 1) and
- (TheArray[Y + 4][X] = 1) and
- (TheArray[Y + 5][X] = 0) and
- (TheArray[Y + 6][X] = 1) and
- (((Y + 10 < Height) and
- (TheArray[Y + 7][X] = 0) and
- (TheArray[Y + 8][X] = 0) and
- (TheArray[Y + 9][X] = 0) and
- (TheArray[Y + 10][X] = 0)) or
- ((Y - 4 >= 0) and
- (TheArray[Y - 1][X] = 0) and
- (TheArray[Y - 2][X] = 0) and
- (TheArray[Y - 3][X] = 0) and
- (TheArray[Y - 4][X] = 0)))) then
- begin
- Inc(Penalty, 40);
- end;
- end;
- end;
- Result := Penalty;
- end;
- // Apply mask penalty rule 4 and return the penalty. Calculate the ratio of dark cells and give
- // penalty if the ratio is far from 50%. It gives 10 penalty for 5% distance. Examples:
- // - 0% => 100
- // - 40% => 20
- // - 45% => 10
- // - 50% => 0
- // - 55% => 10
- // - 55% => 20
- // - 100% => 100
- function TEncoder.ApplyMaskPenaltyRule4(Matrix: TByteMatrix): Integer;
- var
- NumDarkCells: Integer;
- TheArray: T2DByteArray;
- Width: Integer;
- Height: Integer;
- NumTotalCells: Integer;
- DarkRatio: Double;
- X: Integer;
- Y: Integer;
- begin
- NumDarkCells := 0;
- TheArray := Matrix.GetArray;
- Width := Matrix.Width;
- Height := matrix.Height;
- for Y := 0 to Height - 1 do
- begin
- for X := 0 to Width - 1 do
- begin
- if (TheArray[Y][X] = 1) then
- begin
- Inc(NumDarkCells);
- end;
- end;
- end;
- numTotalCells := matrix.Height * Matrix.Width;
- DarkRatio := NumDarkCells / NumTotalCells;
- Result := Round(Abs((DarkRatio * 100 - 50)) / 50);
- end;
- // Helper function for applyMaskPenaltyRule1. We need this for doing this calculation in both
- // vertical and horizontal orders respectively.
- function TEncoder.ApplyMaskPenaltyRule1Internal(Matrix: TByteMatrix; IsHorizontal: Boolean): Integer;
- var
- Penalty: Integer;
- NumSameBitCells: Integer;
- PrevBit: Integer;
- TheArray: T2DByteArray;
- I: Integer;
- J: Integer;
- Bit: Integer;
- ILimit: Integer;
- JLimit: Integer;
- begin
- Penalty := 0;
- NumSameBitCells := 0;
- PrevBit := -1;
- // Horizontal mode:
- // for (int i = 0; i < matrix.height(); ++i) {
- // for (int j = 0; j < matrix.width(); ++j) {
- // int bit = matrix.get(i, j);
- // Vertical mode:
- // for (int i = 0; i < matrix.width(); ++i) {
- // for (int j = 0; j < matrix.height(); ++j) {
- // int bit = matrix.get(j, i);
- if (IsHorizontal) then
- begin
- ILimit := Matrix.Height;
- JLimit := Matrix.Width;
- end else
- begin
- ILimit := Matrix.Width;
- JLimit := Matrix.Height;
- end;
- TheArray := Matrix.GetArray;
- for I := 0 to ILimit - 1 do
- begin
- for J := 0 to JLimit - 1 do
- begin
- if (IsHorizontal) then
- begin
- Bit := TheArray[I][J];
- end else
- begin
- Bit := TheArray[J][I];
- end;
- if (Bit = PrevBit) then
- begin
- Inc(NumSameBitCells);
- // Found five repetitive cells with the same color (bit).
- // We'll give penalty of 3.
- if (NumSameBitCells = 5) then
- begin
- Inc(Penalty, 3);
- end else if (NumSameBitCells > 5) then
- begin
- // After five repetitive cells, we'll add the penalty one
- // by one.
- Inc(Penalty, 1);;
- end;
- end else
- begin
- NumSameBitCells := 1; // Include the cell itself.
- PrevBit := bit;
- end;
- end;
- NumSameBitCells := 0; // Clear at each row/column.
- end;
- Result := Penalty;
- end;
- { TQRCode }
- constructor TQRCode.Create;
- begin
- FMode := qmTerminator;
- FQRCodeError := False;
- FECLevel := nil;
- FVersion := -1;
- FMatrixWidth := -1;
- FMaskPattern := -1;
- FNumTotalBytes := -1;
- FNumDataBytes := -1;
- FNumECBytes := -1;
- FNumRSBlocks := -1;
- FMatrix := nil;
- end;
- destructor TQRCode.Destroy;
- begin
- if (Assigned(FECLevel)) then
- begin
- FECLevel.Free;
- end;
- if (Assigned(FMatrix)) then
- begin
- FMatrix.Free;
- end;
- inherited;
- end;
- function TQRCode.At(X, Y: Integer): Integer;
- var
- Value: Integer;
- begin
- // The value must be zero or one.
- Value := FMatrix.Get(X, Y);
- if (not ((Value = 0) or (Value = 1))) then
- begin
- FQRCodeError := True;
- end;
- Result := Value;
- end;
- function TQRCode.IsValid: Boolean;
- begin
- Result :=
- // First check if all version are not uninitialized.
- ((FECLevel <> nil) and
- (FVersion <> -1) and
- (FMatrixWidth <> -1) and
- (FMaskPattern <> -1) and
- (FNumTotalBytes <> -1) and
- (FNumDataBytes <> -1) and
- (FNumECBytes <> -1) and
- (FNumRSBlocks <> -1) and
- // Then check them in other ways..
- IsValidMaskPattern(FMaskPattern) and
- (FNumTotalBytes = FNumDataBytes + FNumECBytes) and
- // ByteMatrix stuff.
- (Assigned(FMatrix)) and
- (FMatrixWidth = FMatrix.Width) and
- // See 7.3.1 of JISX0510:2004 (Fp.5).
- (FMatrix.Width = FMatrix.Height)); // Must be square.
- end;
- function TQRCode.IsValidMaskPattern(MaskPattern: Integer): Boolean;
- begin
- Result := (MaskPattern >= 0) and (MaskPattern < NUM_MASK_PATTERNS);
- end;
- procedure TQRCode.SetMatrix(NewMatrix: TByteMatrix);
- begin
- if (Assigned(FMatrix)) then
- begin
- FMatrix.Free;
- FMatrix := nil;
- end;
- FMatrix := NewMatrix;
- end;
- procedure TQRCode.SetAll(VersionNum, NumBytes, NumDataBytes, NumRSBlocks,
- NumECBytes, MatrixWidth: Integer);
- begin
- FVersion := VersionNum;
- FNumTotalBytes := NumBytes;
- FNumDataBytes := NumDataBytes;
- FNumRSBlocks := NumRSBlocks;
- FNumECBytes := NumECBytes;
- FMatrixWidth := MatrixWidth;
- end;
- procedure TQRCode.SetECLevel(NewECLevel: TErrorCorrectionLevel);
- begin
- if (Assigned(FECLevel)) then
- begin
- FECLevel.Free;
- end;
- FECLevel := TErrorCorrectionLevel.Create;
- FECLevel.Assign(NewECLevel);
- end;
- { TByteMatrix }
- procedure TByteMatrix.Clear(Value: Byte);
- var
- X, Y: Integer;
- begin
- for Y := 0 to FHeight - 1 do
- begin
- for X := 0 to FWidth - 1 do
- begin
- Bytes[Y][X] := Value;
- end;
- end;
- end;
- constructor TByteMatrix.Create(Width, Height: Integer);
- var
- Y: Integer;
- X: Integer;
- begin
- FWidth := Width;
- FHeight := Height;
- SetLength(Bytes, Height);
- for Y := 0 to Height - 1 do
- begin
- SetLength(Bytes[Y], Width);
- for X := 0 to Width - 1 do
- begin
- Bytes[Y][X] := 0;
- end;
- end;
- end;
- function TByteMatrix.Get(X, Y: Integer): Integer;
- begin
- if (Bytes[Y][X] = 255) then Result := -1 else Result := Bytes[Y][X];
- end;
- function TByteMatrix.GetArray: T2DByteArray;
- begin
- Result := Bytes;
- end;
- function TByteMatrix.Hash: AnsiString;
- var
- X, Y: Integer;
- Counter: Integer;
- CC: Integer;
- begin
- Result := '';
- for Y := 0 to FHeight - 1 do
- begin
- Counter := 0;
- for X := 0 to FWidth - 1 do
- begin
- CC := Get(X, Y);
- if (CC = -1) then CC := 255;
- Counter := Counter + CC;
- end;
- Result := Result + AnsiChar((Counter mod 26) + 65);
- end;
- end;
- procedure TByteMatrix.SetBoolean(X, Y: Integer; Value: Boolean);
- begin
- Bytes[Y][X] := Byte(Value) and $FF;
- end;
- procedure TByteMatrix.SetInteger(X, Y, Value: Integer);
- begin
- Bytes[Y][X] := Value and $FF;
- end;
- procedure TByteMatrix.Assign(Source: TByteMatrix);
- var
- SourceLength: Integer;
- begin
- SourceLength := Length(Source.Bytes);
- SetLength(Bytes, SourceLength);
- if (SourceLength > 0) then
- begin
- Move(Source.Bytes[0], Bytes[0], SourceLength);
- end;
- FWidth := Source.Width;
- FHeight := Source.Height;
- end;
- { TEncoder }
- function TEncoder.CalculateMaskPenalty(Matrix: TByteMatrix): Integer;
- var
- Penalty: Integer;
- begin
- Penalty := 0;
- Inc(Penalty, ApplyMaskPenaltyRule1(Matrix));
- Inc(Penalty, ApplyMaskPenaltyRule2(Matrix));
- Inc(Penalty, ApplyMaskPenaltyRule3(Matrix));
- Inc(Penalty, ApplyMaskPenaltyRule4(Matrix));
- Result := Penalty;
- end;
- {procedure TEncoder.Encode(const Content: WideString; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode);
- begin
- Encode(Content, ECLevel, nil, QRCode);
- end;}
- procedure TEncoder.Encode(const Content: WideString; EncodeOptions: Integer; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode);
- var
- Mode: TMode;
- DataBits: TBitArray;
- FinalBits: TBitArray;
- HeaderBits: TBitArray;
- HeaderAndDataBits: TBitArray;
- Matrix: TByteMatrix;
- NumLetters: Integer;
- MatrixUtil: TMatrixUtil;
- BitsNeeded: Integer;
- ProvisionalBitsNeeded: Integer;
- ProvisionalVersion: TVersion;
- Version: TVersion;
- ECBlocks: TECBlocks;
- NumDataBytes: Integer;
- Dimension: Integer;
- FilteredContent: WideString;
- begin
- DataBits := TBitArray.Create;
- HeaderBits := TBitArray.Create;
- // Pick an encoding mode appropriate for the content. Note that this will not attempt to use
- // multiple modes / segments even if that were more efficient. Twould be nice.
- // Collect data within the main segment, separately, to count its size if needed. Don't add it to
- // main payload yet.
- Mode := ChooseMode(Content, EncodeOptions);
- FilteredContent := FilterContent(Content, Mode, EncodeOptions);
- AppendBytes(FilteredContent, Mode, DataBits, EncodeOptions);
- // (With ECI in place,) Write the mode marker
- AppendModeInfo(Mode, HeaderBits);
- // Hard part: need to know version to know how many bits length takes. But need to know how many
- // bits it takes to know version. First we take a guess at version by assuming version will be
- // the minimum, 1:
- ProvisionalVersion := TVersion.GetVersionForNumber(1);
- try
- ProvisionalBitsNeeded := HeaderBits.GetSize +
- GetModeCharacterCountBits(Mode, ProvisionalVersion) +
- DataBits.GetSize;
- finally
- ProvisionalVersion.Free;
- end;
- ProvisionalVersion := TVersion.ChooseVersion(ProvisionalBitsNeeded, ECLevel);
- try
- // Use that guess to calculate the right version. I am still not sure this works in 100% of cases.
- BitsNeeded := HeaderBits.GetSize +
- GetModeCharacterCountBits(Mode, ProvisionalVersion) +
- DataBits.GetSize;
- Version := TVersion.ChooseVersion(BitsNeeded, ECLevel);
- finally
- ProvisionalVersion.Free;
- end;
- HeaderAndDataBits := TBitArray.Create;
- FinalBits := TBitArray.Create;
- try
- HeaderAndDataBits.AppendBitArray(HeaderBits);
- // Find "length" of main segment and write it
- if (Mode = qmByte) then
- begin
- NumLetters := DataBits.GetSizeInBytes;
- end else
- begin
- NumLetters := Length(FilteredContent);
- end;
- AppendLengthInfo(NumLetters, Version.VersionNumber, Mode, HeaderAndDataBits);
- // Put data together into the overall payload
- HeaderAndDataBits.AppendBitArray(DataBits);
- ECBlocks := Version.GetECBlocksForLevel(ECLevel);
- NumDataBytes := Version.GetTotalCodewords - ECBlocks.GetTotalECCodewords;
- // Terminate the bits properly.
- TerminateBits(NumDataBytes, HeaderAndDataBits);
- // Interleave data bits with error correction code.
- InterleaveWithECBytes(HeaderAndDataBits, Version.GetTotalCodewords,
- NumDataBytes, ECBlocks.GetNumBlocks, FinalBits);
- // QRCode qrCode = new QRCode(); // This is passed in
- QRCode.SetECLevel(ECLevel);
- QRCode.Mode := Mode;
- QRCode.Version := Version.VersionNumber;
- // Choose the mask pattern and set to "qrCode".
- Dimension := Version.GetDimensionForVersion;
- Matrix := TByteMatrix.Create(Dimension, Dimension);
- QRCode.MaskPattern := ChooseMaskPattern(FinalBits, ECLevel, Version.VersionNumber, Matrix);
- Matrix.Free;
- Matrix := TByteMatrix.Create(Dimension, Dimension);
- // Build the matrix and set it to "qrCode".
- MatrixUtil := TMatrixUtil.Create;
- try
- MatrixUtil.BuildMatrix(FinalBits, QRCode.ECLevel, QRCode.Version,
- QRCode.MaskPattern, Matrix);
- finally
- MatrixUtil.Free;
- end;
- QRCode.SetMatrix(Matrix); // QRCode will free the matrix
- finally
- DataBits.Free;
- HeaderAndDataBits.Free;
- FinalBits.Free;
- HeaderBits.Free;
- Version.Free;
- end;
- end;
- function TEncoder.FilterContent(const Content: WideString; Mode: TMode;
- EncodeOptions: Integer): WideString;
- var
- X: Integer;
- CanAdd: Boolean;
- begin
- Result := '';
- for X := 1 to Length(Content) do
- begin
- CanAdd := False;
- if (Mode = qmNumeric) then
- begin
- CanAdd := (Content[X] >= '0') and (Content[X] <= '9');
- end else
- if (Mode = qmAlphanumeric) then
- begin
- CanAdd := GetAlphanumericCode(Ord(Content[X])) > 0;
- end else
- if (Mode = qmByte) then
- begin
- if (EncodeOptions = 3) then
- begin
- CanAdd := Ord(Content[X]) <= $FF;
- end else
- if ((EncodeOptions = 4) or (EncodeOptions = 5)) then
- begin
- CanAdd := True;
- end;
- end;
- if (CanAdd) then
- begin
- Result := Result + Content[X];
- end;
- end;
- end;
- // Return the code point of the table used in alphanumeric mode or
- // -1 if there is no corresponding code in the table.
- function TEncoder.GetAlphanumericCode(Code: Integer): Integer;
- begin
- if (Code < Length(ALPHANUMERIC_TABLE)) then
- begin
- Result := ALPHANUMERIC_TABLE[Code];
- end else
- begin
- Result := -1;
- end;
- end;
- // Choose the mode based on the content
- function TEncoder.ChooseMode(const Content: WideString; var EncodeOptions: Integer): TMode;
- var
- AllNumeric: Boolean;
- AllAlphanumeric: Boolean;
- AllISO: Boolean;
- I: Integer;
- C: WideChar;
- begin
- if (EncodeOptions = 0) then
- begin
- AllNumeric := Length(Content) > 0;
- I := 1;
- while (I <= Length(Content)) and (AllNumeric) do
- begin
- C := Content[I];
- if ((C < '0') or (C > '9')) then
- begin
- AllNumeric := False;
- end else
- begin
- Inc(I);
- end;
- end;
- if (not AllNumeric) then
- begin
- AllAlphanumeric := Length(Content) > 0;
- I := 1;
- while (I <= Length(Content)) and (AllAlphanumeric) do
- begin
- C := Content[I];
- if (GetAlphanumericCode(Ord(C)) < 0) then
- begin
- AllAlphanumeric := False;
- end else
- begin
- Inc(I);
- end;
- end;
- end else
- begin
- AllAlphanumeric := False;
- end;
- if (not AllAlphanumeric) then
- begin
- AllISO := Length(Content) > 0;
- I := 1;
- while (I <= Length(Content)) and (AllISO) do
- begin
- C := Content[I];
- if (Ord(C) > $FF) then
- begin
- AllISO := False;
- end else
- begin
- Inc(I);
- end;
- end;
- end else
- begin
- AllISO := False;
- end;
- if (AllNumeric) then
- begin
- Result := qmNumeric;
- end else
- if (AllAlphanumeric) then
- begin
- Result := qmAlphanumeric;
- end else
- if (AllISO) then
- begin
- Result := qmByte;
- EncodeOptions := 3;
- end else
- begin
- Result := qmByte;
- EncodeOptions := 4;
- end;
- end else
- if (EncodeOptions = 1) then
- begin
- Result := qmNumeric;
- end else
- if (EncodeOptions = 2) then
- begin
- Result := qmAlphanumeric;
- end else
- begin
- Result := qmByte;
- end;
- end;
- constructor TEncoder.Create;
- begin
- FEncoderError := False;
- end;
- {function TEncoder.IsOnlyDoubleByteKanji(const Content: WideString): Boolean;
- var
- I: Integer;
- Char1: Integer;
- begin
- Result := True;
- I := 0;
- while ((I < Length(Content)) and Result) do
- begin
- Char1 := Ord(Content[I + 1]);
- if (((Char1 < $81) or (Char1 > $9F)) and ((Char1 < $E0) or (Char1 > $EB))) then
- begin
- Result := False;
- end;
- end;
- end;}
- function TEncoder.ChooseMaskPattern(Bits: TBitArray; ECLevel: TErrorCorrectionLevel; Version: Integer; Matrix: TByteMatrix): Integer;
- var
- MinPenalty: Integer;
- BestMaskPattern: Integer;
- MaskPattern: Integer;
- MatrixUtil: TMatrixUtil;
- Penalty: Integer;
- begin
- MinPenalty := MaxInt;
- BestMaskPattern := -1;
- // We try all mask patterns to choose the best one.
- for MaskPattern := 0 to NUM_MASK_PATTERNS - 1 do
- begin
- MatrixUtil := TMatrixUtil.Create;
- try
- MatrixUtil.BuildMatrix(Bits, ECLevel, Version, MaskPattern, Matrix);
- finally
- MatrixUtil.Free;
- end;
- Penalty := CalculateMaskPenalty(Matrix);
- if (Penalty < MinPenalty) then
- begin
- MinPenalty := Penalty;
- BestMaskPattern := MaskPattern;
- end;
- end;
- Result := BestMaskPattern;
- end;
- // Terminate bits as described in 8.4.8 and 8.4.9 of JISX0510:2004 (p.24).
- procedure TEncoder.TerminateBits(NumDataBytes: Integer; var Bits: TBitArray);
- var
- Capacity: Integer;
- I: Integer;
- NumBitsInLastByte: Integer;
- NumPaddingBytes: Integer;
- begin
- Capacity := NumDataBytes shl 3;
- if (Bits.GetSize > Capacity) then
- begin
- FEncoderError := True;
- Exit;
- end;
- I := 0;
- while ((I < 4) and (Bits.GetSize < capacity)) do
- begin
- Bits.AppendBit(False);
- Inc(I);
- end;
- // Append termination bits. See 8.4.8 of JISX0510:2004 (p.24) for details.
- // If the last byte isn't 8-bit aligned, we'll add padding bits.
- NumBitsInLastByte := Bits.GetSize and $07;
- if (NumBitsInLastByte > 0) then
- begin
- for I := numBitsInLastByte to 7 do
- begin
- Bits.AppendBit(False);
- end;
- end;
- // If we have more space, we'll fill the space with padding patterns defined in 8.4.9 (p.24).
- NumPaddingBytes := NumDataBytes - Bits.GetSizeInBytes;
- for I := 0 to NumPaddingBytes - 1 do
- begin
- if ((I and $01) = 0) then
- begin
- Bits.AppendBits($EC, 8);
- end else
- begin
- Bits.AppendBits($11, 8);
- end;
- end;
- if (Bits.GetSize <> Capacity) then
- begin
- FEncoderError := True;
- end;
- end;
- // Get number of data bytes and number of error correction bytes for block id "blockID". Store
- // the result in "numDataBytesInBlock", and "numECBytesInBlock". See table 12 in 8.5.1 of
- // JISX0510:2004 (p.30)
- procedure TEncoder.GetNumDataBytesAndNumECBytesForBlockID(NumTotalBytes, NumDataBytes,
- NumRSBlocks, BlockID: Integer; var NumDataBytesInBlock: TIntegerArray;
- var NumECBytesInBlock: TIntegerArray);
- var
- NumRSBlocksInGroup1: Integer;
- NumRSBlocksInGroup2: Integer;
- NumTotalBytesInGroup1: Integer;
- NumTotalBytesInGroup2: Integer;
- NumDataBytesInGroup1: Integer;
- NumDataBytesInGroup2: Integer;
- NumECBytesInGroup1: Integer;
- NumECBytesInGroup2: Integer;
- begin
- if (BlockID >= NumRSBlocks) then
- begin
- FEncoderError := True;
- Exit;
- end;
- // numRsBlocksInGroup2 = 196 % 5 = 1
- NumRSBlocksInGroup2 := NumTotalBytes mod NumRSBlocks;
- // numRsBlocksInGroup1 = 5 - 1 = 4
- NumRSBlocksInGroup1 := NumRSBlocks - NumRSBlocksInGroup2;
- // numTotalBytesInGroup1 = 196 / 5 = 39
- NumTotalBytesInGroup1 := NumTotalBytes div NumRSBlocks;
- // numTotalBytesInGroup2 = 39 + 1 = 40
- NumTotalBytesInGroup2 := NumTotalBytesInGroup1 + 1;
- // numDataBytesInGroup1 = 66 / 5 = 13
- NumDataBytesInGroup1 := NumDataBytes div NumRSBlocks;
- // numDataBytesInGroup2 = 13 + 1 = 14
- NumDataBytesInGroup2 := NumDataBytesInGroup1 + 1;
- // numEcBytesInGroup1 = 39 - 13 = 26
- NumECBytesInGroup1 := NumTotalBytesInGroup1 - NumDataBytesInGroup1;
- // numEcBytesInGroup2 = 40 - 14 = 26
- NumECBytesInGroup2 := NumTotalBytesInGroup2 - NumDataBytesInGroup2;
- // Sanity checks.
- // 26 = 26
- if (NumECBytesInGroup1 <> NumECBytesInGroup2) then
- begin
- FEncoderError := True;
- Exit;
- end;
- // 5 = 4 + 1.
- if (NumRSBlocks <> (NumRSBlocksInGroup1 + NumRSBlocksInGroup2)) then
- begin
- FEncoderError := True;
- Exit;
- end;
- // 196 = (13 + 26) * 4 + (14 + 26) * 1
- if (NumTotalBytes <>
- ((NumDataBytesInGroup1 + NumECBytesInGroup1) * NumRsBlocksInGroup1) +
- ((NumDataBytesInGroup2 + NumECBytesInGroup2) * NumRsBlocksInGroup2)) then
- begin
- FEncoderError := True;
- Exit;
- end;
- if (BlockID < NumRSBlocksInGroup1) then
- begin
- NumDataBytesInBlock[0] := NumDataBytesInGroup1;
- NumECBytesInBlock[0] := numECBytesInGroup1;
- end else
- begin
- NumDataBytesInBlock[0] := NumDataBytesInGroup2;
- NumECBytesInBlock[0] := numEcBytesInGroup2;
- end;
- end;
- // Interleave "bits" with corresponding error correction bytes. On success, store the result in
- // "result". The interleave rule is complicated. See 8.6 of JISX0510:2004 (p.37) for details.
- procedure TEncoder.InterleaveWithECBytes(Bits: TBitArray; NumTotalBytes,
- NumDataBytes, NumRSBlocks: Integer; var Result: TBitArray);
- var
- DataBytesOffset: Integer;
- MaxNumDataBytes: Integer;
- MaxNumECBytes: Integer;
- Blocks: TObjectList;
- NumDataBytesInBlock: TIntegerArray;
- NumECBytesInBlock: TIntegerArray;
- Size: Integer;
- DataBytes: TByteArray;
- ECBytes: TByteArray;
- I, J: Integer;
- BlockPair: TBlockPair;
- begin
- SetLength(ECBytes, 0);
- // "bits" must have "getNumDataBytes" bytes of data.
- if (Bits.GetSizeInBytes <> NumDataBytes) then
- begin
- FEncoderError := True;
- Exit;
- end;
- // Step 1. Divide data bytes into blocks and generate error correction bytes for them. We'll
- // store the divided data bytes blocks and error correction bytes blocks into "blocks".
- DataBytesOffset := 0;
- MaxNumDataBytes := 0;
- MaxNumEcBytes := 0;
- // Since, we know the number of reedsolmon blocks, we can initialize the vector with the number.
- Blocks := TObjectList.Create(True);
- try
- Blocks.Capacity := NumRSBlocks;
- for I := 0 to NumRSBlocks - 1 do
- begin
- SetLength(NumDataBytesInBlock, 1);
- SetLength(NumECBytesInBlock, 1);
- GetNumDataBytesAndNumECBytesForBlockID(
- NumTotalBytes, NumDataBytes, NumRSBlocks, I,
- NumDataBytesInBlock, NumEcBytesInBlock);
- Size := NumDataBytesInBlock[0];
- SetLength(DataBytes, Size);
- Bits.ToBytes(8 * DataBytesOffset, DataBytes, 0, Size);
- ECBytes := GenerateECBytes(DataBytes, NumEcBytesInBlock[0]);
- BlockPair := TBlockPair.Create(DataBytes, ECBytes);
- Blocks.Add(BlockPair);
- MaxNumDataBytes := Max(MaxNumDataBytes, Size);
- MaxNumECBytes := Max(MaxNumECBytes, Length(ECBytes));
- Inc(DataBytesOffset, NumDataBytesInBlock[0]);
- end;
- if (NumDataBytes <> DataBytesOffset) then
- begin
- FEncoderError := True;
- Exit;
- end;
- // First, place data blocks.
- for I := 0 to MaxNumDataBytes - 1 do
- begin
- for J := 0 to Blocks.Count - 1 do
- begin
- DataBytes := TBlockPair(Blocks.Items[J]).GetDataBytes;
- if (I < Length(DataBytes)) then
- begin
- Result.AppendBits(DataBytes[I], 8);
- end;
- end;
- end;
- // Then, place error correction blocks.
- for I := 0 to MaxNumECBytes - 1 do
- begin
- for J := 0 to Blocks.Count - 1 do
- begin
- ECBytes := TBlockPair(Blocks.Items[J]).GetErrorCorrectionBytes;
- if (I < Length(ECBytes)) then
- begin
- Result.AppendBits(ECBytes[I], 8);
- end;
- end;
- end;
- finally
- Blocks.Free;
- end;
- if (numTotalBytes <> Result.GetSizeInBytes) then // Should be same.
- begin
- FEncoderError := True;
- Exit;
- end;
- end;
- function TEncoder.GenerateECBytes(DataBytes: TByteArray; NumECBytesInBlock: Integer): TByteArray;
- var
- NumDataBytes: Integer;
- ToEncode: TIntegerArray;
- ReedSolomonEncoder: TReedSolomonEncoder;
- I: Integer;
- ECBytes: TByteArray;
- GenericGF: TGenericGF;
- begin
- NumDataBytes := Length(DataBytes);
- SetLength(ToEncode, NumDataBytes + NumECBytesInBlock);
- for I := 0 to NumDataBytes - 1 do
- begin
- ToEncode[I] := DataBytes[I] and $FF;
- end;
- GenericGF := TGenericGF.CreateQRCodeField256;
- try
- ReedSolomonEncoder := TReedSolomonEncoder.Create(GenericGF);
- try
- ReedSolomonEncoder.Encode(ToEncode, NumECBytesInBlock);
- finally
- ReedSolomonEncoder.Free;
- end;
- finally
- GenericGF.Free;
- end;
- SetLength(ECBytes, NumECBytesInBlock);
- for I := 0 to NumECBytesInBlock - 1 do
- begin
- ECBytes[I] := ToEncode[NumDataBytes + I];
- end;
- Result := ECBytes;
- end;
- // Append mode info. On success, store the result in "bits".
- procedure TEncoder.AppendModeInfo(Mode: TMode; Bits: TBitArray);
- begin
- Bits.AppendBits(GetModeBits(Mode), 4);
- end;
- // Append length info. On success, store the result in "bits".
- procedure TEncoder.AppendLengthInfo(NumLetters, VersionNum: Integer; Mode: TMode; Bits: TBitArray);
- var
- NumBits: Integer;
- Version: TVersion;
- begin
- Version := TVersion.GetVersionForNumber(VersionNum);
- try
- NumBits := GetModeCharacterCountBits(Mode, Version);
- finally
- Version.Free;
- end;
- if (NumLetters > ((1 shl NumBits) - 1)) then
- begin
- FEncoderError := True;
- Exit;
- end;
- Bits.AppendBits(NumLetters, NumBits);
- end;
- // Append "bytes" in "mode" mode (encoding) into "bits". On success, store the result in "bits".
- procedure TEncoder.AppendBytes(const Content: WideString; Mode: TMode; Bits: TBitArray; EncodeOptions: Integer);
- begin
- if (Mode = qmNumeric) then
- begin
- AppendNumericBytes(Content, Bits);
- end else
- if (Mode = qmAlphanumeric) then
- begin
- AppendAlphanumericBytes(Content, Bits);
- end else
- if (Mode = qmByte) then
- begin
- Append8BitBytes(Content, Bits, EncodeOptions);
- end else
- if (Mode = qmKanji) then
- begin
- AppendKanjiBytes(Content, Bits);
- end else
- begin
- FEncoderError := True;
- Exit;
- end;
- end;
- procedure TEncoder.AppendNumericBytes(const Content: WideString; Bits: TBitArray);
- var
- ContentLength: Integer;
- I: Integer;
- Num1: Integer;
- Num2: Integer;
- Num3: Integer;
- begin
- ContentLength := Length(Content);
- I := 0;
- while (I < ContentLength) do
- begin
- Num1 := Ord(Content[I + 0 + 1]) - Ord('0');
- if (I + 2 < ContentLength) then
- begin
- // Encode three numeric letters in ten bits.
- Num2 := Ord(Content[I + 1 + 1]) - Ord('0');
- Num3 := Ord(Content[I + 2 + 1]) - Ord('0');
- Bits.AppendBits(Num1 * 100 + Num2 * 10 + Num3, 10);
- Inc(I, 3);
- end else
- if (I + 1 < ContentLength) then
- begin
- // Encode two numeric letters in seven bits.
- Num2 := Ord(Content[I + 1 + 1]) - Ord('0');
- Bits.AppendBits(Num1 * 10 + Num2, 7);
- Inc(I, 2);
- end else
- begin
- // Encode one numeric letter in four bits.
- Bits.AppendBits(Num1, 4);
- Inc(I);
- end;
- end;
- end;
- procedure TEncoder.AppendAlphanumericBytes(const Content: WideString; Bits: TBitArray);
- var
- ContentLength: Integer;
- I: Integer;
- Code1: Integer;
- Code2: Integer;
- begin
- ContentLength := Length(Content);
- I := 0;
- while (I < ContentLength) do
- begin
- Code1 := GetAlphanumericCode(Ord(Content[I + 0 + 1]));
- if (Code1 = -1) then
- begin
- FEncoderError := True;
- Exit;
- end;
- if (I + 1 < ContentLength) then
- begin
- Code2 := GetAlphanumericCode(Ord(Content[I + 1 + 1]));
- if (Code2 = -1) then
- begin
- FEncoderError := True;
- Exit;
- end;
- // Encode two alphanumeric letters in 11 bits.
- Bits.AppendBits(Code1 * 45 + Code2, 11);
- Inc(I, 2);
- end else
- begin
- // Encode one alphanumeric letter in six bits.
- Bits.AppendBits(Code1, 6);
- Inc(I);
- end;
- end;
- end;
- procedure TEncoder.Append8BitBytes(const Content: WideString; Bits: TBitArray; EncodeOptions: Integer);
- var
- Bytes: TByteArray;
- I: Integer;
- UTF8Version: AnsiString;
- begin
- SetLength(Bytes, 0);
- if (EncodeOptions = 3) then
- begin
- SetLength(Bytes, Length(Content));
- for I := 1 to Length(Content) do
- begin
- Bytes[I - 1] := Ord(Content[I]) and $FF;
- end;
- end else
- if (EncodeOptions = 4) then
- begin
- // Add the UTF-8 BOM
- UTF8Version := #$EF#$BB#$BF + UTF8Encode(Content);
- SetLength(Bytes, Length(UTF8Version));
- if (Length(UTF8Version) > 0) then
- begin
- Move(UTF8Version[1], Bytes[0], Length(UTF8Version));
- end;
- end else
- if (EncodeOptions = 5) then
- begin
- // No BOM
- UTF8Version := UTF8Encode(Content);
- SetLength(Bytes, Length(UTF8Version));
- if (Length(UTF8Version) > 0) then
- begin
- Move(UTF8Version[1], Bytes[0], Length(UTF8Version));
- end;
- end;
- for I := 0 to Length(Bytes) - 1 do
- begin
- Bits.AppendBits(Bytes[I], 8);
- end;
- end;
- procedure TEncoder.AppendKanjiBytes(const Content: WideString; Bits: TBitArray);
- var
- Bytes: TByteArray;
- ByteLength: Integer;
- I: Integer;
- Byte1: Integer;
- Byte2: Integer;
- Code: Integer;
- Subtracted: Integer;
- Encoded: Integer;
- begin
- SetLength(Bytes, 0);
- try
- except
- FEncoderError := True;
- Exit;
- end;
- ByteLength := Length(Bytes);
- I := 0;
- while (I < ByteLength) do
- begin
- Byte1 := Bytes[I] and $FF;
- Byte2 := Bytes[I + 1] and $FF;
- Code := (Byte1 shl 8) or Byte2;
- Subtracted := -1;
- if ((Code >= $8140) and (Code <= $9ffc)) then
- begin
- Subtracted := Code - $8140;
- end else
- if ((Code >= $e040) and (Code <= $ebbf)) then
- begin
- Subtracted := Code - $c140;
- end;
- if (Subtracted = -1) then
- begin
- FEncoderError := True;
- Exit;
- end;
- Encoded := ((Subtracted shr 8) * $c0) + (Subtracted and $ff);
- Bits.AppendBits(Encoded, 13);
- Inc(I, 2);
- end;
- end;
- procedure TMatrixUtil.ClearMatrix(Matrix: TByteMatrix);
- begin
- Matrix.Clear(Byte(-1));
- end;
- constructor TMatrixUtil.Create;
- begin
- FMatrixUtilError := False;
- end;
- // Build 2D matrix of QR Code from "dataBits" with "ecLevel", "version" and "getMaskPattern". On
- // success, store the result in "matrix" and return true.
- procedure TMatrixUtil.BuildMatrix(DataBits: TBitArray; ECLevel: TErrorCorrectionLevel;
- Version, MaskPattern: Integer; Matrix: TByteMatrix);
- begin
- ClearMatrix(Matrix);
- EmbedBasicPatterns(Version, Matrix);
- // Type information appear with any version.
- EmbedTypeInfo(ECLevel, MaskPattern, Matrix);
- // Version info appear if version >= 7.
- MaybeEmbedVersionInfo(Version, Matrix);
- // Data should be embedded at end.
- EmbedDataBits(DataBits, MaskPattern, Matrix);
- end;
- // Embed basic patterns. On success, modify the matrix and return true.
- // The basic patterns are:
- // - Position detection patterns
- // - Timing patterns
- // - Dark dot at the left bottom corner
- // - Position adjustment patterns, if need be
- procedure TMatrixUtil.EmbedBasicPatterns(Version: Integer; Matrix: TByteMatrix);
- begin
- // Let's get started with embedding big squares at corners.
- EmbedPositionDetectionPatternsAndSeparators(Matrix);
- // Then, embed the dark dot at the left bottom corner.
- EmbedDarkDotAtLeftBottomCorner(Matrix);
- // Position adjustment patterns appear if version >= 2.
- MaybeEmbedPositionAdjustmentPatterns(Version, Matrix);
- // Timing patterns should be embedded after position adj. patterns.
- EmbedTimingPatterns(Matrix);
- end;
- // Embed type information. On success, modify the matrix.
- procedure TMatrixUtil.EmbedTypeInfo(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Matrix: TByteMatrix);
- var
- TypeInfoBits: TBitArray;
- I: Integer;
- Bit: Boolean;
- X1, Y1: Integer;
- X2, Y2: Integer;
- begin
- TypeInfoBits := TBitArray.Create;
- try
- MakeTypeInfoBits(ECLevel, MaskPattern, TypeInfoBits);
- for I := 0 to TypeInfoBits.GetSize - 1 do
- begin
- // Place bits in LSB to MSB order. LSB (least significant bit) is the last value in
- // "typeInfoBits".
- Bit := TypeInfoBits.Get(TypeInfoBits.GetSize - 1 - I);
- // Type info bits at the left top corner. See 8.9 of JISX0510:2004 (p.46).
- X1 := TYPE_INFO_COORDINATES[I][0];
- Y1 := TYPE_INFO_COORDINATES[I][1];
- Matrix.SetBoolean(X1, Y1, Bit);
- if (I < 8) then
- begin
- // Right top corner.
- X2 := Matrix.Width - I - 1;
- Y2 := 8;
- Matrix.SetBoolean(X2, Y2, Bit);
- end else
- begin
- // Left bottom corner.
- X2 := 8;
- Y2 := Matrix.Height - 7 + (I - 8);
- Matrix.SetBoolean(X2, Y2, Bit);
- end;
- end;
- finally
- TypeInfoBits.Free;
- end;
- end;
- // Embed version information if need be. On success, modify the matrix and return true.
- // See 8.10 of JISX0510:2004 (p.47) for how to embed version information.
- procedure TMatrixUtil.MaybeEmbedVersionInfo(Version: Integer; Matrix: TByteMatrix);
- var
- VersionInfoBits: TBitArray;
- I, J: Integer;
- BitIndex: Integer;
- Bit: Boolean;
- begin
- if (Version < 7) then
- begin
- Exit; // Don't need version info.
- end;
- VersionInfoBits := TBitArray.Create;
- try
- MakeVersionInfoBits(Version, VersionInfoBits);
- BitIndex := 6 * 3 - 1; // It will decrease from 17 to 0.
- for I := 0 to 5 do
- begin
- for J := 0 to 2 do
- begin
- // Place bits in LSB (least significant bit) to MSB order.
- Bit := VersionInfoBits.Get(BitIndex);
- Dec(BitIndex);
- // Left bottom corner.
- Matrix.SetBoolean(I, Matrix.Height - 11 + J, Bit);
- // Right bottom corner.
- Matrix.SetBoolean(Matrix.Height - 11 + J, I, bit);
- end;
- end;
- finally
- VersionInfoBits.Free;
- end;
- end;
- // Embed "dataBits" using "getMaskPattern". On success, modify the matrix and return true.
- // For debugging purposes, it skips masking process if "getMaskPattern" is -1.
- // See 8.7 of JISX0510:2004 (p.38) for how to embed data bits.
- procedure TMatrixUtil.EmbedDataBits(DataBits: TBitArray; MaskPattern: Integer; Matrix: TByteMatrix);
- var
- BitIndex: Integer;
- Direction: Integer;
- X, Y, I, XX: Integer;
- Bit: Boolean;
- MaskUtil: TMaskUtil;
- begin
- MaskUtil := TMaskUtil.Create;
- try
- bitIndex := 0;
- direction := -1;
- // Start from the right bottom cell.
- X := Matrix.Width - 1;
- Y := Matrix.Height - 1;
- while (X > 0) do
- begin
- // Skip the vertical timing pattern.
- if (X = 6) then
- begin
- Dec(X, 1);
- end;
- while ((Y >= 0) and (y < Matrix.Height)) do
- begin
- for I := 0 to 1 do
- begin
- XX := X - I;
- // Skip the cell if it's not empty.
- if (not IsEmpty(Matrix.Get(XX, Y))) then
- begin
- Continue;
- end;
- if (BitIndex < DataBits.GetSize) then
- begin
- Bit := DataBits.Get(BitIndex);
- Inc(BitIndex);
- end else
- begin
- // Padding bit. If there is no bit left, we'll fill the left cells with 0, as described
- // in 8.4.9 of JISX0510:2004 (p. 24).
- Bit := False;
- end;
- // Skip masking if mask_pattern is -1.
- if (MaskPattern <> -1) then
- begin
- if (MaskUtil.GetDataMaskBit(MaskPattern, XX, Y)) then
- begin
- Bit := not Bit;
- end;
- end;
- Matrix.SetBoolean(XX, Y, Bit);
- end;
- Inc(Y, Direction);
- end;
- Direction := -Direction; // Reverse the direction.
- Inc(Y, Direction);
- Dec(X, 2); // Move to the left.
- end;
- finally
- MaskUtil.Free;
- end;
- // All bits should be consumed.
- if (BitIndex <> DataBits.GetSize()) then
- begin
- FMatrixUtilError := True;
- Exit;
- end;
- end;
- // Return the position of the most significant bit set (to one) in the "value". The most
- // significant bit is position 32. If there is no bit set, return 0. Examples:
- // - findMSBSet(0) => 0
- // - findMSBSet(1) => 1
- // - findMSBSet(255) => 8
- function TMatrixUtil.FindMSBSet(Value: Integer): Integer;
- var
- NumDigits: Integer;
- begin
- NumDigits := 0;
- while (Value <> 0) do
- begin
- Value := Value shr 1;
- Inc(NumDigits);
- end;
- Result := NumDigits;
- end;
- // Calculate BCH (Bose-Chaudhuri-Hocquenghem) code for "value" using polynomial "poly". The BCH
- // code is used for encoding type information and version information.
- // Example: Calculation of version information of 7.
- // f(x) is created from 7.
- // - 7 = 000111 in 6 bits
- // - f(x) = x^2 + x^1 + x^0
- // g(x) is given by the standard (p. 67)
- // - g(x) = x^12 + x^11 + x^10 + x^9 + x^8 + x^5 + x^2 + 1
- // Multiply f(x) by x^(18 - 6)
- // - f'(x) = f(x) * x^(18 - 6)
- // - f'(x) = x^14 + x^13 + x^12
- // Calculate the remainder of f'(x) / g(x)
- // x^2
- // __________________________________________________
- // g(x) )x^14 + x^13 + x^12
- // x^14 + x^13 + x^12 + x^11 + x^10 + x^7 + x^4 + x^2
- // --------------------------------------------------
- // x^11 + x^10 + x^7 + x^4 + x^2
- //
- // The remainder is x^11 + x^10 + x^7 + x^4 + x^2
- // Encode it in binary: 110010010100
- // The return value is 0xc94 (1100 1001 0100)
- //
- // Since all coefficients in the polynomials are 1 or 0, we can do the calculation by bit
- // operations. We don't care if cofficients are positive or negative.
- function TMatrixUtil.CalculateBCHCode(Value, Poly: Integer): Integer;
- var
- MSBSetInPoly: Integer;
- begin
- // If poly is "1 1111 0010 0101" (version info poly), msbSetInPoly is 13. We'll subtract 1
- // from 13 to make it 12.
- MSBSetInPoly := FindMSBSet(Poly);
- Value := Value shl (MSBSetInPoly - 1);
- // Do the division business using exclusive-or operations.
- while (FindMSBSet(Value) >= MSBSetInPoly) do
- begin
- Value := Value xor (Poly shl (FindMSBSet(Value) - MSBSetInPoly));
- end;
- // Now the "value" is the remainder (i.e. the BCH code)
- Result := Value;
- end;
- // Make bit vector of type information. On success, store the result in "bits" and return true.
- // Encode error correction level and mask pattern. See 8.9 of
- // JISX0510:2004 (p.45) for details.
- procedure TMatrixUtil.MakeTypeInfoBits(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Bits: TBitArray);
- var
- TypeInfo: Integer;
- BCHCode: Integer;
- MaskBits: TBitArray;
- begin
- if ((MaskPattern >= 0) and (MaskPattern < NUM_MASK_PATTERNS)) then
- begin
- TypeInfo := (ECLevel.Bits shl 3) or MaskPattern;
- Bits.AppendBits(TypeInfo, 5);
- BCHCode := CalculateBCHCode(TypeInfo, TYPE_INFO_POLY);
- Bits.AppendBits(BCHCode, 10);
- MaskBits := TBitArray.Create;
- try
- MaskBits.AppendBits(TYPE_INFO_MASK_PATTERN, 15);
- Bits.XorOperation(MaskBits);
- finally
- MaskBits.Free;
- end;
- if (Bits.GetSize <> 15) then // Just in case.
- begin
- FMatrixUtilError := True;
- Exit;
- end;
- end;
- end;
- // Make bit vector of version information. On success, store the result in "bits" and return true.
- // See 8.10 of JISX0510:2004 (p.45) for details.
- procedure TMatrixUtil.MakeVersionInfoBits(Version: Integer; Bits: TBitArray);
- var
- BCHCode: Integer;
- begin
- Bits.AppendBits(Version, 6);
- BCHCode := CalculateBCHCode(Version, VERSION_INFO_POLY);
- Bits.AppendBits(BCHCode, 12);
- if (Bits.GetSize() <> 18) then
- begin
- FMatrixUtilError := True;
- Exit;
- end;
- end;
- // Check if "value" is empty.
- function TMatrixUtil.IsEmpty(Value: Integer): Boolean;
- begin
- Result := (Value = -1);
- end;
- procedure TMatrixUtil.EmbedTimingPatterns(Matrix: TByteMatrix);
- var
- I: Integer;
- Bit: Integer;
- begin
- // -8 is for skipping position detection patterns (size 7), and two horizontal/vertical
- // separation patterns (size 1). Thus, 8 = 7 + 1.
- for I := 8 to Matrix.Width - 9 do
- begin
- Bit := (I + 1) mod 2;
- // Horizontal line.
- if (IsEmpty(Matrix.Get(I, 6))) then
- begin
- Matrix.SetInteger(I, 6, Bit);
- end;
- // Vertical line.
- if (IsEmpty(Matrix.Get(6, I))) then
- begin
- Matrix.SetInteger(6, I, Bit);
- end;
- end;
- end;
- // Embed the lonely dark dot at left bottom corner. JISX0510:2004 (p.46)
- procedure TMatrixUtil.EmbedDarkDotAtLeftBottomCorner(Matrix: TByteMatrix);
- begin
- if (Matrix.Get(8, Matrix.Height - 8) = 0) then
- begin
- FMatrixUtilError := True;
- Exit;
- end;
- Matrix.SetInteger(8, Matrix.Height - 8, 1);
- end;
- procedure TMatrixUtil.EmbedHorizontalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
- var
- X: Integer;
- begin
- // We know the width and height.
- for X := 0 to 7 do
- begin
- if (not IsEmpty(Matrix.Get(XStart + X, YStart))) then
- begin
- FMatrixUtilError := True;
- Exit;
- end;
- Matrix.SetInteger(XStart + X, YStart, HORIZONTAL_SEPARATION_PATTERN[0][X]);
- end;
- end;
- procedure TMatrixUtil.EmbedVerticalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
- var
- Y: Integer;
- begin
- // We know the width and height.
- for Y := 0 to 6 do
- begin
- if (not IsEmpty(Matrix.Get(XStart, YStart + Y))) then
- begin
- FMatrixUtilError := True;
- Exit;
- end;
- Matrix.SetInteger(XStart, YStart + Y, VERTICAL_SEPARATION_PATTERN[Y][0]);
- end;
- end;
- // Note that we cannot unify the function with embedPositionDetectionPattern() despite they are
- // almost identical, since we cannot write a function that takes 2D arrays in different sizes in
- // C/C++. We should live with the fact.
- procedure TMatrixUtil.EmbedPositionAdjustmentPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
- var
- X, Y: Integer;
- begin
- // We know the width and height.
- for Y := 0 to 4 do
- begin
- for X := 0 to 4 do
- begin
- if (not IsEmpty(Matrix.Get(XStart + X, YStart + Y))) then
- begin
- FMatrixUtilError := True;
- Exit;
- end;
- Matrix.SetInteger(XStart + X, YStart + Y, POSITION_ADJUSTMENT_PATTERN[Y][X]);
- end;
- end;
- end;
- procedure TMatrixUtil.EmbedPositionDetectionPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
- var
- X, Y: Integer;
- begin
- // We know the width and height.
- for Y := 0 to 6 do
- begin
- for X := 0 to 6 do
- begin
- if (not IsEmpty(Matrix.Get(XStart + X, YStart + Y))) then
- begin
- FMatrixUtilError := True;
- Exit;
- end;
- Matrix.SetInteger(XStart + X, YStart + Y, POSITION_DETECTION_PATTERN[Y][X]);
- end;
- end;
- end;
- // Embed position detection patterns and surrounding vertical/horizontal separators.
- procedure TMatrixUtil.EmbedPositionDetectionPatternsAndSeparators(Matrix: TByteMatrix);
- var
- PDPWidth: Integer;
- HSPWidth: Integer;
- VSPSize: Integer;
- begin
- // Embed three big squares at corners.
- PDPWidth := Length(POSITION_DETECTION_PATTERN[0]);
- // Left top corner.
- EmbedPositionDetectionPattern(0, 0, Matrix);
- // Right top corner.
- EmbedPositionDetectionPattern(Matrix.Width - PDPWidth, 0, Matrix);
- // Left bottom corner.
- EmbedPositionDetectionPattern(0, Matrix.Width- PDPWidth, Matrix);
- // Embed horizontal separation patterns around the squares.
- HSPWidth := Length(HORIZONTAL_SEPARATION_PATTERN[0]);
- // Left top corner.
- EmbedHorizontalSeparationPattern(0, HSPWidth - 1, Matrix);
- // Right top corner.
- EmbedHorizontalSeparationPattern(Matrix.Width - HSPWidth,
- HSPWidth - 1, Matrix);
- // Left bottom corner.
- EmbedHorizontalSeparationPattern(0, Matrix.Width - HSPWidth, Matrix);
- // Embed vertical separation patterns around the squares.
- VSPSize := Length(VERTICAL_SEPARATION_PATTERN);
- // Left top corner.
- EmbedVerticalSeparationPattern(VSPSize, 0, Matrix);
- // Right top corner.
- EmbedVerticalSeparationPattern(Matrix.Height - VSPSize - 1, 0, Matrix);
- // Left bottom corner.
- EmbedVerticalSeparationPattern(VSPSize, Matrix.Height - VSPSize, Matrix);
- end;
- // Embed position adjustment patterns if need be.
- procedure TMatrixUtil.MaybeEmbedPositionAdjustmentPatterns(Version: Integer; Matrix: TByteMatrix);
- var
- Index: Integer;
- Coordinates: array of Integer;
- NumCoordinates: Integer;
- X, Y, I, J: Integer;
- begin
- if (Version >= 2) then
- begin
- Index := Version - 1;
- NumCoordinates := Length(POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE[Index]);
- SetLength(Coordinates, NumCoordinates);
- Move(POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE[Index][0], Coordinates[0], NumCoordinates * SizeOf(Integer));
- for I := 0 to NumCoordinates - 1 do
- begin
- for J := 0 to NumCoordinates - 1 do
- begin
- Y := Coordinates[I];
- X := Coordinates[J];
- if ((X = -1) or (Y = -1)) then
- begin
- Continue;
- end;
- // If the cell is unset, we embed the position adjustment pattern here.
- if (IsEmpty(Matrix.Get(X, Y))) then
- begin
- // -2 is necessary since the x/y coordinates point to the center of the pattern, not the
- // left top corner.
- EmbedPositionAdjustmentPattern(X - 2, Y - 2, Matrix);
- end;
- end;
- end;
- end;
- end;
- { TBitArray }
- procedure TBitArray.AppendBits(Value, NumBits: Integer);
- var
- NumBitsLeft: Integer;
- begin
- if ((NumBits < 0) or (NumBits > 32)) then
- begin
- end;
- EnsureCapacity(Size + NumBits);
- for NumBitsLeft := NumBits downto 1 do
- begin
- AppendBit(((Value shr (NumBitsLeft - 1)) and $01) = 1);
- end;
- end;
- constructor TBitArray.Create(Size: Integer);
- begin
- Size := Size;
- SetLength(Bits, (Size + 31) shr 5);
- end;
- constructor TBitArray.Create;
- begin
- Size := 0;
- SetLength(Bits, 1);
- end;
- function TBitArray.Get(I: Integer): Boolean;
- begin
- Result := (Bits[I shr 5] and (1 shl (I and $1F))) <> 0;
- end;
- function TBitArray.GetSize: Integer;
- begin
- Result := Size;
- end;
- function TBitArray.GetSizeInBytes: Integer;
- begin
- Result := (Size + 7) shr 3;
- end;
- procedure TBitArray.SetBit(Index: Integer);
- begin
- Bits[Index shr 5] := Bits[Index shr 5] or (1 shl (Index and $1F));
- end;
- procedure TBitArray.AppendBit(Bit: Boolean);
- begin
- EnsureCapacity(Size + 1);
- if (Bit) then
- begin
- Bits[Size shr 5] := Bits[Size shr 5] or (1 shl (Size and $1F));
- end;
- Inc(Size);
- end;
- procedure TBitArray.ToBytes(BitOffset: Integer; Source: TByteArray; Offset,
- NumBytes: Integer);
- var
- I: Integer;
- J: Integer;
- TheByte: Integer;
- begin
- for I := 0 to NumBytes - 1 do
- begin
- TheByte := 0;
- for J := 0 to 7 do
- begin
- if (Get(BitOffset)) then
- begin
- TheByte := TheByte or (1 shl (7 - J));
- end;
- Inc(BitOffset);
- end;
- Source[Offset + I] := TheByte;
- end;
- end;
- procedure TBitArray.XorOperation(Other: TBitArray);
- var
- I: Integer;
- begin
- if (Length(Bits) = Length(Other.Bits)) then
- begin
- for I := 0 to Length(Bits) - 1 do
- begin
- // The last byte could be incomplete (i.e. not have 8 bits in
- // it) but there is no problem since 0 XOR 0 == 0.
- Bits[I] := Bits[I] xor Other.Bits[I];
- end;
- end;
- end;
- procedure TBitArray.AppendBitArray(NewBitArray: TBitArray);
- var
- OtherSize: Integer;
- I: Integer;
- begin
- OtherSize := NewBitArray.GetSize;
- EnsureCapacity(Size + OtherSize);
- for I := 0 to OtherSize - 1 do
- begin
- AppendBit(NewBitArray.Get(I));
- end;
- end;
- procedure TBitArray.EnsureCapacity(Size: Integer);
- begin
- if (Size > (Length(Bits) shl 5)) then
- begin
- SetLength(Bits, Size);
- end;
- end;
- { TErrorCorrectionLevel }
- procedure TErrorCorrectionLevel.Assign(Source: TErrorCorrectionLevel);
- begin
- Self.FBits := Source.FBits;
- end;
- function TErrorCorrectionLevel.Ordinal: Integer;
- begin
- Result := 0;
- end;
- { TVersion }
- class function TVersion.ChooseVersion(NumInputBits: Integer;
- ECLevel: TErrorCorrectionLevel): TVersion;
- var
- VersionNum: Integer;
- Version: TVersion;
- NumBytes: Integer;
- ECBlocks: TECBlocks;
- NumECBytes: Integer;
- NumDataBytes: Integer;
- TotalInputBytes: Integer;
- begin
- Result := nil;
- // In the following comments, we use numbers of Version 7-H.
- for VersionNum := 1 to 40 do
- begin
- Version := TVersion.GetVersionForNumber(VersionNum);
- // numBytes = 196
- NumBytes := Version.GetTotalCodewords;
- // getNumECBytes = 130
- ECBlocks := Version.GetECBlocksForLevel(ECLevel);
- NumECBytes := ECBlocks.GetTotalECCodewords;
- // getNumDataBytes = 196 - 130 = 66
- NumDataBytes := NumBytes - NumECBytes;
- TotalInputBytes := (NumInputBits + 7) div 8;
- if (numDataBytes >= totalInputBytes) then
- begin
- Result := Version;
- Exit;
- end else
- begin
- Version.Free;
- end;
- end;
- end;
- constructor TVersion.Create(VersionNumber: Integer;
- AlignmentPatternCenters: array of Integer; ECBlocks1, ECBlocks2, ECBlocks3,
- ECBlocks4: TECBlocks);
- var
- Total: Integer;
- ECBlock: TECB;
- ECBArray: TECBArray;
- I: Integer;
- begin
- Self.VersionNumber := VersionNumber;
- SetLength(Self.AlignmentPatternCenters, Length(AlignmentPatternCenters));
- if (Length(AlignmentPatternCenters) > 0) then
- begin
- Move(AlignmentPatternCenters[0], Self.AlignmentPatternCenters[0],
- Length(AlignmentPatternCenters) * SizeOf(Integer));
- end;
- SetLength(ECBlocks, 4);
- ECBlocks[0] := ECBlocks1;
- ECBlocks[1] := ECBlocks2;
- ECBlocks[2] := ECBlocks3;
- ECBlocks[3] := ECBlocks4;
- Total := 0;
- ECCodewords := ECBlocks1.GetECCodewordsPerBlock;
- ECBArray := ECBlocks1.GetECBlocks;
- for I := 0 to Length(ECBArray) - 1 do
- begin
- ECBlock := ECBArray[I];
- Inc(Total, ECBlock.GetCount * (ECBlock.GetDataCodewords + ECCodewords));
- end;
- TotalCodewords := Total;
- end;
- destructor TVersion.Destroy;
- var
- X: Integer;
- begin
- for X := 0 to Length(ECBlocks) - 1 do
- begin
- ECBlocks[X].Free;
- end;
- inherited;
- end;
- function TVersion.GetDimensionForVersion: Integer;
- begin
- Result := 17 + 4 * VersionNumber;
- end;
- function TVersion.GetECBlocksForLevel(ECLevel: TErrorCorrectionLevel): TECBlocks;
- begin
- Result := ECBlocks[ECLevel.Ordinal];
- end;
- function TVersion.GetTotalCodewords: Integer;
- begin
- Result := TotalCodewords;
- end;
- class function TVersion.GetVersionForNumber(VersionNum: Integer): TVersion;
- begin
- if (VersionNum = 1) then
- begin
- Result := TVersion.Create(1, [],
- TECBlocks.Create(7, TECB.Create(1, 19)),
- TECBlocks.Create(10, TECB.Create(1, 16)),
- TECBlocks.Create(13, TECB.Create(1, 13)),
- TECBlocks.Create(17, TECB.Create(1, 9)));
- end else
- if (VersionNum = 2) then
- begin
- Result := TVersion.Create(2, [6, 18],
- TECBlocks.Create(10, TECB.Create(1, 34)),
- TECBlocks.Create(16, TECB.Create(1, 28)),
- TECBlocks.Create(22, TECB.Create(1, 22)),
- TECBlocks.Create(28, TECB.Create(1, 16)));
- end else
- if (VersionNum = 3) then
- begin
- Result := TVersion.Create(3, [6, 22],
- TECBlocks.Create(15, TECB.Create(1, 55)),
- TECBlocks.Create(26, TECB.Create(1, 44)),
- TECBlocks.Create(18, TECB.Create(2, 17)),
- TECBlocks.Create(22, TECB.Create(2, 13)));
- end else
- if (VersionNum = 4) then
- begin
- Result := TVersion.Create(4, [6, 26],
- TECBlocks.Create(20, TECB.Create(1, 80)),
- TECBlocks.Create(18, TECB.Create(2, 32)),
- TECBlocks.Create(26, TECB.Create(2, 24)),
- TECBlocks.Create(16, TECB.Create(4, 9)));
- end else
- if (VersionNum = 5) then
- begin
- Result := TVersion.Create(5, [6, 30],
- TECBlocks.Create(26, TECB.Create(1, 108)),
- TECBlocks.Create(24, TECB.Create(2, 43)),
- TECBlocks.Create(18, TECB.Create(2, 15),
- TECB.Create(2, 16)),
- TECBlocks.Create(22, TECB.Create(2, 11),
- TECB.Create(2, 12)));
- end else
- if (VersionNum = 6) then
- begin
- Result := TVersion.Create(6, [6, 34],
- TECBlocks.Create(18, TECB.Create(2, 68)),
- TECBlocks.Create(16, TECB.Create(4, 27)),
- TECBlocks.Create(24, TECB.Create(4, 19)),
- TECBlocks.Create(28, TECB.Create(4, 15)));
- end else
- if (VersionNum = 7) then
- begin
- Result := TVersion.Create(7, [6, 22, 38],
- TECBlocks.Create(20, TECB.Create(2, 78)),
- TECBlocks.Create(18, TECB.Create(4, 31)),
- TECBlocks.Create(18, TECB.Create(2, 14),
- TECB.Create(4, 15)),
- TECBlocks.Create(26, TECB.Create(4, 13),
- TECB.Create(1, 14)));
- end else
- if (VersionNum = 8) then
- begin
- Result := TVersion.Create(8, [6, 24, 42],
- TECBlocks.Create(24, TECB.Create(2, 97)),
- TECBlocks.Create(22, TECB.Create(2, 38),
- TECB.Create(2, 39)),
- TECBlocks.Create(22, TECB.Create(4, 18),
- TECB.Create(2, 19)),
- TECBlocks.Create(26, TECB.Create(4, 14),
- TECB.Create(2, 15)));
- end else
- if (VersionNum = 9) then
- begin
- Result := TVersion.Create(9, [6, 26, 46],
- TECBlocks.Create(30, TECB.Create(2, 116)),
- TECBlocks.Create(22, TECB.Create(3, 36),
- TECB.Create(2, 37)),
- TECBlocks.Create(20, TECB.Create(4, 16),
- TECB.Create(4, 17)),
- TECBlocks.Create(24, TECB.Create(4, 12),
- TECB.Create(4, 13)));
- end else
- if (VersionNum = 10) then
- begin
- Result := TVersion.Create(10, [6, 28, 50],
- TECBlocks.Create(18, TECB.Create(2, 68),
- TECB.Create(2, 69)),
- TECBlocks.Create(26, TECB.Create(4, 43),
- TECB.Create(1, 44)),
- TECBlocks.Create(24, TECB.Create(6, 19),
- TECB.Create(2, 20)),
- TECBlocks.Create(28, TECB.Create(6, 15),
- TECB.Create(2, 16)));
- end else
- if (VersionNum = 11) then
- begin
- Result := TVersion.Create(11, [6, 30, 54],
- TECBlocks.Create(20, TECB.Create(4, 81)),
- TECBlocks.Create(30, TECB.Create(1, 50),
- TECB.Create(4, 51)),
- TECBlocks.Create(28, TECB.Create(4, 22),
- TECB.Create(4, 23)),
- TECBlocks.Create(24, TECB.Create(3, 12),
- TECB.Create(8, 13)));
- end else
- if (VersionNum = 12) then
- begin
- Result := TVersion.Create(12, [6, 32, 58],
- TECBlocks.Create(24, TECB.Create(2, 92),
- TECB.Create(2, 93)),
- TECBlocks.Create(22, TECB.Create(6, 36),
- TECB.Create(2, 37)),
- TECBlocks.Create(26, TECB.Create(4, 20),
- TECB.Create(6, 21)),
- TECBlocks.Create(28, TECB.Create(7, 14),
- TECB.Create(4, 15)));
- end else
- if (VersionNum = 13) then
- begin
- Result := TVersion.Create(13, [6, 34, 62],
- TECBlocks.Create(26, TECB.Create(4, 107)),
- TECBlocks.Create(22, TECB.Create(8, 37),
- TECB.Create(1, 38)),
- TECBlocks.Create(24, TECB.Create(8, 20),
- TECB.Create(4, 21)),
- TECBlocks.Create(22, TECB.Create(12, 11),
- TECB.Create(4, 12)));
- end else
- if (VersionNum = 14) then
- begin
- Result := TVersion.Create(14, [6, 26, 46, 66],
- TECBlocks.Create(30, TECB.Create(3, 115),
- TECB.Create(1, 116)),
- TECBlocks.Create(24, TECB.Create(4, 40),
- TECB.Create(5, 41)),
- TECBlocks.Create(20, TECB.Create(11, 16),
- TECB.Create(5, 17)),
- TECBlocks.Create(24, TECB.Create(11, 12),
- TECB.Create(5, 13)));
- end else
- if (VersionNum = 15) then
- begin
- Result := TVersion.Create(15, [6, 26, 48, 70],
- TECBlocks.Create(22, TECB.Create(5, 87),
- TECB.Create(1, 88)),
- TECBlocks.Create(24, TECB.Create(5, 41),
- TECB.Create(5, 42)),
- TECBlocks.Create(30, TECB.Create(5, 24),
- TECB.Create(7, 25)),
- TECBlocks.Create(24, TECB.Create(11, 12),
- TECB.Create(7, 13)));
- end else
- if (VersionNum = 16) then
- begin
- Result := TVersion.Create(16, [6, 26, 50, 74],
- TECBlocks.Create(24, TECB.Create(5, 98),
- TECB.Create(1, 99)),
- TECBlocks.Create(28, TECB.Create(7, 45),
- TECB.Create(3, 46)),
- TECBlocks.Create(24, TECB.Create(15, 19),
- TECB.Create(2, 20)),
- TECBlocks.Create(30, TECB.Create(3, 15),
- TECB.Create(13, 16)));
- end else
- if (VersionNum = 17) then
- begin
- Result := TVersion.Create(17, [6, 30, 54, 78],
- TECBlocks.Create(28, TECB.Create(1, 107),
- TECB.Create(5, 108)),
- TECBlocks.Create(28, TECB.Create(10, 46),
- TECB.Create(1, 47)),
- TECBlocks.Create(28, TECB.Create(1, 22),
- TECB.Create(15, 23)),
- TECBlocks.Create(28, TECB.Create(2, 14),
- TECB.Create(17, 15)));
- end else
- if (VersionNum = 18) then
- begin
- Result := TVersion.Create(18, [6, 30, 56, 82],
- TECBlocks.Create(30, TECB.Create(5, 120),
- TECB.Create(1, 121)),
- TECBlocks.Create(26, TECB.Create(9, 43),
- TECB.Create(4, 44)),
- TECBlocks.Create(28, TECB.Create(17, 22),
- TECB.Create(1, 23)),
- TECBlocks.Create(28, TECB.Create(2, 14),
- TECB.Create(19, 15)));
- end else
- if (VersionNum = 19) then
- begin
- Result := TVersion.Create(19, [6, 30, 58, 86],
- TECBlocks.Create(28, TECB.Create(3, 113),
- TECB.Create(4, 114)),
- TECBlocks.Create(26, TECB.Create(3, 44),
- TECB.Create(11, 45)),
- TECBlocks.Create(26, TECB.Create(17, 21),
- TECB.Create(4, 22)),
- TECBlocks.Create(26, TECB.Create(9, 13),
- TECB.Create(16, 14)));
- end else
- if (VersionNum = 20) then
- begin
- Result := TVersion.Create(20, [6, 34, 62, 90],
- TECBlocks.Create(28, TECB.Create(3, 107),
- TECB.Create(5, 108)),
- TECBlocks.Create(26, TECB.Create(3, 41),
- TECB.Create(13, 42)),
- TECBlocks.Create(30, TECB.Create(15, 24),
- TECB.Create(5, 25)),
- TECBlocks.Create(28, TECB.Create(15, 15),
- TECB.Create(10, 16)));
- end else
- if (VersionNum = 21) then
- begin
- Result := TVersion.Create(21, [6, 28, 50, 72, 94],
- TECBlocks.Create(28, TECB.Create(4, 116),
- TECB.Create(4, 117)),
- TECBlocks.Create(26, TECB.Create(17, 42)),
- TECBlocks.Create(28, TECB.Create(17, 22),
- TECB.Create(6, 23)),
- TECBlocks.Create(30, TECB.Create(19, 16),
- TECB.Create(6, 17)));
- end else
- if (VersionNum = 22) then
- begin
- Result := TVersion.Create(22, [6, 26, 50, 74, 98],
- TECBlocks.Create(28, TECB.Create(2, 111),
- TECB.Create(7, 112)),
- TECBlocks.Create(28, TECB.Create(17, 46)),
- TECBlocks.Create(30, TECB.Create(7, 24),
- TECB.Create(16, 25)),
- TECBlocks.Create(24, TECB.Create(34, 13)));
- end else
- if (VersionNum = 23) then
- begin
- Result := TVersion.Create(23, [6, 30, 54, 78, 102],
- TECBlocks.Create(30, TECB.Create(4, 121),
- TECB.Create(5, 122)),
- TECBlocks.Create(28, TECB.Create(4, 47),
- TECB.Create(14, 48)),
- TECBlocks.Create(30, TECB.Create(11, 24),
- TECB.Create(14, 25)),
- TECBlocks.Create(30, TECB.Create(16, 15),
- TECB.Create(14, 16)));
- end else
- if (VersionNum = 24) then
- begin
- Result := TVersion.Create(24, [6, 28, 54, 80, 106],
- TECBlocks.Create(30, TECB.Create(6, 117),
- TECB.Create(4, 118)),
- TECBlocks.Create(28, TECB.Create(6, 45),
- TECB.Create(14, 46)),
- TECBlocks.Create(30, TECB.Create(11, 24),
- TECB.Create(16, 25)),
- TECBlocks.Create(30, TECB.Create(30, 16),
- TECB.Create(2, 17)));
- end else
- if (VersionNum = 25) then
- begin
- Result := TVersion.Create(25, [6, 32, 58, 84, 110],
- TECBlocks.Create(26, TECB.Create(8, 106),
- TECB.Create(4, 107)),
- TECBlocks.Create(28, TECB.Create(8, 47),
- TECB.Create(13, 48)),
- TECBlocks.Create(30, TECB.Create(7, 24),
- TECB.Create(22, 25)),
- TECBlocks.Create(30, TECB.Create(22, 15),
- TECB.Create(13, 16)));
- end else
- if (VersionNum = 26) then
- begin
- Result := TVersion.Create(26, [6, 30, 58, 86, 114],
- TECBlocks.Create(28, TECB.Create(10, 114),
- TECB.Create(2, 115)),
- TECBlocks.Create(28, TECB.Create(19, 46),
- TECB.Create(4, 47)),
- TECBlocks.Create(28, TECB.Create(28, 22),
- TECB.Create(6, 23)),
- TECBlocks.Create(30, TECB.Create(33, 16),
- TECB.Create(4, 17)));
- end else
- if (VersionNum = 27) then
- begin
- Result := TVersion.Create(27, [6, 34, 62, 90, 118],
- TECBlocks.Create(30, TECB.Create(8, 122),
- TECB.Create(4, 123)),
- TECBlocks.Create(28, TECB.Create(22, 45),
- TECB.Create(3, 46)),
- TECBlocks.Create(30, TECB.Create(8, 23),
- TECB.Create(26, 24)),
- TECBlocks.Create(30, TECB.Create(12, 15),
- TECB.Create(28, 16)));
- end else
- if (VersionNum = 28) then
- begin
- Result := TVersion.Create(28, [6, 26, 50, 74, 98, 122],
- TECBlocks.Create(30, TECB.Create(3, 117),
- TECB.Create(10, 118)),
- TECBlocks.Create(28, TECB.Create(3, 45),
- TECB.Create(23, 46)),
- TECBlocks.Create(30, TECB.Create(4, 24),
- TECB.Create(31, 25)),
- TECBlocks.Create(30, TECB.Create(11, 15),
- TECB.Create(31, 16)));
- end else
- if (VersionNum = 29) then
- begin
- Result := TVersion.Create(29, [6, 30, 54, 78, 102, 126],
- TECBlocks.Create(30, TECB.Create(7, 116),
- TECB.Create(7, 117)),
- TECBlocks.Create(28, TECB.Create(21, 45),
- TECB.Create(7, 46)),
- TECBlocks.Create(30, TECB.Create(1, 23),
- TECB.Create(37, 24)),
- TECBlocks.Create(30, TECB.Create(19, 15),
- TECB.Create(26, 16)));
- end else
- if (VersionNum = 30) then
- begin
- Result := TVersion.Create(30, [6, 26, 52, 78, 104, 130],
- TECBlocks.Create(30, TECB.Create(5, 115),
- TECB.Create(10, 116)),
- TECBlocks.Create(28, TECB.Create(19, 47),
- TECB.Create(10, 48)),
- TECBlocks.Create(30, TECB.Create(15, 24),
- TECB.Create(25, 25)),
- TECBlocks.Create(30, TECB.Create(23, 15),
- TECB.Create(25, 16)));
- end else
- if (VersionNum = 31) then
- begin
- Result := TVersion.Create(31, [6, 30, 56, 82, 108, 134],
- TECBlocks.Create(30, TECB.Create(13, 115),
- TECB.Create(3, 116)),
- TECBlocks.Create(28, TECB.Create(2, 46),
- TECB.Create(29, 47)),
- TECBlocks.Create(30, TECB.Create(42, 24),
- TECB.Create(1, 25)),
- TECBlocks.Create(30, TECB.Create(23, 15),
- TECB.Create(28, 16)));
- end else
- if (VersionNum = 32) then
- begin
- Result := TVersion.Create(32, [6, 34, 60, 86, 112, 138],
- TECBlocks.Create(30, TECB.Create(17, 115)),
- TECBlocks.Create(28, TECB.Create(10, 46),
- TECB.Create(23, 47)),
- TECBlocks.Create(30, TECB.Create(10, 24),
- TECB.Create(35, 25)),
- TECBlocks.Create(30, TECB.Create(19, 15),
- TECB.Create(35, 16)));
- end else
- if (VersionNum = 33) then
- begin
- Result := TVersion.Create(33, [6, 30, 58, 86, 114, 142],
- TECBlocks.Create(30, TECB.Create(17, 115),
- TECB.Create(1, 116)),
- TECBlocks.Create(28, TECB.Create(14, 46),
- TECB.Create(21, 47)),
- TECBlocks.Create(30, TECB.Create(29, 24),
- TECB.Create(19, 25)),
- TECBlocks.Create(30, TECB.Create(11, 15),
- TECB.Create(46, 16)));
- end else
- if (VersionNum = 34) then
- begin
- Result := TVersion.Create(34, [6, 34, 62, 90, 118, 146],
- TECBlocks.Create(30, TECB.Create(13, 115),
- TECB.Create(6, 116)),
- TECBlocks.Create(28, TECB.Create(14, 46),
- TECB.Create(23, 47)),
- TECBlocks.Create(30, TECB.Create(44, 24),
- TECB.Create(7, 25)),
- TECBlocks.Create(30, TECB.Create(59, 16),
- TECB.Create(1, 17)));
- end else
- if (VersionNum = 35) then
- begin
- Result := TVersion.Create(35, [6, 30, 54, 78, 102, 126, 150],
- TECBlocks.Create(30, TECB.Create(12, 121),
- TECB.Create(7, 122)),
- TECBlocks.Create(28, TECB.Create(12, 47),
- TECB.Create(26, 48)),
- TECBlocks.Create(30, TECB.Create(39, 24),
- TECB.Create(14, 25)),
- TECBlocks.Create(30, TECB.Create(22, 15),
- TECB.Create(41, 16)));
- end else
- if (VersionNum = 36) then
- begin
- Result := TVersion.Create(36, [6, 24, 50, 76, 102, 128, 154],
- TECBlocks.Create(30, TECB.Create(6, 121),
- TECB.Create(14, 122)),
- TECBlocks.Create(28, TECB.Create(6, 47),
- TECB.Create(34, 48)),
- TECBlocks.Create(30, TECB.Create(46, 24),
- TECB.Create(10, 25)),
- TECBlocks.Create(30, TECB.Create(2, 15),
- TECB.Create(64, 16)));
- end else
- if (VersionNum = 37) then
- begin
- Result := TVersion.Create(37, [6, 28, 54, 80, 106, 132, 158],
- TECBlocks.Create(30, TECB.Create(17, 122),
- TECB.Create(4, 123)),
- TECBlocks.Create(28, TECB.Create(29, 46),
- TECB.Create(14, 47)),
- TECBlocks.Create(30, TECB.Create(49, 24),
- TECB.Create(10, 25)),
- TECBlocks.Create(30, TECB.Create(24, 15),
- TECB.Create(46, 16)));
- end else
- if (VersionNum = 38) then
- begin
- Result := TVersion.Create(38, [6, 32, 58, 84, 110, 136, 162],
- TECBlocks.Create(30, TECB.Create(4, 122),
- TECB.Create(18, 123)),
- TECBlocks.Create(28, TECB.Create(13, 46),
- TECB.Create(32, 47)),
- TECBlocks.Create(30, TECB.Create(48, 24),
- TECB.Create(14, 25)),
- TECBlocks.Create(30, TECB.Create(42, 15),
- TECB.Create(32, 16)));
- end else
- if (VersionNum = 39) then
- begin
- Result := TVersion.Create(39, [6, 26, 54, 82, 110, 138, 166],
- TECBlocks.Create(30, TECB.Create(20, 117),
- TECB.Create(4, 118)),
- TECBlocks.Create(28, TECB.Create(40, 47),
- TECB.Create(7, 48)),
- TECBlocks.Create(30, TECB.Create(43, 24),
- TECB.Create(22, 25)),
- TECBlocks.Create(30, TECB.Create(10, 15),
- TECB.Create(67, 16)));
- end else
- if (VersionNum = 40) then
- begin
- Result := TVersion.Create(40, [6, 30, 58, 86, 114, 142, 170],
- TECBlocks.Create(30, TECB.Create(19, 118),
- TECB.Create(6, 119)),
- TECBlocks.Create(28, TECB.Create(18, 47),
- TECB.Create(31, 48)),
- TECBlocks.Create(30, TECB.Create(34, 24),
- TECB.Create(34, 25)),
- TECBlocks.Create(30, TECB.Create(20, 15),
- TECB.Create(61, 16)));
- end else
- begin
- Result := nil;
- end;
- end;
- { TMaskUtil }
- // Return the mask bit for "getMaskPattern" at "x" and "y". See 8.8 of JISX0510:2004 for mask
- // pattern conditions.
- function TMaskUtil.GetDataMaskBit(MaskPattern, X, Y: Integer): Boolean;
- var
- Intermediate: Integer;
- Temp: Integer;
- begin
- Intermediate := 0;
- if ((MaskPattern >= 0) and (MaskPattern < NUM_MASK_PATTERNS)) then
- begin
- case (maskPattern) of
- 0: Intermediate := (Y + X) and 1;
- 1: Intermediate := Y and 1;
- 2: Intermediate := X mod 3;
- 3: Intermediate := (Y + X) mod 3;
- 4: Intermediate := ((y shr 1) + (X div 3)) and 1;
- 5:
- begin
- Temp := Y * X;
- Intermediate := (Temp and 1) + (Temp mod 3);
- end;
- 6:
- begin
- Temp := Y * X;
- Intermediate := ((Temp and 1) + (Temp mod 3)) and 1;
- end;
- 7:
- begin
- Temp := Y * X;
- Intermediate := ((temp mod 3) + ((Y + X) and 1)) and 1;
- end;
- end;
- end;
- Result := Intermediate = 0;
- end;
- { TECBlocks }
- constructor TECBlocks.Create(ECCodewordsPerBlock: Integer; ECBlocks: TECB);
- begin
- Self.ECCodewordsPerBlock := ECCodewordsPerBlock;
- SetLength(Self.ECBlocks, 1);
- Self.ECBlocks[0] := ECBlocks;
- end;
- constructor TECBlocks.Create(ECCodewordsPerBlock: Integer; ECBlocks1,
- ECBlocks2: TECB);
- begin
- Self.ECCodewordsPerBlock := ECCodewordsPerBlock;
- SetLength(Self.ECBlocks, 2);
- ECBlocks[0] := ECBlocks1;
- ECBlocks[1] := ECBlocks2;
- end;
- destructor TECBlocks.Destroy;
- var
- X: Integer;
- begin
- for X := 0 to Length(ECBlocks) - 1 do
- begin
- ECBlocks[X].Free;
- end;
- inherited;
- end;
- function TECBlocks.GetECBlocks: TECBArray;
- begin
- Result := ECBlocks;
- end;
- function TECBlocks.GetECCodewordsPerBlock: Integer;
- begin
- Result := ECCodewordsPerBlock;
- end;
- function TECBlocks.GetNumBlocks: Integer;
- var
- Total: Integer;
- I: Integer;
- begin
- Total := 0;
- for I := 0 to Length(ECBlocks) - 1 do
- begin
- Inc(Total, ECBlocks[I].GetCount);
- end;
- Result := Total;
- end;
- function TECBlocks.GetTotalECCodewords: Integer;
- begin
- Result := ECCodewordsPerBlock * GetNumBlocks;
- end;
- { TBlockPair }
- constructor TBlockPair.Create(BA1, BA2: TByteArray);
- begin
- FDataBytes := BA1;
- FErrorCorrectionBytes := BA2;
- end;
- function TBlockPair.GetDataBytes: TByteArray;
- begin
- Result := FDataBytes;
- end;
- function TBlockPair.GetErrorCorrectionBytes: TByteArray;
- begin
- Result := FErrorCorrectionBytes;
- end;
- { TReedSolomonEncoder }
- function TReedSolomonEncoder.BuildGenerator(Degree: Integer): TGenericGFPoly;
- var
- LastGenerator: TGenericGFPoly;
- NextGenerator: TGenericGFPoly;
- Poly: TGenericGFPoly;
- D: Integer;
- CA: TIntegerArray;
- begin
- if (Degree >= FCachedGenerators.Count) then
- begin
- LastGenerator := TGenericGFPoly(FCachedGenerators[FCachedGenerators.Count - 1]);
- for D := FCachedGenerators.Count to Degree do
- begin
- SetLength(CA, 2);
- CA[0] := 1;
- CA[1] := FField.Exp(D - 1 + FField.GetGeneratorBase);
- Poly := TGenericGFPoly.Create(FField, CA);
- NextGenerator := LastGenerator.Multiply(Poly);
- FCachedGenerators.Add(NextGenerator);
- LastGenerator := NextGenerator;
- end;
- end;
- Result := TGenericGFPoly(FCachedGenerators[Degree]);
- end;
- constructor TReedSolomonEncoder.Create(AField: TGenericGF);
- var
- GenericGFPoly: TGenericGFPoly;
- IntArray: TIntegerArray;
- begin
- FField := AField;
- // Contents of FCachedGenerators will be freed by FGenericGF.Destroy
- FCachedGenerators := TObjectList.Create(False);
- SetLength(IntArray, 1);
- IntArray[0] := 1;
- GenericGFPoly := TGenericGFPoly.Create(AField, IntArray);
- FCachedGenerators.Add(GenericGFPoly);
- end;
- destructor TReedSolomonEncoder.Destroy;
- begin
- FCachedGenerators.Free;
- inherited;
- end;
- procedure TReedSolomonEncoder.Encode(ToEncode: TIntegerArray; ECBytes: Integer);
- var
- DataBytes: Integer;
- Generator: TGenericGFPoly;
- InfoCoefficients: TIntegerArray;
- Info: TGenericGFPoly;
- Remainder: TGenericGFPoly;
- Coefficients: TIntegerArray;
- NumZeroCoefficients: Integer;
- I: Integer;
- begin
- SetLength(Coefficients, 0);
- if (ECBytes > 0) then
- begin
- DataBytes := Length(ToEncode) - ECBytes;
- if (DataBytes > 0) then
- begin
- Generator := BuildGenerator(ECBytes);
- SetLength(InfoCoefficients, DataBytes);
- InfoCoefficients := Copy(ToEncode, 0, DataBytes);
- Info := TGenericGFPoly.Create(FField, InfoCoefficients);
- Info := Info.MultiplyByMonomial(ECBytes, 1);
- Remainder := Info.Divide(Generator)[1];
- Coefficients := Remainder.GetCoefficients;
- NumZeroCoefficients := ECBytes - Length(Coefficients);
- for I := 0 to NumZeroCoefficients - 1 do
- begin
- ToEncode[DataBytes + I] := 0;
- end;
- Move(Coefficients[0], ToEncode[DataBytes + NumZeroCoefficients], Length(Coefficients) * SizeOf(Integer));
- end;
- end;
- end;
- { TECB }
- constructor TECB.Create(Count, DataCodewords: Integer);
- begin
- Self.Count := Count;
- Self.DataCodewords := DataCodewords;
- end;
- function TECB.GetCount: Integer;
- begin
- Result := Count;
- end;
- function TECB.GetDataCodewords: Integer;
- begin
- Result := DataCodewords;
- end;
- { TGenericGFPoly }
- function TGenericGFPoly.AddOrSubtract(Other: TGenericGFPoly): TGenericGFPoly;
- var
- SmallerCoefficients: TIntegerArray;
- LargerCoefficients: TIntegerArray;
- Temp: TIntegerArray;
- SumDiff: TIntegerArray;
- LengthDiff: Integer;
- I: Integer;
- begin
- SetLength(SmallerCoefficients, 0);
- SetLength(LargerCoefficients, 0);
- SetLength(Temp, 0);
- SetLength(SumDiff, 0);
- Result := nil;
- if (Assigned(Other)) then
- begin
- if (FField = Other.FField) then
- begin
- if (IsZero) then
- begin
- Result := Other;
- Exit;
- end;
- if (Other.IsZero) then
- begin
- Result := Self;
- Exit;
- end;
- SmallerCoefficients := FCoefficients;
- LargerCoefficients := Other.Coefficients;
- if (Length(SmallerCoefficients) > Length(LargerCoefficients)) then
- begin
- Temp := smallerCoefficients;
- SmallerCoefficients := LargerCoefficients;
- LargerCoefficients := temp;
- end;
- SetLength(SumDiff, Length(LargerCoefficients));
- LengthDiff := Length(LargerCoefficients) - Length(SmallerCoefficients);
- // Copy high-order terms only found in higher-degree polynomial's coefficients
- if (LengthDiff > 0) then
- begin
- //SumDiff := Copy(LargerCoefficients, 0, LengthDiff);
- Move(LargerCoefficients[0], SumDiff[0], LengthDiff * SizeOf(Integer));
- end;
- for I := LengthDiff to Length(LargerCoefficients) - 1 do
- begin
- SumDiff[I] := TGenericGF.AddOrSubtract(SmallerCoefficients[I - LengthDiff], LargerCoefficients[I]);
- end;
- Result := TGenericGFPoly.Create(FField, SumDiff);
- end;
- end;
- end;
- function TGenericGFPoly.Coefficients: TIntegerArray;
- begin
- Result := FCoefficients;
- end;
- constructor TGenericGFPoly.Create(AField: TGenericGF;
- ACoefficients: TIntegerArray);
- var
- CoefficientsLength: Integer;
- FirstNonZero: Integer;
- begin
- FField := AField;
- SetLength(FField.FPolyList, Length(FField.FPolyList) + 1);
- FField.FPolyList[Length(FField.FPolyList) - 1] := Self;
- CoefficientsLength := Length(ACoefficients);
- if ((CoefficientsLength > 1) and (ACoefficients[0] = 0)) then
- begin
- // Leading term must be non-zero for anything except the constant polynomial "0"
- FirstNonZero := 1;
- while ((FirstNonZero < CoefficientsLength) and (ACoefficients[FirstNonZero] = 0)) do
- begin
- Inc(FirstNonZero);
- end;
- if (FirstNonZero = CoefficientsLength) then
- begin
- FCoefficients := AField.GetZero.Coefficients;
- end else
- begin
- SetLength(FCoefficients, CoefficientsLength - FirstNonZero);
- FCoefficients := Copy(ACoefficients, FirstNonZero, Length(FCoefficients));
- end;
- end else
- begin
- FCoefficients := ACoefficients;
- end;
- end;
- destructor TGenericGFPoly.Destroy;
- begin
- Self.FField := FField;
- inherited;
- end;
- function TGenericGFPoly.Divide(Other: TGenericGFPoly): TGenericGFPolyArray;
- var
- Quotient: TGenericGFPoly;
- Remainder: TGenericGFPoly;
- DenominatorLeadingTerm: Integer;
- InverseDenominatorLeadingTerm: integer;
- DegreeDifference: Integer;
- Scale: Integer;
- Term: TGenericGFPoly;
- IterationQuotient: TGenericGFPoly;
- begin
- SetLength(Result, 0);
- if ((FField = Other.FField) and (not Other.IsZero)) then
- begin
- Quotient := FField.GetZero;
- Remainder := Self;
- DenominatorLeadingTerm := Other.GetCoefficient(Other.GetDegree);
- InverseDenominatorLeadingTerm := FField.Inverse(DenominatorLeadingTerm);
- while ((Remainder.GetDegree >= Other.GetDegree) and (not Remainder.IsZero)) do
- begin
- DegreeDifference := Remainder.GetDegree - Other.GetDegree;
- Scale := FField.Multiply(Remainder.GetCoefficient(Remainder.GetDegree), InverseDenominatorLeadingTerm);
- Term := Other.MultiplyByMonomial(DegreeDifference, Scale);
- IterationQuotient := FField.BuildMonomial(degreeDifference, scale);
- Quotient := Quotient.AddOrSubtract(IterationQuotient);
- Remainder := Remainder.AddOrSubtract(Term);
- end;
- SetLength(Result, 2);
- Result[0] := Quotient;
- Result[1] := Remainder;
- end;
- end;
- function TGenericGFPoly.GetCoefficient(Degree: Integer): Integer;
- begin
- Result := FCoefficients[Length(FCoefficients) - 1 - Degree];
- end;
- function TGenericGFPoly.GetCoefficients: TIntegerArray;
- begin
- Result := FCoefficients;
- end;
- function TGenericGFPoly.GetDegree: Integer;
- begin
- Result := Length(FCoefficients) - 1;
- end;
- function TGenericGFPoly.IsZero: Boolean;
- begin
- Result := FCoefficients[0] = 0;
- end;
- function TGenericGFPoly.Multiply(Other: TGenericGFPoly): TGenericGFPoly;
- var
- ACoefficients: TIntegerArray;
- BCoefficients: TIntegerArray;
- Product: TIntegerArray;
- ALength: Integer;
- BLength: Integer;
- I: Integer;
- J: Integer;
- ACoeff: Integer;
- begin
- SetLength(ACoefficients, 0);
- SetLength(BCoefficients, 0);
- Result := nil;
- if (FField = Other.FField) then
- begin
- if (IsZero or Other.IsZero) then
- begin
- Result := FField.GetZero;
- Exit;
- end;
- ACoefficients := FCoefficients;
- ALength := Length(ACoefficients);
- BCoefficients := Other.Coefficients;
- BLength := Length(BCoefficients);
- SetLength(Product, aLength + bLength - 1);
- for I := 0 to ALength - 1 do
- begin
- ACoeff := ACoefficients[I];
- for J := 0 to BLength - 1 do
- begin
- Product[I + J] := TGenericGF.AddOrSubtract(Product[I + J],
- FField.Multiply(ACoeff, BCoefficients[J]));
- end;
- end;
- Result := TGenericGFPoly.Create(FField, Product);
- end;
- end;
- function TGenericGFPoly.MultiplyByMonomial(Degree,
- Coefficient: Integer): TGenericGFPoly;
- var
- I: Integer;
- Size: Integer;
- Product: TIntegerArray;
- begin
- Result := nil;
- if (Degree >= 0) then
- begin
- if (Coefficient = 0) then
- begin
- Result := FField.GetZero;
- Exit;
- end;
- Size := Length(Coefficients);
- SetLength(Product, Size + Degree);
- for I := 0 to Size - 1 do
- begin
- Product[I] := FField.Multiply(FCoefficients[I], Coefficient);
- end;
- Result := TGenericGFPoly.Create(FField, Product);
- end;
- end;
- { TGenericGF }
- class function TGenericGF.AddOrSubtract(A, B: Integer): Integer;
- begin
- Result := A xor B;
- end;
- function TGenericGF.BuildMonomial(Degree, Coefficient: Integer): TGenericGFPoly;
- var
- Coefficients: TIntegerArray;
- begin
- CheckInit();
- if (Degree >= 0) then
- begin
- if (Coefficient = 0) then
- begin
- Result := FZero;
- Exit;
- end;
- SetLength(Coefficients, Degree + 1);
- Coefficients[0] := Coefficient;
- Result := TGenericGFPoly.Create(Self, Coefficients);
- end else
- begin
- Result := nil;
- end;
- end;
- procedure TGenericGF.CheckInit;
- begin
- if (not FInitialized) then
- begin
- Initialize;
- end;
- end;
- constructor TGenericGF.Create(Primitive, Size, B: Integer);
- begin
- FInitialized := False;
- FPrimitive := Primitive;
- FSize := Size;
- FGeneratorBase := B;
- if (FSize < 0) then
- begin
- Initialize;
- end;
- end;
- class function TGenericGF.CreateQRCodeField256: TGenericGF;
- begin
- Result := TGenericGF.Create($011D, 256, 0);
- end;
- destructor TGenericGF.Destroy;
- var
- X: Integer;
- Y: Integer;
- begin
- for X := 0 to Length(FPolyList) - 1 do
- begin
- if (Assigned(FPolyList[X])) then
- begin
- for Y := X + 1 to Length(FPolyList) - 1 do
- begin
- if (FPolyList[Y] = FPolyList[X]) then
- begin
- FPolyList[Y] := nil;
- end;
- end;
- FPolyList[X].Free;
- end;
- end;
- inherited;
- end;
- function TGenericGF.Exp(A: Integer): Integer;
- begin
- CheckInit;
- Result := FExpTable[A];
- end;
- function TGenericGF.GetGeneratorBase: Integer;
- begin
- Result := FGeneratorBase;
- end;
- function TGenericGF.GetZero: TGenericGFPoly;
- begin
- CheckInit;
- Result := FZero;
- end;
- procedure TGenericGF.Initialize;
- var
- X: Integer;
- I: Integer;
- CA: TIntegerArray;
- begin
- SetLength(FExpTable, FSize);
- SetLength(FLogTable, FSize);
- X := 1;
- for I := 0 to FSize - 1 do
- begin
- FExpTable[I] := x;
- X := X shl 1; // x = x * 2; we're assuming the generator alpha is 2
- if (X >= FSize) then
- begin
- X := X xor FPrimitive;
- X := X and (FSize - 1);
- end;
- end;
- for I := 0 to FSize - 2 do
- begin
- FLogTable[FExpTable[I]] := I;
- end;
- // logTable[0] == 0 but this should never be used
- SetLength(CA, 1);
- CA[0] := 0;
- FZero := TGenericGFPoly.Create(Self, CA);
- SetLength(CA, 1);
- CA[0] := 1;
- FOne := TGenericGFPoly.Create(Self, CA);
- FInitialized := True;
- end;
- function TGenericGF.Inverse(A: Integer): Integer;
- begin
- CheckInit;
- if (a <> 0) then
- begin
- Result := FExpTable[FSize - FLogTable[A] - 1];
- end else
- begin
- Result := 0;
- end;
- end;
- function TGenericGF.Multiply(A, B: Integer): Integer;
- begin
- CheckInit;
- if ((A <> 0) and (B <> 0)) then
- begin
- Result := FExpTable[(FLogTable[A] + FLogTable[B]) mod (FSize - 1)];
- end else
- begin
- Result := 0;
- end;
- end;
- function GenerateQRCode(const Input: WideString; EncodeOptions: Integer): T2DBooleanArray;
- var
- Encoder: TEncoder;
- Level: TErrorCorrectionLevel;
- QRCode: TQRCode;
- X: Integer;
- Y: Integer;
- begin
- Level := TErrorCorrectionLevel.Create;
- Level.FBits := 1;
- Encoder := TEncoder.Create;
- QRCode := TQRCode.Create;
- try
- Encoder.Encode(Input, EncodeOptions, Level, QRCode);
- if (Assigned(QRCode.FMatrix)) then
- begin
- SetLength(Result, QRCode.FMatrix.FHeight);
- for Y := 0 to QRCode.FMatrix.FHeight - 1 do
- begin
- SetLength(Result[Y], QRCode.FMatrix.FWidth);
- for X := 0 to QRCode.FMatrix.FWidth - 1 do
- begin
- Result[Y][X] := QRCode.FMatrix.Get(Y, X) = 1;
- end;
- end;
- end;
- finally
- QRCode.Free;
- Encoder.Free;
- Level.Free;
- end;
- end;
- { TDelphiZXingQRCode }
- constructor TDelphiZXingQRCode.Create;
- begin
- FData := '';
- FEncoding := qrAuto;
- FQuietZone := 4;
- FRows := 0;
- FColumns := 0;
- end;
- function TDelphiZXingQRCode.GetIsBlack(Row, Column: Integer): Boolean;
- begin
- Dec(Row, FQuietZone);
- Dec(Column, FQuietZone);
- if ((Row >= 0) and (Column >= 0) and (Row < (FRows - FQuietZone * 2)) and (Column < (FColumns - FQuietZone * 2))) then
- begin
- Result := FElements[Column, Row];
- end else
- begin
- Result := False;
- end;
- end;
- procedure TDelphiZXingQRCode.SetData(const NewData: WideString);
- begin
- if (FData <> NewData) then
- begin
- FData := NewData;
- Update;
- end;
- end;
- procedure TDelphiZXingQRCode.SetEncoding(NewEncoding: TQRCodeEncoding);
- begin
- if (FEncoding <> NewEncoding) then
- begin
- FEncoding := NewEncoding;
- Update;
- end;
- end;
- procedure TDelphiZXingQRCode.SetQuietZone(NewQuietZone: Integer);
- begin
- if ((FQuietZone <> NewQuietZone) and (NewQuietZone >= 0) and (NewQuietZone <= 100)) then
- begin
- FQuietZone := NewQuietZone;
- Update;
- end;
- end;
- procedure TDelphiZXingQRCode.Update;
- begin
- FElements := GenerateQRCode(FData, Ord(FEncoding));
- FRows := Length(FElements) + FQuietZone * 2;
- FColumns := FRows;
- end;
- end.
|