DirectShow实现抓图(Delphi)

曾经终败给现在 2021-11-30 01:28 252阅读 0赞

unit Unit1;

interface

uses  
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
Dialogs, StdCtrls,shlobj, ExtCtrls, \{TFlatButtonUnit,TFlatPanelUnit,TFlatTitlebarUnit,\}  
FlatBars, FlatBtns, FlatUtils, FlatPanel;

type

//====================定义窗体类==========================//  
TForm1 = class(TForm)  
//界面控件  
open: TOpenDialog; //打开对话框控件  
FlatPanel1: TFlatPanel; //FlatPanel控件  
Button1: TFlatButton; //按钮控件  
Button2: TFlatButton; //按钮控件  
FlatTitlebar1: TFlatTitlebar; //Titlebar 控件  
FlatButton1: TFlatButton; //按钮控件  
FlatButton2: TFlatButton; //按钮控件  
//窗口事件  
procedure FormClose(Sender: TObject; var Action: TCloseAction); //窗口关闭事件  
procedure FormShow(Sender: TObject); //窗口显示事件  
procedure Button1Click(Sender: TObject); //Button1的Click事件  
procedure Button2Click(Sender: TObject); //Button2的Click事件  
procedure FlatButton1Click(Sender: TObject); //FlatButton1的Click事件  
procedure FlatButton2Click(Sender: TObject); //FlatButton2的Click事件  
private  
\{ Private declarations \}

mtv:widestring; //视频文件名

public  
\{ Public declarations \}  
fillcolor:TColor; //需要填充的颜色  
catchcolor:TColor; //需要抠出的颜色  
detal:Byte; //颜色误差范围  
procedure CreatDirectshow; //创建Directshow环境资源  
Procedure FreeDirectshow; //释放Directshow环境资源  
procedure catchpicture; //捕捉视频图象，并做处理  
end;

var  
Form1: TForm1; //定义窗体对象

implementation

\{$R \*.dfm\}  
uses  
Directshow9,comobj,DSutil, Unit2; //包含附加的单元。Directshow9为微软DirectX SDK中Directshow的DELPHI单元文件  
//comobj为DELPHI的COM的单元  
//DSUtil为DIRECTSHOW的DELPHI工具单元  
//Unit2为 设置窗口 的单元

//==================变量定义部分===============//  
var  
FilterGraph:IGraphBuilder=nil; //Directshow的IGraphBuilder接口，用于Directshow的框架  
MediaControl:IMediaControl=nil; //Directshow的IMediaControl接口，用于控制媒体播放，暂停，停止  
VideoRender:IBaseFilter=nil; //Directshow的IBaseFilter接口，IBaseFiler是Directshow中所有Filter的基类.此处是保存的VMR Video Filter  
SampleGrabber:ISampleGrabber=nil;//Directshow的ISampleGrabber接口，此接口存在于SampleGrabber Filter上，用这接口可从 SampleGrabber Filter中获得视频图象颜色信息  
id:integer=0;//调试所用，用于在DIRECTSHOW SDK自带的 graphedt工具中申明个ID ，用于调试。

//===================函数实现部分===============//

