Delphi ZXING Always Errors In Windows using Webcam

  

This is my first question on this forum. I am trying to follow the rules, but if I transgress please just let me know and I’ll fix it…….. anyway onto my problem…..
I use Delphi Rad Studio 10.3.3 with all Patches applied…. I am not an expert but have a reasonable working knowledge of the environment.

I downloaded the latest version of the ZXING for Delphi native port and have incorporated into my project. Using code from the demo examples I am trying to read a barcode using the webcam for a proof of concept.
If I compile any of the provided demos for Windows that use decoding from the wecam, Windows complains with a message “Problem has caused Windows to Stop Working”. All I am trying to do is put the ReadResult.Text into a memo.

Even if I carve out the GetImage method from the demo example that uses ttask to continually synchronize threads I still have the issue.

I have got as far as identifying that the issue exists when trying to access any of the ReadResult properties or methods after a call to ScanManager

After searching the internet for days (some of the articles have looked tantalisingly close) I have to finally admit that I need help and need to ask the question…… “what am I missing?”

Many Thanks

unit Unit1;

interface

uses
System.SysUtils,
System.Types,
System.UITypes,
System.Classes,
System.Variants,
System.Math.Vectors,
System.Actions,
System.Threading,
System.Permissions,
FMX.Types,
FMX.Controls,
FMX.Forms,
FMX.Graphics,
FMX.Dialogs,
FMX.Objects,
FMX.StdCtrls,
FMX.Media,
FMX.Platform,
FMX.MultiView,
FMX.ListView.Types,
FMX.ListView,
FMX.Layouts,
FMX.ActnList,
FMX.TabControl,
FMX.ListBox,
FMX.Controls.Presentation,
FMX.ScrollBox,
FMX.Memo,
FMX.Controls3D,
ZXing.BarcodeFormat,
ZXing.ReadResult,
ZXing.ScanManager, FMX.Edit;

