Delphi USBCamera DirectShow 预览录像截图

参照：https://www.haolizi.net/example/view_37332.html

实例介绍

【实例简介】用DirectShow 的方式，视频输入设备枚举、视频支持格式枚举、视频预览、视频录像、视频截图。Delphi 源代码

【实例截图】

 

 【核心代码】

unit untUSBCamera;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, DirectShow9, ActiveX, Dialogs, StdCtrls, ExtCtrls;

type
  PVideoInputInfo  = ^TVideoInputInfo;
  PVideoFormatInfo = ^TVideoFormatInfo;

  { 视频输入设备 }
  TVideoInputInfo = record
    id: TGUID;
    strName: ShortString;
    index: Integer;
  end;

  { 视频支持格式 }
  TVideoFormatInfo = record
    id: TGUID;
    iWidth, iHeight: Integer;
    iMod: TGUID;
    Frame: Int64;
    format: ShortString;
  end;

type
  IAMStreamConfig = interface(IUnknown)
    ['{C6E13340-30AC-11d0-A18C-00A0C9118956}']
    function SetFormat(const pmt: TAMMediaType): HResult; stdcall;
    function GetFormat(out ppmt: PAMMediaType): HResult; stdcall;
    function GetNumberOfCapabilities(out piCount, piSize: Integer): HResult; stdcall;
    { Delphi 声明有误，修改声明 }
    function GetStreamCaps(iIndex: Integer; var ppmt: PAMMediaType; pSCC: PVideoStreamConfigCaps): HResult; stdcall;
  end;

  ISampleGrabber = interface(IUnknown)
    ['{6B652FFF-11FE-4FCE-92AD-0266B5D7C78F}']
    function SetOneShot(OneShot: BOOL): HResult; stdcall;
    { Delphi 声明有误，修改声明 }
    function SetMediaType(pType: PAMMediaType): HResult; stdcall;
    function GetConnectedMediaType(out pType: TAMMediaType): HResult; stdcall;
    function SetBufferSamples(BufferThem: BOOL): HResult; stdcall;
    function GetCurrentBuffer(var pBufferSize: longint; pBuffer: Pointer): HResult; stdcall;
    function GetCurrentSample(out ppSample: IMediaSample): HResult; stdcall;
    function SetCallback(pCallback: ISampleGrabberCB; WhichMethodToCallback: longint): HResult; stdcall;
  end;

  { 枚举所有视频输入设备 }
procedure EnumAllUSBCamera(strsList: TStrings);

{ 枚举视频支持格式 }
function EnumVideoFormat(const strFriendlyName: String; const intIndex: Integer; strsList: TStrings): Boolean;

{ 视频预览 }
function USBVideoPreview(var FIGraphBuilder: IGraphBuilder; var FICaptureGraphBuilder2: ICaptureGraphBuilder2; var FSysDevEnum: IBaseFilter; var FIVideoWindow: IVideoWindow; var FIMediaControl: IMediaControl; var FISampleGrabber: ISampleGrabber; pv: PVideoInputInfo; pf: PVideoFormatInfo; pnl: TPanel; const bSnapBmp: Boolean = False): Boolean;

{ 视频录制 }
function USBVideoRecord(var FIGraphBuilder: IGraphBuilder; var FICaptureGraphBuilder2: ICaptureGraphBuilder2; var FSysDevEnum: IBaseFilter; var FIVideoWindow: IVideoWindow; var FIMediaControl: IMediaControl; var FISampleGrabber: ISampleGrabber; pv: PVideoInputInfo; pf: PVideoFormatInfo; pnl: TPanel; const strSaveFileName: String): Boolean;

implementation

