基于DirectShow的媒体播放(可SnapShot)

 

  1 unit  Main;
  2
  3 interface
  4
  5 uses
  6   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7   DirectShow, ExtCtrls, Buttons, ActiveX;
  8
  9 const
 10   WM_GraphNotify  =  WM_App + 1 ;
 11
 12 type
 13   TMainForm  =   class (TForm)
 14     DisplayPanel: TPanel;
 15     SpeedButton1: TSpeedButton;
 16     SpeedButton2: TSpeedButton;
 17     SpeedButton3: TSpeedButton;
 18     SpeedButton4: TSpeedButton;
 19     SpeedButton5: TSpeedButton;
 20     SpeedButton6: TSpeedButton;
 21     SpeedButton7: TSpeedButton;
 22     Image1: TImage;
 23     OpenDialog: TOpenDialog;
 24      procedure  SpeedButton1Click(Sender: TObject);
 25      procedure  FormCreate(Sender: TObject);
 26      procedure  FormDestroy(Sender: TObject);
 27      procedure  DisplayPanelResize(Sender: TObject);
 28      procedure  SpeedButton2Click(Sender: TObject);
 29      procedure  SpeedButton3Click(Sender: TObject);
 30      procedure  SpeedButton4Click(Sender: TObject);
 31      procedure  SpeedButton5Click(Sender: TObject);
 32      procedure  SpeedButton6Click(Sender: TObject);
 33      procedure  SpeedButton7Click(Sender: TObject);
 34    private
 35      {  Private declarations  }
 36    protected
 37      procedure  WMGraphNotify( var  Msg: TMessage);  message  WM_GraphNotify;
 38    public
 39      {  Public declarations  }
 40     GraphBuilder: IGraphBuilder;
 41     VideoWindow: IVideoWindow;
 42     MediaControl: IMediaControl;
 43     MediaEvent: IMediaEventEx;
 44     MediaSeek: IMediaSeeking;
 45     SampleGrabber: ISampleGrabber;
 46
 47      procedure  GraphDestory;
 48      procedure  OpenFile( const  FileName:  string );
 49      procedure  Play;
 50      procedure  Next;
 51      procedure  Prev;
 52      procedure  Fast;
 53      procedure  Slow;
 54      procedure  SnapShot;
 55    end ;
 56
 57 var
 58   MainForm: TMainForm;
 59
 60 implementation
 61
 62 uses
 63   ComObj;
 64
 65 { $R *.DFM }
 66
 67 procedure  TMainForm.SpeedButton1Click(Sender: TObject);
 68 begin
 69    if  OpenDialog.Execute  then
 70    begin
 71     GraphDestory;
 72     OpenFile(OpenDialog.FileName)
 73    end
 74 end ;
 75
 76 procedure  TMainForm.FormCreate(Sender: TObject);
 77 begin
 78   CoInitialize( nil )
 79 end ;
 80
 81 procedure  TMainForm.FormDestroy(Sender: TObject);
 82 begin
 83   GraphDestory;
 84
 85   CoUninitialize
 86 end ;
 87
 88 procedure  TMainForm.OpenFile( const  FileName:  string );
 89 var
 90   PFileName:  array  [ 0 .. 255 ]  of  WideChar;
 91   Filter: IBaseFilter;
 92   MediaType: TAM_MEDIA_TYPE;
 93   Intf: IInterface;
 94 begin
 95   GraphDestory;
 96   
 97   GraphBuilder: = CreateComObject(CLSID_FilterGraph)  as  IGraphBuilder;
 98
 99   Filter: = CreateComObject(CLSID_SampleGrabber)  as  IBaseFilter;
