TCameraComponent and TVideoCaptureDevice do not in

Question

I use the standard code to initialize TVideoCaptureDevice and start capturing.

const  M_LAUNCH_CAMERA = WM_APP + 450;
type
  TCamSF1 = class(TForm)
...
  protected
    procedure LaunchCamera(var Message: TMessage); message M_LAUNCH_CAMERA;
...
end;
...
procedure TCamSF1.LaunchCamera(var Message: TMessage);
begin
if VideoCamera = nil then
    begin
      VideoCamera := TCaptureDeviceManager.Current.DefaultVideoCaptureDevice;
      if VideoCamera <> nil then
      begin
        VideoCamera.OnSampleBufferReady := CameraReady;
        VideoCamera.StartCapture;
      end
      else
      begin
        Caption := 'Video capture devices not available.';
      end;
    end
    else
    begin
      VideoCamera.StartCapture;
    end;
end;

procedure TCamSF1.IdTCPServer1Execute(AContext: TIdContext);
var
  S: AnsiString;
  Command: TAnsiStrings;
  Msg: TMessage;
begin
  if (AContext <> nil) and (AContext.Connection.Socket.Connected) and
    (not AContext.Connection.Socket.InputBufferIsEmpty) then
    S := AContext.Connection.Socket.ReadLn;
  if S = '' then
    exit;
  Memo1.Lines.Add(S);
  Command := ParseCommandString(S, '#');
  if Command[0] = 'camresol' then
  begin
    CamShotParams := Command;
    Msg.Msg := M_LAUNCH_CAMERA;
    Dispatch(Msg);
  end;
end;

The code properly works when I dispatch a message from a button OnClick event but when the message is dispatched from TIdTCPServer OnExecute the camera does not start and Caption := 'Video capture devices not available.' is run. Moreover, after this the camera does not initialize even from the Button OnClick event.

The code also does not work in case of direct calling of

VideoCamera := TCaptureDeviceManager.Current.DefaultVideoCaptureDevice;
if VideoCamera <> nil then
  begin 
    VideoCamera.OnSampleBufferReady := CameraReady;
    VideoCamera.StartCapture;
  end;

from within Server OnExecute event. Though it works fine when run from the Button OnClick. Using of TCameraComponent cause the same problems. This issue could be reolved if camera initialization is handled in Form OnCreate event but this is not suitable as simultaneous usage of camera is not allowed by two or more applications.

Answer 1

It seems, capture device should be initialized and manipulated from the main thread. Try to wrap capture manipulating in TThread.Synchronize class procedure, smth like this:

procedure TMyForm.IdTCPServer1Execute(AContext: TIdContext);
...
begin
...
TThread.Synchronize(nil,
  procedure
  begin
    DoSmthWithCamera();
  end;
);
...
end;

Answer 2

The reason why initializing the camera from TIdTCPServer.OnExecute does not work is because the code in the OnExecute event method is by default executed in separate a thread. So you are facing the common problems of accessing VCL in multithreading applications.

You should make sure that your camera initialization and also finalization code is executed from main thread via Synchronization.

Answer 3

The code works properly if to call dispatch in the following way:

procedure TCamSF1.IdTCPServer1Execute(AContext: TIdContext);
var
  Command: TAnsiStrings;
  Msg: TMessage;
begin
  ... 
  if ... then
  begin
    TThread.Synchronize(TThread.CurrentThread, (
      procedure
      begin
        Counter := 0;
        CamShotParams := Command;
        Msg.Msg := M_LAUNCH_CAMERA;
        Dispatch(Msg)
      end));
  end;
end;

Answer 4

Thank you for your help, my special gratitude to @whosrdaddy, @SilverWarior and @Sergey-Krasilnikov. I have found a way out though it does not seem nice. I decided to use a TTimer. It has the following OnTimer event.

procedure TCamSF1.Timer1Timer(Sender: TObject);
begin
  if IdTCPServer1.Contexts.IsCountLessThan(1) then
  begin
    if (CameraComponent <> nil) and (CameraComponent.Active) then
      CameraComponent.Active := false;
    if CameraComponent <> nil then
    begin
      CameraComponent.Destroy;
      CameraComponent.FreeOnRelease;
      CameraComponent := nil;
    end;
  end
  else
  begin
    if CameraComponent = nil then
    begin
      CameraComponent := TCameraComponent.Create(Self);
      CameraComponent.OnSampleBufferReady := CameraComponentReady;
    end;
    CameraComponent.Active := true;
  end;
end;

So I managed to swich the camera on/off by means of connecting/disconnecting the client. Should you find a better solution, please, kindly let me know.