Delphixe7FireMonkey/Mobile(Android,iOS)生成QRCode完整实例

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

这个实例在windows、OS X、IOS和Android等平台运行正常。
本文参考这个网站提供的方法：http://zarko-gajic.iz.hr/firemonkey-mobile-android-ios-qr-code-generation-using-delphi-xe-5-delphizxingqrcode/

代码中用到的DelphiZXingQRCode.Pas点这下载

  1 unit Unit3;
  2 
  3 interface
  4 
  5 uses
  6   System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  7   FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  8   FMX.Controls.Presentation, FMX.Edit, FMX.StdCtrls,DelphiZXingQRCode,
  9   FMX.ListBox,system.math;
 10 
 11 type
 12   TForm3 = class(TForm)
 13     Button1: TButton;
 14     edtText: TEdit;
 15     imgQRCode: TImage;
 16     cmbEncoding: TComboBox;
 17     edtQuietZone: TEdit;
 18     procedure Button1Click(Sender: TObject);
 19   private
 20     { Private declarations }
 21     BMP: TBitmap;
 22   public
 23     { Public declarations }
 24   end;
 25 
 26 var
 27   Form3: TForm3;
 28 
 29 implementation
 30 
 31 {$R *.fmx}
 32 
 33 procedure TForm3.Button1Click(Sender: TObject);
 34 const
 35   downsizeQuality: Integer = 2; // bigger value, better quality, slower rendering
 36 var
 37   QRCode: TDelphiZXingQRCode;
 38   Row, Column: Integer;
 39   pixelColor : TAlphaColor;
 40   vBitMapData : TBitmapData;
 41   pixelCount, y, x: Integer;
 42   columnPixel, rowPixel: Integer;
 43   function GetPixelCount(AWidth, AHeight: Single): Integer;
 44   begin
 45     if QRCode.Rows > 0 then
 46       Result := Trunc(Min(AWidth, AHeight)) div QRCode.Rows
 47     else
 48       Result := 0;
 49   end;
 50 begin
 51   QRCode := TDelphiZXingQRCode.Create;
 52   try
 53     QRCode.Data := edtText.Text;
 54     QRCode.Encoding := TQRCodeEncoding(cmbEncoding.ItemIndex);
 55     QRCode.QuietZone := StrToIntDef(edtQuietZone.Text, 4);
 56     pixelCount := GetPixelCount(imgQRCode.Width, imgQRCode.Height);
 57     case imgQRCode.WrapMode of
 58       TImageWrapMode.iwOriginal,TImageWrapMode.iwTile,TImageWrapMode.iwCenter:
 59       begin
 60         if pixelCount > 0 then
 61           imgQRCode.Bitmap.SetSize(QRCode.Columns * pixelCount,
 62             QRCode.Rows * pixelCount);
 63       end;
 64       TImageWrapMode.iwFit:
 65       begin
 66         if pixelCount > 0 then
 67         begin
 68           imgQRCode.Bitmap.SetSize(QRCode.Columns * pixelCount * downsizeQuality,
 69             QRCode.Rows * pixelCount * downsizeQuality);
 70           pixelCount := pixelCount * downsizeQuality;
 71         end;
 72       end;
 73       TImageWrapMode.iwStretch:
 74         raise Exception.Create('Not a good idea to stretch the QR Code');
 75     end;
 76//     if imgQRCode.Bitmap.Canvas.BeginScene then
 77//     begin
 78       try
 79         imgQRCode.Bitmap.Canvas.Clear(TAlphaColors.White);
 80         if pixelCount > 0 then
 81         begin
 82           if imgQRCode.Bitmap.Map(TMapAccess.maWrite, vBitMapData)  then
 83           begin
 84             try
 85               for Row := 0 to QRCode.Rows - 1 do
 86               begin
 87                 for Column := 0 to QRCode.Columns - 1 do
 88                 begin
 89                   if (QRCode.IsBlack[Row, Column]) then
 90                     pixelColor := TAlphaColors.Black
 91                   else
 92                     pixelColor := TAlphaColors.White;
 93                   columnPixel := Column * pixelCount;
 94                   rowPixel := Row * pixelCount;
 95                   for x := 0 to pixelCount - 1 do
 96                     for y := 0 to pixelCount - 1 do
 97                       vBitMapData.SetPixel(columnPixel + x,
 98                         rowPixel + y, pixelColor);
 99                 end;
100               end;
101             finally
102               imgQRCode.Bitmap.Unmap(vBitMapData);
103             end;
104           end;
105         end;
106       finally
107//         imgQRCode.Bitmap.Canvas.EndScene;
108//       end;
109     end;
110   finally
111     QRCode.Free;
112   end;
113 end;
114 
115 end.

