基于DirectShow的媒体播放(可SnapShot)
1
unit 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
unit Main;2
3
interface4
5
uses6
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,7
DirectShow, ExtCtrls, Buttons, ActiveX;8
9
const10
WM_GraphNotify = WM_App+1;11
12
type13
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
private35
{ Private declarations }36
protected37
procedure WMGraphNotify(var Msg: TMessage); message WM_GraphNotify;38
public39
{ 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
var58
MainForm: TMainForm;59
60
implementation61
62
uses63
ComObj;64
65
{$R *.DFM}66
67
procedure TMainForm.SpeedButton1Click(Sender: TObject);68
begin69
if OpenDialog.Execute then70
begin71
GraphDestory;72
OpenFile(OpenDialog.FileName)73
end74
end;75
76
procedure TMainForm.FormCreate(Sender: TObject);77
begin78
CoInitialize(nil)79
end;80
81
procedure TMainForm.FormDestroy(Sender: TObject);82
begin83
GraphDestory;84
85
CoUninitialize86
end;87
88
procedure TMainForm.OpenFile(const FileName: string);89
var90
PFileName: array [0..255] of WideChar;91
Filter: IBaseFilter;92
MediaType: TAM_MEDIA_TYPE;93
Intf: IInterface;94
begin95
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
begin130
if VideoWindow<>nil then131
begin132
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:=nil142
end;143
144
procedure TMainForm.DisplayPanelResize(Sender: TObject);145
begin146
if VideoWindow<>nil then147
VideoWindow.SetWindowPosition(0, 0, DisplayPanel.Width, DisplayPanel.Height)148
end;149
150
procedure TMainForm.SpeedButton2Click(Sender: TObject);151
begin152
Play153
end;154
155
procedure TMainForm.WMGraphNotify(var Msg: TMessage);156
var157
EventCode: Integer;158
Param1, Param2: Integer;159
CurrentPosition, EndPosition: Int64;160
begin161
if MediaEvent<>nil then162
begin163
while MediaEvent.GetEvent(EventCode, Param1, Param2, 0)=S_OK do164
begin165
MediaEvent.FreeEventParams(EventCode, Param1, Param2);166
if EventCode=EC_Complete then167
begin168
if MediaControl<>nil then169
MediaControl.Stop;170
if MediaSeek<>nil then171
begin172
CurrentPosition:=0;173
MediaSeek.SetPositions(CurrentPosition,174
AM_SEEKING_AbsolutePositioning,175
EndPosition, AM_SEEKING_NoPositioning)176
end177
end178
end179
end180
end;181
182
procedure TMainForm.SpeedButton3Click(Sender: TObject);183
begin184
Next185
end;186
187
procedure TMainForm.SpeedButton4Click(Sender: TObject);188
begin189
Prev190
end;191
192
procedure TMainForm.SpeedButton5Click(Sender: TObject);193
begin194
Fast195
end;196
197
procedure TMainForm.SpeedButton6Click(Sender: TObject);198
begin199
Slow200
end;201
202
procedure TMainForm.SpeedButton7Click(Sender: TObject);203
begin204
SnapShot205
end;206
207
procedure TMainForm.Play;208
begin209
if MediaControl<>nil then210
MediaControl.Run211
end;212
213
procedure TMainForm.Next;214
var215
CurrentPosition, EndPosition: Int64;216
begin217
if MediaControl<>nil then218
MediaControl.Pause;219
if MediaSeek<>nil then220
begin221
MediaSeek.GetPositions(CurrentPosition, EndPosition);222
Inc(CurrentPosition);223
MediaSeek.SetPositions(CurrentPosition, AM_SEEKING_AbsolutePositioning,224
EndPosition, AM_SEEKING_NoPositioning)225
end226
end;227
228
procedure TMainForm.Prev;229
var230
CurrentPosition, EndPosition: Int64;231
begin232
if MediaControl<>nil then233
MediaControl.Pause;234
if MediaSeek<>nil then235
begin236
MediaSeek.GetPositions(CurrentPosition, EndPosition);237
Dec(CurrentPosition);238
MediaSeek.SetPositions(CurrentPosition, AM_SEEKING_AbsolutePositioning,239
EndPosition, AM_SEEKING_NoPositioning)240
end241
end;242
243
procedure TMainForm.Fast;244
begin245
if MediaSeek<>nil then246
MediaSeek.SetRate(2)247
end;248
249
procedure TMainForm.Slow;250
begin251
if MediaSeek<>nil then252
MediaSeek.SetRate(0.125)253
end;254
255
procedure TMainForm.SnapShot;256
var257
MediaType: TAM_MEDIA_TYPE;258
VideoInfoHeader: TVideoInfoHeader;259
BitmapInfo: TBitmapInfo;260
Bitmap: HBitmap;261
Buffer: Pointer;262
BufferSize: Integer;263
begin264
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:=Bitmap276
end;277
278
end. 279