const
  IID_IPropertyBag: TGUID = '{55272A00-42CB-11CE-8135-00AA004BB851}';

  c_arrVideoFormatGUID: array [0 .. 35] of PGUID = (                                                                                 //
    @MEDIASUBTYPE_CLPL, @MEDIASUBTYPE_YUYV, @MEDIASUBTYPE_IYUV, @MEDIASUBTYPE_YVU9, @MEDIASUBTYPE_Y411, @MEDIASUBTYPE_Y41P,          //
    @MEDIASUBTYPE_YUY2, @MEDIASUBTYPE_YVYU, @MEDIASUBTYPE_UYVY, @MEDIASUBTYPE_Y211, @MEDIASUBTYPE_YV12, @MEDIASUBTYPE_CLJR,          //
    @MEDIASUBTYPE_IF09, @MEDIASUBTYPE_CPLA, @MEDIASUBTYPE_MJPG, @MEDIASUBTYPE_TVMJ, @MEDIASUBTYPE_WAKE, @MEDIASUBTYPE_CFCC,          //
    @MEDIASUBTYPE_IJPG, @MEDIASUBTYPE_Plum, @MEDIASUBTYPE_DVCS, @MEDIASUBTYPE_DVSD, @MEDIASUBTYPE_MDVF, @MEDIASUBTYPE_RGB1,          //
    @MEDIASUBTYPE_RGB4, @MEDIASUBTYPE_RGB8, @MEDIASUBTYPE_RGB565, @MEDIASUBTYPE_RGB555, @MEDIASUBTYPE_RGB24, @MEDIASUBTYPE_RGB32,    //
    @MEDIASUBTYPE_ARGB1555, @MEDIASUBTYPE_ARGB4444, @MEDIASUBTYPE_ARGB32, @MEDIASUBTYPE_AYUV, @MEDIASUBTYPE_AI44, @MEDIASUBTYPE_IA44 //
    );

  c_arrVideoFormatName: array [0 .. 35] of AnsiString = (    //
    'CLPL', 'YUYV', 'IYUV', 'YVU9', 'Y411', 'Y41P',          //
    'YUY2', 'YVYU', 'UYVY', 'Y211', 'YV12', 'CLJR',          //
    'IF09', 'CPLA', 'MJPG', 'TVMJ', 'WAKE', 'CFCC',          //
    'IJPG', 'Plum', 'DVCS', 'DVSD', 'MDVF', 'RGB1',          //
    'RGB4', 'RGB8', 'RGB565', 'RGB555', 'RGB24', 'RGB32',    //
    'ARGB1555', 'ARGB4444', 'ARGB32', 'AYUV', 'AI44', 'IA44' //
    );

function GetMaxIndex(const strsList: TStrings; const strUSBCameraName: string): Integer;
var
  III, Count: Integer;
begin
  Result  := 0;
  Count   := strsList.Count;
  for III := 0 to Count - 1 do
  begin
    if CompareText(String(PVideoInputInfo(strsList.Objects[III])^.strName), strUSBCameraName) = 0 then
    begin
      Result := Result   1;
    end;
  end;
end;

function CreateFilter(gid: TGUID; FriendlyName: AnsiString; instanceIndex: Integer): IBaseFilter;
var
  pSysDevEnum: ICreateDevEnum;
  pEnumCat   : IEnumMoniker;
  pMoniker   : IMoniker;
  cFetched   : ULONG;
  pPropBag   : IPropertyBag;
  bc         : IBindCtx;
  mo         : IMoniker;
  er         : IErrorLog;
  ov         : OleVariant;
  iIndex     : Integer;
begin
  Result := nil;

  pSysDevEnum := nil;
  pEnumCat    := nil;
  pMoniker    := nil;

  if CocreateInstance(CLSID_SystemDeviceEnum, nil, CLSCTX_INPROC, IID_ICreateDevEnum, pSysDevEnum) = S_OK then
  begin
    if pSysDevEnum.CreateClassEnumerator(gid, pEnumCat, 0) = S_OK then
    begin
      iIndex := 0;
      while (pEnumCat.Next(1, pMoniker, @cFetched) = S_OK) and (cFetched > 0) and (pMoniker <> nil) do
      begin
        bc := nil;
        mo := nil;
        pMoniker.BindToStorage(bc, mo, IID_IPropertyBag, pPropBag);
        er := nil;
        pPropBag.Read('FriendlyName', ov, er);
        if AnsiString(ov) = FriendlyName then
        begin
          if iIndex = instanceIndex then
          begin
            bc := nil;
            mo := nil;
            pMoniker.BindToObject(bc, mo, IID_IBaseFilter, Result);
          end;
          Inc(iIndex);
        end;
        pPropBag := nil;
        pMoniker := nil;
      end;
    end;
  end;
  pEnumCat    := nil;
  pSysDevEnum := nil;
