paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-21 15:09:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Some cosmetic, license text and other changes based on code review by Nayuki

Browse Source 
git-svn-id: trunk@37440 -
This commit is contained in:
michael 2017-10-10 06:51:44 +00:00
parent 1b2511c0a0
commit 7abc3af339
3 changed files with 138 additions and 180 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
packages/fcl-image/examples/qrdemo.pp
View File

@ -4,6 +4,7 @@
* Run this command-line program with no arguments. The program * Run this command-line program with no arguments. The program
* computes a demonstration QR Codes and print it to the console. * 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) * Copyright (c) Project Nayuki. (MIT License)
* https://www.nayuki.io/page/qr-code-generator-library * https://www.nayuki.io/page/qr-code-generator-library
* *
@ -29,18 +30,16 @@
{$CODEPAGE UTF8} {$CODEPAGE UTF8}
uses fpqrcodegen, sysutils; uses fpqrcodegen, sysutils;
// Prints the given QR Code to the console.
Procedure printqr (qrcode : TQRBuffer); Procedure printqr (qrcode : TQRBuffer);
Var var
size : cardinal; size : cardinal;
border: byte; border: byte;
x,y : Integer; x,y : Integer;
begin begin
Size:=QRgetSize(qrcode); Size:=QRgetSize(qrcode);
Writeln(Size);
border:=4; border:=4;
For Y:=-Border to size+Border-1 do For Y:=-Border to size+Border-1 do
begin begin
@ -62,7 +61,6 @@ var
tempbuffer, tempbuffer,
qrcode: TQRBuffer; qrcode: TQRBuffer;
begin begin
SetLength(tempBuffer,QRBUFFER_LEN_MAX); SetLength(tempBuffer,QRBUFFER_LEN_MAX);
SetLength(qrCode,QRBUFFER_LEN_MAX); SetLength(qrCode,QRBUFFER_LEN_MAX);
@ -72,22 +70,20 @@ begin
printQr(qrcode); printQr(qrcode);
end; end;
// Creates a variety of QR Codes that exercise different features of the library, and prints each one to the console. // Creates a variety of QR Codes that exercise different features of the library, and prints each one to the console.
procedure doVarietyDemo; procedure doVarietyDemo;
COnst const
UTF8Encoded : Array[0..34] of byte = 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); ($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; atext : UTF8String;
tempbuffer, tempbuffer,
qrcode: TQRBuffer; qrcode: TQRBuffer;
Procedure ResetBuffer; procedure ResetBuffer;
begin begin
FillChar(tempBuffer[0],QRBUFFER_LEN_MAX,0); FillChar(tempBuffer[0],QRBUFFER_LEN_MAX,0);
@ -95,46 +91,48 @@ Var
end; end;
begin begin
// Project Nayuki URL
SetLength(tempBuffer,QRBUFFER_LEN_MAX); SetLength(tempBuffer,QRBUFFER_LEN_MAX);
SetLength(qrCode,QRBUFFER_LEN_MAX); SetLength(qrCode,QRBUFFER_LEN_MAX);
if QRencodeText('https://www.nayuki.io/', tempBuffer, qrcode, if QRencodeText('https://www.nayuki.io/', tempBuffer, qrcode,
EccHIGH, QRVERSIONMIN, QRVERSIONMAX, mp3, true) then EccHIGH, QRVERSIONMIN, QRVERSIONMAX, mp3, true) then
PrintQr(qrCode); PrintQr(qrCode);
// Numeric mode encoding (3.33 bits per digit)
ResetBuffer; ResetBuffer;
if QRencodeText('314159265358979323846264338327950288419716939937510', tempBuffer, qrcode, if QRencodeText('314159265358979323846264338327950288419716939937510', tempBuffer, qrcode,
EccMEDIUM, QRVERSIONMIN, QRVERSIONMAX, mpAUTO, true) then EccMEDIUM, QRVERSIONMIN, QRVERSIONMAX, mpAUTO, true) then
printQr(qrcode); printQr(qrcode);
ResetBuffer;
// Alphanumeric mode encoding (5.5 bits per character)
ResetBuffer;
if QRencodeText('DOLLAR-AMOUNT:$39.87 PERCENTAGE:100.00% OPERATIONS:+-*/', tempBuffer, qrcode, if QRencodeText('DOLLAR-AMOUNT:$39.87 PERCENTAGE:100.00% OPERATIONS:+-*/', tempBuffer, qrcode,
eccHIGH, QRVERSIONMIN, QRVERSIONMAX, mpAUTO, true) then eccHIGH, QRVERSIONMIN, QRVERSIONMAX, mpAUTO, true) then
printQr(qrcode); printQr(qrcode);
ResetBuffer; 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)); if QRencodeText(atext, tempBuffer, qrcode,
Move(UTF8Encoded[0],atext[1],Length(UTF8Encoded)); eccQUARTILE, QRVERSIONMIN, QRVERSIONMAX, mp0, true) then
printQr(qrcode);
ResetBuffer;
if QRencodeText(atext, tempBuffer, qrcode, if QRencodeText(atext, tempBuffer, qrcode,
eccQUARTILE, QRVERSIONMIN, QRVERSIONMAX, mp0, true) then eccQUARTILE, QRVERSIONMIN, QRVERSIONMAX, mp1, true) then
printQr(qrcode); printQr(qrcode);
ResetBuffer; ResetBuffer;
if QRencodeText(atext, tempBuffer, qrcode, if QRencodeText(atext, tempBuffer, qrcode,
eccQUARTILE, QRVERSIONMIN, QRVERSIONMAX, mp1, true) then eccQUARTILE, QRVERSIONMIN, QRVERSIONMAX, mp5, true) then
printQr(qrcode); printQr(qrcode);
ResetBuffer; ResetBuffer;
if QRencodeText(atext, tempBuffer, qrcode, if QRencodeText(atext, tempBuffer, qrcode,
eccQUARTILE, QRVERSIONMIN, QRVERSIONMAX, mp5, true) then eccQUARTILE, QRVERSIONMIN, QRVERSIONMAX, mp7, true) then
printQr(qrcode); printQr(qrcode);
ResetBuffer; 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) // Moderately large QR Code using longer text (from Lewis Carroll's Alice in Wonderland)
atext := atext :=
@ -154,7 +152,7 @@ end;
procedure doSegmentDemo; procedure doSegmentDemo;
Const const
kanjiChars : Array[0..28] of word = ( // Kanji mode encoding (13 bits per character) kanjiChars : Array[0..28] of word = ( // Kanji mode encoding (13 bits per character)
$0035, $1002, $0FC0, $0AED, $0AD7, $0035, $1002, $0FC0, $0AED, $0AD7,
$015C, $0147, $0129, $0059, $01BD, $015C, $0147, $0129, $0059, $01BD,
@ -164,7 +162,7 @@ Const
$0000, $0208, $01FF, $0008); $0000, $0208, $01FF, $0008);
Var var
aText,silver0,silver1,golden0,golden1,golden2 : String; aText,silver0,silver1,golden0,golden1,golden2 : String;
tempbuffer, tempbuffer,
qrcode: TQRBuffer; qrcode: TQRBuffer;
@ -194,8 +192,9 @@ begin
segs[0]:=QRmakeAlphanumeric(silver0, segBuf0); segs[0]:=QRmakeAlphanumeric(silver0, segBuf0);
segs[1]:=QRmakeNumeric(silver1, segBuf1); segs[1]:=QRmakeNumeric(silver1, segBuf1);
if QRencodeSegments(segs, eccLOW, tempBuffer, qrcode) then if QRencodeSegments(segs, eccLOW, tempBuffer, qrcode) then
printQr(qrcode); printQr(qrcode);
// Illustration "golden"
SetLength(Segbuf0,0); SetLength(Segbuf0,0);
SetLength(Segbuf1,0); SetLength(Segbuf1,0);
golden0 := 'Golden ratio '#$CF#$86' = 1.'; golden0 := 'Golden ratio '#$CF#$86' = 1.';
@ -218,10 +217,11 @@ begin
SetLength(bytes,0); SetLength(bytes,0);
if QRencodeSegments(segs2,EccLOW, tempBuffer, qrcode) then if QRencodeSegments(segs2,EccLOW, tempBuffer, qrcode) then
PrintQR(qrCode); PrintQR(qrCode);
// Illustration "Madoka": kanji, kana, Greek, Cyrillic, full-width Latin characters
SetLength(segBuf0,0); SetLength(segBuf0,0);
SetLength(segBuf1,0); SetLength(segBuf1,0);
SetLength(segBuf2,0); SetLength(segBuf2,0);
atext:= // Encoded in UTF-8 atext:= // Encoded in UTF-8
#$E3#$80#$8C#$E9#$AD#$94#$E6#$B3#$95#$E5+ #$E3#$80#$8C#$E9#$AD#$94#$E6#$B3#$95#$E5+
#$B0#$91#$E5#$A5#$B3#$E3#$81#$BE#$E3#$81+ #$B0#$91#$E5#$A5#$B3#$E3#$81#$BE#$E3#$81+
@ -253,11 +253,8 @@ begin
printQr(qrcode); printQr(qrcode);
end; end;
// Prints the given QR Code to the console.
begin begin
doBasicDemo(); doBasicDemo();
doVarietyDemo(); doVarietyDemo();
doSegmentDemo(); doSegmentDemo();
end. end.