\{DELPHI函数格式简介：

1.procedure 过程名称 (参数) ; //如果没有参数则可以省略"()"  
//局部变量申明

var //变量申明系统关键字  
MediaRect:TRect;//其中MediaRect为变量名称，TRect为变量类型

begin  
... //函数体部分  
...  
end; // begin.....end 结构类似于C++中的 \{.......\}

\{ 2.function 函数名称(参数):返回值类型; //如果没有参数则可以省略"()"  
//局部变量申明  
  
var //变量申明系统关键字  
MediaRect:TRect;//其中MediaRect为变量名称，TRect为变量类型

begin  
... //函数体部分  
...  
result:=...;//result为返回值变量，不需要自己声明，它代表函数的返回值变量,":="为DELPHI的赋值符号  
end; // begin.....end 结构类似于C++中的 \{.......\}  
//\}

procedure TForm1.CreatDirectshow;  
//函数局部变量申明部分  
var  
MediaRect:TRect; //区域局部变量，用于设置视频在窗口显示的区域  
pType:\_AMMEDIATYPE; //视频媒体类型变量，用于设置SampleGrabber Filter的接收视频的类型（如告诉系统：接受的为视频信息，视频内部图象格式为RGB32位）  
VideoWindow:IVideoWindow; //Directshow的IVideoWindow接口,用于对视频的显示窗口做设置（例如：设置其父窗体）  
begin  
FilterGraph:=CreateComobject(CLSID\_FilterGraph) as IGraphBuilder; //创建Directshow中的FilterGraph COM对象并返回IGraphBuilder接口  
VideoRender:=createcomobject(CLSID\_VideoMixingRenderer) as IBaseFilter; //创建Directshow中的VideoMixingRenderer Filter COM对象并返回IBaseFilter接口  
SampleGrabber:=createcomobject(CLSID\_SampleGrabber) AS ISampleGrabber; //创建Directshow中的SampleGrabber Filter COM对象并返回ISampleGrabber接口

Filtergraph.AddFilter(VideoRender,'VideoRender'); //在Filtregraph框架中添加刚创建的VideoMixingRenderer Filter  
FilterGraph.AddFilter(SampleGrabber as IBaseFilter,'SampleGrabber'); //在Filtregraph框架中添加刚创建的SampleGrabber Filter

fillchar(ptype,sizeof(\_AMMEDIATYPE),0);//对ptype变量初始化  
ptype.majortype:=MEDIATYPE\_Video;//设置主类型为视频格式  
ptype.subtype:=MEDIASUBTYPE\_RGB32; //设置辅助类型为RGB32（就是接受视频流为RGB32的，FilterGraph会智能加入相应的转换Filter）  
ptype.formattype:=FORMAT\_VideoInfo; //设置媒体信息格式为FORMAT\_VideoInfo格式

SampleGrabber.SetMediaType(pType);//将SampleGrabber Filter的类型设置为pType变量所指定的类型  
SampleGrabber.SetBufferSamples(true);//将SampleGrabber Filter设置为缓冲模式

FilterGraph.RenderFile(pwidechar(mtv),nil); //完成播放指定文件的所有Filter连接

VideoRender.QueryInterface(IID\_IVideoWindow, VideoWindow);//从VideoRender中获得IVideoWindow接口  
Videowindow.put\_Owner(OAHWND(FlatPanel1.Handle)); //设置视频窗口的父窗体为FlatPanel控件  
Videowindow.put\_windowstyle(WS\_CHILD or WS\_Clipsiblings); //设置视频窗体为子窗体，剪裁类型

Videowindow.put\_Left(0);//设置视频窗体的LEFT  
Videowindow.put\_Top(0);//设置视频窗体的TOP  
Videowindow.put\_Width(FlatPanel1.Width); //设置视频窗体的Width  
Videowindow.put\_Height(FlatPanel1.Height);//设置视频窗体的Height

Videowindow.put\_Visible(true); //让视频窗体可见

FilterGraph.QueryInterface(IID\_IMediaControl,MediaControl);//从FilterGraph中获得IMediaControl接口

dsutil.AddGraphToRot(filterGraph,id); //注册GraphEdit所用的ID，可以方便在GraphEdit控件中调试

end;

procedure TForm1.FreeDirectshow;  
begin  
dsutil.RemoveGraphFromRot(id); //清除在GraphEdit中注册的ID

if VideoRender<>nil then VideoRender:=nil; //释放VideoRender  
if FilterGraph<>nil then FilterGraph:=nil; //释放FilterGraph  
IF SampleGrabber<>NIL THEN SampleGrabber:=NIL;//释放SampleGrabber  
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);  
begin  
freedirectshow; //释放Directshow环境  
end;

procedure TForm1.FormShow(Sender: TObject);  
begin  
open.DefaultExt:=extractfiledir(application.ExeName); //设置打开对话框的打开默认路径，为应用程序的当前路径  
if open.Execute=false then close; //如果没有选择打开的文件，则关闭程序  
if trim(open.FileName)='' then close; //如果打开文件的文件名为空，则关闭程序  
if not fileexists(open.FileName) then close; //如果打开不存在的文件，则关闭程序  
mtv:=open.FileName; //将打开窗口中用户选择的文件的名称赋值给MTV变量  
CreatDirectshow; //创建Directshow环境

end;

//============抓图处理关键代码部分==============//  
procedure TForm1.catchpicture;  
var  
ptype:\_AMMEDIATYPE; //视频媒体类型变量，详细介绍见，CreateDirectshow函数部分  
size:integer;  
buf:pchar; //用于存放获得的视频数据的缓冲区  
bmphead:tagBitmapfileheader;//BMP图片的文件头结构体变量  
BMPINFO:PBitmapinfoheader;//BMP图片的文件头结构体指针变量  
bmpcore:tagBITMAPCoreheader; //BMP图片的Core头结构体变量  
filestream:TFilestream; //DELPHI的文件流类型变量

step:integer;  
i:integer;  
catch,current,fill:integer;  
absvalue:integer;

test1,test2,test3,test4,test5,test6:byte;  
begin  
try  
MediaControl.Pause; //播放暂停  
SampleGrabber.GetConnectedMediaType(ptype); //获得SampleGrabber Filter上的输入PIN上的连接类型  
size:=0;  
buf:=nil;  
SampleGrabber.GetCurrentBuffer(size,nil);//获得SampleGrabber Filter上的缓冲区大小

try  
buf:=allocmem(size); //分配buf空间  
SampleGrabber.GetCurrentBuffer(size,buf);//获得视频的当前数据，保存到buf中

if (ptype.cbFormat=sizeof(VIDEOINFOHEADER)) and (ptype.pbFormat<>nil) and (IsEqualGUID(ptype.formattype,FORMAT\_VideoInfo)) then //判断Sampler Grabber中的输入Pin上的类型是否满足我们的要求  
begin

//=设置bmp Head部分=//  
with bmphead do  
begin  
bftype:=$4d42;  
bfsize:=sizeof(tagBitmapfileheader);  
bfreserved1:=0;  
bfreserved2:=0;  
bfOffBits:=bfsize+sizeof(tagBITMAPCoreheader);  
end;  
bmpinfo:=PBitmapinfoheader(@(PVideoinfoheader(ptype.pbFormat).bmiHeader));  
step:=bmpinfo.biBitCount div 8;  
bmpcore.bcSize:=sizeof(tagBITMAPCoreheader);  
bmpcore.bcWidth:=bmpinfo.biWidth;  
bmpcore.bcHeight:=bmpinfo.biHeight;  
bmpcore.bcPlanes:=1;  
bmpcore.bcBitCount:=bmpinfo.biBitCount;

if catchcolor<>fillcolor then  
begin  
catch:=COLORTORGB(Catchcolor);  
fill:=COLORTORGB(fillcolor);  
fill:=RGB(GETBValue(fillcolor),GETGValue(fillcolor),GetRValue(fillcolor));

current:=0;  
for i:=0 to bmpinfo.biWidth\*bmpinfo.biHeight-1 do//循环查找视频图象颜色中的数据  
begin

Current:=PInteger(Pchar(buf)+i\*step)^;

if (abs(GetBValue(Current)-GetRValue(catch))<=detal) and (abs(GetGValue(Current)-GetGValue(catch))<=detal) and (abs(GetRValue(Current)-GetBValue(catch))<=detal) then //判断当前像素中的颜色是否符合抠像填充条件  
begin  
PInteger(pchar(buf)+i\*step)^:=fill;//填充用户设置的填充颜色  
end;  
end;  
end;

try

filestream:=TFilestream.Create(Extractfiledir(Application.ExeName)+'/抓下来的视频图.bmp',fmCreate or fmOpenWrite); //创建FileStream视频流  
filestream.WriteBuffer(bmphead,bmphead.bfSize);//将bmphead变量中的数据写入流中

filestream.WriteBuffer(bmpcore,sizeof(tagBITMAPCoreheader)); //将bmpcore变量中的数据写入流中  
filestream.WriteBuffer(buf^,size); //将buf指针所指向的数据写入流中

windows.MessageBox(handle,'抓图成功！','提示',MB\_ICONINFORMATION);//提示用户，抓图成功  
finally  
filestream.Free;//释放Filestream视频流  
end;

end;  
finally  
freemem(buf); //释放Buf所占用的空间  
end;

finally

MediaControl.Run;//重新播放  
end;  
end;

procedure TForm1.Button1Click(Sender: TObject);  
begin

MediaControl.Run;//播放视频  
button1.Enabled:=false; //将Button1按钮设为不可用  
button2.Enabled:=true; //将Button2按钮设置为可用  
end;

procedure TForm1.Button2Click(Sender: TObject);  
begin  
catchpicture(); //调用自己编写的抓图处理函数  
end;

procedure TForm1.FlatButton1Click(Sender: TObject);  
begin  
close; //关闭窗体，也将关闭程序  
end;

procedure TForm1.FlatButton2Click(Sender: TObject);  
begin  
form2.ShowModal;//显示FORM2窗体（模态显示，也就是你必须关闭了FORM2，才能操作程序的其他窗体）  
end;

end.

转载于:https://www.cnblogs.com/MaxWoods/archive/2008/10/06/1304830.html