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

  1unit Main;
  2
  3interface
  4
  5uses
  6  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7  DirectShow, ExtCtrls, Buttons, ActiveX;
  8
  9const
 10  WM_GraphNotify = WM_App+1;
 11
 12type
 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
 57var
 58  MainForm: TMainForm;
 59
 60implementation
 61
 62uses
 63  ComObj;
 64
 65{$R *.DFM}
 66
 67procedure TMainForm.SpeedButton1Click(Sender: TObject);
 68begin
 69  if OpenDialog.Execute then
 70  begin
 71    GraphDestory;
 72    OpenFile(OpenDialog.FileName)
 73  end
 74end;
 75
 76procedure TMainForm.FormCreate(Sender: TObject);
 77begin
 78  CoInitialize(nil)
 79end;
 80
 81procedure TMainForm.FormDestroy(Sender: TObject);
 82begin
 83  GraphDestory;
 84
 85  CoUninitialize
 86end;
 87
 88procedure TMainForm.OpenFile(const FileName: string);
 89var
 90  PFileName: array [0..255] of WideChar;
 91  Filter: IBaseFilter;
 92  MediaType: TAM_MEDIA_TYPE;
 93  Intf: IInterface;
 94begin
 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);
126end;
127
128procedure TMainForm.GraphDestory;
129begin
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
142end;
143
144procedure TMainForm.DisplayPanelResize(Sender: TObject);
145begin
146  if VideoWindow<>nil then
147    VideoWindow.SetWindowPosition(0, 0, DisplayPanel.Width, DisplayPanel.Height)
148end;
149
150procedure TMainForm.SpeedButton2Click(Sender: TObject);
151begin
152  Play
153end;
154
155procedure TMainForm.WMGraphNotify(var Msg: TMessage);
156var
157  EventCode: Integer;
158  Param1, Param2: Integer;
159  CurrentPosition, EndPosition: Int64;
160begin
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
180end;
181
182procedure TMainForm.SpeedButton3Click(Sender: TObject);
183begin
184  Next
185end;
186
187procedure TMainForm.SpeedButton4Click(Sender: TObject);
188begin
189  Prev
190end;
191
192procedure TMainForm.SpeedButton5Click(Sender: TObject);
193begin
194  Fast
195end;
196
197procedure TMainForm.SpeedButton6Click(Sender: TObject);
198begin
199  Slow
200end;
201
202procedure TMainForm.SpeedButton7Click(Sender: TObject);
203begin
204  SnapShot
205end;
206
207procedure TMainForm.Play;
208begin
209  if MediaControl<>nil then
210    MediaControl.Run
211end;
212
213procedure TMainForm.Next;
214var
215  CurrentPosition, EndPosition: Int64;
216begin
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
226end;
227
228procedure TMainForm.Prev;
229var
230  CurrentPosition, EndPosition: Int64;
231begin
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
241end;
242
243procedure TMainForm.Fast;
244begin
245  if MediaSeek<>nil then
246    MediaSeek.SetRate(2)
247end;
248
249procedure TMainForm.Slow;
250begin
251  if MediaSeek<>nil then
252    MediaSeek.SetRate(0.125)
253end;
254
255procedure TMainForm.SnapShot;
256var
257  MediaType: TAM_MEDIA_TYPE;
258  VideoInfoHeader: TVideoInfoHeader;
259  BitmapInfo: TBitmapInfo;
260  Bitmap: HBitmap;
261  Buffer: Pointer;
262  BufferSize: Integer;
263begin
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
276end;
277
278end. 
279