100   Filter.QueryInterface(IID_ISampleGrabber, SampleGrabber);
101   GraphBuilder.AddFilter(Filter,  ' Grabber ' );
102   Filter: = nil ;
103   ZeroMemory(@MediaType, SizeOf(TAM_MEDIA_TYPE));
104   MediaType.majortype: = MEDIATYPE_Video;
105   MediaType.subtype: = MEDIASUBTYPE_RGB24;
106   MediaType.formattype: = FORMAT_VideoInfo;
107   SampleGrabber.SetMediaType(MediaType);
108   SampleGrabber.SetBufferSamples(True);
109
110   StringToWideChar(FileName, PFileName,  255 );
111   GraphBuilder.RenderFile(PFileName,  nil );
112
113   GraphBuilder.QueryInterface(IID_IVideoWindow, VideoWindow);
114   VideoWindow.put_Owner(DisplayPanel.Handle);
115   VideoWindow.put_WindowStyle(WS_CHILD  or  WS_CLIPSIBLINGS);
116   VideoWindow.put_Visible(True);
117   DisplayPanelResize( nil );
118
119   GraphBuilder.QueryInterface(IID_IMediaSeeking, MediaSeek);
120   MediaSeek.SetTimeFormat(Time_Format_Frame);
121
122   GraphBuilder.QueryInterface(IID_IMediaControl, MediaControl);
123
124   GraphBuilder.QueryInterface(IID_IMediaEventEx, MediaEvent);
125   MediaEvent.SetNotifyWindow(Handle, WM_GraphNotify,  0 );
126 end ;
127
128 procedure  TMainForm.GraphDestory;
129 begin
130    if  VideoWindow <> nil   then
131    begin
132     VideoWindow.put_Visible(False);
133     VideoWindow.put_Owner( 0 )
134    end ;
135   VideoWindow: = nil ;
136
137   MediaControl: = nil ;
138
139   MediaEvent: = nil ;
140
141   GraphBuilder: = nil
142 end ;
143
144 procedure  TMainForm.DisplayPanelResize(Sender: TObject);
145 begin
146    if  VideoWindow <> nil   then
147     VideoWindow.SetWindowPosition( 0 ,  0 , DisplayPanel.Width, DisplayPanel.Height)
148 end ;
149
150 procedure  TMainForm.SpeedButton2Click(Sender: TObject);
151 begin
152   Play
153 end ;
154
155 procedure  TMainForm.WMGraphNotify( var  Msg: TMessage);
156 var
157   EventCode: Integer;
158   Param1, Param2: Integer;
159   CurrentPosition, EndPosition: Int64;
160 begin
161    if  MediaEvent <> nil   then
162    begin
163      while  MediaEvent.GetEvent(EventCode, Param1, Param2,  0 ) = S_OK  do
164      begin
165       MediaEvent.FreeEventParams(EventCode, Param1, Param2);
166        if  EventCode = EC_Complete  then
167        begin
168          if  MediaControl <> nil   then
169           MediaControl.Stop;
170          if  MediaSeek <> nil   then
171          begin
172           CurrentPosition: = 0 ;
173           MediaSeek.SetPositions(CurrentPosition,
174             AM_SEEKING_AbsolutePositioning,
175             EndPosition, AM_SEEKING_NoPositioning)
176          end
177        end
178      end
179    end
180 end ;
181
182 procedure  TMainForm.SpeedButton3Click(Sender: TObject);
183 begin
184   Next
185 end ;
186
187 procedure  TMainForm.SpeedButton4Click(Sender: TObject);
188 begin
189   Prev
190 end ;
191
192 procedure  TMainForm.SpeedButton5Click(Sender: TObject);
193 begin
194   Fast
195 end ;
196
197 procedure  TMainForm.SpeedButton6Click(Sender: TObject);
198 begin
199   Slow
200 end ;
201
202 procedure  TMainForm.SpeedButton7Click(Sender: TObject);
203 begin
204   SnapShot
205 end ;
206
207 procedure  TMainForm.Play;
208 begin
209    if  MediaControl <> nil   then
210     MediaControl.Run
211 end ;
212
213 procedure  TMainForm.Next;
214 var
215   CurrentPosition, EndPosition: Int64;
216 begin
217    if  MediaControl <> nil   then
218     MediaControl.Pause;
219    if  MediaSeek <> nil   then
220    begin
221     MediaSeek.GetPositions(CurrentPosition, EndPosition);
222     Inc(CurrentPosition);
223     MediaSeek.SetPositions(CurrentPosition, AM_SEEKING_AbsolutePositioning,
224       EndPosition, AM_SEEKING_NoPositioning)
225    end
226 end ;
227
228 procedure  TMainForm.Prev;
229 var
230   CurrentPosition, EndPosition: Int64;
231 begin
232    if  MediaControl <> nil   then
233     MediaControl.Pause;
234    if  MediaSeek <> nil   then
235    begin
236     MediaSeek.GetPositions(CurrentPosition, EndPosition);
237     Dec(CurrentPosition);
238     MediaSeek.SetPositions(CurrentPosition, AM_SEEKING_AbsolutePositioning,
239       EndPosition, AM_SEEKING_NoPositioning)
240    end
241 end ;
242
243 procedure  TMainForm.Fast;
244 begin
245    if  MediaSeek <> nil   then
246     MediaSeek.SetRate( 2 )
247 end ;
248
249 procedure  TMainForm.Slow;
250 begin
251    if  MediaSeek <> nil   then
252     MediaSeek.SetRate( 0.125 )
253 end ;
254
255 procedure  TMainForm.SnapShot;
256 var
257   MediaType: TAM_MEDIA_TYPE;
258   VideoInfoHeader: TVideoInfoHeader;
259   BitmapInfo: TBitmapInfo;
260   Bitmap: HBitmap;
261   Buffer: Pointer;
262   BufferSize: Integer;
263 begin
264   SampleGrabber.GetConnectedMediaType(MediaType);
265
266   ZeroMemory(@VideoInfoHeader, SizeOf(TVideoInfoHeader));
267   CopyMemory(@VideoInfoHeader, MediaType.pbFormat, SizeOf(VideoInfoHeader));
268
269   ZeroMemory(@BitmapInfo, SizeOf(TBitmapInfo));
270   CopyMemory(@BitmapInfo, @VideoInfoHeader.bmiHeader, SizeOf(VideoInfoHeader.bmiHeader));
271
272   Bitmap: = CreateDIBSection( 0 , BitmapInfo, DIB_RGB_COLORS, Buffer,  0 ,  0 );
273   SampleGrabber.GetCurrentBuffer(BufferSize, Buffer);
274
275   Image1.Picture.Bitmap.Handle: = Bitmap
276 end ;
277
278 end . 
279

 

转载于:https://www.cnblogs.com/smallmuda/archive/2009/09/19/1569847.html