这是我在这个论坛上的第一个问题。我正在尝试遵守规则，但是如果我违规，请让我知道，我会解决它........无论如何要解决我的问题.....我使用Delphi Rad Studio 10.3.3并应用了所有修补程序。...我不是专家，但是对环境有一定的了解。
我下载了用于Delphi本机端口的最新版本的ZXING，并将其合并到我的项目中。使用演示示例中的代码，我试图使用网络摄像头读取条形码以证明概念。如果我为使用Windows摄像头提供的解码功能编译了Windows提供的任何演示，则Windows会显示一条消息“问题导致Windows停止工作”。我要做的就是将ReadResult.Text放入备忘录中。
即使我从使用ttask连续同步线程的演示示例中提取了GetImage方法，我仍然遇到问题。
我已经确定在调用ScanManager后尝试访问任何ReadResult属性或方法时存在此问题
经过数天的互联网搜索（其中一些文章看起来非常接近），我最终不得不承认我需要帮助，并且需要问一个问题……“我缺少什么？”
非常感谢
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.
我对线程没有太多的经验，所以这不是很优雅，但是我认为我会作为一个答案，以防它对其他人有所帮助，帮助我更好地进步。以下代码在没有AV的情况下有效。请注意，解码条形码的命中率将完全取决于相机自动对焦的速度和精度，并且您将需要一台分辨率合适的相机。我在LowRes中无法获得扫描结果。
问题很多。因此，我将简要介绍主要内容：
1使用firemonkey时，请使用FMX.Graphics.TBitmap; （我也愚蠢地引用了没有正确实例化的对象。...疲劳的迹象:-(）
2将与表单上的控件的交互保持在最低限度。
3最重要的是，我可以使它作为原型工作的唯一方法是创建一个位图，可以从每个视频帧的单元内部全局访问该位图。然后，我需要一个计时器来每隔[x]毫秒运行一次，以充当工作人员进行处理，但关键的是（出于我未知的原因），我必须创建一个单独的过程来解码条形码并在OnTimer事件中从TTASK调用。如果不使用TTASK，则将获得AV。请记住，要使用TTask，需要将System.Threading添加到“ Uses”子句中。
无论如何，我希望这可以帮助其他人。
unit Unit1;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, ZXing.BarcodeFormat,
ZXing.ReadResult,
ZXing.ScanManager, FMX.ScrollBox, FMX.Memo, FMX.Controls.Presentation,
FMX.StdCtrls, FMX.ListBox, FMX.Objects, FMX.Media, System.Threading;
type
TForm1 = class(TForm)
CameraComponent1: TCameraComponent;
imgCameraView: TImage;
ComboBox1: TComboBox;
ComboBox2: TComboBox;
Start: TButton;
Memo1: TMemo;
lblScanStatus: TLabel;
ScanTimer: TTimer;
procedure FormCreate(Sender: TObject);
procedure CameraComponent1SampleBufferReady(Sender: TObject;
const ATime: TMediaTime);
procedure StartClick(Sender: TObject);
procedure ScanTimerTimer(Sender: TObject);
private
{ Private declarations }
procedure GetImage;
procedure GetBarcode;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
Var
ThisFrameCount :Integer;
MyBitmap:FMX.Graphics.TBitmap;
procedure TForm1.CameraComponent1SampleBufferReady(Sender: TObject;
const ATime: TMediaTime);
begin
TThread.Synchronize(TThread.CurrentThread, GetImage);
end;
procedure TForm1.GetImage;
begin
CameraComponent1.SampleBufferToBitmap(imgCameraView.Bitmap, True);
If ScanTimer.Enabled=True then MyBitmap:= imgCameraView.Bitmap;
end;
procedure TForm1.GetBarcode;
Var
ReadResult: TReadResult;
ScanManager: TScanManager;
begin
ScanManager := TScanManager.Create(TBarcodeFormat.auto, nil);
try
try
ReadResult:=ScanManager.Scan(MyBitmap);
if ReadResult <> nil then
begin
MEMO1.Lines.Add(ReadResult.Text);
ScanTimer.Enabled:=False;
end
else
begin
//mybitmap.SaveToFile('D:\Documents\DelphiProjects\WinSoftTest2\'+inttostr(Random(10000000))+'.jpg');
memo1.lines.add ('No Barcode Fount Yet');
end;
except
on E : Exception do
begin
ShowMessage('Exception class name = '+E.ClassName);
ShowMessage('Exception message = '+E.Message);
exit;
end;
end;
finally
freeandnil(ScanManager);
Freeandnil(ReadResult);
end;
end;
procedure TForm1.ScanTimerTimer(Sender: TObject);
begin
TTask.Run(
procedure
begin
getbarcode;
end);
end;
procedure TForm1.StartClick(Sender: TObject);
begin
if CameraComponent1.active then
begin
CameraComponent1.active:=False;
CameraComponent1.Quality:=(TVideoCaptureQuality.MediumQuality);
Start.Text:='Start';
ScanTimer.enabled:=False;
end
else
begin
CameraComponent1.Quality:=(TVideoCaptureQuality.MediumQuality);
CameraComponent1.active:=True;
Start.Text:='STOP';
ScanTimer.enabled:=True;
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;
end.