fpc/packages/fcl-image/examples/qrdemo.pp
2017-10-10 06:51:44 +00:00

261 lines
8.9 KiB
ObjectPascal

{*
* QR Code generator demo (Pascal)
*
* 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
*
* 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.
*/
}
{$mode objfpc}
{$h+}
{$CODEPAGE UTF8}
uses fpqrcodegen, sysutils;
// Prints the given QR Code to the console.
Procedure printqr (qrcode : TQRBuffer);
var
size : cardinal;
border: byte;
x,y : Integer;
begin
Size:=QRgetSize(qrcode);
border:=4;
For Y:=-Border to size+Border-1 do
begin
For x:=-Border to size+Border-1 do
if (X>=0) and (Y>=0) and QRgetModule(qrcode, x, y) then
write('##')
else
Write(' ');
writeln;
end;
end;
// Creates a single QR Code, then prints it to the console.
procedure doBasicDemo;
var
aText : string;
errCorLvl : TQRErrorLevelCorrection;
tempbuffer,
qrcode: TQRBuffer;
begin
SetLength(tempBuffer,QRBUFFER_LEN_MAX);
SetLength(qrCode,QRBUFFER_LEN_MAX);
aText:='Hello, world!'; // User-supplied text
errCorLvl:=EccLOW; // Error correction level
if QRencodeText(atext, tempBuffer, qrcode, errCorLvl, QRVERSIONMIN, QRVERSIONMAX, mpAUTO, true) then
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
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
atext : UTF8String;
tempbuffer,
qrcode: TQRBuffer;
procedure ResetBuffer;
begin
FillChar(tempBuffer[0],QRBUFFER_LEN_MAX,0);
FillChar(qrCode[0],QRBUFFER_LEN_MAX,0);
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);
// 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
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, 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, mp7, true) then
printQr(qrcode);
ResetBuffer;
// Moderately large QR Code using longer text (from Lewis Carroll's Alice in Wonderland)
atext :=
'Alice was beginning to get very tired of sitting by her sister on the bank, '
+'and of having nothing to do: once or twice she had peeped into the book her sister was reading, '
+'but it had no pictures or conversations in it, ''and what is the use of a book,'' thought Alice '
+'''without pictures or conversations?'' So she was considering in her own mind (as well as she could, '
+'for the hot day made her feel very sleepy and stupid), whether the pleasure of making a '
+'daisy-chain would be worth the trouble of getting up and picking the daisies, when suddenly '
+'a White Rabbit with pink eyes ran close by her.';
Writeln(atext);
if QRencodeText(atext, tempBuffer, qrcode, eccHIGH, QRVERSIONMIN, QRVERSIONMAX, mpAUTO, true) then
printQr(qrcode);
end;
procedure doSegmentDemo;
const
kanjiChars : Array[0..28] of word = ( // Kanji mode encoding (13 bits per character)
$0035, $1002, $0FC0, $0AED, $0AD7,
$015C, $0147, $0129, $0059, $01BD,
$018D, $018A, $0036, $0141, $0144,
$0001, $0000, $0249, $0240, $0249,
$0000, $0104, $0105, $0113, $0115,
$0000, $0208, $01FF, $0008);
var
aText,silver0,silver1,golden0,golden1,golden2 : String;
tempbuffer,
qrcode: TQRBuffer;
bytes,
segbuf0,
segbuf1,
segbuf2 : TQRBuffer;
seg : TQRSegment;
segs : TQRSegmentArray;
segs2 : TQRSegmentArray;
len, I,j : integer;
begin
SetLength(tempBuffer,QRBUFFER_LEN_MAX);
SetLength(qrCode,QRBUFFER_LEN_MAX);
// Illustration 'silver'
silver0 := 'THE SQUARE ROOT OF 2 IS 1.';
silver1 := '41421356237309504880168872420969807856967187537694807317667973799';
aText:=silver0+Silver1;
if QRencodeText(aText, tempBuffer, qrcode, EccLOW, QRVERSIONMIN, QRVERSIONMAX, mpAUTO, true) then
printQr(qrcode);
SetLength(segBuf0,QRcalcSegmentBufferSize(mALPHANUMERIC, length(silver0)));
SetLength(segBuf1,QRcalcSegmentBufferSize(mNUMERIC, length(silver1)));
SetLength(Segs,2);
segs[0]:=QRmakeAlphanumeric(silver0, segBuf0);
segs[1]:=QRmakeNumeric(silver1, segBuf1);
if QRencodeSegments(segs, eccLOW, tempBuffer, qrcode) then
printQr(qrcode);
// Illustration "golden"
SetLength(Segbuf0,0);
SetLength(Segbuf1,0);
golden0 := 'Golden ratio '#$CF#$86' = 1.';
golden1 := '6180339887498948482045868343656381177203091798057628621354486227052604628189024497072072041893911374';
golden2 := '......';
atext:=Golden0+Golden1+Golden2;
if QRencodeText(aText, tempBuffer, qrcode, EccLOW, QRVERSIONMIN, QRVERSIONMAX, mpAUTO, true) then
printQr(qrcode);
SetLength(bytes,Length(golden0));
for I:=1 to Length(golden0) do
bytes[i-1]:=Ord(golden0[i]);
SetLength(segBuf0,QRcalcSegmentBufferSize(mBYTE, length(golden0)));
SetLength(segBuf1,QRcalcSegmentBufferSize(mNUMERIC, length(golden1)));
SetLength(segBuf2,QRcalcSegmentBufferSize(mALPHANUMERIC, length(golden2)));
SetLength(Segs2,3);
segs2[0]:=QRmakeBytes(bytes, segBuf0);
segs2[1]:=QRmakeNumeric(golden1, segBuf1);
segs2[2]:=QRmakeAlphanumeric(golden2, segBuf2);
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+
#$A9#$E3#$81#$8B#$E2#$98#$86#$E3#$83#$9E+
#$E3#$82#$AE#$E3#$82#$AB#$E3#$80#$8D#$E3+
#$81#$A3#$E3#$81#$A6#$E3#$80#$81#$E3#$80+
#$80#$D0#$98#$D0#$90#$D0#$98#$E3#$80#$80+
#$EF#$BD#$84#$EF#$BD#$85#$EF#$BD#$93#$EF+
#$BD#$95#$E3#$80#$80#$CE#$BA#$CE#$B1#$EF+
#$BC#$9F;
if QRencodeText(aText, tempBuffer, qrcode, eccLOW, QRVERSIONMIN, QRVERSIONMAX, mpAUTO, true) then
printQr(qrcode);
len:= SizeOf(kanjiChars) div sizeof(Word);
SetLength(segBuf0,QRcalcSegmentBufferSize(mKANJI, len));
seg.mode := mKANJI;
seg.numChars := len;
seg.bitLength := 0;
for I:=0 to Len-1 do
for j:=12 downto 0 do
begin
segBuf0[seg.bitLength shr 3]:=segBuf0[seg.bitLength shr 3] or ((kanjiChars[i] shr j) and 1) shl (7 - (seg.bitLength and 7));
inc(seg.bitLength);
end;
seg.data:=segBuf0;
SetLength(segs,1);
segs[0]:=Seg;
if QRencodeSegments(segs,eccLOW, tempBuffer, qrcode) then
printQr(qrcode);
end;
begin
doBasicDemo();
doVarietyDemo();
doSegmentDemo();
end.