Delphi XE3双摄像头DirectX多线程访问：画面重复显示问题

你遇到的重复显示最后摄像头画面的问题，核心原因有以下几点：

1. 线程不安全的控件访问：在线程的Execute方法中直接读取主窗体ComboBox的选中值，VCL控件仅允许在主线程访问，跨线程读取可能导致两个线程获取到相同的摄像头名称。
2. 资源未正确隔离与释放：原线程类未规范处理COM资源（CoUninitialize）和视频对象的释放，可能引发DirectShow组件的全局状态冲突。
3. 冗余的线程类设计：两个线程类逻辑高度重复，增加了代码维护成本和潜在的状态干扰风险。

1. 线程与主窗体解耦 #

创建线程时直接传入选中的摄像头名称和目标显示控件，避免在线程内访问主窗体控件。

2. 规范线程资源管理 #

• 每个线程独立初始化/释放COM环境
• 在线程销毁时停止视频采集并释放相关对象

3. 合并通用线程类 #

将两个摄像头线程合并为一个通用类，减少重复代码并确保逻辑一致性

通用摄像头线程类 #

type
  TCamThread = class(TThread)
  private
    fVideoImage: TVideoImage;
    fVideoBitmap: TBitmap;
    fTargetImage: TImage;
    fCamName: string;
    procedure OnNewVideoFrame(Sender: TObject; Width, Height: Integer; DataPtr: Pointer);
  protected
    procedure Execute; override;
  public
    constructor Create(const CamName: string; TargetImage: TImage);
    destructor Destroy; override;
  end;

constructor TCamThread.Create(const CamName: string; TargetImage: TImage);
begin
  inherited Create(True);
  fCamName := CamName;
  fTargetImage := TargetImage;
  fVideoBitmap := TBitmap.Create;
  fVideoImage := TVideoImage.Create;
  fVideoImage.OnNewVideoFrame := OnNewVideoFrame;
  FreeOnTerminate := True; // 线程结束自动释放资源
end;

destructor TCamThread.Destroy;
begin
  fVideoImage.VideoStop;
  fVideoImage.Free;
  fVideoBitmap.Free;
  inherited;
end;

procedure TCamThread.Execute;
begin
  CoInitialize(nil);
  try
    fVideoImage.VideoStart(fCamName);
    while not Terminated do
      Sleep(10); // 保持线程存活，等待终止信号
  finally
    CoUninitialize;
  end;
end;

procedure TCamThread.OnNewVideoFrame(Sender: TObject; Width, Height: Integer; DataPtr: Pointer);
begin
  fVideoImage.GetBitmap(fVideoBitmap);
  // 同步到主线程更新UI
  Synchronize(procedure
    begin
      fTargetImage.Picture.Bitmap.Assign(fVideoBitmap);
    end);
end;

主窗体调用代码 #

// 启动摄像头A
procedure TMainForm.btnStartAClick(Sender: TObject);
var
  CamName: string;
begin
  if ComboBox1.ItemIndex >= 0 then
  begin
    CamName := ComboBox1.Items[ComboBox1.ItemIndex];
    TCamThread.Create(CamName, Image1).Start;
  end;
end;

// 启动摄像头B
procedure TMainForm.btnStartBClick(Sender: TObject);
var
  CamName: string;
begin
  if ComboBox2.ItemIndex >= 0 then
  begin
    CamName := ComboBox2.Items[ComboBox2.ItemIndex];
    TCamThread.Create(CamName, Image2).Start;
  end;
end;

额外检查项 #

如果修改后仍存在画面重复问题，需排查VFrames.pas中TVideoImage的实现：

• 确认是否存在全局共享的DirectShow组件（如IGraphBuilder），若有需改为每个实例独立创建
• 检查VideoStart方法是否正确处理了不同设备的初始化逻辑

内容的提问来源于stack exchange，提问作者Pablo Constantino