235
packages/fcl-image/src/fpqrcodegen.pp
View File

@ -1,14 +1,9 @@
{ { **********************************************************************
This file is part of the Free Pascal class library FCL. This file is part of the Free Pascal class library FCL.
Pascal translation and additions (c) 2017 by Michael Van Canneyt, Pascal translation and additions (c) 2017 by Michael Van Canneyt,
member of the Free Pascal development team. member of the Free Pascal development team.
The Object Pascal version of Nayuki's QR code generator Ported from Nayuki's library with permission (see below).
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.
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright of the Pascal version. for details about the copyright of the Pascal version.
@ -17,7 +12,10 @@
but WITHOUT ANY WARRANTY; without even the implied warranty of but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 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} {$mode objfpc}
unit fpqrcodegen; unit fpqrcodegen;
@ -25,32 +23,6 @@ interface
uses sysutils; 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----} {---- Enum and struct types----}
Type Type
@ -75,9 +47,9 @@ Type
// The mode indicator for this segment. // The mode indicator for this segment.
mode : TQRMode; mode : TQRMode;
// The length of this segment's unencoded data. Always in the range [0, 32767]. // 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 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 byte mode, this measures in bytes (raw binary data, text in UTF-8, or other encodings).
// For ECI mode, this is always zero. // for ECI mode, this is always zero.
numChars : word; numChars : word;
// The data bits of this segment, packed in bitwise big endian. // The data bits of this segment, packed in bitwise big endian.
// Can be null if the bit length is zero. // Can be null if the bit length is zero.
@ -100,7 +72,7 @@ Const
QRVERSIONMAX = High(TQRVersion); QRVERSIONMAX = High(TQRVersion);
// Calculates the number of bytes needed to store any QR Code up to and including the given version number, // 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. // can store any single QR Code from version 1 to 25, inclusive.
// Requires qrcodegen_VERSION_MIN <= n <= qrcodegen_VERSION_MAX. // Requires qrcodegen_VERSION_MIN <= n <= qrcodegen_VERSION_MAX.
Function QRBUFFER_LEN_FOR_VERSION(n : TQRVersion) : integer; 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). * 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. * - 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. * - 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 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. * - 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. * An actual ECI segment can have shorter data. for non-ECI modes, the result is exact.
} }
Function QRCalcSegmentBufferSize(aMode: TQRMode; numChars : Cardinal) : Cardinal; Function QRCalcSegmentBufferSize(aMode: TQRMode; numChars : Cardinal) : Cardinal;
@ -291,53 +263,44 @@ Function QRgetModule(qrcode : TQRBuffer; x, y : word) : Boolean;
Implementation 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 Type
TDegree = 1..30; TDegree = 1..30;
TGenerator = Array[0..29] of byte; 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; 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; {---- Forward declarations for private functions ----}
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 appendBitsToBuffer(val : cardinal; numBits : integer; buffer : TQRBuffer; var bitLen : integer); forward;
procedure setModule(qrcode : TQRBuffer; x,y : Word; isBlack : boolean);forward; procedure appendErrorCorrection(data : TQRBuffer; version: TQRVersion; ecl: TQRErrorLevelCorrection; Result: TQRBuffer); forward;
procedure setModuleBounded(qrcode : TQRBuffer; x,y : Word; isBlack : Boolean);forward; function getNumDataCodewords(version : TQRVersion; ecl : TQRErrorLevelCorrection) : integer; forward;
function getNumRawDataModules(version : TQRVersion): integer; forward;
function calcSegmentBitLength(mode : TQRMode; numChars : Integer) : integer;forward; procedure calcReedSolomonGenerator(degree : TDegree; out result : TGenerator); forward;
function getTotalBits(segs : TQRSegmentArray; version : TQRVersion) : integer;forward; procedure calcReedSolomonRemainder(const data : PByte; dataLen : Integer; constref generator : TGenerator; degree : TDegree; result : PByte); forward;
function numCharCountBits(mode : TQRMode; version : TQRVersion) : integer;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 ----} {---- Private tables of constants ----}
// For checking text and encoding segments. // for checking text and encoding segments.
const const
ALPHANUMERIC_CHARSET = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ $%*+-./:'; ALPHANUMERIC_CHARSET = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ $%*+-./:';
// For generating error correction codes. // for generating error correction codes.
const const
ECC_CODEWORDS_PER_BLOCK : Array[0..3,0..40] of shortint = ( 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) // 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 (-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 = ( 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) // 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 //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 (-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 const
PENALTY_N1 = 3; PENALTY_N1 = 3;
PENALTY_N2 = 3; PENALTY_N2 = 3;
@ -372,7 +335,7 @@ const
function QREncodeText(aText : TQRString; tempBuffer, qrcode : TQRBuffer; function QREncodeText(aText : TQRString; tempBuffer, qrcode : TQRBuffer;
ecl : TQRErrorLevelCorrection; minVersion, maxVersion : TQRVersion; mask : TQRMask; boostEcl : Boolean) : boolean; ecl : TQRErrorLevelCorrection; minVersion, maxVersion : TQRVersion; mask : TQRMask; boostEcl : Boolean) : boolean;
Var var
i, buflen, textLen : Integer; i, buflen, textLen : Integer;
seg : TQRSegmentArray; seg : TQRSegmentArray;
failed : Boolean; failed : Boolean;
@ -391,17 +354,17 @@ begin
seg[0]:=QRmakeNumeric(aText,tempBuffer); seg[0]:=QRmakeNumeric(aText,tempBuffer);
end end
else if (QRisAlphanumeric(aText)) then else if (QRisAlphanumeric(aText)) then
begin begin
Failed:=(QRcalcSegmentBufferSize(mALPHANUMERIC, textLen) > bufLen); Failed:=(QRcalcSegmentBufferSize(mALPHANUMERIC, textLen) > bufLen);
if not Failed then if not Failed then
Seg[0]:=QRMakeAlphanumeric(aText, tempBuffer); Seg[0]:=QRMakeAlphanumeric(aText, tempBuffer);
end end
else else
begin begin
Failed:=(textLen > bufLen); Failed:=(textLen > bufLen);
if not Failed then if not Failed then
begin begin
For I:=1 to Textlen do for I:=1 to Textlen do
tempBuffer[i-1]:=Ord(aText[i]); tempBuffer[i-1]:=Ord(aText[i]);
seg[0].mode:=mBYTE; seg[0].mode:=mBYTE;
seg[0].bitLength:=calcSegmentBitLength(seg[0].mode, textLen); seg[0].bitLength:=calcSegmentBitLength(seg[0].mode, textLen);
@ -425,7 +388,7 @@ end;
function QREncodeBinary(dataAndTemp : TQRBuffer; dataLen : Integer; qrcode : TQRBuffer; function QREncodeBinary(dataAndTemp : TQRBuffer; dataLen : Integer; qrcode : TQRBuffer;
ecl: TQRErrorLevelCorrection; minVersion, maxVersion: TQRVersion; mask: TQRMask; boostEcl : Boolean) : Boolean; ecl: TQRErrorLevelCorrection; minVersion, maxVersion: TQRVersion; mask: TQRMask; boostEcl : Boolean) : Boolean;
Var var
seg : TQRSegmentArray; seg : TQRSegmentArray;
begin begin
@ -447,21 +410,19 @@ end;
// Appends the given sequence of bits to the given byte-based bit buffer, increasing the bit length. // 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); procedure appendBitsToBuffer(val : cardinal; numBits : integer; buffer : TQRBuffer; var bitLen : integer);
Var var
I,idx : integer; I,idx : integer;
begin begin
assert((0 <= numBits) and (numBits <= 16) and ((val shr numBits) = 0)); assert((0 <= numBits) and (numBits <= 16) and ((val shr numBits) = 0));
for I:=numBits-1 downto 0 do for I:=numBits-1 downto 0 do
begin begin
idx:=bitLen shr 3; idx:=bitLen shr 3;
buffer[idx]:=buffer[idx] or ((val shr i) and 1) shl (7 - (bitLen and 7)); buffer[idx]:=buffer[idx] or ((val shr i) and 1) shl (7 - (bitLen and 7));
Inc(Bitlen); Inc(Bitlen);
end; end;
end; end;
{---- Error correction code generation functions ----} {---- Error correction code generation functions ----}
// Appends error correction bytes to each block of the given data array, then interleaves bytes // 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]. // 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); procedure appendErrorCorrection(data : TQRBuffer; version: TQRVersion; ecl: TQRErrorLevelCorrection; Result: TQRBuffer);
Var var
numBlocks : Shortint; numBlocks : Shortint;
blockEccLen : Shortint; blockEccLen : Shortint;
blocklen,I,J,K,L : integer; blocklen,I,J,K,L : integer;
rawCodewords : Integer; rawCodewords : Integer;
dataLen : Integer; dataLen : Integer;
@ -481,7 +441,6 @@ Var
shortBlockDataLen : Integer; shortBlockDataLen : Integer;
generator : TGenerator; generator : TGenerator;
begin begin
numBlocks:=NUM_ERROR_CORRECTION_BLOCKS[Ord(ecl)][version]; numBlocks:=NUM_ERROR_CORRECTION_BLOCKS[Ord(ecl)][version];
blockEccLen:=ECC_CODEWORDS_PER_BLOCK[Ord(ecl)][version]; blockEccLen:=ECC_CODEWORDS_PER_BLOCK[Ord(ecl)][version];
@ -507,7 +466,7 @@ begin
for I:=0 to numBlocks-1 do for I:=0 to numBlocks-1 do
begin begin
l:=I; l:=I;
For J:=0 to shortBlockDataLen-1 do for J:=0 to shortBlockDataLen-1 do
begin begin
result[l]:=data[k]; result[l]:=data[k];
Inc(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]. // for the given version number and error correction level. The result is in the range [9, 2956].
function getNumDataCodewords(version : TQRVersion; ecl : TQRErrorLevelCorrection) : integer; function getNumDataCodewords(version : TQRVersion; ecl : TQRErrorLevelCorrection) : integer;
Var var
v,e : integer; v,e : integer;
begin begin
v:=version; v:=version;
e:=Ord(ecl); 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. // The result is in the range [208, 29648]. This could be implemented as a 40-entry lookup table.
function getNumRawDataModules(version : TQRVersion): integer; function getNumRawDataModules(version : TQRVersion): integer;
Var var
numAlign: integer; numAlign: integer;
begin begin
@ -571,14 +531,12 @@ begin
end; end;
end; end;
{---- Reed-Solomon ECC generator functions ----} {---- Reed-Solomon ECC generator functions ----}
// Calculates the Reed-Solomon generator polynomial of the given degree, storing in result[0 : degree]. // Calculates the Reed-Solomon generator polynomial of the given degree, storing in result[0 : degree].
procedure calcReedSolomonGenerator(degree : TDegree; out result : TGenerator); procedure calcReedSolomonGenerator(degree : TDegree; out result : TGenerator);
Var var
I,J : byte; I,J : byte;
Root : Byte; Root : Byte;
@ -587,12 +545,11 @@ begin
Result[0]:=0; // Avoid warning Result[0]:=0; // Avoid warning
FillChar(result,sizeof(TGenerator),0); FillChar(result,sizeof(TGenerator),0);
result[degree-1]:= 1; result[degree-1]:= 1;
// Compute the product polynomial (x - r^0) * (x - r^1) * (x - r^2) * ... * (x - r^{degree-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. // 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). // Note that r = 0x02, which is a generator element of this field GF(2^8/0x11D).
root:=1; root:=1;
For I:=0 to degree-1 do for I:=0 to degree-1 do
begin begin
// Multiply the current product by (x - r^i) // Multiply the current product by (x - r^i)
for j:=0 to Degree-1 do 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]. // 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); procedure calcReedSolomonRemainder(const data : PByte; dataLen : Integer; constref generator : TGenerator; degree : TDegree; result : PByte);
Var var
I,J : Integer; I,J : Integer;
factor : byte ; factor : byte ;
begin begin
FillChar(Result^,degree,0); FillChar(Result^,degree,0);
for I:=0 to Datalen-1 do for I:=0 to Datalen-1 do
@ -620,7 +578,7 @@ begin
factor:=data[i] xor result[0]; factor:=data[i] xor result[0];
move( result[1],result[0],(degree - 1)); move( result[1],result[0],(degree - 1));
result[degree-1] := 0; result[degree-1] := 0;
For j:=0 to degree-1 do for j:=0 to degree-1 do
begin begin
result[j]:=result[j] xor finiteFieldMultiply(generator[j], factor); result[j]:=result[j] xor finiteFieldMultiply(generator[j], factor);
end; end;
@ -632,7 +590,7 @@ end;
// All inputs are valid. This could be implemented as a 256*256 lookup table. // All inputs are valid. This could be implemented as a 256*256 lookup table.
function finiteFieldMultiply(x,y : Byte) : Byte; function finiteFieldMultiply(x,y : Byte) : Byte;
Var var
Z : Byte; Z : Byte;
I : shortint; I : shortint;
@ -655,7 +613,7 @@ end;
// version's size, then marks every function module as black. // version's size, then marks every function module as black.
procedure initializeFunctionModules(version : TQRVersion; qrcode : TQRBuffer); procedure initializeFunctionModules(version : TQRVersion; qrcode : TQRBuffer);
Var var
qrsize : byte; qrsize : byte;
alignPatPos : TPatternPositions; alignPatPos : TPatternPositions;
i,j,numAlign : integer; i,j,numAlign : integer;
@ -679,8 +637,8 @@ begin
alignPatPos[0]:=0; // Avoid warning alignPatPos[0]:=0; // Avoid warning
FillChar(alignPatPos,SizeOf(TPatternPositions),0); FillChar(alignPatPos,SizeOf(TPatternPositions),0);
numAlign:=getAlignmentPatternPositions(version, alignPatPos); numAlign:=getAlignmentPatternPositions(version, alignPatPos);
For i:=0 to numAlign-1 do for i:=0 to numAlign-1 do
For j:=0 to NumAlign-1 do for j:=0 to NumAlign-1 do
begin begin
if ((i=0) and (j=0)) or ((i=0) and (j=(numAlign-1))) or ((i=(numAlign-1)) and (j=0)) then 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 continue; // Skip the three finder corners
@ -718,8 +676,8 @@ begin
end; end;
// Draw 3 finder patterns (all corners except bottom right; overwrites some timing modules) // Draw 3 finder patterns (all corners except bottom right; overwrites some timing modules)
For I:=-4 to 4 do for I:=-4 to 4 do
For J:=-4 to 4 do for J:=-4 to 4 do
begin begin
dist:=abs(i); dist:=abs(i);
if (abs(j) > dist) then if (abs(j) > dist) then
@ -741,8 +699,8 @@ begin
alignPatPos[0]:=0; // Avoid warning alignPatPos[0]:=0; // Avoid warning
FillChar(alignPatPos,SizeOf(TPatternPositions),0); FillChar(alignPatPos,SizeOf(TPatternPositions),0);
numAlign:=getAlignmentPatternPositions(version, alignPatPos); numAlign:=getAlignmentPatternPositions(version, alignPatPos);
For i:=0 to numAlign-1 do for i:=0 to numAlign-1 do
For j:=0 to NumAlign-1 do for j:=0 to NumAlign-1 do
begin begin
if ((i=0) and (j=0)) or ((i=0) and (j=(numAlign-1))) or ((i=(numAlign-1)) and (j=0)) then 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 continue; // Skip the three finder corners
@ -778,7 +736,7 @@ end;
// the format bits, unlike drawWhiteFunctionModules() which might skip black modules. // the format bits, unlike drawWhiteFunctionModules() which might skip black modules.
procedure drawFormatBits(ecl : TQRErrorLevelCorrection; mask : TQRMask; qrcode : TQRBuffer); procedure drawFormatBits(ecl : TQRErrorLevelCorrection; mask : TQRMask; qrcode : TQRBuffer);
Var var
qrsize,i,rem,data : integer; qrsize,i,rem,data : integer;
begin begin
@ -819,7 +777,7 @@ end;
// storing them to the given array and returning an array length in the range [0, 7]. // storing them to the given array and returning an array length in the range [0, 7].
function getAlignmentPatternPositions(version : TQRVersion; var res : TPatternPositions) : Integer; function getAlignmentPatternPositions(version : TQRVersion; var res : TPatternPositions) : Integer;
Var var
i,numalign, step, pos : Integer; i,numalign, step, pos : Integer;
begin begin
@ -863,7 +821,7 @@ end;
procedure drawCodewords(const data : TQRBuffer; dataLen : integer; qrcode : TQRBuffer); procedure drawCodewords(const data : TQRBuffer; dataLen : integer; qrcode : TQRBuffer);
Var var
i,right,vert,j,y,x,qrsize : integer; i,right,vert,j,y,x,qrsize : integer;
black,upward : boolean; black,upward : boolean;
@ -908,7 +866,7 @@ end;
// well-formed QR Code symbol needs exactly one mask applied (not zero, not two, etc.). // well-formed QR Code symbol needs exactly one mask applied (not zero, not two, etc.).
procedure applyMask(Modules : TQRBuffer; qrcode : TQRBuffer; mask : TQRMask); procedure applyMask(Modules : TQRBuffer; qrcode : TQRBuffer; mask : TQRMask);
Var var
x,y,qrsize : integer; x,y,qrsize : integer;
invert,val : boolean; invert,val : boolean;
@ -1059,7 +1017,7 @@ end;
// Public function - see documentation comment in header file. // Public function - see documentation comment in header file.
function QRgetModule(qrcode : TQRBuffer; x,y : Word) : Boolean; function QRgetModule(qrcode : TQRBuffer; x,y : Word) : Boolean;
Var var
QrSize : Integer; QrSize : Integer;
begin begin
assert(Length(qrcode)>0); assert(Length(qrcode)>0);
@ -1087,7 +1045,7 @@ end;
// Sets the module at the given coordinates, which must be in bounds. // Sets the module at the given coordinates, which must be in bounds.
procedure setModule(qrcode : TQRBuffer; x,y : Word; isBlack : boolean); procedure setModule(qrcode : TQRBuffer; x,y : Word; isBlack : boolean);
Var var
index,bitindex,byteindex,qrsize : integer; index,bitindex,byteindex,qrsize : integer;
begin begin
@ -1108,6 +1066,7 @@ procedure setModuleBounded(qrcode : TQRBuffer; x,y : Word; isBlack : Boolean);
var var
qrsize : word; qrsize : word;
begin begin
qrsize := qrcode[0]; qrsize := qrcode[0];
if ((x < qrsize) and (y < qrsize)) then if ((x < qrsize) and (y < qrsize)) then
@ -1121,7 +1080,7 @@ end;
// Public function - see documentation comment in header file. // Public function - see documentation comment in header file.
Function QRIsNumeric(atext : TQRString) : Boolean; Function QRIsNumeric(atext : TQRString) : Boolean;
Var var
L,I : integer; L,I : integer;
begin begin
@ -1137,7 +1096,7 @@ end;
Function QRIsAlphanumeric(aText : TQRString) : Boolean; Function QRIsAlphanumeric(aText : TQRString) : Boolean;
Var var
L,I : integer; L,I : integer;
begin begin
@ -1156,7 +1115,7 @@ end;
// Public function - see documentation comment in header file. // Public function - see documentation comment in header file.
Function QRCalcSegmentBufferSize(aMode: TQRMode; numChars : Cardinal) : Cardinal; Function QRCalcSegmentBufferSize(aMode: TQRMode; numChars : Cardinal) : Cardinal;
Var var
Temp : Integer; Temp : Integer;
begin begin
@ -1173,12 +1132,12 @@ end;
// - Returns -1 on failure, i.e. numChars > INT16_MAX or // - Returns -1 on failure, i.e. numChars > INT16_MAX or
// the number of needed bits exceeds INT16_MAX (i.e. 32767). // the number of needed bits exceeds INT16_MAX (i.e. 32767).
// - Otherwise, all valid results are in the range [0, INT16_MAX]. // - 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 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. // - 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. // An actual ECI segment can have shorter data. for non-ECI modes, the result is exact.
function calcSegmentBitLength(mode : TQRMode; numChars : Integer) : integer; function calcSegmentBitLength(mode : TQRMode; numChars : Integer) : integer;
Var var
temp,N,Limit: integer; temp,N,Limit: integer;
begin begin
@ -1248,12 +1207,11 @@ end;
// Public function - see documentation comment in header file. // Public function - see documentation comment in header file.
Function QRMakeNumeric(digits : TQRString; buf : TQRBuffer) : TQRSegment; Function QRMakeNumeric(digits : TQRString; buf : TQRBuffer) : TQRSegment;
Var var
accumcount, bitlen,len: integer; accumcount, bitlen,len: integer;
accumData : Cardinal; accumData : Cardinal;
c : ansichar; c : ansichar;
begin begin
assert(Length(digits)>0); assert(Length(digits)>0);
len := length(digits); len := length(digits);
@ -1288,7 +1246,7 @@ end;
// Public function - see documentation comment in header file. // Public function - see documentation comment in header file.
Function QRMakeAlphanumeric(aText : TQRString; buf : TQRBuffer) : TQRSegment; Function QRMakeAlphanumeric(aText : TQRString; buf : TQRBuffer) : TQRSegment;
Var var
p,accumcount, bitlen,len: integer; p,accumcount, bitlen,len: integer;
accumData : Cardinal; accumData : Cardinal;
c : ansichar; c : ansichar;
@ -1360,7 +1318,6 @@ end;
// Public function - see documentation comment in header file. // Public function - see documentation comment in header file.
Function QREncodeSegments(Segs : TQRSegmentArray; ecl: TQRErrorLevelCorrection; tempBuffer, qrcode : TQRBuffer) : Boolean; Function QREncodeSegments(Segs : TQRSegmentArray; ecl: TQRErrorLevelCorrection; tempBuffer, qrcode : TQRBuffer) : Boolean;
begin begin
Result:=QRencodeSegmentsAdvanced(segs, ecl, QRVERSIONMIN, QRVERSIONMAX, mpAuto, True, tempBuffer, qrcode); Result:=QRencodeSegmentsAdvanced(segs, ecl, QRVERSIONMIN, QRVERSIONMAX, mpAuto, True, tempBuffer, qrcode);
end; end;
@ -1370,7 +1327,7 @@ end;
Function QREncodeSegmentsAdvanced(Segs : TQRSegmentArray; ecl: TQRErrorLevelCorrection; Function QREncodeSegmentsAdvanced(Segs : TQRSegmentArray; ecl: TQRErrorLevelCorrection;
minVersion, maxVersion : TQRVersion; mask : TQRMask; boostEcl : Boolean; tempBuffer, qrcode : TQRBuffer) : Boolean; minVersion, maxVersion : TQRVersion; mask : TQRMask; boostEcl : Boolean; tempBuffer, qrcode : TQRBuffer) : Boolean;
Var var
modebits : byte; modebits : byte;
bitlen, I,j : Integer; bitlen, I,j : Integer;
Version : TQRVersion; Version : TQRVersion;
@ -1480,14 +1437,14 @@ end;
// or if the actual answer exceeds INT16_MAX. // or if the actual answer exceeds INT16_MAX.
function getTotalBits(segs : TQRSegmentArray; version : TQRVersion): integer; function getTotalBits(segs : TQRSegmentArray; version : TQRVersion): integer;
Var var
ccbits,I,numChars,bitLength : integer; ccbits,I,numChars,bitLength : integer;
temp : integer; temp : integer;
begin begin
assert(Length(segs)>0); assert(Length(segs)>0);
result := 0; result := 0;
For I:=0 to Length(segs)-1 do for I:=0 to Length(segs)-1 do
begin begin
numChars := segs[i].numChars; numChars := segs[i].numChars;
bitLength := segs[i].bitLength; bitLength := segs[i].bitLength;
@ -1520,7 +1477,7 @@ Const
bmBYTE : T3Bytes = ( 8, 16, 16); bmBYTE : T3Bytes = ( 8, 16, 16);
bmKANJI : T3Bytes = (8, 10, 12); bmKANJI : T3Bytes = (8, 10, 12);
Var var
I : Integer; I : Integer;
begin begin
@ -1534,7 +1491,6 @@ begin
begin begin
assert(false); assert(false);
end; end;
case (mode) of case (mode) of
mNUMERIC : Result:=bmNumeric[i]; mNUMERIC : Result:=bmNumeric[i];
mALPHANUMERIC: Result:=bmALPHANUMERIC[i]; mALPHANUMERIC: Result:=bmALPHANUMERIC[i];
@ -1556,6 +1512,7 @@ end;
---------------------------------------------------------------------} ---------------------------------------------------------------------}
function TQRCodeGenerator.GetBits(X : Word; Y : Word): Boolean; function TQRCodeGenerator.GetBits(X : Word; Y : Word): Boolean;
begin begin
if Assigned(FBytes) then if Assigned(FBytes) then
Result:=getModule(FBytes,X,Y) Result:=getModule(FBytes,X,Y)
@ -1564,6 +1521,7 @@ begin
end; end;
function TQRCodeGenerator.GetSize: Integer; function TQRCodeGenerator.GetSize: Integer;
begin begin
if Assigned(FBytes) then if Assigned(FBytes) then
Result:=QRgetSize(FBytes) Result:=QRgetSize(FBytes)
@ -1572,6 +1530,7 @@ begin
end; end;
procedure TQRCodeGenerator.SetBufferLength(AValue: Word); procedure TQRCodeGenerator.SetBufferLength(AValue: Word);
begin begin
if AValue>QRBUFFER_LEN_MAX then if AValue>QRBUFFER_LEN_MAX then
AValue:=QRBUFFER_LEN_MAX; AValue:=QRBUFFER_LEN_MAX;
@ -1590,6 +1549,7 @@ begin
end; end;
destructor TQRCodeGenerator.Destroy; destructor TQRCodeGenerator.Destroy;
begin begin
SetLength(FBytes,0); SetLength(FBytes,0);
inherited Destroy; inherited Destroy;
@ -1597,7 +1557,7 @@ end;
procedure TQRCodeGenerator.Generate(aText: TQRString); procedure TQRCodeGenerator.Generate(aText: TQRString);
Var var
Tmp : TQRBuffer; Tmp : TQRBuffer;
begin begin
@ -1608,7 +1568,8 @@ begin
end; end;
procedure TQRCodeGenerator.Generate(aNumber: Int64); procedure TQRCodeGenerator.Generate(aNumber: Int64);
Var
var
Tmp : TQRBuffer; Tmp : TQRBuffer;
aText : TQRString; aText : TQRString;

4
packages/fcl-report/demos/rptqrcode.pp
View File

@ -104,7 +104,7 @@ begin
QR.Layout.Top := 1; QR.Layout.Top := 1;
QR.Layout.Width := 34; QR.Layout.Width := 34;
QR.Layout.Height := 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.Center:=True;
QR:= TFPReportQRcode.Create(TitleBand); QR:= TFPReportQRcode.Create(TitleBand);
@ -243,7 +243,7 @@ end;
procedure TQRCodeDemo.InitialiseData; procedure TQRCodeDemo.InitialiseData;
Var var
SL : TStringList; SL : TStringList;
i : Integer; i : Integer;
N,V : String; N,V : String;