fpc/packages/fcl-image/examples/qrdemo.pp

{* 
 * 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 ([email protected])
 * 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.