Delphi USB摄像头

游厚满 發表於 2021-1-26 18:56:00

参考：https://blog.csdn.net/qq_44111597/article/details/112787624
RAD Studio 10.2.3 测试√
<hr>
 
<div class="toc">
<h3>目录</h3>
<ul>
<li>
<ul>
<li>声明：</li>
<li>1.展示设备</li>
<li>2.展示格式</li>
<li>3.打开预览</li>
<li>4.保存图片至本地</li>
<li>5.色彩选择和通道选项</li>
<li>附件：untUSBCamera单元文件</li>
</ul>
</li>
</ul>
<img src="https://img2020.cnblogs.com/blog/1107379/202101/1107379-20210126185234789-1584625483.png" alt="" loading="lazy">
<h2>声明：</h2>
<div class="cnblogs_code">
<pre>uses
DirectShow9, untUSBCamera, Winapi.ActiveX

private
{ Private declarations }
// 系统开发人员枚举【基本 Filter】
 mBaseFilter : IBaseFilter;
// FI图形生成器【图形生成器】
 mGraphBuilder : IGraphBuilder;
// FI媒体控制【媒体控制】
 mMediaControl : IMediaControl;
// FI视频窗口【视频窗口】
 mVideoWindow : IVideoWindow;
// FI捕获图生成器2【捕获图生成器2】
 mCaptureGraphBuilder2: ICaptureGraphBuilder2;
// FI样品采集器【样品采集器】
 mSampleGrabber : ISampleGrabber;
procedure FreeGraph;
procedure mSnapBmp;
function ShowFilterPropertyPages(filter: IBaseFilter; hFormHandle: THandle): Boolean;
function ShowPinPropertyPages(pin: IPin; hFormHandle: THandle): Boolean;</pre>
</div>
<div class="cnblogs_code">
<pre>// 视频预览变量初始化
procedure TForm1.FreeGraph;
begin
mBaseFilter := nil;
mGraphBuilder := nil;
mMediaControl := nil;
mVideoWindow := nil;
mCaptureGraphBuilder2 := nil;
mSampleGrabber := nil;
end;

// 截图 -- 保存
procedure TForm1.mSnapBmp;
var
pfs : TFilterState;
mt : TAMMediaType;
hr : HResult;
pBufferSize: Integer;
pBuffer : PByte;
bmp : TBitmap;
vi : PVideoInfoHeader;
begin
if mMediaControl = nil then
Exit;

// FI媒体控制.获取状态（时间，Filter状态）
mMediaControl.GetState(1000, pfs);
if pfs = State_Stopped then
Exit;

{ 获取媒体类型 }
// = 样品采集器.获取连接的媒体类型（媒体类型）
hr := mSampleGrabber.GetConnectedMediaType(mt);
if hr <> S_OK then
Exit;

// 如果媒体类型.格式 = nil
if mt.pbFormat = nil then
Exit;

// = 视频信息标题（媒体类型.格式）
vi := PVideoInfoHeader(mt.pbFormat);

{ 获取当前帧数据大小 }
// = 样品采集器.获取当前缓冲区（p缓冲区大小，nil）
hr := mSampleGrabber.GetCurrentBuffer(pBufferSize, nil);
if hr <> S_OK then
Exit;

{ 分配内存大小 }
pBuffer := AllocMem(pBufferSize);
try
{ 再一次获取当前帧，获取图像数据 }
hr := mSampleGrabber.GetCurrentBuffer(pBufferSize, pBuffer);
if hr <> S_OK then
 Exit;

