這個實例在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