+ Added QR code generator, image drawer

* QR Code generator code translated from C code from Project Nayuki (http://nayuki.io) (reused with permission) * Translated demo app from project Nayuki * Added sample QR code generator demo app git-svn-id: trunk@37436 -
2025-04-21 09:09:30 +02:00 · 2017-10-09 19:17:26 +00:00 · 2017-10-09 19:17:26 +00:00 · 656405d7dc
commit 656405d7dc
parent f218a369d6
8 changed files with 2316 additions and 0 deletions
--- a/.gitattributes
+++ b/.gitattributes
@ -2442,10 +2442,14 @@ packages/fcl-image/examples/Makefile svneol=native#text/plain
 packages/fcl-image/examples/Makefile.fpc svneol=native#text/plain
 packages/fcl-image/examples/createbarcode.lpi svneol=native#text/plain
 packages/fcl-image/examples/createbarcode.lpr svneol=native#text/plain
+packages/fcl-image/examples/createqrcode.lpi svneol=native#text/plain
+packages/fcl-image/examples/createqrcode.pp svneol=native#text/plain
 packages/fcl-image/examples/drawing.pp svneol=native#text/plain
 packages/fcl-image/examples/imgconv.pp svneol=native#text/plain
 packages/fcl-image/examples/interpoldemo.pp svneol=native#text/plain
 packages/fcl-image/examples/pattern.png -text svneol=unset#image/png
+packages/fcl-image/examples/qrdemo.lpi svneol=native#text/plain
+packages/fcl-image/examples/qrdemo.pp svneol=native#text/plain
 packages/fcl-image/examples/textout.pp svneol=native#text/plain
 packages/fcl-image/examples/xwdtobmp.pas svneol=native#text/plain
 packages/fcl-image/fpmake.pp svneol=native#text/plain
@ -2472,10 +2476,12 @@ packages/fcl-image/src/fpimgbarcode.pp svneol=native#text/plain
 packages/fcl-image/src/fpimgcanv.pp svneol=native#text/plain
 packages/fcl-image/src/fpimgcmn.pp svneol=native#text/plain
 packages/fcl-image/src/fpimggauss.pp svneol=native#text/plain
+packages/fcl-image/src/fpimgqrcode.pp svneol=native#text/plain
 packages/fcl-image/src/fpinterpolation.inc svneol=native#text/plain
 packages/fcl-image/src/fppalette.inc svneol=native#text/plain
 packages/fcl-image/src/fppen.inc svneol=native#text/plain
 packages/fcl-image/src/fppixlcanv.pp svneol=native#text/plain
+packages/fcl-image/src/fpqrcodegen.pp svneol=native#text/plain
 packages/fcl-image/src/fpquantizer.pas svneol=native#text/plain
 packages/fcl-image/src/fpreadbmp.pp svneol=native#text/plain
 packages/fcl-image/src/fpreadgif.pas svneol=native#text/plain
--- a/packages/fcl-image/examples/createqrcode.lpi
+++ b/packages/fcl-image/examples/createqrcode.lpi
@ -0,0 +1,61 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="10"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="Create QR code"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="createqrcode.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="fpimgqrcode.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="createqrcode"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
--- a/packages/fcl-image/examples/createqrcode.pp
+++ b/packages/fcl-image/examples/createqrcode.pp
@ -0,0 +1,154 @@
+program createqrcode;
+
+{$mode objfpc}
+{$H+}
+
+uses
+  Classes, SysUtils, CustApp, fpimage, fpqrcodegen,  fpimgqrcode,
+  fpwritepng,fpwritebmp,fpwritexpm, FPWriteJPEG, FPWritePCX,
+  FPWritePNM, FPWriteTIFF;
+
+type
+
+  { TCreateQRApplication }
+
+  TCreateQRApplication = class(TCustomApplication)
+  Private
+    FText : UTF8String;
+    FBorder : Integer;
+    Foutput : String;
+    FPixelSize : Integer;
+    FGenerator : TImageQRCodeGenerator;
+    procedure WriteQRCode(QRCode: TQRBuffer);
+  protected
+
+    function ParseOptions : Boolean;
+    procedure DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    Destructor Destroy; override;
+    procedure WriteHelp(Msg : String); virtual;
+  end;
+
+{ TCreateQRApplication }
+
+function TCreateQRApplication.ParseOptions: Boolean;
+
+Var
+  ErrorMsg : String;
+
+begin
+  Result:=False;
+  ErrorMsg:=CheckOptions('b:ht:o:m:ep:', ['help','text:','output:','mask:','error-correctionlevel:','pixel-size','border']);
+  if (ErrorMsg<>'') or HasOption('h','help') then
+    begin
+    WriteHelp(ErrorMsg);
+    Exit;
+    end;
+  FText:=GetOptionValue('t','text');
+  FGenerator.PixelSize:=StrToIntDef(GetOptionValue('p','pixel-size'),4);
+  FBorder:=StrToIntDef(GetOptionValue('b','border'),0);
+  FOutput:=GetOptionValue('o','output');
+  if Foutput='' then
+    Foutput:='qrcode.png';
+  Case LowerCase(GetOptionValue('e','error-correctionlevel')) of
+    'low' : FGenerator.ErrorCorrectionLevel:=EccLOW;
+    'high' : FGenerator.ErrorCorrectionLevel:=EccHigh;
+    'medium' : FGenerator.ErrorCorrectionLevel:=EccMEDIUM;
+    'quartile' : FGenerator.ErrorCorrectionLevel:=EccQUARTILE;
+  else
+    FGenerator.ErrorCorrectionLevel:=EccMEDIUM;
+  end;
+  Case LowerCase(GetOptionValue('m','mask')) of
+    '0' : FGenerator.Mask:=mp0;
+    '1' : FGenerator.Mask:=mp1;
+    '2' : FGenerator.Mask:=mp2;
+    '3' : FGenerator.Mask:=mp3;
+    '4' : FGenerator.Mask:=mp4;
+    '5' : FGenerator.Mask:=mp5;
+    '6' : FGenerator.Mask:=mp6;
+    '7' : FGenerator.Mask:=mp7;
+  else
+    FGenerator.Mask:=mpAuto;
+  end;
+  Result:=True;
+end;
+
+procedure TCreateQRApplication.DoRun;
+
+begin
+  Terminate;
+  // quick check parameters
+  if not ParseOptions then
+     exit;
+  FGenerator.Generate(FText);
+  FGenerator.SaveToFile(Foutput,FBorder);
+  Terminate;
+end;
+
+procedure TCreateQRApplication.WriteQRCode(QRCode: TQRBuffer);
+
+Var
+  Img : TFPCustomImage;
+  D,S,X,Y : Word;
+
+
+begin
+  S:=QRGetSize(QRCode);
+  if S=0 then exit;
+  D:=FPixelSize*S;
+
+  Img:=TFPCompactImgGray8Bit.Create(D+FBorder*2,D+FBorder*2);
+  try
+    For X:=0 to D+(FBorder*2)-1 do
+      For Y:=1 to FBorder do
+        begin
+        Img[X,Y-1]:=colWhite;
+        Img[X,D+(FBorder*2)-Y]:=colWhite;
+        end;
+    For Y:=FBorder to D+FBorder-1 do
+      For X:=1 to FBorder do
+        begin
+        Img[X-1,Y]:=colWhite;
+        Img[D+(FBorder*2)-X,Y]:=colWhite;
+        end;
+
+    DrawQRCode(Img,QRCode,Point(FBorder,FBorder),FPixelSize);
+    Img.SaveToFile(Foutput);
+  finally
+    Img.Free;
+  end;
+end;
+
+
+constructor TCreateQRApplication.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  StopOnException:=True;
+  FGenerator:=TImageQRCodeGenerator.Create;
+
+end;
+
+destructor TCreateQRApplication.Destroy;
+begin
+  FreeAndNil(FGenerator);
+  inherited Destroy;
+end;
+
+procedure TCreateQRApplication.WriteHelp(Msg : string);
+begin
+  if (Msg<>'') then
+    Writeln('Error : ',Msg);
+  writeln('Usage: ', ExeName, ' -h');
+end;
+
+
+var
+  Application: TCreateQRApplication;
+begin
+  Application:=TCreateQRApplication.Create(nil);
+  Application.Title:='Create QR code';
+  Application.Run;
+  Application.Free;
+end.
+
--- a/packages/fcl-image/examples/qrdemo.lpi
+++ b/packages/fcl-image/examples/qrdemo.lpi
@ -0,0 +1,68 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="10"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="qrdemo"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="qrdemo.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="qrdemo"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <IncludeAssertionCode Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <Checks>
+        <RangeChecks Value="True"/>
+      </Checks>
+    </CodeGeneration>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
--- a/packages/fcl-image/examples/qrdemo.pp
+++ b/packages/fcl-image/examples/qrdemo.pp
@ -0,0 +1,263 @@
+{* 
+ * 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.
+ * 
+ * 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;
+
+
+Procedure printqr (qrcode : TQRBuffer);
+
+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
+    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
+  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);
+  ResetBuffer;
+  if QRencodeText('314159265358979323846264338327950288419716939937510', tempBuffer, qrcode,
+        EccMEDIUM, QRVERSIONMIN, QRVERSIONMAX, mpAUTO, true) then
+      printQr(qrcode);
+  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);
+
+  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);
+  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;
+
+// Prints the given QR Code to the console.
+
+
+begin
+   doBasicDemo();
+  doVarietyDemo();
+   doSegmentDemo();
+end.
--- a/packages/fcl-image/fpmake.pp
+++ b/packages/fcl-image/fpmake.pp
@ -264,6 +264,7 @@ begin
    T:=P.Targets.AddUnit('fpimggauss.pp');
    With T.Dependencies do
      AddUnit('fpimage');