end;

function VideoMediaSubTypeToStr(mst: TGUID): AnsiString;
var
  I: Integer;
begin
  Result := '';
  for I  := 0 to 35 do
    if CompareMem(c_arrVideoFormatGUID[I], @mst, sizeof(TGUID)) then
    begin
      Result := c_arrVideoFormatName[I];
      break;
    end;
end;

procedure FreeMediaType(mt: TAMMediaType);
begin
  if (mt.cbFormat <> 0) then
  begin
    CoTaskMemFree(mt.pbFormat);
    mt.cbFormat := 0;
    mt.pbFormat := nil;
  end;
  if (mt.pUnk <> nil) then
  begin
    mt.pUnk := nil;
  end;
end;

procedure DeleteMediaType(pmt: PAMMediaType);
begin
  if pmt <> nil then
  begin
    FreeMediaType(pmt^);
    CoTaskMemFree(pmt);
  end;
end;

function GetOutputPin(filter: IBaseFilter): IPin;
var
  penum: IEnumPins;
  f    : Integer;
  d    : PIN_DIRECTION;
begin
  Result := nil;
  filter.EnumPins(penum);
  while (penum.Next(1, Result, @f) = S_OK) and (f > 0) do
  begin
    if (Result.QueryDirection(d) = S_OK) and (d = PINDIR_OUTPUT) then
    begin
      { 找到输出接口，返回 }
      Exit;
    end;
  end;
  Result := nil;
end;

function StrToVideoMediaSubType(ss: AnsiString): TGUID;
var
  I: Integer;
begin
  Result := c_arrVideoFormatGUID[0]^;
  for I  := 0 to 35 do
    if ss = c_arrVideoFormatName[I] then
    begin
      Result := c_arrVideoFormatGUID[I]^;
      break;
    end;
end;

function CompareGUID(const g1, g2: TGUID): Boolean;
begin
  Result := CompareMem(@g1, @g2, sizeof(TGUID));
end;

function SetMediaType(filter: IBaseFilter; Width, Height: Integer; format: AnsiString): Boolean;
var
  pmt            : PAMMediaType;
  piCount, piSize: Integer;
  I              : Integer;
  pSCC           : PVideoStreamConfigCaps;
  streamConfig   : IAMStreamConfig;
  outPin         : IPin;
  formatID       : TGUID;
  selectedIndex  : Integer;
  ih             : PVIDEOINFOHEADER;
  bitRate        : dword;
begin
  Result := False;

  if (Width = 0) or (Height = 0) then
    Exit;

  outPin := GetOutputPin(filter);
  outPin.QueryInterface(IID_IAMStreamConfig, streamConfig);
  if assigned(streamConfig) then
  begin
    selectedIndex := -1;
    bitRate       := 0;
    formatID      := StrToVideoMediaSubType(format);
    streamConfig.GetNumberOfCapabilities(piCount, piSize);
    getmem(pSCC, piSize);
    try
      for I := 0 to piCount - 1 do
      begin
        streamConfig.GetStreamCaps(I, pmt, pSCC);
        ih := Pointer(pmt^.pbFormat);
        if (pSCC^.MinOutputSize.cx = Width) and (pSCC^.MinOutputSize.cy = Height) and (ih^.bmiHeader.biWidth = Width) and (ih^.bmiHeader.biheight = Height) and ((format = '') or (CompareGUID(formatID, pmt^.subtype))) and (ih^.dwBitRate > bitRate) // select format with maximum bitrate
        then
        begin
          selectedIndex := I;
          bitRate       := ih^.dwBitRate;
        end;
        DeleteMediaType(pmt);
      end;
      if selectedIndex > -1 then
      begin
        streamConfig.GetStreamCaps(selectedIndex, pmt, pSCC);
        try
          streamConfig.SetFormat(pmt^);
        finally
          DeleteMediaType(pmt);
        end;
      end;
    finally
      FreeMem(pSCC);
    end;
  end;
  Result := True;
