Delphi使用Zxing创建二维码

原作者: [db:作者] 来自: [db:来源] 收藏邀请

效果

DelphiZXingQRCode下载地址:https://www.debenu.com/open-source/delphizxingqrcode/

为了调用方便unit DelphiZXIngQRCode增加了一个过程

procedure EncodeToImage(const text: string; const Img: TImage);

procedure TDelphiZXingQRCode.EncodeToImage(const text: string; const Img: TImage);
var
  Row, Column: Integer;
  BMP: TBitmap;
  Scale: Double;
begin
  Data := text;
  BMP := TBitmap.Create;
  BMP.Height := Rows;
  BMP.Width := Columns;
  for Row := 0 to Rows - 1 do
  begin
    for Column := 0 to Columns - 1 do
    begin
      if (IsBlack[Row, Column]) then
        BMP.Canvas.Pixels[Column, Row] := clBlack
      else
        BMP.Canvas.Pixels[Column, Row] := clWhite;
    end;
  end;
  Img.Canvas.Brush.Color := clWhite;
  Img.Canvas.FillRect(Rect(0, 0, Img.Width, Img.Height));
  if ((BMP.Width > 0) and (BMP.Height > 0)) then
  begin
    if (Img.Width < Img.Height) then
      Scale := Img.Width / BMP.Width
    else
      Scale := Img.Height / BMP.Height;
    Img.Canvas.StretchDraw(Rect(0, 0, Trunc(Scale * BMP.Width), Trunc(Scale * BMP.Height)), BMP);
  end;
  BMP.Free;
end;

调用方式

uses
  DelphiZXIngQRCode;


procedure TForm1.Button1Click(Sender: TObject);
var
  zxing: TDelphiZXingQRCode;
begin
  zxing := TDelphiZXingQRCode.Create;
  try
    //二维码外边距
    zxing.QuietZone := SpinEdit1.Value;
    //可选值qrAuto, qrNumeric, qrAlphanumeric, qrISO88591, qrUTF8NoBOM, qrUTF8BOM
    zxing.Encoding := TQRCodeEncoding(ComboBox1.ItemIndex);
    zxing.EncodeToImage(Memo1.Text, Image1);
  finally
    zxing.Free;
  end;
end;

DelphiZXIngQRCode.pas

unit DelphiZXIngQRCode;

// ZXing QRCode port to Delphi, by Debenu Pty Ltd
// www.debenu.com

// Original copyright notice
(*
 * Copyright 2008 ZXing authors
 *
 * Licensed under the Apache License, Version 2.0 (the "License");
 * you may not use this file except in compliance with the License.
 * You may obtain a copy of the License at
 *
 *      http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 *)

interface

uses
  Vcl.Graphics, Vcl.ExtCtrls;

type
  TQRCodeEncoding = (qrAuto, qrNumeric, qrAlphanumeric, qrISO88591, qrUTF8NoBOM, qrUTF8BOM);

  T2DBooleanArray = array of array of Boolean;

  TDelphiZXingQRCode = class
  protected
    FData: WideString;
    FRows: Integer;
    FColumns: Integer;
    FEncoding: TQRCodeEncoding;
    FQuietZone: Integer;
    FElements: T2DBooleanArray;
    procedure SetEncoding(NewEncoding: TQRCodeEncoding);
    procedure SetData(const NewData: WideString);
    procedure SetQuietZone(NewQuietZone: Integer);
    function GetIsBlack(Row, Column: Integer): Boolean;
    procedure Update;
  public
    constructor Create;
    property Data: WideString read FData write SetData;
    property Encoding: TQRCodeEncoding read FEncoding write SetEncoding;
    property QuietZone: Integer read FQuietZone write SetQuietZone;
    property Rows: Integer read FRows;
    property Columns: Integer read FColumns;
    property IsBlack[Row, Column: Integer]: Boolean read GetIsBlack;
    procedure EncodeToImage(const text: string; const Img: TImage);
  end;

