TCameraComponent 和 TVideoCaptureDevice 不在 Win32 中初始化

Question

我使用标准代码初始化 TVideoCaptureDevice 并开始捕获。

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;

当我从按钮 OnClick 事件发送消息时代码正常工作，但是当从 TIdTCPServer OnExecute 发送消息时，相机不会启动并且 Caption := 'Video capture devices not available.' 是运行。此外，此后相机甚至不会从 Button OnClick 事件初始化。

如果直接调用

，代码也不起作用

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

来自 Server OnExecute 事件。虽然当运行来自 Button OnClick 时它工作正常。使用 TCameraComponent 会导致同样的问题。如果在 Form OnCreate 事件中处理相机初始化，则可以解决此问题，但这不适合，因为两个或多个应用程序不允许同时使用相机。

Answer 1

看来，捕获设备应该从主线程初始化和操作。尝试在 TThread.Synchronize class 过程中包装捕获操作，如下所示：

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

Answer 2

为什么从TIdTCPServer.OnExecute初始化相机不起作用是因为OnExecute事件方法中的代码默认在单独的线程中执行。所以你遇到了在多线程应用程序中访问VCL的常见问题。

您应该确保您的相机初始化和完成代码是通过同步从主线程执行的。

Answer 3

感谢您的帮助，特别感谢@whosrdaddy、@SilverWarior 和@Sergey-Krasilnikov。我找到了出路，虽然它看起来不太好。我决定使用 TTimer。它有以下 OnTimer 事件。

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;

所以我设法通过 connecting/disconnecting 客户端切换相机 on/off。如果您找到更好的解决方案，请告诉我。

Answer 4

如果按以下方式调用调度，代码将正常工作：

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;

TCameraComponent 和 TVideoCaptureDevice 不在 Win32 中初始化

TCameraComponent and TVideoCaptureDevice do not initialize in Win32

delphi

firemonkey

indy