DirectShow (Delphi)

Unit unit1;

Interface

Uses
Windows, messages, sysutils, variants, classes, graphics, controls, forms,
Dialogs, stdctrls, shlobj, extctrls, {tflatbuttonunit, tflatpanelunit, tflattitlebarunit ,}
Flatbars, flatbtns, flatutils, flatpanel;

Type

// ================================== Define a form class ======================== ================ //
Tform1 = Class (tform)
// Interface Control
Open: topendialog; // open the dialog box Control
Flatpanel1: tflatpanel; // flatpanel Control
Button1: tflatbutton; // button control
Button2: tflatbutton; // button control
Flattitlebar1: tflattitlebar; // titlebar Control
Flatbutton1: tflatbutton; // button control
Flatbutton2: tflatbutton; // button control
// Window event
Procedure formclose (Sender: tobject; var action: tcloseaction); // window close event
Procedure formshow (Sender: tobject); // window display event
Procedure button1click (Sender: tobject); // Click Event of button1
Procedure button2click (Sender: tobject); // Click Event of button2
Procedure flatbutton1click (Sender: tobject); // Click Event of flatbutton1
Procedure flatbutton2click (Sender: tobject); // Click Event of flatbutton2
Private
{Private Declarations}

MTV: widestring; // video file name

Public
{Public declarations}
Fillcolor: tcolor; // The color to be filled
Catchcolor: tcolor; // specifies the color to be extracted.
Detal: byte; // color error range
Procedure creatdirectshow; // create a DirectShow Environment Resource
Procedure freedirectshow; // releases DirectShow Environment Resources
Procedure catchpicture; // capture video images and process them
End;

VaR
Form1: tform1; // defines the form object.

Implementation

{$ R *. DFM}
Uses
Directshow9, comobj, dsutil, unit2; // contains additional units. Directshow9 is the Delphi unit file of DirectShow in Microsoft DirectX SDK.
// Comobj is the com unit of Delphi
// Dsutil is the Delphi tool unit of DirectShow
// Unit2 is the unit for setting the window

// ============================= Variable definition ================================ //
VaR
Filtergraph: igraphbuilder = nil; // The igraphbuilder interface of DirectShow for the DirectShow framework
Mediacontrol: imediacontrol = nil; // imediacontrol interface of DirectShow, used to control media playback, pause, and stop
Videorender: ibasefilter = nil; // ibasefilter interface of DirectShow. ibasefiler is the base class of all filters in DirectShow. The saved vmr video Filter
Samplegrabber: isamplegrabber = nil; // DirectShow isamplegrabber interface, which exists on samplegrabber filter. This interface can be used to obtain video image color information from samplegrabber filter.
ID: integer = 0; // used for debugging. It is used to declare an ID in the graphedt tool provided by DirectShow SDK for debugging.

// ================================ Function implementation section =========================//