implementation

uses
  contnrs, Math, Classes;

type
  TByteArray = array of Byte;

  T2DByteArray = array of array of Byte;

  TIntegerArray = array of Integer;

const
  NUM_MASK_PATTERNS = 8;
  QUIET_ZONE_SIZE = 4;
  ALPHANUMERIC_TABLE: array[0..95] of Integer = (-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,  // 0x00-0x0f
    -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,  // 0x10-0x1f
    36, -1, -1, -1, 37, 38, -1, -1, -1, -1, 39, 40, -1, 41, 42, 43,  // 0x20-0x2f
    0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 44, -1, -1, -1, -1, -1,  // 0x30-0x3f
    -1, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24,  // 0x40-0x4f
    25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1   // 0x50-0x5f
    );
  DEFAULT_BYTE_MODE_ENCODING = 'ISO-8859-1';
  POSITION_DETECTION_PATTERN: array[0..6, 0..6] of Integer = ((1, 1, 1, 1, 1, 1, 1), (1, 0, 0, 0, 0, 0, 1), (1, 0, 1, 1, 1, 0, 1), (1, 0, 1, 1, 1, 0, 1), (1, 0, 1, 1, 1, 0, 1), (1, 0, 0, 0, 0, 0, 1), (1, 1, 1, 1, 1, 1, 1));
  HORIZONTAL_SEPARATION_PATTERN: array[0..0, 0..7] of Integer = ((0, 0, 0, 0, 0, 0, 0, 0));
  VERTICAL_SEPARATION_PATTERN: array[0..6, 0..0] of Integer = ((0), (0), (0), (0), (0), (0), (0));
  POSITION_ADJUSTMENT_PATTERN: array[0..4, 0..4] of Integer = ((1, 1, 1, 1, 1), (1, 0, 0, 0, 1), (1, 0, 1, 0, 1), (1, 0, 0, 0, 1), (1, 1, 1, 1, 1));

  // From Appendix E. Table 1, JIS0510X:2004 (p 71). The table was double-checked by komatsu.
  POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE: array[0..39, 0..6] of Integer = ((-1, -1, -1, -1, -1, -1, -1),  // Version 1
    (6, 18, -1, -1, -1, -1, -1),  // Version 2
    (6, 22, -1, -1, -1, -1, -1),  // Version 3
    (6, 26, -1, -1, -1, -1, -1),  // Version 4
    (6, 30, -1, -1, -1, -1, -1),  // Version 5
    (6, 34, -1, -1, -1, -1, -1),  // Version 6
    (6, 22, 38, -1, -1, -1, -1),  // Version 7
    (6, 24, 42, -1, -1, -1, -1),  // Version 8
    (6, 26, 46, -1, -1, -1, -1),  // Version 9
    (6, 28, 50, -1, -1, -1, -1),  // Version 10
    (6, 30, 54, -1, -1, -1, -1),  // Version 11
    (6, 32, 58, -1, -1, -1, -1),  // Version 12
    (6, 34, 62, -1, -1, -1, -1),  // Version 13
    (6, 26, 46, 66, -1, -1, -1),  // Version 14
    (6, 26, 48, 70, -1, -1, -1),  // Version 15
    (6, 26, 50, 74, -1, -1, -1),  // Version 16
    (6, 30, 54, 78, -1, -1, -1),  // Version 17
    (6, 30, 56, 82, -1, -1, -1),  // Version 18
    (6, 30, 58, 86, -1, -1, -1),  // Version 19
    (6, 34, 62, 90, -1, -1, -1),  // Version 20
    (6, 28, 50, 72, 94, -1, -1),  // Version 21
    (6, 26, 50, 74, 98, -1, -1),  // Version 22
    (6, 30, 54, 78, 102, -1, -1),  // Version 23
    (6, 28, 54, 80, 106, -1, -1),  // Version 24
    (6, 32, 58, 84, 110, -1, -1),  // Version 25
    (6, 30, 58, 86, 114, -1, -1),  // Version 26
    (6, 34, 62, 90, 118, -1, -1),  // Version 27
    (6, 26, 50, 74, 98, 122, -1),  // Version 28
    (6, 30, 54, 78, 102, 126, -1),  // Version 29
    (6, 26, 52, 78, 104, 130, -1),  // Version 30
    (6, 30, 56, 82, 108, 134, -1),  // Version 31
    (6, 34, 60, 86, 112, 138, -1),  // Version 32
    (6, 30, 58, 86, 114, 142, -1),  // Version 33
    (6, 34, 62, 90, 118, 146, -1),  // Version 34
    (6, 30, 54, 78, 102, 126, 150),  // Version 35
    (6, 24, 50, 76, 102, 128, 154),  // Version 36
    (6, 28, 54, 80, 106, 132, 158),  // Version 37
    (6, 32, 58, 84, 110, 136, 162),  // Version 38
    (6, 26, 54, 82, 110, 138, 166),  // Version 39
    (6, 30, 58, 86, 114, 142, 170)   // Version 40
    );

  // Type info cells at the left top corner.
  TYPE_INFO_COORDINATES: array[0..14, 0..1] of Integer = ((8, 0), (8, 1), (8, 2), (8, 3), (8, 4), (8, 5), (8, 7), (8, 8), (7, 8), (5, 8), (4, 8), (3, 8), (2, 8), (1, 8), (0, 8));

  // From Appendix D in JISX0510:2004 (p. 67)
  VERSION_INFO_POLY = $1f25;  // 1 1111 0010 0101

  // From Appendix C in JISX0510:2004 (p.65).
  TYPE_INFO_POLY = $537;
  TYPE_INFO_MASK_PATTERN = $5412;
  VERSION_DECODE_INFO: array[0..33] of Integer = ($07C94, $085BC, $09A99, $0A4D3, $0BBF6, $0C762, $0D847, $0E60D, $0F928, $10B78, $1145D, $12A17, $13532, $149A6, $15683, $168C9, $177EC, $18EC4, $191E1, $1AFAB, $1B08E, $1CC1A, $1D33F, $1ED75, $1F250, $209D5, $216F0, $228BA, $2379F, $24B0B, $2542E, $26A64, $27541, $28C69);