end;

{ 枚举所有视频输入设备 }
procedure EnumAllUSBCamera(strsList: TStrings);
var
  SysDevEnum: ICreateDevEnum;
  EnumCat   : IEnumMoniker;
  hr        : Integer;
  Moniker   : IMoniker;
  Fetched   : ULONG;
  PropBag   : IPropertyBag;
  strName   : OleVariant;
  strGuid   : OleVariant;
  III       : Integer;
  puInfo    : PVideoInputInfo;
  intIndex  : Integer;
begin
  { 创建系统枚举器对象 }
  hr := CocreateInstance(CLSID_SystemDeviceEnum, nil, CLSCTX_INPROC, IID_ICreateDevEnum, SysDevEnum);
  if hr <> S_OK then
    Exit;

  { 用指定的 Filter 目录类型创建一个枚举器，并获得 IEnumMoniker 接口； }
  hr := SysDevEnum.CreateClassEnumerator(CLSID_VideoInputDeviceCategory, EnumCat, 0);
  if hr <> S_OK then
    Exit;

  try
    { 释放内存 }
    if strsList.Count > 0 then
    begin
      for III := 0 to strsList.Count - 1 do
      begin
        FreeMem(PVideoFormatInfo(strsList.Objects[III]));
      end;
    end;
    strsList.Clear;

    { 获取指定类型目录下所有设备标识 }
    while (EnumCat.Next(1, Moniker, @Fetched) = S_OK) do
    begin
      Moniker.BindToStorage(nil, nil, IID_IPropertyBag, PropBag);
      PropBag.Read('CLSID', strGuid, nil);
      PropBag.Read('FriendlyName', strName, nil);
      New(puInfo);
      puInfo^.id      := TGUID(strGuid);
      puInfo^.strName := ShortString(strName);
      puInfo^.index   := 0;
      if strsList.IndexOf(strName) = -1 then
      begin
        strsList.AddObject(strName, TObject(puInfo));
      end
      else
      begin
        { 相同名称的 USBCamera 相机，<有可能有多个名称重复的相机> }
        intIndex      := GetMaxIndex(strsList, strName);
        puInfo^.index := intIndex   1;
        strsList.AddObject(strName   format('(%d)', [puInfo^.index]), TObject(puInfo));
      end;
      PropBag := nil;
      Moniker := nil;
    end;

  finally
    EnumCat    := nil;
    SysDevEnum := nil;
  end;
end;

{ 枚举视频支持格式 }
function EnumVideoFormat(const strFriendlyName: String; const intIndex: Integer; strsList: TStrings): Boolean;
var
  SysDevEnum          : IBaseFilter;
  CaptureGraphBuilder2: ICaptureGraphBuilder2;
  iunk                : IUnknown;
  fStreamConfig       : IAMStreamConfig;
  piCount, piSize     : Integer;
  III                 : Integer;
  pmt                 : PAMMediaType;
  pSCC                : PVideoStreamConfigCaps;
  pvInfo              : PVideoFormatInfo;
