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;

从服务器OnExecute事件中

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

Answer 1

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

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

Answer 2

从T IdTCPServer.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;

所以我设法通过连接/断开客户端来打开/关闭相机。如果您找到更好的解决方案，请告诉我。

Answer 4

如果以下列方式调用dispatch，代码可以正常工作：

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中初始化

4 个答案: