Это мой первый вопрос на этом форуме. Я пытаюсь следовать правилам, но если я нарушу, пожалуйста, просто дайте мне знать, и я исправлю это ........ в любом случае на мою проблему ..... Я использую Delphi Rad Studio 10.3.3 со всеми примененными патчами .... Я не эксперт, но обладаю достаточными практическими знаниями об окружающей среде.
Я скачал последнюю версию ZXING для собственного порта Delphi и включил в свой проект. Используя код из демонстрационных примеров, я пытаюсь прочитать штрих-код с помощью веб-камеры для подтверждения концепции. Если я скомпилирую любую из предоставленных демонстраций для Windows, использующих декодирование с веб-камеры, Windows жалуется с сообщением «Из-за проблемы Windows перестал работать». Все, что я пытаюсь сделать, это поместить ReadResult.Text в заметку.
Даже если я извлекаю метод GetImage из демонстрационного примера, который использует ttask для постоянной синхронизации потоков, у меня все еще есть проблема.
Я дошел до того, что обнаружил, что проблема существует при попытке получить доступ к любому из свойств или методов ReadResult после вызова ScanManager
После поиска по inte rnet в течение нескольких дней (некоторые статьи выглядело мучительно близко) Я должен наконец признать, что мне нужна помощь и мне нужно задать вопрос ...... «Что я пропускаю?»
Большое спасибо
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.