FMX：

 1 object Form3: TForm3
 2   Left = 0
 3   Top = 0
 4   Caption = 'Form3'
 5   ClientHeight = 487
 6   ClientWidth = 328
 7   FormFactor.Width = 320
 8   FormFactor.Height = 480
 9   FormFactor.Devices = [Desktop]
10   DesignerMasterStyle = 3
11   object Button1: TButton
12     Position.X = 32.000000000000000000
13     Position.Y = 104.000000000000000000
14     Size.Width = 89.000000000000000000
15     Size.Height = 44.000000000000000000
16     Size.PlatformDefault = False
17     TabOrder = 0
18     Text = 'Button1'
19     OnClick = Button1Click
20   end
21   object edtText: TEdit
22     Touch.InteractiveGestures = [LongTap, DoubleTap]
23     TabOrder = 1
24     Position.X = 32.000000000000000000
25     Position.Y = 56.000000000000000000
26     Size.Width = 233.000000000000000000
27     Size.Height = 32.000000000000000000
28     Size.PlatformDefault = False
29   end
30   object imgQRCode: TImage
31     MultiResBitmap = <
32       item
33       end>
34     Anchors = [akLeft, akTop, akRight, akBottom]
35     MarginWrapMode = Center
36     Position.X = 32.000000000000000000
37     Position.Y = 192.000000000000000000
38     Size.Width = 250.000000000000000000
39     Size.Height = 250.000000000000000000
40     Size.PlatformDefault = False
41   end
42   object cmbEncoding: TComboBox
43     Items.Strings = (
44       'Auto'
45       'Numeric'
46       'Alphanumeric'
47       'ISO-8859-1'
48       'UTF-8 without BOM'
49       'UTF-8 with BOM')
50     ItemIndex = 0
51     Position.X = 136.000000000000000000
52     Position.Y = 112.000000000000000000
53     Size.Width = 145.000000000000000000
54     Size.Height = 32.000000000000000000
55     Size.PlatformDefault = False
56     TabOrder = 3
57   end
58   object edtQuietZone: TEdit
59     Touch.InteractiveGestures = [LongTap, DoubleTap]
60     TabOrder = 4
61     Text = '4'
62     Position.X = 32.000000000000000000
63     Position.Y = 152.000000000000000000
64     Size.Width = 100.000000000000000000
65     Size.Height = 32.000000000000000000
66     Size.PlatformDefault = False
67   end
68 end

2015-02-13 新的demo，简化调用方式，要配合下面的DelphiZXIngQRCode.pas

unit Unit3;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  FMX.Controls.Presentation, FMX.Edit, FMX.StdCtrls,DelphiZXingQRCode,
  FMX.ListBox,system.math;

type
  TForm3 = class(TForm)
    Button1: TButton;
    edtText: TEdit;
    imgQRCode: TImage;
    cmbEncoding: TComboBox;
    edtQuietZone: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    BMP: TBitmap;
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

{$R *.fmx}

procedure TForm3.Button1Click(Sender: TObject);
var
  QRCode: TDelphiZXingQRCode;
begin
  QRCode := TDelphiZXingQRCode.Create;
  try
    QRCode.Data := edtText.Text;
    QRCode.Encoding := TQRCodeEncoding(cmbEncoding.ItemIndex);
    QRCode.QuietZone := StrToIntDef(edtQuietZone.Text, 4);
    QRCode.DrawQrcode(imgQRCode,QRCode);
  finally
    QRCode.Free;
  end;
end;

end.

View Code

新的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
  System.UITypes,
  FMX.Graphics,
  FMX.Objects,
  FMX.Types;

type
  TQRCodeEncoding = (qrAuto, qrNumeric, qrAlphanumeric, qrISO88591, qrUTF8NoBOM,
    qrUTF8BOM);
  T2DBooleanArray = array of array of Boolean;

  TDelphiZXingQRCode = class
  protected
    FData: String;
    FRows: Integer;
    FColumns: Integer;
    FEncoding: TQRCodeEncoding;
    FQuietZone: Integer;
    FElements: T2DBooleanArray;
    procedure SetEncoding(NewEncoding: TQRCodeEncoding);
    procedure SetData(const NewData: string);
    procedure SetQuietZone(NewQuietZone: Integer);
    function GetIsBlack(Row, Column: Integer): Boolean;
    procedure Update;
  public
    constructor Create;
    procedure DrawQrcode(imgQRCode: TImage; QRCode: TDelphiZXingQRCode);
    property Data: string 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;
  end;

implementation

uses
  System.Generics.Collections, Math, Classes, System.SysUtils;

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