{Delphi Function Format introduction:

1. procedure process name (parameter); // skip "()" If no parameter exists "()"
// Local variable Declaration

VaR // variable declaration system keyword
Mediarect: trect; // Where mediarect is the variable name and trect is the variable type

Begin
... // Function body part
...
End; // The begin... end structure is similar to {...} in C ++ {.......}

{2. Function Name (parameter): return value type; // You can omit "()" If no parameter exists "()"
// Local variable Declaration

VaR // variable declaration system keyword
Mediarect: trect; // Where mediarect is the variable name and trect is the variable type

Begin
... // Function body part
...
Result: =...; // result is the return value variable and does not need to be declared by yourself. It represents the return value variable of the function. ": =" is the value-assigned symbol of Delphi.
End; // The begin... end structure is similar to {...} in C ++ {.......}
//}

procedure tform1.creatdirectshow;
// Function Local variable declaration
var
mediarect: trect; // region local variable, used to set the video display area in the window
ptype: _ ammediatype; // The video media type variable, used to set the type of the video received by samplegrabber filter (for example, tell the system: the received video information, and the internal video image format is rgb32 bits)
videowindow: ivideowindow; // DirectShow ivideowindow interface, used to set the display window of the video (for example:
begin
filtergraph: = createcomobject (clsid_filtergraph) as igraphbuilder; // create the filtergraph COM Object in DirectShow and return the igraphbuilder interface
videorender: = createcomobject (screenshot) as ibasefilter; // create the videomixingrenderer filter COM Object in DirectShow and return the ibasefilter interface
samplegrabber: = createcomobject (clsid_samplegrabber) as isamplegrabber; // create the samplegrabber filter COM Object in DirectShow and return the isamplegrabber interface

Filtergraph. addfilter (videorender, 'videoorender'); // Add the newly created videomixingrenderer filter to the filtregraph framework.
Filtergraph. addfilter (samplegrabber as ibasefilter, 'samplegrabber '); // Add the newly created samplegrabber filter to the filtregraph framework.

Fillchar (ptype, sizeof (_ ammediatype), 0); // initialize the ptype variable
Ptype. majortype: = mediatype_video; // you can specify the main type as the video format.
Ptype. Subtype: = mediasubtype_rgb32; // sets the secondary type to rgb32 (that is, the video stream is accepted as rgb32, and filtergraph intelligently adds the corresponding conversion filter)
Ptype. formattype: = format_videoinfo; // set the media information format to format_videoinfo.

Samplegrabber. setmediatype (ptype); // set the samplegrabber filter type to the type specified by the ptype variable
Samplegrabber. setbuffersamples (true); // set samplegrabber filter to buffer Mode

 

Filtergraph. renderfile (pwidechar (MTV), nil); // completes all the filters for the specified file to be played.

Videorender. QueryInterface (iid_ivideowindow, videowindow); // obtain the ivideowindow interface from videorender
Videowindow. put_owner (oahwnd (flatpanel1.handle); // set the parent form of the video window to the flatpanel control.
Videowindow. put_windowstyle (ws_child or ws_clipsiblings); // you can specify the video form as a subform and the cropping type.

Videowindow. put_left (0); // sets the left of the video form.
Videowindow. put_top (0); // sets the top of the video form.
Videowindow. put_width (flatpanel1.width); // you can specify the width of the video form.
Videowindow. put_height (flatpanel1.height); // sets the height of the video form.

Videowindow. put_visible (true); // make the video form visible

Filtergraph. QueryInterface (iid_imediacontrol, mediacontrol); // obtain the imediacontrol interface from filtergraph.

Dsutil. addgraphtorot (filtergraph, ID); // register the ID used by graphedit for easy debugging in the graphedit Control

End;

Procedure tform1.freedirectshow;
Begin
Dsutil. removegraphfromrot (ID); // clear the ID registered in graphedit

If videorender <> nil then videorender: = nil; // release videorender
If filtergraph <> nil then filtergraph: = nil; // release filtergraph
If samplegrabber <> nil then samplegrabber: = nil; // release samplegrabber
End;

Procedure tform1.formclose (Sender: tobject; var action: tcloseaction );
Begin
Freedirectshow; // release the DirectShow Environment
End;

Procedure tform1.formshow (Sender: tobject );
Begin
Open. defaultext: = extractfiledir (application. exename); // you can specify the default path for opening the dialog box.ProgramCurrent path
If open. Execute = false then close; // if no file is selected, close the program
If trim (open. filename) = ''then close; // if the file name to open is empty, close the program
If not fileexists (open. filename) then close; // if you open a file that does not exist, close the program.
MTV: = open. filename; // assign the name of the file selected in the window to the MTV variable.
Creatdirectshow; // create a DirectShow Environment

End;

// =============== Key to Image CaptureCodePart ====================== //
Procedure tform1.catchpicture;
VaR
Ptype: _ ammediatype; // variable of the video media type. For details, see the createdirectshow function section.
Size: integer;
Buf: pchar; // buffer used to store the obtained video data
Bmphead: tagbitmapfileheader; // File Header struct variable of the BMP Image
BMP info: pbitmapinfoheader; // File Header pointer variable of the BMP Image
BMP core: tagbitmapcoreheader; // BMP image's core header struct variable
Filestream: tfilestream; // file stream type variable of Delphi

Step: integer;
I: integer;
Catch, current, fill: integer;
Absvalue: integer;

Test1, Test2, test3, test4, test5, test6: byte;
Begin
Try
Mediacontrol. Pause; // pause
Samplegrabber. getconnectedmediatype (ptype); // obtain the connection type of the Input Pin on samplegrabber filter.
Size: = 0;
Buf: = nil;
Samplegrabber. getcurrentbuffer (size, nil); // obtain the buffer size on samplegrabber Filter

 

Try
Buf: = allocmem (size); // allocate Buf Space
Samplegrabber. getcurrentbuffer (size, Buf); // obtain the current video data and save it to Buf.

If (ptype. cbformat = sizeof (videoinfoheader) and (ptype. pbformat <> nil) and (isw.guid (ptype. formattype, format_videoinfo) Then // determine whether the type of the Input Pin in sampler grabber meets our requirements
Begin

// = Set the BMP head part = //
With bmphead do
Begin
Bftype: = $4d42;
Bfsize: = sizeof (tagbitmapfileheader );
Bfreserved1: = 0;
Bfreserved2: = 0;
Bfoffbits: = bfsize + sizeof (tagbitmapcoreheader );
End;
BMP info: = pbitmapinfoheader (@ (pvideoinfoheader (ptype. pbformat). bmiheader ));
Step: = BMP info. bibitcount Div 8;
BMP core. bcsize: = sizeof (tagbitmapcoreheader );
BMP core. bcwidth: = BMP info. biwidth;
BMP core. bcheight: = BMP info. biheight;
BMP core. bcplanes: = 1;
BMP core. bcbitcount: = BMP info. 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 BMP info. biwidth * BMP info. biHeight-1 do // cyclically find the data in the video image color
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 // determine whether the color in the current pixel meets the fill condition for the image.
begin
pinteger (pchar (BUF) + I * step) ^: = fill; // fill the fill color set by the user
end;

Try

Filestream: = tfilestream. Create (extractfiledir (application. exename) + '/capture video .bmp', fmcreate or fmopenwrite); // create a filestream video stream
Filestream. writebuffer (bmphead, bmphead. bfsize); // write data in the bmphead variable to the stream

Filestream. writebuffer (BMP core, sizeof (tagbitmapcoreheader); // write data in the BMP core variable to the stream
Filestream. writebuffer (BUF ^, size); // write the data pointed to by the Buf pointer to the stream

Windows. MessageBox (handle, 'image capturing successful! ',' Hint ', mb_iconinformation); // a prompt is displayed, indicating that the image is captured successfully.
Finally
Filestream. Free; // release the filestream video stream
End;

End;
Finally
Freemem (BUF); // release the space occupied by the Buf.
End;

Finally

Mediacontrol. Run; // Replay
End;
End;

Procedure tform1.button1click (Sender: tobject );
Begin

Mediacontrol. Run; // play the video
Button1.enabled: = false; // set the button1 button to unavailable
Button2.enabled: = true; // set the button2 button to available
End;

Procedure tform1.button2click (Sender: tobject );
Begin
Catchpicture (); // call your own image capture processing function
End;

Procedure tform1.flatbutton1click (Sender: tobject );
Begin
Close; // close the form and close the program
End;

Procedure tform1.flatbutton2click (Sender: tobject );
Begin
Form2.showmodal; // display the form2 form (modal display, that is, you must disable form2 to operate other forms of the Program)
End;

End.