{ 创建位图 }
bmp := TBitmap.Create;
try
 // bmp.像素格式 =
 bmp.PixelFormat := pf24bit;
 bmp.width := vi^.bmiHeader.biWidth;
 bmp.height := vi^.bmiHeader.biHeight;
 SetBitmapBits(bmp.Handle, vi^.bmiHeader.biSizeImage, pBuffer);
 bmp.Canvas.CopyRect(bmp.Canvas.ClipRect, bmp.Canvas, Rect(0, bmp.height, bmp.width, 0));
 // 把位图信息放在img控件中
 bmp.SaveToFile(ExtractFilePath(Paramstr(0)) + 'Temp\' + FormatDateTime('YYYYMMDDhhmmss', Now()) + '.jpg');
finally
 bmp.Free;
end;
finally
FreeMem(pBuffer);
end;
end;

// 显示 Filter 属性页【调用 Filter 的属性页，窗口的 Windows 本身的】
function TForm1.ShowFilterPropertyPages(filter: IBaseFilter; hFormHandle: THandle): Boolean;
var
// 指定属性页
pSpecify: ISpecifyPropertyPages;
// 全局唯一标识符
caGUID: TCAGUID;
begin
Result := False;
pSpecify := nil;
filter.QueryInterface(ISpecifyPropertyPages, pSpecify);
if pSpecify <> nil then
begin
// 指定属性页.获取页面（全局唯一标识符）
 pSpecify.GetPages(caGUID);
pSpecify := nil;
Result := OleCreatePropertyFrame(hFormHandle, 0, 0, '', 1, Pointer(@filter), caGUID.cElems, PGUID(caGUID.pElems), 0, 0, nil) = S_OK;
CoTaskMemFree(caGUID.pElems);
end;
end;

function TForm1.ShowPinPropertyPages(pin: IPin; hFormHandle: THandle): Boolean;
var
// 指定属性页
pSpecify: ISpecifyPropertyPages;
// 全局唯一标识符
caGUID: TCAGUID;
begin
Result := False;
pSpecify := nil;
// Filter.查询接口（类型，值【指定属性页】）
pin.QueryInterface(ISpecifyPropertyPages, pSpecify);
if pSpecify <> nil then
begin
// 指定属性页.获取页面（全局唯一标识符）
 pSpecify.GetPages(caGUID);
pSpecify := nil;
Result := OleCreatePropertyFrame(hFormHandle, 0, 0, '', 1, Pointer(@pin), caGUID.cElems, PGUID(caGUID.pElems), 0, 0, nil) = S_OK;
CoTaskMemFree(caGUID.pElems);
end;
end;</pre>
</div>
<h2>1.展示设备</h2>
<div class="cnblogs_code">
<pre>begin
{ 视频预览变量初始化 }
FreeGraph;
// 获取所有USB摄像头，存入下面控件的列表中
EnumAllUSBCamera(ListBox3.Items);
end;</pre>
</div>
<h2>2.展示格式</h2>
<div class="cnblogs_code">
<pre>begin
if ListBox3.ItemIndex = -1 then
begin
ShowMessage('请选择设备！');
exit;
end;
{ 枚举视频支持格式 }
if not EnumVideoFormat(String(PVideoInputInfo(ListBox3.Items.Objects)^.strName), PVideoInputInfo(ListBox3.Items.Objects)^.index, ListBox4.Items) then
Exit;

ListBox4.ItemIndex := 0;
ListBox4.SetFocus;
end;</pre>
</div>
<h2>3.打开预览</h2>
<div class="cnblogs_code">
<pre>begin
if mMediaControl = nil then
begin
{ 视频预览 }
if USBVideoPreview(mGraphBuilder, mCaptureGraphBuilder2, mBaseFilter, mVideoWindow, mMediaControl, mSampleGrabber, PVideoInputInfo(ListBox3.Items.Objects), PVideoFormatInfo(ListBox4.Items.Objects), Panel1, True) then
begin
 Button14.Caption := '3.停止预览';
 mMediaControl.Run;
end;
end
else
begin
Button14.Caption := '3.打开预览';
mMediaControl.Stop;
FreeGraph;
end;
end;</pre>
</div>
<h2>4.保存图片至本地</h2>
<div class="cnblogs_code">
<pre>begin
mSnapBmp;
end;</pre>
</div>
<h2>5.色彩选择和通道选项</h2>
<div class="cnblogs_code">
<pre>// 色彩选择
begin
ShowFilterPropertyPages(mBaseFilter, Handle);
end;
// 通道选项
var
pin: IPin;
begin
mCaptureGraphBuilder2.FindPin(mBaseFilter, PINDIR_OUTPUT, nil, nil, False, 0, pin);
ShowPinPropertyPages(pin, Handle);
end;</pre>
</div>
<h2>附件：untUSBCamera单元文件</h2>
<div class="cnblogs_code">
<pre>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;

{ 枚举所有视频输入设备 }
/// <summary>
/// 枚举所有视频输入设备
/// </summary>
/// <param name="strsList">设备名称展示的存放地方</param>
procedure EnumAllUSBCamera(strsList: TStrings);

{ 枚举视频支持格式 }
/// <summary>
/// 枚举视频支持格式【遍历出支持的视频格式】
/// </summary>
/// <param name="strFriendlyName">传进来的设备名称</param>
/// <param name="intIndex">设备的下标序号</param>
/// <param name="strsList">格式展示的box</param>
/// <returns>布尔类型</returns>
function EnumVideoFormat(const strFriendlyName: String; const intIndex: Integer; strsList: TStrings): Boolean;

{ 视频预览 }
/// <summary>
/// 视频预览【USB视频预览】
/// </summary>
/// <param name="FIGraphBuilder">FI图形生成器</param>
/// <param name="FICaptureGraphBuilder2">FI捕获图生成器2</param>
/// <param name="FSysDevEnum">FSys开发枚举【mBaseFilter】</param>
/// <param name="FIVideoWindow">FI视频窗口</param>
/// <param name="FIMediaControl">FI媒体控制</param>
/// <param name="FISampleGrabber">FI样品采集器</param>
/// <param name="pv">P视频输入信息（USB摄像头.列表.对象）</param>
/// <param name="pf">P视频输入信息（USB摄像头支持格式.列表.对象）</param>
/// <param name="pnl">pnl视频【放视频的面板】</param>
/// <param name="bSnapBmp">是否需要截屏功能</param>
/// <returns>布尔类型</returns>
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 = True): Boolean;