begin
  Result := False;

  { 获取指定USB摄像头的 Filter }
  SysDevEnum := CreateFilter(CLSID_VideoInputDeviceCategory, AnsiString(strFriendlyName), intIndex);
  if SysDevEnum = nil then
    Exit;

  { 释放内存 }
  if strsList.Count > 0 then
  begin
    for III := 0 to strsList.Count - 1 do
    begin
      FreeMem(PVideoFormatInfo(strsList.Objects[III]));
    end;
  end;
  strsList.Clear;

  { 创建 ICaptureGraphBuilder2 接口 }
  if Failed(CocreateInstance(CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC, IID_ICaptureGraphBuilder2, CaptureGraphBuilder2)) then
    Exit;

  { 获取 IID_IAMStreamConfig 接口 }
  if Failed(CaptureGraphBuilder2.FindInterface(nil, nil, SysDevEnum, IID_IAMStreamConfig, iunk)) then
    Exit;

  { 获取 IAMStreamConfig 媒体类型接口 }
  if Failed(iunk.QueryInterface(IID_IAMStreamConfig, fStreamConfig)) then
    Exit;

  if Failed(fStreamConfig.GetNumberOfCapabilities(piCount, piSize)) then
    Exit;

  if piCount <= 0 then
    Exit;

  { 枚举支持的视频格式 }
  pSCC := AllocMem(piSize);
  try
    for III := 0 to piCount - 1 do
    begin
      if fStreamConfig.GetStreamCaps(III, pmt, pSCC) = S_OK then
      begin
        try
          New(pvInfo); { 注意释放内存 }
          pvInfo^.Frame   := PVIDEOINFOHEADER(pmt^.pbFormat)^.AvgTimePerFrame;
          pvInfo^.id      := pmt^.formattype;
          pvInfo^.iWidth  := pSCC^.MaxOutputSize.cx;
          pvInfo^.iHeight := pSCC^.MaxOutputSize.cy;
          pvInfo^.iMod    := pmt^.subtype;
          pvInfo^.format  := VideoMediaSubTypeToStr(pmt^.subtype);
          strsList.AddObject(format('类型：%s  分辨率：%4d×%4d', [pvInfo^.format, pvInfo^.iWidth, pvInfo^.iHeight]), TObject(pvInfo));
        finally
          DeleteMediaType(pmt);
        end;
      end;
    end;
  finally
    FreeMem(pSCC);
  end;

  SysDevEnum           := nil;
  CaptureGraphBuilder2 := nil;
  fStreamConfig        := nil;

  Result := True;
end;

function CommonVideo(var FIGraphBuilder: IGraphBuilder;               //
  var FICaptureGraphBuilder2: ICaptureGraphBuilder2;                  //
  var FSysDevEnum: IBaseFilter;                                       //
  var FIVideoWindow: IVideoWindow;                                    //
  var FIMediaControl: IMediaControl;                                  //
  var FISampleGrabber: ISampleGrabber;                                //
  pv: PVideoInputInfo; pf: PVideoFormatInfo;                          //
  pnl: TPanel;                                                        //
  const strSaveFileName: string = ''; const bRecord: Boolean = False; // 录像
  const bSnapBmp: Boolean = False                                     // 截图
  ): Boolean;
var
  SampleGrabberFilter: IBaseFilter;
  mt                 : TAMMediaType;
  multiplexer        : IBaseFilter;
  Writer             : IFileSinkFilter;
