简介:DSPack Delphi10.2 是一套面向 Delphi 10.2 开发者的视频采集与实时预览组件包,重点解决 Windows 10 下高清摄像头原生驱动不兼容时的视频流接入问题,适合需要快速实现摄像头预览、视频监控或多媒体采集功能的桌面应用开发者。资源共 82 个文件,压缩包约 6.64MB,包含 DSPack 组件源码、Delphi 设计期/运行期包工程文件、示例 Demo、帮助文档(CHM)及安装工程文件等,其中 pas/dcu 为源码与编译单元,dfm/res 为窗体与界面资源,dproj/dpk 对应 Delphi 10.2 的工程和组件包配置,可直接在 IDE 中编译安装。此外还附带一个高清摄像头实时监控测试 Demo,方便初学者对照运行效果快速上手。已有 536 人学习下载,适合中高级 Delphi 开发者用于集成视频采集、帧率控制和分辨率调整等能力,也可作为研究 DSPack 内部实现与 Win10 摄像头兼容处理的学习参考。
1. DSPack 摄像头开发:Delphi 10.2 下的视频采集实战切入点
在 Delphi 里做摄像头预览,很多人第一反应还是 VFW 那套老组件,但到了 Delphi 10.2 这个时代,VFW 驱动早被边缘化,换个新摄像头经常出现格式不支持、预览黑屏、无法枚举的问题。DSPack 直接把微软 DirectShow 封装成了 Delphi 能调的组件,从设备枚举、视频预览、帧回调到录像截图一条链路全打通,是目前 Delphi 桌面端做摄像头采集最省事的方案。这套资源适合正在维护老项目、想从 VFW 迁移到 DirectShow 的开发者,也适合要做工业视觉上位机和视频监控客户端的从业者——它解决的不是"能不能打开摄像头"的问题,而是"如何在 Delphi 10.2 里稳定拿到每一帧"的问题。
2. DSPack 组件体系与 Delphi 10.2 安装踩线
2.1 组件雷达:TFilterGraph 与 TSampleGrabber 的分工
DSPack 是对 DirectShow 的完整封装,核心思路是把多媒体处理流程抽象成一条 Filter Graph 链路:源过滤器(摄像头采集)、变换过滤器(格式处理)、渲染过滤器(显示或抓帧)。在这套体系里,你最常用的其实是三个组件。
TFilterGraph 是总调度器,负责创建、连接、运行整条链路。TFilterGraph 是容器,不是具体的采集设备,它本身不产生画面。TFilterGraph 加上 TSampleGrabber 加 TVideoWindow 是标准组合。TSampleGrabber 是"中途截胡"的组件,它插在源和渲染之间,每一帧数据流过时都会触发回调,你可以在这拿到原始图像数据。TVideoWindow 负责把画面显示到窗口上,它继承自 TWinControl,可以直接拖到 Form 上。
数据流是单向的:摄像头 → TFilterGraph 创建的采集过滤器 → TSampleGrabber → TVideoWindow。如果只需要预览不要回调,可以省略 TSampleGrabber 直接摄像头 → TVideoWindow;如果要做图像处理,就必须把 TSampleGrabber 插在中间。这套结构对应 DirectShow 里的 Capture Graph Builder 加 Sample Grabber Filter,DSPack 做了封装,但底层逻辑没变。
提示:TSampleGrabber 不是万能胶水,它只能处理未压缩或指定格式的媒体类型。接 MJPG 压缩格式的摄像头时,必须在 Grabber 后面再接解码器,否则回调拿到的不是 Bitmap 而是一坨压缩流。
2.2 Delphi 10.2 下的安装流程
DSPack 最后更新的版本停留在 2.3.5,但它对 Delphi 10.2 Tokyo 的兼容性实测是没问题的。安装流程分三步,每一步都有坑。
先打开 DSPack 安装包里的 Packages 目录,找到对应 Delphi 版本的包组文件。常见做法是直接打开 DSPack.dpk,编译时按 F7 逐个编译。编译顺序不能乱,先编译运行时包(DSPack_Runtime),再编译设计时包(DSPack_DesignTime)。如果直接编译设计时包,会报找不到 DSPack 相关单元的错。
// 编译前检查:确认包依赖关系 // Dspack.dpk 依赖以下运行时单元 // DirectShow9.pas — DirectShow COM 接口声明 // DSPackUtils.pas — 工具函数与流处理 // VideoWindow.pas — 视频显示窗口组件 // 编译时若报 *.dcu 找不到,先检查 Library Path 是否包含 DSPack 根目录编译通过后,要把 DSPack 的源码目录和输出目录加到 IDE 的 Library Path 里。具体路径在 Tools → Options → Delphi Options → Library,把 DSPack 文件夹加进去,否则新建工程时组件面板不显示 DSPack 标签页。
64 位编译是第一个大坑。Delphi 10.2 默认支持 64 位目标,但 DSPack 的包文件是老工程,部分源文件在 64 位下编译会报错。常见做法是直接用 32 位目标平台编译安装,反正 DSPack 封装的是 COM 接口,32 位生成的组件在 64 位工程里引用 dcu 也会遇到麻烦——最稳妥的方案是整个工程保持 32 位。第二个坑是 Windows 10 以上的系统权限,DSPack 的安装程序如果以管理员权限运行,会把组件注册到系统目录,编译器反而找不到;把 IDE 以管理员权限运行,用 IDE 自带的安装功能来装,能少很多玄学问题。
3. 把摄像头画面搬上窗口:预览链路与回调数据流
3.1 最小可运行预览代码
装好组件后,第一件事不是写逻辑,而是先跑通"能看到画面"这条链路。我一般会在窗体上放一个 TVideoWindow 和一个按钮,按钮事件里写最少代码。下面这段是经过验证的最小预览实现。
procedure TForm1.btnPreviewClick(Sender: TObject); var FilterGraph: TFilterGraph; SampleGrabber: TSampleGrabber; CapFilter: IBaseFilter; begin // 1. 创建 FilterGraph,这是整个管线的容器 FilterGraph := TFilterGraph.Create(nil); FilterGraph.Active := True; // 必须激活,否则后续接口调用无效 // 2. 枚举并选择第一个视频输入设备 // CreateCaptureFilter 内部调用 SystemDeviceEnum, // 只筛选 CLSID_VideoInputDeviceCategory 的设备 CapFilter := FilterGraph.CreateCaptureFilter( CLSID_VideoInputDeviceCategory, 0, 0); // 3. 把采集设备加入 FilterGraph 图 FilterGraph.AddFilter(CapFilter, 'CaptureFilter'); // 4. 设置视频窗口的显示容器 // 让 DSPack 把画面渲染到 Form 上的 panelVideo 控件 FilterGraph.WindowHandle := panelVideo.Handle; // 5. 调用 RenderFromCamera,自动连接采集 Filter 到 VideoWindow // 这一步等价于手动连接 CaptureFilter 的输出 Pin 到 VideoRenderer FilterGraph.RenderFromCamera(CapFilter, 0, 0, 0); // 6. 启动图,开始采集 FilterGraph.Play; end;这段代码的逻辑分三段:创建容器、加入设备、渲染并播放。CreateCaptureFilter的参数分别是设备类别、设备序号和分辨率模式,第三个参数传 0 表示使用设备默认分辨率。RenderFromCamera是关键方法,它内部处理了采集 Pin 到渲染器的连接,省去了手动枚举 Pin 的麻烦。FilterGraph.Play等价于 DirectShow 里的 Run 方法,如果忘记调用,画面不会出现,但程序也不会报错——这是最容易忽略的一步。
实际运行中如果出现只有窗口底色没有画面,先检查FilterGraph.Active := True是否在创建后立刻执行,再检查WindowHandle是否指向了一个可见控件的句柄。有些时候控件还没创建完成,Handle 为 0,画面就渲染不上去。
3.2 帧回调里拿到 Bitmap:SampleGrabber 的缓冲区再处理
预览跑通后,下一步是把帧数据截到自己手里。TSampleGrabber 提供 OnBuffer 事件,但直接使用它之前,必须先做三件事:设置媒体类型、开启回调缓冲、指定回调方式。
// 在 FilterGraph 创建后、RenderFromCamera 之前,配置 SampleGrabber procedure TForm1.ConfigureGrabber(SampleGrabber: TSampleGrabber); var MediaType: TMediaType; begin // 1. 设置回调的数据格式为 RGB24 // 不设置的话,grabber 回调拿到的是摄像头原始格式(通常是 YUY2) MediaType.MajorType := MEDIATYPE_Video; MediaType.SubType := MEDIASUBTYPE_RGB24; MediaType.FormatType := FORMAT_VideoInfo; SampleGrabber.SetMediaType(MediaType); // 2. 开启自动缓冲,让抓取的帧数据拷贝到内部缓冲区 // BufferSize 单位为字节,RGB24 格式下 640x480 约为 921600 字节 SampleGrabber.BufferSize := 921600; SampleGrabber.SetBufferSamples(True); // 3. 设置非 OneShot 模式 // OneShot=True 时,抓取一帧后自动停止回调 // 手动取单帧时用 True,连续处理时保持 False SampleGrabber.OneShot := False; end;SetMediaType是这里最关键的调用。它告诉 DirectShow 中间过滤器:我只要 RGB24 格式的数据,请把上游的数据转换好再递给我。如果不设置,回调里拿到的 Unaligned 指针指向的数据是 YUY2 或摄像头裸格式,直接转 TBitmap 会得到花屏。SetBufferSamples(True)开启缓冲后,每次回调传入的数据是一份完整拷贝,处理完可以直接释放;如果设 False,回调里的指针指向的是 DirectShow 内部缓冲区,处理期间不能阻塞,否则会拖垮采集管线。
OnBuffer 事件拿到的是 PByte 指针,需要手动组装成 TBitmap。这里有一个常见的误区:直接用 TBitmap.Handle 赋值是行不通的,必须先创建 DIB 段再拷贝像素数据。
procedure TForm1.GrabberBuffer(Sender: TObject; SampleTime: Double; pBuffer: Pointer; BufferLen: Integer); var Bitmap: TBitmap; DIBInfo: TBitmapInfo; pBits: Pointer; begin // 1. 固定为 640x480,如果分辨率可变,从 SampleGrabber 的媒体类型里读取 FillChar(DIBInfo, SizeOf(DIBInfo), 0); DIBInfo.bmiHeader.biSize := SizeOf(TBitmapInfoHeader); DIBInfo.bmiHeader.biWidth := 640; DIBInfo.bmiHeader.biHeight := -480; // 负值表示自顶向下像素序 DIBInfo.bmiHeader.biPlanes := 1; DIBInfo.bmiHeader.biBitCount := 24; // RGB24 每像素 3 字节 // 2. 创建 DIB 段,并映射到写入区 Bitmap := TBitmap.Create; try Bitmap.PixelFormat := pf24bit; Bitmap.Width := 640; Bitmap.Height := 480; pBits := Bitmap.ScanLine[0]; // 3. 拷贝像素——注意每行可能按 4 字节对齐,直接 MemCpy 可能错位 // 这里按行拷贝,每行像素字节数 = 640 * 3 = 1920 CopyMemory(pBits, pBuffer, BufferLen); // 4. 保存或显示 Bitmap Image1.Picture.Bitmap.Assign(Bitmap); finally Bitmap.Free; end; end;这段代码里最阴间的点在于 biHeight 负值:DirectShow 里 RGB24 帧数据一般是自底向上的,如果不加负号,画面会上下颠倒。另外 640x480 的 RGB24 每行正好 1920 字节,刚好能被 4 整除,所以 MemCpy 全场拷贝不会错位;一旦换成 320x240 按 4 字节对齐规则,每行 960 字节也整除。但如果是 720x576,每行 2160 字节,不做行对齐处理就会花屏。遇到这种情况,老老实实按行拷贝,每行行宽用(Width * 3 + 3) and not 3计算。
4. 截图保存与关键参数调整:分辨率、帧率与格式
4.1 把一帧存成 BMP/JPEG 的完整套路
从回调里拿到 Bitmap 之后,保存是我们经常干的事。DSPack 本身不提供图像编码能力,需要借助 Delphi 自带的 JPEG 单元。存 BMP 最简单,但体积大;存 JPEG 要注意质量参数和颜色格式转换。
procedure TForm1.SaveFrameToJPEG(Bitmap: TBitmap; FileName: string); var JPG: TJPEGImage; begin // 1. 创建 JPEG 对象 JPG := TJPEGImage.Create; try // 2. 把 RGB24 Bitmap 转成 JPEG 内部格式 // Assign 触发了从 pf24bit 到 JPEG 的像素格式转换 JPG.Assign(Bitmap); // 3. 设置质量参数,85 是监控场景常用的平衡点 JPG.CompressionQuality := 85; // 4. 保存到文件 JPG.SaveToFile(FileName); finally JPG.Free; end; end;需要注意:JPEG 的 Assign 内部会做颜色空间转换,RGB24 转 YCbCr 的过程是 Delphi 自己实现的,速度尚可,但如果在高帧率下连续保存,这个转换会成为性能瓶颈。工业场景里我一般会把图像处理线程和保存线程分开,回调里只做队列入队,保存线程负责编码落盘。DSPack 的回调运行在 DirectShow 的工作线程上,不能在回调里做耗时操作——这是硬规矩,违反它会导致预览画面卡顿、内存持续增长、程序无响应。
4.2 分辨率与帧率背后的 DirectShow 协商机制
很多新手在 DSPack 里尝试设置摄像头分辨率时,直接找 TFilterGraph 或 TSampleGrabber 的属性,结果发现根本没有 Width/Height 这种属性。这是因为分辨率协商发生在 Filter 的 Pin 上,不是组件层面。DSPack 里干这事需要拿到 IAMStreamConfig 接口。
procedure SetCameraResolution(FilterGraph: TFilterGraph; Width, Height: Integer); var CapFilter: IBaseFilter; Config: IAMStreamConfig; MediaType: PAMMediaType; pVideoInfo: PVideoInfoHeader; Count, Size: Integer; begin // 1. 拿到采集过滤器(前提:已经 AddFilter 到 FilterGraph) CapFilter := FilterGraph.CreateCaptureFilter( CLSID_VideoInputDeviceCategory, 0, 0); // 2. 查询 Pin 上的 IAMStreamConfig 接口 // 采集设备默认输出 Pin 一般是第 0 个 Pin if Succeeded(CapFilter.EnumPins(...)) then begin // 3. 枚举该 Pin 支持的所有媒体类型 Config.GetNumberOfCapabilities(Count, Size); for Index := 0 to Count - 1 do begin Config.GetStreamCaps(Index, @MediaType, ...); pVideoInfo := PVideoInfoHeader(MediaType.pbFormat); // 这里是 640x480 的候选 if (pVideoInfo.bmiHeader.biWidth = Width) and (pVideoInfo.bmiHeader.biHeight = Height) then begin // 4. 固定输出格式:把 YUY2 改成 RGB24,幅度大但通用 MediaType.subtype := MEDIASUBTYPE_RGB24; Config.SetFormat(MediaType); Break; end; end; end; end;这段代码的核心逻辑是"枚举能力 → 匹配分辨率 → 设置格式"。DirectShow 是能力协商机制,不是你想设多少就设多少,必须从GetStreamCaps返回的列表里挑一个设备真正支持的组合。常见的坑是摄像头宣传支持 1280x720,但那个分辨率只在 MJPG 格式下可用,YUY2 下只支持到 640x480——如果你只匹配宽高不匹配 SubType,SetFormat会返回失败。
帧率的设置走的是同一个接口,在VIDEOINFOHEADER里改AvgTimePerFrame字段。例如要设置 30fps,这个字段的值是 10000000 纳秒除以 30,约等于 333333。设置顺序必须在SetFormat里和分辨率一起提交,单独改帧率在这个接口里是无效的。
提示:很多工业相机驱动对
SetFormat的实现并不标准,调用后设备自动重启采集流,导致预览中断。设置完参数后,必须重新走一遍"停止 → 释放图 → 重建图 → 播放"的流程,不要试图在运行中直接改参数。
4.3 摄像头属性调节:亮度、对比度、曝光度的统一入口
除了分辨率和帧率,摄像头属性(亮度、对比度、饱和度、曝光、白平衡)也是开发中绕不开的。DirectShow 里控制这些属性的接口是 IAMVideoProcAmp 和 IAMCameraControl,DSPack 没有封装成独立组件,但可以通过 FilterGraph 查询接口直接调用。
procedure AdjustBrightness(FilterGraph: TFilterGraph; Value: Integer); var CapFilter: IBaseFilter; ProcAmp: IAMVideoProcAmp; begin CapFilter := FilterGraph.CreateCaptureFilter( CLSID_VideoInputDeviceCategory, 0, 0); // 查询 IAMVideoProcAmp 接口,控制画面属性 if Succeeded(CapFilter.QueryInterface(IID_IAMVideoProcAmp, ProcAmp)) then begin // VideoProcAmp_Brightness 对应亮度,范围由设备决定 // 常见范围 -10000 到 10000,默认 5000 左右 ProcAmp.Set(VideoProcAmp_Brightness, Value, VideoProcAmp_Flags_Manual); end; end;亮度、对比度、色相、饱和度的控制代码完全一致,区别只在第一个参数:VideoProcAmp_Brightness、VideoProcAmp_Contrast、VideoProcAmp_Saturation。曝光和焦距走IAMCameraControl接口,方法名和参数模式相同。VideoProcAmp_Flags_Manual表示强制手动模式,有些摄像头默认是自动模式,必须先把自动改为手动才能设置生效,否则 Set 调用返回成功但内部的自动增益会立刻覆盖你的值。
这个接口的另一层坑在于:很多 UVC 摄像头驱动对属性值的范围和步进定义不一致。有的是 0 到 255,有的是 -10000 到 10000 的映射。不要写死范围,使用时先调用GetRange读出Min/ Max/ SteppingDelta,再根据范围计算实际值。
5. DSPack 摄像头开发避坑实录:从黑屏到内存暴涨
5.1 只有窗口底色没有画面
现象:TVideoWindow 显示出来了,但里面只有 Form 的背景色,没有视频画面,也不报错。
原因:最常见的是FilterGraph.Play没有被调用,DirectShow 图停留在停止状态。其次是WindowHandle指向的控件在渲染前还没创建句柄。
解决:确认代码顺序是Active := True→AddFilter→RenderFromCamera→Play。如果这四个步骤都执行了依然黑屏,用FilterGraph.Graph的DumpGraph导出图文件检查连接状态。注意RenderFromCamera有时会失败但不会抛出异常,返回值需要检查,失败时手动调用Render方法代替。
5.2 关闭窗体后内存不释放,二次打开直接崩溃
现象:程序第一次预览正常,关闭摄像头窗口后内存占用不降,再打开时 DirectShow 报错或直接崩溃。
原因:DSPack 的 TFilterGraph 在窗体关闭时不会自动释放内部 COM 接口。DirectShow 图仍在运行状态,采集线程还在跑,引用计数不为 0,导致设备无法重新打开。
解决:在窗体 OnClose 事件里,必须先停止图,再断开所有 Filter 连接,最后释放 FilterGraph。顺序顺序错了,释放时间会从毫秒级变成秒级。
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin // 1. 必须先停止播放,否则设备占用未释放 if Assigned(FilterGraph) then begin FilterGraph.Stop; FilterGraph.ClearGraph; // 断开所有 Filter 连接 FreeAndNil(FilterGraph); // 释放图对象 end; end;5.3 回调频率远低于设置帧率
现象:摄像头设定 30fps,OnBuffer 每秒却只触发 10 到 15 次。
原因:SetMediaType没有设置。TSampleGrabber 如果不知道你要什么格式,它会尝试把所有经过的数据都回调,包括中间的格式协商帧,增加了大量无效开销。另外OnBuffer里做了耗时操作会拖慢 DirectShow 的拉流线程。
解决:严格按照第 3 章的ConfigureGrabber设置SetMediaType。回调函数里只做像素拷贝和入队操作,绝对不写文件、不弹 MessageBox、不做字符串拼接。如果回调逻辑必须复杂,用 TThreadedQueue 做一个生产-消费队列,回调只负责 Produce。
5.4 部分摄像头打不开或打开后花屏
现象:同一个程序,A 摄像头正常,B 摄像头黑屏;或者画面显示为绿色条纹、雪花点。
原因:问题出在格式协商。B 摄像头默认输出 MJPG,而RenderFromCamera直接连接的是 Video Renderer,没有解码器介入。花屏则是OnBuffer里按 RGB24 解析数据,但实际数据是 YUY2。
解决:先调用SetMediaType强制输出 RGB24,如果设备不支持 RGB24,则改用RenderFromCamera的重载版本,它会自动插入 MJPG 解码器。更稳妥的做法是所有摄像头统一走TSampleGrabber管线,Grabber 之前不接 Renderer,Grabber 之后接解码器再接显示——但这套复杂度较高,我的习惯是先用GetStreamCaps枚举设备能力,看 SubType 列表里有哪种格式,再决定是否加解码器。
5.5 Delphi 10.2 64 位编译报错
现象:工程切到 64 位目标平台后,DSPack 相关单元编译报错,错误集中在接口声明和指针类型转换。
原因:DSPack 2.3.5 的源码基于 32 位指针假设写的,部分代码对 64 位指针做了不安全的硬编码转换,例如Integer(pBuffer)这种写法在高位地址下会截断指针。
解决:不要尝试修改源码适配 64 位——改动量太大且无维护者。DSPack 相关的工程直接以 32 位平台为目标编译即可,Windows 10 和 11 完美兼容 32 位桌面程序。如果必须 64 位,替代方案是改用 Media Foundation 相关的类库,但那不是这套资源覆盖的范围。在 Delphi 10.2 下老老实实 32 位,能省掉半天无意义的编译排错。
6. 进阶:多摄像头切换与通用采集工具类的封装
聊完避坑,最后一个话题落地到一个具体技巧:多摄像头切换。工业视觉设备往往同时接两三个 USB 摄像头,DSPack 枚举设备的方式是按索引取,但物理插入顺序会变——上次是索引 0 的设备,这次可能变成索引 1。所以我习惯在启动时根据设备描述做映射,而不是硬编码索引。
// 枚举所有摄像头,按名称建立索引映射 procedure EnumCameras(var DeviceList: TStringList); var SysDevice: TSysDevEnum; i: Integer; begin SysDevice := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory); try DeviceList.Clear; for i := 0 to SysDevice.CountFilters - 1 do begin // FriendlyName 是设备驱动报告的友好名称 // 同一型号的两个摄像头会在名称后追加 #2 / #3 DeviceList.Add(SysDevice.Filters[i].FriendlyName); end; finally SysDevice.Free; end; end;拿到映射后,再建立的 FilterGraph 就按 Name 匹配而不是按索引。切换摄像头时释放旧图、重建新图,整个过程控制在 500 毫秒以内。这里有两个执行细节:切换前要把旧的 FilterGraph 完全置空再创建新的,不能复用同一个 Graph;切换后RenderFromCamera的分辨率参数需要重新设置,因为不同摄像头的默认输出格式可能不同。
还有一个小习惯:我会把所有摄像头操作封装成一个TCameraCapture类,里面持有 FilterGraph、SampleGrabber、当前分辨率、回调委托,对外只暴露Open/ GrabFrame/ Close/ SetResolution四个方法。这样做的好处是主界面逻辑不会被 DirectShow 的图操作污染,测试也方便——脱离 UI 直接跑控制台测试采集链路。DSPack 的组件拖拽方式对快速验证很好用,但项目一复杂,图管埋紧紧耦合在 Form 里会非常狼狈。
在这个项目里我栽过最狠的跟头是:在 OnBuffer 回调里直接做 JPEG 编码,结果帧率从 30fps 掉到 8fps,内存上涨到几个 GB,最后进程被系统掐掉。从那以后我每次写回调都强制走一遍"拷贝像素 → 入队 → 立即返回"的流程,处理全交给工作线程。希望帮到你。
本文还有配套的精品资源,点击获取