type
  TMode = (qmTerminator, qmNumeric, qmAlphanumeric, qmStructuredAppend, qmByte, qmECI, qmKanji, qmFNC1FirstPosition, qmFNC1SecondPosition, qmHanzi);

const
  ModeCharacterCountBits: array[TMode] of array[0..2] of Integer = ((0, 0, 0), (10, 12, 14), (9, 11, 13), (0, 0, 0), (8, 16, 16), (0, 0, 0), (8, 10, 12), (0, 0, 0), (0, 0, 0), (8, 10, 12));
  ModeBits: array[TMode] of Integer = (0, 1, 2, 3, 4, 7, 8, 5, 9, 13);

type
  TErrorCorrectionLevel = class
  private
    FBits: Integer;
  public
    procedure Assign(Source: TErrorCorrectionLevel);
    function Ordinal: Integer;
    property Bits: Integer read FBits;
  end;

  TECB = class
  private
    Count: Integer;
    DataCodewords: Integer;
  public
    constructor Create(Count, DataCodewords: Integer);
    function GetCount: Integer;
    function GetDataCodewords: Integer;
  end;

  TECBArray = array of TECB;

  TECBlocks = class
  private
    ECCodewordsPerBlock: Integer;
    ECBlocks: TECBArray;
  public
    constructor Create(ECCodewordsPerBlock: Integer; ECBlocks: TECB); overload;
    constructor Create(ECCodewordsPerBlock: Integer; ECBlocks1, ECBlocks2: TECB); overload;
    destructor Destroy; override;
    function GetTotalECCodewords: Integer;
    function GetNumBlocks: Integer;
    function GetECCodewordsPerBlock: Integer;
    function GetECBlocks: TECBArray;
  end;

  TByteMatrix = class
  protected
    Bytes: T2DByteArray;
    FWidth: Integer;
    FHeight: Integer;
  public
    constructor Create(Width, Height: Integer);
    function Get(X, Y: Integer): Integer;
    procedure SetBoolean(X, Y: Integer; Value: Boolean);
    procedure SetInteger(X, Y: Integer; Value: Integer);
    function GetArray: T2DByteArray;
    procedure Assign(Source: TByteMatrix);
    procedure Clear(Value: Byte);
    function Hash: AnsiString;
    property Width: Integer read FWidth;
    property Height: Integer read FHeight;
  end;

  TBitArray = class
  private
    Bits: array of Integer;
    Size: Integer;
    procedure EnsureCapacity(Size: Integer);
  public
    constructor Create; overload;
    constructor Create(Size: Integer); overload;
    function GetSizeInBytes: Integer;
    function GetSize: Integer;
    function Get(I: Integer): Boolean;
    procedure SetBit(Index: Integer);
    procedure AppendBit(Bit: Boolean);
    procedure AppendBits(Value, NumBits: Integer);
    procedure AppendBitArray(NewBitArray: TBitArray);
    procedure ToBytes(BitOffset: Integer; Source: TByteArray; Offset, NumBytes: Integer);
    procedure XorOperation(Other: TBitArray);
  end;

  TCharacterSetECI = class
  end;

  TVersion = class
  private
    VersionNumber: Integer;
    AlignmentPatternCenters: array of Integer;
    ECBlocks: array of TECBlocks;
    TotalCodewords: Integer;
    ECCodewords: Integer;
  public
    constructor Create(VersionNumber: Integer; AlignmentPatternCenters: array of Integer; ECBlocks1, ECBlocks2, ECBlocks3, ECBlocks4: TECBlocks);
    destructor Destroy; override;
    class function GetVersionForNumber(VersionNum: Integer): TVersion;
    class function ChooseVersion(NumInputBits: Integer; ecLevel: TErrorCorrectionLevel): TVersion;
    function GetTotalCodewords: Integer;
    function GetECBlocksForLevel(ECLevel: TErrorCorrectionLevel): TECBlocks;
    function GetDimensionForVersion: Integer;
  end;

  TMaskUtil = class
  public
    function GetDataMaskBit(MaskPattern, X, Y: Integer): Boolean;
  end;

  TQRCode = class
  private
    FMode: TMode;
    FECLevel: TErrorCorrectionLevel;
    FVersion: Integer;
    FMatrixWidth: Integer;
    FMaskPattern: Integer;
    FNumTotalBytes: Integer;
    FNumDataBytes: Integer;
    FNumECBytes: Integer;
    FNumRSBlocks: Integer;
    FMatrix: TByteMatrix;
    FQRCodeError: Boolean;
  public
    constructor Create;
    destructor Destroy; override;
    function At(X, Y: Integer): Integer;
    function IsValid: Boolean;
    function IsValidMaskPattern(MaskPattern: Integer): Boolean;
    procedure SetMatrix(NewMatrix: TByteMatrix);
    procedure SetECLevel(NewECLevel: TErrorCorrectionLevel);
    procedure SetAll(VersionNum, NumBytes, NumDataBytes, NumRSBlocks, NumECBytes, MatrixWidth: Integer);
    property QRCodeError: Boolean read FQRCodeError;
    property Mode: TMode read FMode write FMode;
    property Version: Integer read FVersion write FVersion;
    property NumDataBytes: Integer read FNumDataBytes;
    property NumTotalBytes: Integer read FNumTotalBytes;
    property NumRSBlocks: Integer read FNumRSBlocks;
    property MatrixWidth: Integer read FMatrixWidth;
    property MaskPattern: Integer read FMaskPattern write