type
TForm1 = class(TForm)
Layout1: TLayout;
StartButton: TButton;
ComboBox1: TComboBox;
Image1: TImage;
Label1: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Image2: TImage;
Memo1: TMemo;
imgCamera: TImage;
lblScanStatus: TLabel;
procedure FormCreate(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure StartButtonClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormDeactivate(Sender: TObject);
private
{ Private declarations }
FScanManager: TScanManager;
FScanInProgress: Boolean;
FFrameTake: Integer;
procedure GetImage();
public
{ Public declarations }
VideoCamera: TVideoCaptureDevice;
procedure SampleBufferSync;
procedure SampleBufferReady(Sender: TObject; const ATime: TMediaTime);

end;

var
Form1: TForm1;

implementation

uses

FMX.DialogService;

{$R *.fmx}

Var
ThisFrameCount :Integer;

procedure TForm1.ComboBox1Change(Sender: TObject);
var
AppEventSvc: IFMXApplicationEventService;
begin
VideoCamera := TVideoCaptureDevice
(TCaptureDeviceManager.Current.GetDevicesByName(ComboBox1.Selected.Text));
if (VideoCamera <> nil) then
begin
StartButton.Enabled := true;
VideoCamera.Quality:=TVideoCaptureQuality.LowQuality;
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
VideoCamera.StopCapture;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if VideoCamera.State=tcapturedevicestate.Capturing then
begin
Formdeactivate(nil);
Canclose:=False;
application.ProcessMessages;
end;

end;

procedure TForm1.FormCreate(Sender: TObject);
var
DeviceList: TCaptureDeviceList;
i: integer;
begin
ThisFrameCount:=0;
lblScanStatus.Text := ”;
DeviceList := TCaptureDeviceManager.Current.GetDevicesByMediaType
(TMediaType.Video);
for i := 0 to DeviceList.Count – 1 do
begin
ComboBox1.Items.Add(DeviceList[i].Name);
ComboBox1.ItemIndex:=0;
end;

end;

procedure TForm1.FormDeactivate(Sender: TObject);
begin
if videocamera <> nil then
begin
VideoCamera.StopCapture;
StartButton.Text := ‘Start’;
end;
end;

procedure TForm1.SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
begin
TThread.Synchronize(TThread.CurrentThread, SampleBufferSync);//GetImage); Commented out as this methodology seemed even worse. Left the routine in for further investigation if needed
//Resize the image so the video to be buffered on its original size.
Image1.Width:=Image1.Bitmap.Width;
Image1.Height:=Image1.Bitmap.Height;
end;

procedure TForm1.SampleBufferSync;
Var
ReadResult: TReadResult;
ScanManager: TScanManager;
Bitmap:TBitMap;
CheckResult : String;
begin
bitmap := TBitmap.Create;
Inc(ThisFrameCount);
VideoCamera.SampleBufferToBitmap(Bitmap, true);
Image1.Bitmap:= Bitmap;
CheckResult:=”;
ReadResult:=Nil;
// Only want every 5th frame prsed for decoding
if ThisFrameCount > 5 then
begin
ScanManager := TScanManager.Create(TBarcodeFormat.auto, nil);
try
Image2.Bitmap:=Bitmap; // This just copies to a different TImage so I coud be sure it wasnt a different issue
ReadResult:=ScanManager.Scan(Bitmap);
//PROBLEM IS HERE
if ReadResult <> nil then MEMO1.Lines.Add(ReadResult.Text); // <– ALWAYS Windows throws exception “Problem has caused Windows to Stop Working
// Throws this error wwhen tring to access ANY property or Method of ReadResult EG ToString
// Remove this line and it runs just fine….. but alas no barcode number which defeats the purpose
finally
freeandnil(ScanManager);
Freeandnil(ReadResult);
BitMap.Free;
ThisFrameCount:=0;
end;
end;
end;

procedure TForm1.StartButtonClick(Sender: TObject);
begin
if (VideoCamera <> nil) then
begin
if (VideoCamera.State = TCaptureDeviceState.Stopped) then
begin
VideoCamera.OnSampleBufferReady := SampleBufferReady;
VideoCamera.StartCapture;
StartButton.Text := ‘Stop’;
end
else
begin
VideoCamera.StopCapture;
StartButton.Text := ‘Start’;
end;
end
else
begin
Caption := ‘Video capture devices not available.’;
end;
end;

procedure TForm1.GetImage;
var
scanBitmap: TBitmap;
ReadResult: TReadResult;

begin
VideoCamera.SampleBufferToBitmap(imgCamera.Bitmap, True);

if (FScanInProgress) then
begin
exit;
end;

{ This code will take every 4 frame. }
inc(FFrameTake);
if (FFrameTake mod 4 <> 0) then
begin
exit;
end;

scanBitmap := TBitmap.Create();
scanBitmap.Assign(imgCamera.Bitmap);
ReadResult := nil;

// There is bug in Delphi Berlin 10.1 update 2 which causes the TTask and
// the TThread.Synchronize to cause exceptions.
// See: https://quality.embarcadero.com/browse/RSP-16377?jql=project%20%3D%20RSP%20AND%20issuetype%20%3D%20Bug%20AND%20affectedVersion%20%3D%20%2210.1%20Berlin%20Update%202%22%20AND%20status%20%3D%20Open%20ORDER%20BY%20priority%20DESC

TTask.Run(
procedure
begin
try
FScanInProgress := True;
try
ReadResult := FScanManager.Scan(scanBitmap);
except
on E: Exception do
begin
TThread.Synchronize(nil,
procedure
begin
lblScanStatus.Text := E.Message;
end);

exit;
end;
end;

TThread.Synchronize(nil,
procedure
begin

if (length(lblScanStatus.Text) > 10) then
begin
lblScanStatus.Text := ‘*’;
end;

lblScanStatus.Text := lblScanStatus.Text + ‘*’;
if (ReadResult <> nil) then
begin
// Memo1.Lines.Insert(0, ReadResult.Text);
end;

end);

finally
ReadResult.Free;
scanBitmap.Free;
FScanInProgress := false;
end;

end);

end;

end.

Comments are closed.