Delphi XE5 Android 调用 Google ZXing
{ Google ZXing Call demo Delphi Version: Delphi XE5 Version 19.0.13476.4176 By: flcop(zylove619@hotmail.com) } unit UMain; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls, FMX.Layouts, FMX.Memo, System.Rtti, FMX.Helpers.Android, Androidapi.JNI.Net, Androidapi.JNI.GraphicsContentViewText, Androidapi.JNI.JavaTypes, FMX.platform, FMX.Platform.Android; type TFrmMain = class(TForm) Memo1: TMemo; Button1: TButton; Button2: TButton; Button3: TButton; PanelOpt: TPanel; Panel2: TPanel; SBTitle: TSpeedButton; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure SBTitleClick(Sender: TObject); private { Private declarations } FClipboardService: IFMXClipboardService; FClipboardValue: TValue; FZXingCalled: Boolean; procedure CallZXing(const ACodeMode: string); function IsIntentCallable(const AIntent: JIntent): Boolean; function GetZXingIntent: JIntent; procedure ClipboardSave; procedure ClipboardBack; procedure ShowInfo(const AInfo: string); function HandleAppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean; procedure CheckEnvironment; procedure OpenURL(const AURL: string); public { Public declarations } end; var FrmMain: TFrmMain; implementation {$R *.fmx} const CodeModes: array[0..2] of string = ('PRODUCT_MODE', 'QR_CODE_MODE', 'SCAN_MODE'); procedure TFrmMain.Button1Click(Sender: TObject); begin // 0, 1, 2 CallZXing(CodeModes[TButton(Sender).Tag]); end; procedure TFrmMain.CallZXing(const ACodeMode: string); var LIntent: JIntent; begin ClipboardSave; FClipboardService.SetClipboard(''); LIntent := GetZXingIntent(); LIntent.putExtra(StringToJString('SCAN_MODE'), StringToJString(ACodeMode)); SharedActivity.startActivityForResult(LIntent, 0); FZXingCalled := True; end; procedure TFrmMain.CheckEnvironment; var LFMXApplicationEventService: IFMXApplicationEventService; LIsZXingCallable: Boolean; LStr: string; begin if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationEventService, IInterface(LFMXApplicationEventService)) then LFMXApplicationEventService.SetApplicationEventHandler(HandleAppEvent) else LStr := '调用失败,不支持IFMXApplicationEventService!'; if not TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService, IInterface(FClipboardService)) then LStr := LStr + sLineBreak + '调用失败, 不支持IFMXClipboardService!'; LIsZXingCallable := IsIntentCallable(GetZXingIntent); if not LIsZXingCallable then begin SBTitle.Text := '点我去ZXing下载页...'; SBTitle.OnClick := SBTitleClick; LStr := LStr + sLineBreak + '未发现ZXing, 请安装ZXing后重新启动本程序'; end else SBTitle.Text := 'Google ZXing Call'; ShowInfo(LStr.Trim); PanelOpt.Enabled := Assigned(LFMXApplicationEventService) and Assigned(FClipboardService) and LIsZXingCallable; end; procedure TFrmMain.ClipboardBack; begin FClipboardService.SetClipboard(FClipboardValue); end; procedure TFrmMain.ClipboardSave; begin FClipboardValue := FClipboardService.GetClipboard; end; procedure TFrmMain.FormCreate(Sender: TObject); begin CheckEnvironment; end; function TFrmMain.GetZXingIntent: JIntent; const GOOGLE_ZXING = 'com.google.zxing.client.android.SCAN'; GOOGLE_ZXING_PACKAGE = 'com.google.zxing.client.android'; begin Result := TJIntent.JavaClass.init(StringToJString(GOOGLE_ZXING)); Result.setPackage(StringToJString(GOOGLE_ZXING_PACKAGE)); end; function TFrmMain.HandleAppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean; var LResult: string; begin if FZXingCalled and (AAppEvent = TApplicationEvent.aeBecameActive) then begin LResult := FClipboardService.GetClipboard.ToString; if LResult.IsEmpty then ShowInfo('扫描取消') else ShowInfo(LResult); ClipboardBack; FZXingCalled := False; end; Result := True; end; function TFrmMain.IsIntentCallable(const AIntent: JIntent): Boolean; var LJPackageManager: JPackageManager; begin Result := False; if Assigned(AIntent) then begin LJPackageManager := SharedActivityContext.getPackageManager; Result := LJPackageManager.queryIntentActivities(AIntent, TJPackageManager.JavaClass.MATCH_DEFAULT_ONLY).size <> 0; end; end; procedure TFrmMain.OpenURL(const AURL: string); var LIntent: JIntent; begin LIntent := TJIntent.JavaClass.init(TJIntent.JavaClass.ACTION_VIEW, TJnet_Uri.JavaClass.parse(StringToJString(AURL))); SharedActivity.startActivity(LIntent); end; procedure TFrmMain.SBTitleClick(Sender: TObject); begin OpenURL('http://code.google.com/p/zxing/downloads/list'); end; procedure TFrmMain.ShowInfo(const AInfo: string); begin Memo1.Text := AInfo; end; end.