1
votes

Can anyone help me with this? I made an application in Delphi 10.2 with FireMonkey that displays video from a webcam on my Form, and on an action I insert it into a database. Code for webcam is like this:

https://www.youtube.com/watch?v=EDgCyE0MSVo

I use the TVideoCaptureDevice class and this code:

VideoCamera := TCaptureDeviceManager.Current.DefaultVideoCaptureDevice;
if VideoCamera <> nil then
begin
  VideoCamera.OnSampleBufferReady := SampleBufferReady;
  VideoCamera.StartCapture;
end
else
begin
  // MessageDlg('.',  TMsgDlgType.mtWarning, [TMsgDlgBtn.mbOK], 0);
end;

In the SampleBufferReady() procedure, I have this line of code:

VideoCamera.SampleBufferToBitmap(frame, true);

When I close the application, I have this code:

if VideoCamera <> nil then
  VideoCamera.StopCapture;

Application works fine for thousands of times, but some times I get an Access Violation, I suppose somewhere in FMX.Media or in System, as you can see:

Print screen from debugger

or maybe this one

Next print screen from debugger

How can I figure out what happens?

As you can see below, I can't change the frame rate

Print screen with frame rate change

When I list AvailableCaptureSettings I get only 30 fps

Available settings

Now I have compleatly differnet print screen from debugger

New print screen

As you say, I made a new simple project. This is the complete code:

unit Unit3;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Media,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects, FMX.Layouts;

type
  TForm3 = class(TForm)
    layCamera1: TLayout;
    imgCamera1: TImage;
    Rectangle1: TRectangle;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
    VideoCamera : TVideoCaptureDevice;
    procedure SampleBufferSync;
    procedure SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
  end;

var
  Form3: TForm3;
  frame: TBitmap;

implementation

{$R *.fmx}

procedure TForm3.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if VideoCamera <> nil then
    VideoCamera.StopCapture;

end;

procedure TForm3.FormShow(Sender: TObject);
begin
  VideoCamera:= TCaptureDeviceManager.Current.DefaultVideoCaptureDevice;
  if VideoCamera <> nil then
  begin
      VideoCamera.OnSampleBufferReady := SampleBufferReady;
      VideoCamera.StartCapture;
  end
  else
  begin

  end;
end;

procedure TForm3.SampleBufferReady(Sender: TObject; const ATime: TMediaTime);
begin
  if frame = nil then
    frame := TBitmap.Create;

  VideoCamera.SampleBufferToBitmap(frame, true);


  imgCamera1.Bitmap.Assign(frame);

end;

procedure TForm3.SampleBufferSync;
begin
  try
     if frame = nil then
      frame := TBitmap.Create;
    VideoCamera.SampleBufferToBitmap(frame, true);
    imgCamera1.Bitmap.Assign(frame);
  except on E:Exception do
  begin
     MessageDlg(E.Message, TMsgDlgType.mtWarning, [TMsgDlgBtn.mbOK], 0);
  end;
  end;
end;

end.

When I started the program, it worked for a while, but accidentally crashes after a few minutes (sometimes 2 minutes other times 22 minutes) with this debug window

Debugger window

Another problem is that sometimes, when I close a program, it doesn't close until I force it by press the stop button in Delphi

1
Run your application under the debugger to see where the access violation occurs and edit your question with that information.fpiette
I did it, of course. But I cannot figure where it happens. When I get Access Violetion debugger stops on postition in System unite as you can see in picture above. I putted break points almost every where in my code, I put try except also every where and I dont get exception any time. I cannot figure what happensDejan Lučić
Your screen dump do not show the debugger in action. You should have a look at the call stack (View / Debug window / call stack) and see the first line of your own code. Of course you must build the debug configuration and also check the project option "use debug dcu" to get as much as possible information.fpiette
are you using threads?whosrdaddy
This is what I get. Delphi raises Access Violetion and stops in GETMEM.INC on the line 1973 in function SysGetMem(Size: NativeInt): Pointer; but I dont know how program get there. I cannot put print screen here in commentDejan Lučić

1 Answers

1
votes

As stated in the comments, I have built the "simple new project" the OP published in his question.

It is running for more than 6 hours without any problem and is still running while I'm doing other things. I have a Logitech C310 webcam. Windows 10 Pro 20H2 ver 19042.685 with all updates installed. Delphi 10.4.1 update 1, ver 27.0.38860.1461.

My conclusion is that there is a bug in Delphi 10.2 that the OP is using. That bug has been fixed at least in Delphi 10.4.1 that I'm using.