{ 视频录制 }
/// <summary>
/// 视频录制【USB视频录制】
/// </summary>
/// <param name="FIGraphBuilder">FI图形生成器</param>
/// <param name="FICaptureGraphBuilder2">FI捕获图生成器</param>
/// <param name="FSysDevEnum">FSys开发枚举</param>
/// <param name="FIVideoWindow">FI视频窗口</param>
/// <param name="FIMediaControl">FI媒体控制</param>
/// <param name="FISampleGrabber">FI样品采集器</param>
/// <param name="pv">P视频输入信息（USB摄像头.列表.对象）</param>
/// <param name="pf">P视频输入信息（USB摄像头支持格式.列表.对象）</param>
/// <param name="pnl">pnl视频【放视频的面板】</param>
/// <param name="strSaveFileName">视频文件保存的位置</param>
/// <returns>布尔类型</returns>
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)^.strName), strUSBCameraName) = 0 then
begin
 Result := Result + 1;
end;
end;
end;

// 创建 Filter【Filter 实际上它不是物理摄像头，只是模拟摄像头设备可以采集图像】
/// <summary>
/// 创建 Filter【Filter 实际上它不是物理摄像头，只是模拟摄像头设备可以采集图像
/// </summary>
/// <param name="gid">全局唯一标识</param>
/// <param name="FriendlyName">摄像头名字</param>
/// <param name="instanceIndex">摄像头下标序号</param>
/// <returns>基本 Filter</returns>
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;

// 如果共同创建实例（） = 0
if CocreateInstance(CLSID_SystemDeviceEnum, nil, CLSCTX_INPROC, IID_ICreateDevEnum, pSysDevEnum) = S_OK then
begin
// 系统开发人员枚举.创建类枚举器（gid，枚举猫，0）
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, @mst, sizeof(TGUID)) then
begin
 Result := c_arrVideoFormatName;
 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;

// Str到视频媒体子类型（格式）
function StrToVideoMediaSubType(ss: AnsiString): TGUID;
var
I: Integer;
begin
Result := c_arrVideoFormatGUID[0]^;
for I:= 0 to 35 do
if ss = c_arrVideoFormatName then
begin
 Result := c_arrVideoFormatGUID^;
 break;
end;
end;

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

// 设置媒体类型（基本Filter，宽，高，格式）
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);
// 查询界面（IID_IAM流配置，流配置）
outPin.QueryInterface(IID_IAMStreamConfig, streamConfig);
// 如果已分配（流配置）
if assigned(streamConfig) then
begin
// 选定索引 = -1
selectedIndex := -1;
// 比特率 = 0
bitRate := 0;
// 格式ID = Str到视频媒体子类型（格式）
formatID := StrToVideoMediaSubType(format);
// 配置流.获取功能数量（数量，大小）
 streamConfig.GetNumberOfCapabilities(piCount, piSize);
// getmen（视频流配置上限，大小）
 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;

// 枚举所有USB摄像头
{ 枚举所有视频输入设备 }
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);
// 如果 hr <> 0
if hr <> S_OK then
Exit;

// 系统开发人员枚举.创建类枚举器（CLSID视频输入设备类别，枚举猫，0）
{ 用指定的 Filter 目录类型创建一个枚举器，并获得 IEnumMoniker 接口； }
hr := SysDevEnum.CreateClassEnumerator(CLSID_VideoInputDeviceCategory, EnumCat, 0);
if hr <> S_OK then
Exit;

