diff --git a/packages/fcl-image/examples/qrdemo.pp b/packages/fcl-image/examples/qrdemo.pp index 324a637b16..abe0e38c8c 100644 --- a/packages/fcl-image/examples/qrdemo.pp +++ b/packages/fcl-image/examples/qrdemo.pp @@ -3,7 +3,8 @@ * * Run this command-line program with no arguments. The program * computes a demonstration QR Codes and print it to the console. - * + * + * Pascal Version: Copyright (c) Michael Van Canneyt (michael@freepascal.org) * Copyright (c) Project Nayuki. (MIT License) * https://www.nayuki.io/page/qr-code-generator-library * @@ -29,18 +30,16 @@ {$CODEPAGE UTF8} uses fpqrcodegen, sysutils; - +// Prints the given QR Code to the console. Procedure printqr (qrcode : TQRBuffer); -Var +var size : cardinal; border: byte; x,y : Integer; begin - Size:=QRgetSize(qrcode); - Writeln(Size); border:=4; For Y:=-Border to size+Border-1 do begin @@ -62,7 +61,6 @@ var tempbuffer, qrcode: TQRBuffer; - begin SetLength(tempBuffer,QRBUFFER_LEN_MAX); SetLength(qrCode,QRBUFFER_LEN_MAX); @@ -72,22 +70,20 @@ begin printQr(qrcode); end; - // Creates a variety of QR Codes that exercise different features of the library, and prints each one to the console. - procedure doVarietyDemo; -COnst +const UTF8Encoded : Array[0..34] of byte = ($E3,$81,$93,$E3,$82,$93,$E3,$81,$AB,$E3,$81,$A1,Ord('w'),Ord('a'),$E3,$80,$81,$E4,$B8,$96,$E7,$95,$8C,$EF,$BC,$81,$20,$CE,$B1,$CE,$B2,$CE,$B3,$CE,$B4); -Var +var atext : UTF8String; tempbuffer, qrcode: TQRBuffer; - Procedure ResetBuffer; + procedure ResetBuffer; begin FillChar(tempBuffer[0],QRBUFFER_LEN_MAX,0); @@ -95,46 +91,48 @@ Var end; begin + // Project Nayuki URL SetLength(tempBuffer,QRBUFFER_LEN_MAX); SetLength(qrCode,QRBUFFER_LEN_MAX); if QRencodeText('https://www.nayuki.io/', tempBuffer, qrcode, EccHIGH, QRVERSIONMIN, QRVERSIONMAX, mp3, true) then PrintQr(qrCode); + // Numeric mode encoding (3.33 bits per digit) ResetBuffer; if QRencodeText('314159265358979323846264338327950288419716939937510', tempBuffer, qrcode, EccMEDIUM, QRVERSIONMIN, QRVERSIONMAX, mpAUTO, true) then printQr(qrcode); - ResetBuffer; + // Alphanumeric mode encoding (5.5 bits per character) + ResetBuffer; if QRencodeText('DOLLAR-AMOUNT:$39.87 PERCENTAGE:100.00% OPERATIONS:+-*/', tempBuffer, qrcode, eccHIGH, QRVERSIONMIN, QRVERSIONMAX, mpAUTO, true) then printQr(qrcode); ResetBuffer; - // Unicode text as UTF-8, and different masks + // Unicode text as UTF-8, and different masks + SetLength(aText,Length(UTF8Encoded)); + Move(UTF8Encoded[0],atext[1],Length(UTF8Encoded)); - SetLength(aText,Length(UTF8Encoded)); - Move(UTF8Encoded[0],atext[1],Length(UTF8Encoded)); - - if QRencodeText(atext, tempBuffer, qrcode, - eccQUARTILE, QRVERSIONMIN, QRVERSIONMAX, mp0, true) then - printQr(qrcode); - ResetBuffer; + if QRencodeText(atext, tempBuffer, qrcode, + eccQUARTILE, QRVERSIONMIN, QRVERSIONMAX, mp0, true) then + printQr(qrcode); + ResetBuffer; - if QRencodeText(atext, tempBuffer, qrcode, - eccQUARTILE, QRVERSIONMIN, QRVERSIONMAX, mp1, true) then - printQr(qrcode); - ResetBuffer; + if QRencodeText(atext, tempBuffer, qrcode, + eccQUARTILE, QRVERSIONMIN, QRVERSIONMAX, mp1, true) then + printQr(qrcode); + ResetBuffer; - if QRencodeText(atext, tempBuffer, qrcode, - eccQUARTILE, QRVERSIONMIN, QRVERSIONMAX, mp5, true) then - printQr(qrcode); - ResetBuffer; + if QRencodeText(atext, tempBuffer, qrcode, + eccQUARTILE, QRVERSIONMIN, QRVERSIONMAX, mp5, true) then + printQr(qrcode); + ResetBuffer; - if QRencodeText(atext, tempBuffer, qrcode, - eccQUARTILE, QRVERSIONMIN, QRVERSIONMAX, mp7, true) then - printQr(qrcode); - ResetBuffer; + if QRencodeText(atext, tempBuffer, qrcode, + eccQUARTILE, QRVERSIONMIN, QRVERSIONMAX, mp7, true) then + printQr(qrcode); + ResetBuffer; // Moderately large QR Code using longer text (from Lewis Carroll's Alice in Wonderland) atext := @@ -154,7 +152,7 @@ end; procedure doSegmentDemo; -Const +const kanjiChars : Array[0..28] of word = ( // Kanji mode encoding (13 bits per character) $0035, $1002, $0FC0, $0AED, $0AD7, $015C, $0147, $0129, $0059, $01BD, @@ -164,7 +162,7 @@ Const $0000, $0208, $01FF, $0008); -Var +var aText,silver0,silver1,golden0,golden1,golden2 : String; tempbuffer, qrcode: TQRBuffer; @@ -194,8 +192,9 @@ begin segs[0]:=QRmakeAlphanumeric(silver0, segBuf0); segs[1]:=QRmakeNumeric(silver1, segBuf1); if QRencodeSegments(segs, eccLOW, tempBuffer, qrcode) then - printQr(qrcode); + printQr(qrcode); + // Illustration "golden" SetLength(Segbuf0,0); SetLength(Segbuf1,0); golden0 := 'Golden ratio '#$CF#$86' = 1.'; @@ -218,10 +217,11 @@ begin SetLength(bytes,0); if QRencodeSegments(segs2,EccLOW, tempBuffer, qrcode) then PrintQR(qrCode); + + // Illustration "Madoka": kanji, kana, Greek, Cyrillic, full-width Latin characters SetLength(segBuf0,0); SetLength(segBuf1,0); SetLength(segBuf2,0); - atext:= // Encoded in UTF-8 #$E3#$80#$8C#$E9#$AD#$94#$E6#$B3#$95#$E5+ #$B0#$91#$E5#$A5#$B3#$E3#$81#$BE#$E3#$81+ @@ -253,11 +253,8 @@ begin printQr(qrcode); end; -// Prints the given QR Code to the console. - - begin - doBasicDemo(); + doBasicDemo(); doVarietyDemo(); - doSegmentDemo(); + doSegmentDemo(); end. diff --git a/packages/fcl-image/src/fpqrcodegen.pp b/packages/fcl-image/src/fpqrcodegen.pp index 5b0cf46561..dbbfe22e46 100644 --- a/packages/fcl-image/src/fpqrcodegen.pp +++ b/packages/fcl-image/src/fpqrcodegen.pp @@ -1,14 +1,9 @@ -{ +{ ********************************************************************** This file is part of the Free Pascal class library FCL. Pascal translation and additions (c) 2017 by Michael Van Canneyt, member of the Free Pascal development team. - The Object Pascal version of Nayuki's QR code generator - can be used under the FPC license with permission of the - original copyright owner Nayuki. (http://nayuki.io/) - - Original C code for QR code generation is Copyright (c) Project Nayuki. - (MIT Licensed) see below for the original copyright. + Ported from Nayuki's library with permission (see below). See the file COPYING.FPC, included in this distribution, for details about the copyright of the Pascal version. @@ -17,7 +12,10 @@ but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - **********************************************************************} + QR Code generator library (C language) + Copyright (c) Project Nayuki. (MIT License) + https://www.nayuki.io/page/qr-code-generator-library + **********************************************************************} {$mode objfpc} unit fpqrcodegen; @@ -25,32 +23,6 @@ interface uses sysutils; -// Original copyright of C version of QR Code generator - -{* - * QR Code generator library (C) - * - * Copyright (c) Project Nayuki. (MIT License) - * https://www.nayuki.io/page/qr-code-generator-library - * - * Permission is hereby granted, free of charge, to any person obtaining a copy of - * this software and associated documentation files (the "Software"), to deal in - * the Software without restriction, including without limitation the rights to - * use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of - * the Software, and to permit persons to whom the Software is furnished to do so, - * subject to the following conditions: - * - The above copyright notice and this permission notice shall be included in - * all copies or substantial portions of the Software. - * - The Software is provided "as is", without warranty of any kind, express or - * implied, including but not limited to the warranties of merchantability, - * fitness for a particular purpose and noninfringement. In no event shall the - * authors or copyright holders be liable for any claim, damages or other - * liability, whether in an action of contract, tort or otherwise, arising from, - * out of or in connection with the Software or the use or other dealings in the - * Software. - *} - - {---- Enum and struct types----} Type @@ -75,9 +47,9 @@ Type // The mode indicator for this segment. mode : TQRMode; // The length of this segment's unencoded data. Always in the range [0, 32767]. - // For numeric, alphanumeric, and kanji modes, this measures in Unicode code points. - // For byte mode, this measures in bytes (raw binary data, text in UTF-8, or other encodings). - // For ECI mode, this is always zero. + // for numeric, alphanumeric, and kanji modes, this measures in Unicode code points. + // for byte mode, this measures in bytes (raw binary data, text in UTF-8, or other encodings). + // for ECI mode, this is always zero. numChars : word; // The data bits of this segment, packed in bitwise big endian. // Can be null if the bit length is zero. @@ -100,7 +72,7 @@ Const QRVERSIONMAX = High(TQRVersion); // Calculates the number of bytes needed to store any QR Code up to and including the given version number, -// as a compile-time constant. For example, 'uint8_t buffer[qrcodegen_BUFFER_LEN_FOR_VERSION(25)];' +// as a compile-time constant. for example, 'uint8_t buffer[qrcodegen_BUFFER_LEN_FOR_VERSION(25)];' // can store any single QR Code from version 1 to 25, inclusive. // Requires qrcodegen_VERSION_MIN <= n <= qrcodegen_VERSION_MAX. Function QRBUFFER_LEN_FOR_VERSION(n : TQRVersion) : integer; @@ -212,9 +184,9 @@ Function QRIsNumeric(atext : TQRString) : Boolean; * the number of needed bits exceeds INT16_MAX (i.e. 32767). * - Otherwise, all valid results are in the range [0, ceil(INT16_MAX / 8)], i.e. at most 4096. * - It is okay for the user to allocate more bytes for the buffer than needed. - * - For byte mode, numChars measures the number of bytes, not Unicode code points. - * - For ECI mode, numChars must be 0, and the worst-case number of bytes is returned. - * An actual ECI segment can have shorter data. For non-ECI modes, the result is exact. + * - for byte mode, numChars measures the number of bytes, not Unicode code points. + * - for ECI mode, numChars must be 0, and the worst-case number of bytes is returned. + * An actual ECI segment can have shorter data. for non-ECI modes, the result is exact. } Function QRCalcSegmentBufferSize(aMode: TQRMode; numChars : Cardinal) : Cardinal; @@ -291,53 +263,44 @@ Function QRgetModule(qrcode : TQRBuffer; x, y : word) : Boolean; Implementation - -{---- Forward declarations for private functions ----} -procedure appendBitsToBuffer(val : cardinal; numBits : integer; buffer : TQRBuffer; var bitLen : integer); forward; - -procedure appendErrorCorrection(data : TQRBuffer; version: TQRVersion; ecl: TQRErrorLevelCorrection; Result: TQRBuffer);forward; -function getNumDataCodewords(version : TQRVersion; ecl : TQRErrorLevelCorrection) : integer;forward; -function getNumRawDataModules(version : TQRVersion): integer;forward; - Type TDegree = 1..30; TGenerator = Array[0..29] of byte; -procedure calcReedSolomonGenerator(degree : TDegree; out result : TGenerator);forward; -procedure calcReedSolomonRemainder(const data : PByte; dataLen : Integer; constref generator : TGenerator; degree : TDegree; result : PByte);forward; - - -function finiteFieldMultiply(x,y : Byte) : Byte;forward; - -procedure initializeFunctionModules(version : TQRVersion; qrcode : TQRBuffer);forward; -procedure drawWhiteFunctionModules(qrcode : TQRBuffer; version : TQRVersion);forward; -procedure drawFormatBits(ecl : TQRErrorLevelCorrection; mask : TQRMask; qrcode : TQRBuffer);forward; - -Type TPatternPositions = array[0..6] of byte; -function getAlignmentPatternPositions(version : TQRVersion; var res : TPatternPositions) : Integer;forward; -Procedure fillRectangle(left,top,width,height : Integer; qrcode : TQRBuffer);forward; -procedure drawCodewords(const data : TQRBuffer; dataLen : integer; qrcode : TQRBuffer);forward; -procedure applyMask(Modules : TQRBuffer; qrcode : TQRBuffer; mask : TQRMask);forward; -function getPenaltyScore(const qrcode : TQRBuffer) : int64;forward; +{---- Forward declarations for private functions ----} -function getModule(qrcode : TQRBuffer; x, y : word) : Boolean;forward; -procedure setModule(qrcode : TQRBuffer; x,y : Word; isBlack : boolean);forward; -procedure setModuleBounded(qrcode : TQRBuffer; x,y : Word; isBlack : Boolean);forward; - -function calcSegmentBitLength(mode : TQRMode; numChars : Integer) : integer;forward; -function getTotalBits(segs : TQRSegmentArray; version : TQRVersion) : integer;forward; -function numCharCountBits(mode : TQRMode; version : TQRVersion) : integer;forward; +procedure appendBitsToBuffer(val : cardinal; numBits : integer; buffer : TQRBuffer; var bitLen : integer); forward; +procedure appendErrorCorrection(data : TQRBuffer; version: TQRVersion; ecl: TQRErrorLevelCorrection; Result: TQRBuffer); forward; +function getNumDataCodewords(version : TQRVersion; ecl : TQRErrorLevelCorrection) : integer; forward; +function getNumRawDataModules(version : TQRVersion): integer; forward; +procedure calcReedSolomonGenerator(degree : TDegree; out result : TGenerator); forward; +procedure calcReedSolomonRemainder(const data : PByte; dataLen : Integer; constref generator : TGenerator; degree : TDegree; result : PByte); forward; +function finiteFieldMultiply(x,y : Byte) : Byte; forward; +procedure initializeFunctionModules(version : TQRVersion; qrcode : TQRBuffer); forward; +procedure drawWhiteFunctionModules(qrcode : TQRBuffer; version : TQRVersion); forward; +procedure drawFormatBits(ecl : TQRErrorLevelCorrection; mask : TQRMask; qrcode : TQRBuffer); forward; +function getAlignmentPatternPositions(version : TQRVersion; var res : TPatternPositions) : Integer; forward; +procedure fillRectangle(left,top,width,height : Integer; qrcode : TQRBuffer); forward; +procedure drawCodewords(const data : TQRBuffer; dataLen : integer; qrcode : TQRBuffer); forward; +procedure applyMask(Modules : TQRBuffer; qrcode : TQRBuffer; mask : TQRMask); forward; +function getPenaltyScore(const qrcode : TQRBuffer) : int64; forward; +function getModule(qrcode : TQRBuffer; x, y : word) : Boolean; forward; +procedure setModule(qrcode : TQRBuffer; x,y : Word; isBlack : boolean); forward; +procedure setModuleBounded(qrcode : TQRBuffer; x,y : Word; isBlack : Boolean); forward; +function calcSegmentBitLength(mode : TQRMode; numChars : Integer) : integer; forward; +function getTotalBits(segs : TQRSegmentArray; version : TQRVersion) : integer; forward; +function numCharCountBits(mode : TQRMode; version : TQRVersion) : integer; forward; {---- Private tables of constants ----} -// For checking text and encoding segments. +// for checking text and encoding segments. const ALPHANUMERIC_CHARSET = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ $%*+-./:'; -// For generating error correction codes. +// for generating error correction codes. const ECC_CODEWORDS_PER_BLOCK : Array[0..3,0..40] of shortint = ( // Version: (note that index 0 is for padding, and is set to an illegal value) @@ -348,7 +311,7 @@ const (-1, 17, 28, 22, 16, 22, 28, 26, 26, 24, 28, 24, 28, 22, 24, 24, 30, 28, 28, 26, 28, 30, 24, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30, 30) // High ); -// For generating error correction codes. +// for generating error correction codes. NUM_ERROR_CORRECTION_BLOCKS : Array [0..3,0..40] of shortint = ( // Version: (note that index 0 is for padding, and is set to an illegal value) //0, 1, 2, 3, 4, 5, 6, 7, 8, 9,10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40 Error correction level @@ -358,7 +321,7 @@ const (-1, 1, 1, 2, 4, 4, 4, 5, 6, 8, 8, 11, 11, 16, 16, 18, 16, 19, 21, 25, 25, 25, 34, 30, 32, 35, 37, 40, 42, 45, 48, 51, 54, 57, 60, 63, 66, 70, 74, 77, 81) // High ); -// For automatic mask pattern selection. +// for automatic mask pattern selection. const PENALTY_N1 = 3; PENALTY_N2 = 3; @@ -372,7 +335,7 @@ const function QREncodeText(aText : TQRString; tempBuffer, qrcode : TQRBuffer; ecl : TQRErrorLevelCorrection; minVersion, maxVersion : TQRVersion; mask : TQRMask; boostEcl : Boolean) : boolean; -Var +var i, buflen, textLen : Integer; seg : TQRSegmentArray; failed : Boolean; @@ -391,17 +354,17 @@ begin seg[0]:=QRmakeNumeric(aText,tempBuffer); end else if (QRisAlphanumeric(aText)) then - begin - Failed:=(QRcalcSegmentBufferSize(mALPHANUMERIC, textLen) > bufLen); - if not Failed then - Seg[0]:=QRMakeAlphanumeric(aText, tempBuffer); - end + begin + Failed:=(QRcalcSegmentBufferSize(mALPHANUMERIC, textLen) > bufLen); + if not Failed then + Seg[0]:=QRMakeAlphanumeric(aText, tempBuffer); + end else begin Failed:=(textLen > bufLen); if not Failed then begin - For I:=1 to Textlen do + for I:=1 to Textlen do tempBuffer[i-1]:=Ord(aText[i]); seg[0].mode:=mBYTE; seg[0].bitLength:=calcSegmentBitLength(seg[0].mode, textLen); @@ -425,7 +388,7 @@ end; function QREncodeBinary(dataAndTemp : TQRBuffer; dataLen : Integer; qrcode : TQRBuffer; ecl: TQRErrorLevelCorrection; minVersion, maxVersion: TQRVersion; mask: TQRMask; boostEcl : Boolean) : Boolean; -Var +var seg : TQRSegmentArray; begin @@ -447,21 +410,19 @@ end; // Appends the given sequence of bits to the given byte-based bit buffer, increasing the bit length. procedure appendBitsToBuffer(val : cardinal; numBits : integer; buffer : TQRBuffer; var bitLen : integer); -Var +var I,idx : integer; begin assert((0 <= numBits) and (numBits <= 16) and ((val shr numBits) = 0)); for I:=numBits-1 downto 0 do - begin - idx:=bitLen shr 3; - buffer[idx]:=buffer[idx] or ((val shr i) and 1) shl (7 - (bitLen and 7)); - Inc(Bitlen); - end; + begin + idx:=bitLen shr 3; + buffer[idx]:=buffer[idx] or ((val shr i) and 1) shl (7 - (bitLen and 7)); + Inc(Bitlen); + end; end; - - {---- Error correction code generation functions ----} // Appends error correction bytes to each block of the given data array, then interleaves bytes @@ -470,10 +431,9 @@ end; // and will be clobbered by this function. The final answer is stored in result[0 : rawCodewords]. procedure appendErrorCorrection(data : TQRBuffer; version: TQRVersion; ecl: TQRErrorLevelCorrection; Result: TQRBuffer); -Var +var numBlocks : Shortint; blockEccLen : Shortint; - blocklen,I,J,K,L : integer; rawCodewords : Integer; dataLen : Integer; @@ -481,7 +441,6 @@ Var shortBlockDataLen : Integer; generator : TGenerator; - begin numBlocks:=NUM_ERROR_CORRECTION_BLOCKS[Ord(ecl)][version]; blockEccLen:=ECC_CODEWORDS_PER_BLOCK[Ord(ecl)][version]; @@ -507,7 +466,7 @@ begin for I:=0 to numBlocks-1 do begin l:=I; - For J:=0 to shortBlockDataLen-1 do + for J:=0 to shortBlockDataLen-1 do begin result[l]:=data[k]; Inc(k); @@ -543,8 +502,9 @@ end; // for the given version number and error correction level. The result is in the range [9, 2956]. function getNumDataCodewords(version : TQRVersion; ecl : TQRErrorLevelCorrection) : integer; -Var +var v,e : integer; + begin v:=version; e:=Ord(ecl); @@ -557,7 +517,7 @@ end; // The result is in the range [208, 29648]. This could be implemented as a 40-entry lookup table. function getNumRawDataModules(version : TQRVersion): integer; -Var +var numAlign: integer; begin @@ -571,14 +531,12 @@ begin end; end; - - {---- Reed-Solomon ECC generator functions ----} // Calculates the Reed-Solomon generator polynomial of the given degree, storing in result[0 : degree]. procedure calcReedSolomonGenerator(degree : TDegree; out result : TGenerator); -Var +var I,J : byte; Root : Byte; @@ -587,12 +545,11 @@ begin Result[0]:=0; // Avoid warning FillChar(result,sizeof(TGenerator),0); result[degree-1]:= 1; - // Compute the product polynomial (x - r^0) * (x - r^1) * (x - r^2) * ... * (x - r^{degree-1}), // drop the highest term, and store the rest of the coefficients in order of descending powers. // Note that r = 0x02, which is a generator element of this field GF(2^8/0x11D). root:=1; - For I:=0 to degree-1 do + for I:=0 to degree-1 do begin // Multiply the current product by (x - r^i) for j:=0 to Degree-1 do @@ -610,9 +567,10 @@ end; // polynomials are in big endian and the generator has an implicit leading 1 term, storing the result in result[0 : degree]. procedure calcReedSolomonRemainder(const data : PByte; dataLen : Integer; constref generator : TGenerator; degree : TDegree; result : PByte); -Var +var I,J : Integer; factor : byte ; + begin FillChar(Result^,degree,0); for I:=0 to Datalen-1 do @@ -620,7 +578,7 @@ begin factor:=data[i] xor result[0]; move( result[1],result[0],(degree - 1)); result[degree-1] := 0; - For j:=0 to degree-1 do + for j:=0 to degree-1 do begin result[j]:=result[j] xor finiteFieldMultiply(generator[j], factor); end; @@ -632,7 +590,7 @@ end; // All inputs are valid. This could be implemented as a 256*256 lookup table. function finiteFieldMultiply(x,y : Byte) : Byte; -Var +var Z : Byte; I : shortint; @@ -655,7 +613,7 @@ end; // version's size, then marks every function module as black. procedure initializeFunctionModules(version : TQRVersion; qrcode : TQRBuffer); -Var +var qrsize : byte; alignPatPos : TPatternPositions; i,j,numAlign : integer; @@ -679,8 +637,8 @@ begin alignPatPos[0]:=0; // Avoid warning FillChar(alignPatPos,SizeOf(TPatternPositions),0); numAlign:=getAlignmentPatternPositions(version, alignPatPos); - For i:=0 to numAlign-1 do - For j:=0 to NumAlign-1 do + for i:=0 to numAlign-1 do + for j:=0 to NumAlign-1 do begin if ((i=0) and (j=0)) or ((i=0) and (j=(numAlign-1))) or ((i=(numAlign-1)) and (j=0)) then continue; // Skip the three finder corners @@ -718,8 +676,8 @@ begin end; // Draw 3 finder patterns (all corners except bottom right; overwrites some timing modules) - For I:=-4 to 4 do - For J:=-4 to 4 do + for I:=-4 to 4 do + for J:=-4 to 4 do begin dist:=abs(i); if (abs(j) > dist) then @@ -741,8 +699,8 @@ begin alignPatPos[0]:=0; // Avoid warning FillChar(alignPatPos,SizeOf(TPatternPositions),0); numAlign:=getAlignmentPatternPositions(version, alignPatPos); - For i:=0 to numAlign-1 do - For j:=0 to NumAlign-1 do + for i:=0 to numAlign-1 do + for j:=0 to NumAlign-1 do begin if ((i=0) and (j=0)) or ((i=0) and (j=(numAlign-1))) or ((i=(numAlign-1)) and (j=0)) then continue; // Skip the three finder corners @@ -778,7 +736,7 @@ end; // the format bits, unlike drawWhiteFunctionModules() which might skip black modules. procedure drawFormatBits(ecl : TQRErrorLevelCorrection; mask : TQRMask; qrcode : TQRBuffer); -Var +var qrsize,i,rem,data : integer; begin @@ -819,7 +777,7 @@ end; // storing them to the given array and returning an array length in the range [0, 7]. function getAlignmentPatternPositions(version : TQRVersion; var res : TPatternPositions) : Integer; -Var +var i,numalign, step, pos : Integer; begin @@ -863,7 +821,7 @@ end; procedure drawCodewords(const data : TQRBuffer; dataLen : integer; qrcode : TQRBuffer); -Var +var i,right,vert,j,y,x,qrsize : integer; black,upward : boolean; @@ -908,7 +866,7 @@ end; // well-formed QR Code symbol needs exactly one mask applied (not zero, not two, etc.). procedure applyMask(Modules : TQRBuffer; qrcode : TQRBuffer; mask : TQRMask); -Var +var x,y,qrsize : integer; invert,val : boolean; @@ -1059,7 +1017,7 @@ end; // Public function - see documentation comment in header file. function QRgetModule(qrcode : TQRBuffer; x,y : Word) : Boolean; -Var +var QrSize : Integer; begin assert(Length(qrcode)>0); @@ -1087,7 +1045,7 @@ end; // Sets the module at the given coordinates, which must be in bounds. procedure setModule(qrcode : TQRBuffer; x,y : Word; isBlack : boolean); -Var +var index,bitindex,byteindex,qrsize : integer; begin @@ -1108,6 +1066,7 @@ procedure setModuleBounded(qrcode : TQRBuffer; x,y : Word; isBlack : Boolean); var qrsize : word; + begin qrsize := qrcode[0]; if ((x < qrsize) and (y < qrsize)) then @@ -1121,7 +1080,7 @@ end; // Public function - see documentation comment in header file. Function QRIsNumeric(atext : TQRString) : Boolean; -Var +var L,I : integer; begin @@ -1137,7 +1096,7 @@ end; Function QRIsAlphanumeric(aText : TQRString) : Boolean; -Var +var L,I : integer; begin @@ -1156,7 +1115,7 @@ end; // Public function - see documentation comment in header file. Function QRCalcSegmentBufferSize(aMode: TQRMode; numChars : Cardinal) : Cardinal; -Var +var Temp : Integer; begin @@ -1173,12 +1132,12 @@ end; // - Returns -1 on failure, i.e. numChars > INT16_MAX or // the number of needed bits exceeds INT16_MAX (i.e. 32767). // - Otherwise, all valid results are in the range [0, INT16_MAX]. -// - For byte mode, numChars measures the number of bytes, not Unicode code points. -// - For ECI mode, numChars must be 0, and the worst-case number of bits is returned. -// An actual ECI segment can have shorter data. For non-ECI modes, the result is exact. +// - for byte mode, numChars measures the number of bytes, not Unicode code points. +// - for ECI mode, numChars must be 0, and the worst-case number of bits is returned. +// An actual ECI segment can have shorter data. for non-ECI modes, the result is exact. function calcSegmentBitLength(mode : TQRMode; numChars : Integer) : integer; -Var +var temp,N,Limit: integer; begin @@ -1248,12 +1207,11 @@ end; // Public function - see documentation comment in header file. Function QRMakeNumeric(digits : TQRString; buf : TQRBuffer) : TQRSegment; -Var +var accumcount, bitlen,len: integer; accumData : Cardinal; c : ansichar; - begin assert(Length(digits)>0); len := length(digits); @@ -1288,7 +1246,7 @@ end; // Public function - see documentation comment in header file. Function QRMakeAlphanumeric(aText : TQRString; buf : TQRBuffer) : TQRSegment; -Var +var p,accumcount, bitlen,len: integer; accumData : Cardinal; c : ansichar; @@ -1360,7 +1318,6 @@ end; // Public function - see documentation comment in header file. Function QREncodeSegments(Segs : TQRSegmentArray; ecl: TQRErrorLevelCorrection; tempBuffer, qrcode : TQRBuffer) : Boolean; - begin Result:=QRencodeSegmentsAdvanced(segs, ecl, QRVERSIONMIN, QRVERSIONMAX, mpAuto, True, tempBuffer, qrcode); end; @@ -1370,7 +1327,7 @@ end; Function QREncodeSegmentsAdvanced(Segs : TQRSegmentArray; ecl: TQRErrorLevelCorrection; minVersion, maxVersion : TQRVersion; mask : TQRMask; boostEcl : Boolean; tempBuffer, qrcode : TQRBuffer) : Boolean; -Var +var modebits : byte; bitlen, I,j : Integer; Version : TQRVersion; @@ -1480,14 +1437,14 @@ end; // or if the actual answer exceeds INT16_MAX. function getTotalBits(segs : TQRSegmentArray; version : TQRVersion): integer; -Var +var ccbits,I,numChars,bitLength : integer; temp : integer; begin assert(Length(segs)>0); result := 0; - For I:=0 to Length(segs)-1 do + for I:=0 to Length(segs)-1 do begin numChars := segs[i].numChars; bitLength := segs[i].bitLength; @@ -1520,7 +1477,7 @@ Const bmBYTE : T3Bytes = ( 8, 16, 16); bmKANJI : T3Bytes = (8, 10, 12); -Var +var I : Integer; begin @@ -1534,7 +1491,6 @@ begin begin assert(false); end; - case (mode) of mNUMERIC : Result:=bmNumeric[i]; mALPHANUMERIC: Result:=bmALPHANUMERIC[i]; @@ -1556,6 +1512,7 @@ end; ---------------------------------------------------------------------} function TQRCodeGenerator.GetBits(X : Word; Y : Word): Boolean; + begin if Assigned(FBytes) then Result:=getModule(FBytes,X,Y) @@ -1564,6 +1521,7 @@ begin end; function TQRCodeGenerator.GetSize: Integer; + begin if Assigned(FBytes) then Result:=QRgetSize(FBytes) @@ -1572,6 +1530,7 @@ begin end; procedure TQRCodeGenerator.SetBufferLength(AValue: Word); + begin if AValue>QRBUFFER_LEN_MAX then AValue:=QRBUFFER_LEN_MAX; @@ -1590,6 +1549,7 @@ begin end; destructor TQRCodeGenerator.Destroy; + begin SetLength(FBytes,0); inherited Destroy; @@ -1597,7 +1557,7 @@ end; procedure TQRCodeGenerator.Generate(aText: TQRString); -Var +var Tmp : TQRBuffer; begin @@ -1608,7 +1568,8 @@ begin end; procedure TQRCodeGenerator.Generate(aNumber: Int64); -Var + +var Tmp : TQRBuffer; aText : TQRString; diff --git a/packages/fcl-report/demos/rptqrcode.pp b/packages/fcl-report/demos/rptqrcode.pp index 9e8f4a699f..a9b57847bb 100644 --- a/packages/fcl-report/demos/rptqrcode.pp +++ b/packages/fcl-report/demos/rptqrcode.pp @@ -104,7 +104,7 @@ begin QR.Layout.Top := 1; QR.Layout.Width := 34; QR.Layout.Height := 34; - QR.Value:='http://nayuki.io/'; + QR.Value:='https://www.nayuki.io/page/qr-code-generator-library/'; QR.Center:=True; QR:= TFPReportQRcode.Create(TitleBand); @@ -243,7 +243,7 @@ end; procedure TQRCodeDemo.InitialiseData; -Var +var SL : TStringList; i : Integer; N,V : String;