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