Сканер QR Кода зависает приложение

[Aleks133]

Добрый вечер. Пытаюсь добавить сканеровку qr кода в приложение.Делаю так:

uses FMX.ALDevBarcode;

private
    FBarcode: TALDevBarcode;
    procedure BarcodeScanResult(Sender: TObject; AResult: string);
    procedure convert(s: string);

procedure TForm1.BarcodeScanResult(Sender: TObject; AResult: string);
var
  ScanThread: TScanthread;
begin
  convert(AResult);

end;

procedure TForm1.convert(s: string);
var
  d, t, sum_start, fn_start, i_start: integer;
  dt, tm: TDateTime;
  sdt, tdt, summa, fn, fn_find_str: string;
  fn_find, fn_name_find: variant;
begin
  if ContainsText(s, 't=') and ContainsText(s, 'T') and ContainsText(s, '&s=')
    and ContainsText(s, '&fn=') then
  begin
    sum_start := pos('&s=', s, 1); // начало суммы
    fn_start := pos('&fn=', s, 1); // начало фн номера
    i_start := pos('&i=', s, 1); // начало i номера
    fn := copy(s, fn_start + 4, i_start - (fn_start + 4));//ФН номер
    summa := copy(s, sum_start + 3, fn_start - (sum_start + 3)); // сумма
    summa := stringreplace(summa, '.', ',', [rfReplaceAll]);
    sdt := copy(s, pos('t=', s, 1) + 2, 8); // вся дата
    tdt := copy(s, pos('T', s, 1) + 1, 4); // все время
    dt := EncodeDate(strtoint(copy(sdt, 1, 4)), strtoint(copy(sdt, 5, 2)),
      strtoint(copy(sdt, 7, 2))); // цифры переводим в дату
    tm := encodetime(strtoint(copy(tdt, 1, 2)), strtoint(copy(tdt, 3, 2)), 0,
      0); // цифры переводим в время

    DateEdit1.DateTime := dt + tm;
    Label1.Text := summa;
    Button2.Hint := fn;  // кнопке сканера присаиваем результат фн
    dm.magaz.Open('select * from magaz');   //список магазинов
    fn_find := dm.magaz.Lookup('fn', fn, 'name');  //ищем имя магазина в бд
    fn_name_find := dm.magaz.Lookup('fn', fn, 'fn');  //ищем фн в бд
    if vartype(fn_name_find) = varnull then
    begin
      Label40.Text := 'Не известный магазин'; // Не известный магазин
      Label40.tag := 0; // такого фн нет в БД
    end
    else if (vartype(fn_find) = varnull) or (fn_find = '') then
    begin
      Label40.Text := 'Не известный магазин'; // Не известный магазин
      Label40.tag := 2; // у этого ФН нет названияв в БД
    end
    else
    begin
      Label40.Text := fn_find; // название найденного по фн магазина
      Label40.tag := 1; // название магазина есть в БД
    end;
    if Label40.tag <> 4 then
      Label40.HitTest := True;    
  end
  else
    showmessage('QR код не содержит нужных данных');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin    
      FBarcode.Scan;

end;

Содержимое FMX.ALDevBarcode

unit FMX.ALDevBarcode;

interface

uses
  FMX.Types, FMX.Platform, System.Classes, System.Rtti,
  Androidapi.JNI.GraphicsContentViewText, Androidapi.Helpers;

type
  TALDevBarcodeScanEvent = procedure (Sender: TObject; AResult: string) of object;
  TALDevBarcode = class(TFmxObject)
  private
    FPreservedClipboardValue: TValue;
    FMonitorClipboard: Boolean;
    FClipService: IFMXClipboardService;
    FOnScanResult: TALDevBarcodeScanEvent;
    function HandleAppEvent(AAppEvent: TApplicationEvent; AContext: TObject): Boolean;
    procedure DoScanResult(AValue: string);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Scan;
    property OnScanResult: TALDevBarcodeScanEvent read FOnScanResult write FOnScanResult;
  end;

implementation


{ TALDevBarcode }

constructor TALDevBarcode.Create(AOwner: TComponent);
var
  aFMXApplicationEventService: IFMXApplicationEventService;
begin
  inherited Create(AOwner);
  FMonitorClipboard := False;
  if not TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService, IInterface(FClipService)) then
    FClipService := nil;
  if TPlatformServices.Current.SupportsPlatformService(IFMXApplicationEventService, IInterface(aFMXApplicationEventService)) then
    aFMXApplicationEventService.SetApplicationEventHandler(HandleAppEvent)
  else
    Log.d('Application Event Service is not supported.');