begin
  Result := False;

  { 创建 IGraphBuilder 接口 }
  if Failed(CocreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC, IID_IGraphBuilder, FIGraphBuilder)) then
    Exit;

  { 创建 ICaptureGraphBuilder2 接口 }
  if Failed(CocreateInstance(CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC, IID_ICaptureGraphBuilder2, FICaptureGraphBuilder2)) then
    Exit;

  { 调用 ICaptureGraphBuilder2 的 SetFilterGraph 方法将 FilterGraph 加入到Builder中 }
  if Failed(FICaptureGraphBuilder2.SetFiltergraph(FIGraphBuilder)) then
    Exit;

  { 获取指定USB摄像头的 Filter }
  FSysDevEnum := CreateFilter(CLSID_VideoInputDeviceCategory, AnsiString(pv^.strName), pv^.index);
  if FSysDevEnum = nil then
    Exit;

  { 设置指定 Filter 的媒体格式类型 }
  if not SetMediaType(FSysDevEnum, pf^.iWidth, pf^.iHeight, pf^.format) then
    Exit;

  { 将视频捕捉 Filter 添加到 Filter 图中 }
  if Failed(FIGraphBuilder.AddFilter(FSysDevEnum, 'VideoCapture')) then
    Exit;

  { 如果需要截图功能 }
  if bSnapBmp then
  begin
    CocreateInstance(CLSID_SampleGrabber, nil, CLSCTX_INPROC, IID_IBaseFilter, SampleGrabberFilter);
    FIGraphBuilder.AddFilter(SampleGrabberFilter, 'SampleGrabber');
    SampleGrabberFilter.QueryInterface(IID_ISampleGrabber, FISampleGrabber);
    zeromemory(@mt, sizeof(AM_MEDIA_TYPE));
    mt.majortype := MEDIATYPE_Video;
    mt.subtype   := MEDIASUBTYPE_RGB24;     // 24位，位图格式输出
    FISampleGrabber.SetMediaType(@mt);      //
    FISampleGrabber.SetBufferSamples(True); // 允许从 Buffer 中获取数据
    { 渲染预览视频PIN }
    if Failed(FICaptureGraphBuilder2.RenderStream(@PIN_CATEGORY_PREVIEW, @MEDIATYPE_Video, FSysDevEnum, SampleGrabberFilter, nil)) then
      Exit;
  end
  else
  begin
    { 渲染预览视频PIN }
    if Failed(FICaptureGraphBuilder2.RenderStream(@PIN_CATEGORY_PREVIEW, @MEDIATYPE_Video, FSysDevEnum, nil, nil)) then
      Exit;
  end;

  { 如果是视频录制 }
  if bRecord then
  begin
    { 视频录制文件保持路径 }
    if Failed(FICaptureGraphBuilder2.SetOutputFileName(MEDIASUBTYPE_Avi, PWideChar(strSaveFileName), multiplexer, Writer)) then
      Exit;

    if Failed(FICaptureGraphBuilder2.RenderStream(@PIN_CATEGORY_CAPTURE, @MEDIATYPE_Video, FSysDevEnum, nil, multiplexer)) then
      Exit;
  end;

  { 设置视频预览窗口 }
  if Failed(FIGraphBuilder.QueryInterface(IID_IVideoWindow, FIVideoWindow)) then
    Exit;

  { 设置视频播放的WINDOWS窗口 }
  if Failed(FIVideoWindow.put_Owner(pnl.Handle)) then
    Exit;

  if Failed(FIVideoWindow.put_windowstyle(WS_CHILD or WS_Clipsiblings)) then
    Exit;

  { 设置视频尺寸 }
  if Failed(FIVideoWindow.SetWindowposition(0, 0, pnl.Width, pnl.Height)) then
    Exit;

  { 得到IMediaControl接口，用于控制流播放 }
  if Failed(FIGraphBuilder.QueryInterface(IID_IMediaControl, FIMediaControl)) then
    Exit;

  Result := True;
end;

{ 视频预览 }
function USBVideoPreview(var FIGraphBuilder: IGraphBuilder; var FICaptureGraphBuilder2: ICaptureGraphBuilder2; var FSysDevEnum: IBaseFilter; var FIVideoWindow: IVideoWindow; var FIMediaControl: IMediaControl; var FISampleGrabber: ISampleGrabber; pv: PVideoInputInfo; pf: PVideoFormatInfo; pnl: TPanel; const bSnapBmp: Boolean = False): Boolean;
begin
  Result := CommonVideo(FIGraphBuilder, FICaptureGraphBuilder2, FSysDevEnum, FIVideoWindow, FIMediaControl, FISampleGrabber, pv, pf, pnl, '', False, True);
end;

{ 视频录制 }
function USBVideoRecord(var FIGraphBuilder: IGraphBuilder; var FICaptureGraphBuilder2: ICaptureGraphBuilder2; var FSysDevEnum: IBaseFilter; var FIVideoWindow: IVideoWindow; var FIMediaControl: IMediaControl; var FISampleGrabber: ISampleGrabber; pv: PVideoInputInfo; pf: PVideoFormatInfo; pnl: TPanel; const strSaveFileName: String): Boolean;
begin
  Result := CommonVideo(FIGraphBuilder, FICaptureGraphBuilder2, FSysDevEnum, FIVideoWindow, FIMediaControl, FISampleGrabber, pv, pf, pnl, strSaveFileName, True, True);
end;

end.