線上訂房服務-台灣趴趴狗聯合訂房中心
發文 回覆 瀏覽次數:2220
推到 Plurk!
推到 Facebook!

android qrcode ....

 
cat200188
中階會員


發表:37
回覆:78
積分:68
註冊:2005-01-18

發送簡訊給我
#1 引用回覆 回覆 發表時間:2013-12-12 23:29:07 IP:123.240.xxx.xxx 訂閱
相信不是很多人會java 所以看不懂李大師的技術研討 所以就分享一個和我做法類似的取qrcode方法
我的就不公開 這個很容易就懂 純delphi 完成 希望大家多多分享 讓delphi 永續生存和使用率上升到全語言之冠

[code delphi]
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.

[/code]


------
.......
P.D.
版主


發表:603
回覆:4038
積分:3874
註冊:2006-10-31

發送簡訊給我
#2 引用回覆 回覆 發表時間:2013-12-13 00:45:56 IP:118.169.xxx.xxx 未訂閱
感謝分享, 讚 1
系統時間:2024-04-20 2:16:37
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!