end;

destructor TALDevBarcode.Destroy;
begin
  inherited Destroy;
end;

procedure TALDevBarcode.DoScanResult(AValue: string);
begin
  if Assigned(FOnScanResult) then
    FOnScanResult(Self, AValue);
end;

function TALDevBarcode.HandleAppEvent(AAppEvent: TApplicationEvent;
  AContext: TObject): Boolean;
  function GetBarcodeValue: Boolean;
  var
    value: String;
  begin
    Result := False;
    FMonitorClipboard := False;
    if (FClipService.GetClipboard.ToString <> 'nil') then
    begin
      DoScanResult(FClipService.GetClipboard.ToString);
      FClipService.SetClipboard(FPreservedClipboardValue);
      Result := True;
    end;
  end;
begin
  Result := False;
  if FMonitorClipboard and (AAppEvent = TApplicationEvent.BecameActive) then
    Result := GetBarcodeValue;
end;

procedure TALDevBarcode.Scan;
var
  intent: JIntent;
begin
  if Assigned(FClipService) then
  begin
    FPreservedClipboardValue := FClipService.GetClipboard;
    FMonitorClipboard := True;
    FClipService.SetClipboard('nil');
    intent := TJIntent.Create;
    intent.setAction(StringToJString('com.google.zxing.client.android.SCAN'));
    //intent.putExtras(TJIntent.JavaClass.EXTRA_TEXT, StringToJString('"SCAN_MODE", "CODE_39"'));
    SharedActivity.startActivityForResult(intent, 0);
  end;
end;
end.

После нажатия на button2 открывается сканер, сканирую и приложение зависает(в оснавном когда сканирую первый раз).

[Slym]

SharedActivity.startActivityForResult(intent, 0);
результат получаешь в TMessageResultNotification
intent.getStringExtra("SCAN_RESULT");
intent.getStringExtra("SCAN_RESULT_FORMAT");

[Aleks133]

16 часов назад, Slym сказал:

SharedActivity.startActivityForResult(intent, 0);
результат получаешь в TMessageResultNotification
intent.getStringExtra("SCAN_RESULT");
intent.getStringExtra("SCAN_RESULT_FORMAT");

Спасибо за ответ.Вот только знать бы как это все работает и где это  применить((Буду изучать...еще раз спасибо. 

[Aleks133]

Сам не знаю как, но получилось)))пол дня читал форумы чтобы хоть что-то понять из этого.

И методом "научного тыка" вот:

uses androidapi.helpers,
Androidapi.JNI.app,FMX.Helpers.Android,
  Androidapi.JNI.GraphicsContentViewText;

var
FMessageSubscriptionID:integer;

procedure tform1.Scan1;
var
  intent: JIntent;
begin
FMessageSubscriptionID := TMessageManager.DefaultManager.SubscribeToMessage(TMessageResultNotification,
    HandleActivityMessage);
    intent := TJIntent.Create;
    intent.setAction(StringToJString('com.google.zxing.client.android.SCAN'));
    SharedActivity.startActivityForResult(intent, 0);
end;


procedure TForm1.HandleActivityMessage(const Sender: TObject; const M:TMessage);
var
   RequestCode, ResultCode: Integer;
   Intent: JIntent;
   s:string;
begin
  if not(M is TMessageResultNotification) then exit;
  TMessageManager.DefaultManager.Unsubscribe(TMessageResultNotification, FMessageSubscriptionID);
  FMessageSubscriptionID := 0;

  RequestCode:=TMessageResultNotification(M).RequestCode;
  ResultCode:=TMessageResultNotification(M).ResultCode;
  Intent:=TMessageResultNotification(M).Value;

   if ResultCode = TJActivity.JavaClass.RESULT_OK then
   begin
    if Assigned(Intent) then
      begin
      s:=JStringToString(intent.getStringExtra(StringToJString('SCAN_RESULT')));  //получил результат со сканера
      convert(s);  //использовал результат со сканера в своей процедуре
      end;
    end
    else if ResultCode = TJActivity.JavaClass.RESULT_CANCELED then
    begin
      //Memo1.Lines.Append('RESULT_CANCELED');
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  scan1; //запуск сканеровки;
end;

Не знаю правильно ли это все будет работать, но во всяком случае приложение не виснит(пока) и что хотел получил.

Slym'у большое спасибо за наводку.

Если кто знает что нужно добавить\исправить для гарантированно стабильной(без сюрпризов в дальнейшем) работы кода, буду благодарен.

Изменено 26 февраля, 2020 пользователем Aleks133