怎么从视频文件中抽取每一帧的图像数据?用控件不用控件都可以,我现在用DSPack不好实现啊。

zoar_zhong 2008-12-13 09:27:10
我问的问题以前有人问过,但没有答案就结帖了
以下是原帖地址:
http://topic.csdn.net/t/20051127/15/4421192.html

我也是想尽快截取每一帧的数据,


我没有分,不过如果能完成,我会帖出源码以便于更多人可以分享到此答案,无论是大家指教的还是自己研究出来的
谢谢
...全文
562 1 打赏 收藏 转发到动态 举报
写回复
用AI写文章
1 条回复
切换为时间正序
请发表友善的回复…
发表回复
zoar_zhong 2008-12-14
  • 打赏
  • 举报
回复
线索
在directshow有一对象,IMediaDet,可以读取视频某一秒的图片
但我希望能够用SampleGrabber按视频顺序获得所有帧,
SampleGrabber or the Null Renderer,应该可以实现

以下为IMediaDet获得某帧图片的源码

unit VideoFrameGrabber;

interface

uses
Windows, SysUtils, ExtCtrls;

type
TVideoFrameGrabber = class(TObject)
private
{ Private declarations }
FLastErrorMessage: String;
public
{ Public declarations }
constructor Create;
destructor Destroy; override;
function GetFrame(FrameTime: Double; const VideoFileName, ImageFileName: String): HRESULT;
property LastErrorMessage: String read FLastErrorMessage;
end;

implementation

uses
DirectShow9, ActiveX, Jpeg, Graphics;

constructor TVideoFrameGrabber.Create;
begin
inherited Create;
FLastErrorMessage := 'no error.';
end;

destructor TVideoFrameGrabber.Destroy;
begin
inherited Destroy;
end;

function TVideoFrameGrabber.GetFrame(FrameTime: Double; const VideoFileName, ImageFileName: String): HRESULT;
var
MediaDet: IMediaDet;
MediaType: TAMMediaType;
VideoStreams: Integer;
BufferSize: Integer;
Buffer: PByte;
VideoWidth, VideoHeight: Integer;
BMIHeader: PBitmapInfoHeader;
BMPInfo: BitmapInfo;
PData: pointer;
HDCDest: HDC;
StreamTime: Double;
BitmapHdl: HBITMAP;
NewBitmap: TBitmap;
Jpeg: TJpegImage;
FolderPath: String;
begin
Result := S_FALSE;
try
if (CoCreateInstance(CLSID_MediaDet, nil, CLSCTX_INPROC, IMediaDet, MediaDet) = S_OK) then
begin
try
if (MediaDet.put_Filename(VideoFileName) = S_OK)
and (MediaDet.get_OutputStreams(VideoStreams) = S_OK)
and (VideoStreams > 0)
and (MediaDet.put_CurrentStream(0) = S_OK)
and (MediaDet.get_StreamMediaType(MediaType) = S_OK)
and (MediaDet.get_StreamLength(StreamTime) = S_OK) then
begin
if StreamTime >= FrameTime then
StreamTime := FrameTime;
VideoWidth := PVideoInfoHeader(MediaType.pbFormat)^.bmiHeader.biWidth;
VideoHeight := PVideoInfoHeader(MediaType.pbFormat)^.bmiHeader.biHeight;
if Failed(MediaDet.GetBitmapBits(StreamTime, @buffersize, nil, VideoWidth, VideoHeight)) then
begin
FLastErrorMessage := 'GetBitmapBits(StreamTime, @buffersize, nil, VideoWidth, VideoHeight) failed - ' + VideoFileName;
Exit;
end;
GetMem(Buffer, BufferSize);
try
if Failed(MediaDet.GetBitmapBits(StreamTime, @buffersize, Buffer, VideoWidth, VideoHeight)) then
begin
FLastErrorMessage := 'GetBitmapBits(StreamTime, @buffersize, Buffer, VideoWidth, VideoHeight) failed - ' + VideoFileName;
Exit;
end;
BMIHeader := PBitmapInfoHeader(Buffer);
Inc(BMIHeader);
pData := BMIHeader;
BMIHeader := PBitmapInfoHeader(Buffer);
ZeroMemory(@BMPInfo, sizeof(BITMAPINFO));
CopyMemory(@BMPInfo.bmiHeader, bmiHeader, SizeOf(TBITMAPINFOHEADER));
HDCDest := GetDC(0);
if HDCDest = 0 then
begin
FLastErrorMessage := 'HDCDest = 0 - ' + VideoFileName;
Exit;
end;
try
BitmapHdl := CreateDIBitmap(HDCDest, BMIHeader^, CBM_INIT, pData, BMPInfo, DIB_RGB_COLORS);
if BitmapHdl = 0 then
begin
FLastErrorMessage := 'CreateDIBitmap failed - ' + VideoFileName;
Exit;
end
else
begin
NewBitmap := TBitmap.Create;
try
NewBitmap.Handle := BitmapHdl;
Jpeg := TJpegImage.Create;
try
Jpeg.Assign(NewBitmap);
if Jpeg.Empty then
begin
FLastErrorMessage := 'Jpg.Empty - ' + VideoFileName;
Exit;
end;
Jpeg.CompressionQuality := 100;
FolderPath := ExtractFilePath(ImageFileName);
if not DirectoryExists(FolderPath) then
begin
if not ForceDirectories(FolderPath) then
begin
FLastErrorMessage := 'ForceDirectories(' + FolderPath + ') failed.';
Exit;
end;
end;
Jpeg.SaveToFile(ImageFileName);
finally
Jpeg.Free;
end;
finally
NewBitmap.Free;
end;
end;
finally
ReleaseDC(0, HDCDest );
end;
finally
FreeMem(Buffer);
end;
end
else
begin
if MediaDet.put_Filename(VideoFileName) <> S_OK then
FLastErrorMessage := 'MediaDet.put_Filename(' + VideoFileName + ') failed.'
else if MediaDet.get_OutputStreams(VideoStreams) <> S_OK then
FLastErrorMessage := 'MediaDet.get_OutputStreams(' + IntToStr(VideoStreams) + ') failed.'
else if VideoStreams <= 0 then
FLastErrorMessage := 'VideoStreams = ' + IntToStr(VideoStreams)
else if MediaDet.put_CurrentStream(0) <> S_OK then
FLastErrorMessage := 'MediaDet.put_CurrentStream(0) failed.'
else if MediaDet.get_StreamMediaType(MediaType) <> S_OK then
FLastErrorMessage := 'MediaDet.get_StreamMediaType(MediaType) failed.'
else if MediaDet.get_StreamLength(StreamTime) <> S_OK then
FLastErrorMessage := 'MediaDet.get_StreamLength(StreamTime) failed.'
else
FLastErrorMessage := 'Unknown Error.';
Exit;
end;
finally
MediaDet := nil;
end;
end;
Result := S_OK;
except on E: Exception do
FLastErrorMessage := E.Message;
end;
end;

end.

1,183

社区成员

发帖
与我相关
我的任务
社区描述
Delphi GAME,图形处理/多媒体
社区管理员
  • GAME,图形处理/多媒体社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