+      
    T:=P.Targets.AddUnit('fpbarcode.pp');
    T:=P.Targets.AddUnit('fpimgbarcode.pp');
    With T.Dependencies do
@ -271,6 +272,16 @@ begin
      AddUnit('fpimage');
      AddUnit('fpcanvas');
      Addunit('fpimgcmn');
+      AddUnit('fpbarcode');
+      end;
+    T:=P.Targets.AddUnit('fpqrcodegen.pp');
+    T:=P.Targets.AddUnit('fpimgqrcode.pp');
+    With T.Dependencies do
+      begin
+      AddUnit('fpimage');
+      AddUnit('fpcanvas');
+      Addunit('fpimgcmn');
+      AddUnit('fpqrcodegen');
      end;

    P.ExamplePath.Add('examples');
--- a/packages/fcl-image/src/fpimgqrcode.pp
+++ b/packages/fcl-image/src/fpimgqrcode.pp
@ -0,0 +1,130 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2017 by Michael Van Canneyt, member of the Free Pascal development team
+
+    fpImage QR code drawing algorithm.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit fpimgqrcode;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpImage, fpqrcodegen;
+
+type
+
+  { TImageQRCodeGenerator }
+
+  TImageQRCodeGenerator = Class(TQRCodeGenerator)
+  private
+    FOrigin: TPoint;
+    FPixelSize: Integer;
+  Public
+    Constructor Create; override;
+    Procedure Draw(Img : TFPCustomImage);
+    // overrides Origin.
+    Procedure SaveToFile(const AFileName : String; aBorder : Integer = 0);
+    Property PixelSize : Integer Read FPixelSize Write FPixelSize default 2;
+    Property Origin : TPoint Read FOrigin Write FOrigin;
+  end;
+
+Procedure DrawQRCode(Img : TFPCustomImage; QRCode : TQRBuffer; aOrigin: TPoint; PixelSize : Byte = 1);
+
+implementation
+
+Procedure DrawQRCode(Img : TFPCustomImage; QRCode : TQRBuffer; aOrigin: TPoint; PixelSize : Byte = 1);
+
+Var
+  X,Y,PH,PV,PX,PY,S : Word;
+  col : TFPColor;
+
+begin
+  PY:=aOrigin.Y;
+  S:=QRGetSize(QRCode);
+//  Writeln('Size ',S);
+  if S=0 then
+      exit;
+  For Y:=0 to S-1 do
+    begin
+    PX:=aOrigin.X;
+    For X:=0 to S-1 do
+      begin
+      if QRgetModule(QRCode,X,Y) then
+        begin
+        Col:=colBlack;
+//        Write('##');
+        end
+      else
+        begin
+        Col:=colWhite;
+//        Write('  ');
+        end;
+      For pV:=0 to PixelSize-1 do
+        For pH:=0 to PixelSize-1 do
+          Img.Colors[PX+PH,PY+PV]:=col;
+      Inc(PX,PixelSize);
+      end;
+//    Writeln;
+    Inc(PY,PixelSize);
+    end;
+end;
+
+{ TImageQRCodeGenerator }
+
+constructor TImageQRCodeGenerator.Create;
+begin
+  inherited Create;
+  FPixelSize:=2;
+end;
+
+procedure TImageQRCodeGenerator.Draw(Img: TFPCustomImage);
+begin
+  DrawQRCode(Img,Bytes,FOrigin,PixelSize);
+end;
+
+procedure TImageQRCodeGenerator.SaveToFile(const AFileName: String; aBorder: Integer);
+
+
+Var
+  Img : TFPCustomImage;
+  D,S,X,Y : Word;
+
+
+begin
+  S:=Size;
+  if S=0 then exit;
+  D:=PixelSize*S;
+  Img:=TFPCompactImgGray8Bit.Create(D+aBorder*2,D+aBorder*2);
+  try
+    For X:=0 to D+(aBorder*2)-1 do
+      For Y:=1 to aBorder do
+        begin
+        Img[X,Y-1]:=colWhite;
+        Img[X,D+(aBorder*2)-Y]:=colWhite;
+        end;
+    For Y:=aBorder to D+aBorder-1 do
+      For X:=1 to aBorder do
+        begin
+        Img[X-1,Y]:=colWhite;
+        Img[D+(aBorder*2)-X,Y]:=colWhite;
+        end;
+    Origin:=Point(aBorder,aBorder);
+    Draw(Img);
+    Img.SaveToFile(aFileName);
+  finally
+    Img.Free;
+  end;
+end;
+
+end.
+
--- a/packages/fcl-image/src/fpqrcodegen.pp
+++ b/packages/fcl-image/src/fpqrcodegen.pp