try
{ 释放内存 }
// 如果数组的成员数量 > 0
if strsList.Count > 0 then
begin
 for III := 0 to strsList.Count - 1 do
 begin
 // 释放（视频格式信息（对象））
 FreeMem(PVideoFormatInfo(strsList.Objects));
 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)', ), TObject(puInfo));
 end;
 PropBag := nil;
 Moniker := nil;
end;

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

// 遍历出来所有支持的格式【各种分辨率】参数1：传进来的名字，参数2：选择名字的下标，参数3：枚举出来的格式放在那里
{ 枚举视频支持格式 }
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;

// Filter 实际上它不是物理摄像头，只是模拟摄像头设备可以采集图像
{ 获取指定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));
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 视频流配置上线
{ 枚举支持的视频格式 }
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', ), TObject(pvInfo));
 finally
 DeleteMediaType(pmt);
 end;
 end;
end;
finally
FreeMem(pSCC);
end;

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

Result := True;
end;

/// <summary>
/// 普通影片
/// </summary>
/// <param name="FIGraphBuilder">FI图形生成器</param>
/// <param name="FICaptureGraphBuilder2">FI捕获图生成器</param>
/// <param name="FSysDevEnum">FSys开发枚举</param>
/// <param name="FIVideoWindow">FI视频窗口</param>
/// <param name="FIMediaControl">FI媒体控制</param>
/// <param name="FISampleGrabber">FI样品采集器</param>
/// <param name="pv">P视频输入信息</param>
/// <param name="pf">P视频格式信息</param>
/// <param name="pnl">搭载视频的面板【panel面板控件】</param>
/// <param name="strSaveFileName">保存文件路径名</param>
/// <param name="bRecord">是否开始录像</param>
/// <param name="bSnapBmp">是否开启截图功能</param>
/// <returns>布尔类型</returns>
function CommonVideo(var FIGraphBuilder: IGraphBuilder; // FI图形生成器
var FICaptureGraphBuilder2: ICaptureGraphBuilder2; // FI捕获图生成器
var FSysDevEnum: IBaseFilter; // FSys开发枚举
var FIVideoWindow: IVideoWindow; // FI视频窗口
var FIMediaControl: IMediaControl; // FI媒体控制
var FISampleGrabber: ISampleGrabber; // FI样品采集器
pv: PVideoInputInfo; pf: PVideoFormatInfo; // pv：P视频输入信息、pf：P视频格式信息
pnl: TPanel; // 搭载视频的面板【panel面板控件】
const strSaveFileName: string = ''; const bRecord: Boolean = False; // 录像【strSaveFileName：保存文件路径名、bRecord：是否开始录像】
const bSnapBmp: Boolean = False // 截图【bSnapBmp：是否开启截图功能】
): 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;

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

// 调用本单元的 CreateFilter 创建 Filter
{ 获取指定USB摄像头的 Filter }
FSysDevEnum := CreateFilter(CLSID_VideoInputDeviceCategory, AnsiString(pv^.strName), pv^.index);
if FSysDevEnum = nil then
Exit;

// 调用本单元 SetMediaType 【设置指定 Filter 的媒体格式类型】
{ 设置指定 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
// 共同创建实例（，，，，样品采集器Filter）
CocreateInstance(CLSID_SampleGrabber, nil, CLSCTX_INPROC, IID_IBaseFilter, SampleGrabberFilter);
// FI图形生成器.添加 Filter（样品采集器Filter，‘样品采集器’）
FIGraphBuilder.AddFilter(SampleGrabberFilter, 'SampleGrabber');
// 样品采集器Filter.查询接口（）
 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
// SetOutputFileName：设置输出文件名
{ 视频录制文件保持路径 }
if Failed(FICaptureGraphBuilder2.SetOutputFileName(MEDIASUBTYPE_Avi, PWideChar(strSaveFileName), multiplexer, Writer)) then
 Exit;

// RenderStream：渲染流
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 = True): Boolean;
begin
Result := CommonVideo(FIGraphBuilder, FICaptureGraphBuilder2, FSysDevEnum, FIVideoWindow, FIMediaControl, FISampleGrabber, pv, pf, pnl, '', False, bSnapBmp);
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.</pre>
</div>
 
<pre class="prettyprint"></pre>
</div>

</div>
<div id="MySignature" role="contentinfo">
好的代码像粥一样，都是用时间熬出来的 
来源：https://www.cnblogs.com/jijm123/p/14331959.html

頁: [1]

琼殿技术论坛's Archiver

Delphi USB摄像头