再谈截屏问题?(300分)

截屏时怎样才能截取活动视频图象(比如MediaPlayer中正在播放的图象,采集卡用Overlay显
示的图象,DX游戏的图象...)

在多媒体文件中批量抓取图象


---- 目前，随着计算机的逐渐普及，人们在VCD影碟、游戏光盘、甚至是学习软件中，都可以获得大量的多媒体文件。如何把其中的心爱片段剪辑下来，制作成BMP位图、AVI视频文件，或是压缩成JMEP动画图片，已经成为人们日益关心的问题。


---- 其实，用DELPHI只需要不多的几行程序就可以在多媒体文件中实现批量抓取图象的功能，而且，采样频率还可自由设定。至于如何将剪辑下来的位图制作成AVI或JPEG文件，相关的软件以及程序的制作介绍已经很多了，如Paint Shop Pro等，这里便不再多说。下面，就让我们DIY。


---- 首先，我们需要一个媒体播放器：System卡下的MediaPlayer控件(MdPlayer)。MediaPlayer控件可以播放有声或无声的AVI剪辑，CD唱盘等各种多媒体文件，如果用户安装了Microsoft 的 ActiveMovie的话，其还能播放MPEG格式的电影(.dat)。为了便于管理，我们需要一个Panel作为播放的画板(Panel1)，并将MdPlayer的Display属性设为Panel1。Label1显示文件名、文件的总帧数以及起始位置， Label2显示当前位置。Edit1显示采样率，即，每隔几帧进行一次图象抓取，由一个UpDown控件(UpDown1)进行控制，min属性设为1、max属性设为10、Position属性设为1即，采样率为1—10帧/点，默认为1。TrackBar1控制文件的播放位置。SpeedButton1的Flat为True，GroupIndex为1，按下时准备采样，弹起时停止采样。Button1打开文件选取菜单。


---- 接着，我们需要编写程序。文件打开之后对MdPlayer执行Open方法，即可在Panel1上播放。当按下‘准备采样’按钮后，在MdPlayer的OnClick 事件中写下如下代码


if ((Button = btBack) or (Button = btStep))

and Fetchf then


//采样按钮是否按下，是否点击的是前进或后退按钮

（兰色按钮）

//如满足条件：

try

myBmp := TBitMap.Create

//创建位图对象

MyCanvas := TCanvas.Create

//创建画布对象

rect := mdPlayer.DisplayRect

//取边界

Dc := GetDc(Panel1.Handle);

//取得Panel1的设备环境

myCanvas.Handle := dc;

//赋给画布对象

myBmp.Width := rect.Right - rect.Left

myBmp.Height := rect.Bottom - rect.Top

//设定位图大小

myBmp.Canvas.CopyRect(rect

myCanvas

Rect);

//复制于位图对象上

. . . .

//将文件保存于特定路径

//释放所有句柄


详细程序如下：

var

Form1 : TForm1;

Fetchf : Boolean;

path : string;

Count : integer;


implementation


{$R *.DFM}


Procedure TForm1.UpdataTrackBar

begin


TrackBar.min := MdPlayer.StartPos;

TrackBar.max := MdPlayer.Length;

TrackBar.Position := MdPlayer.Position;

Label2.Caption := '当前位置： '

+Inttostr(MdPlayer.Position);

end;



procedure TForm1.InitShow;

begin


with Mdplayerdo
begin


Form1.Caption := FileName

Path := ExtractFilePath(FileName)+'bmp';

Count := 0;

if FileName < > '' then
begin


Open;

TrackBar.Enabled := True;

UpdataTrackBar;

TrackBar.SetFocus

Frames := 1;

label1.Caption :='文件名: ' +

FileName + #13#10 +' 总长度: '+ Inttostr(Length);

label1.Caption :=Label1.Caption +

#13#10 +' 起始位置: '+ Inttostr(StartPos)

end else
begin


Label1.Caption :='';

Label2.Caption :='';

end;


end;


end;



procedure TForm1.FormCreate(Sender: TObject);

begin


MdPlayer.FileName :='';

TrackBar.Enabled := False;

InitShow;

end;



procedure TForm1.FormClose(Sender: TObject;

var Action: TCloseAction);

begin


mdPlayer.Close

end;



procedure TForm1.SpeedButton1Click(Sender: TObject);

begin


if SpeedButton1.Down then
begin


Fetchf := True;

mdPlayer.Frames := updown1.Position

end

else
Fetchf := False;

end;



procedure TForm1.Button1Click(Sender: TObject);

begin


MdPlayer.Close

TrackBar.Enabled := False;

label1.Caption := '';

label2.Caption := '';

if OpenDlg.Execute then
begin


mdPlayer.FileName := OpenDlg.FileName

InitShow

end;


end;



procedure TForm1.MdPlayerClick(Sender: TObject;

Button: TMPBtnType;

vardo
Default: Boolean);

var MyBmp : TBitmap;

MyCanvas : Tcanvas;

dc : Hdc;

rect : TRect;

name

tmp : String;

begin


UpdataTrackBar;

if ((Button = btBack) or (Button = btStep))

and Fetchf then


try

myBmp := TBitMap.Create

MyCanvas := TCanvas.Create

rect := mdPlayer.DisplayRect


Dc := GetDc(Panel1.Handle);

myCanvas.Handle := dc;


myBmp.Width := rect.Right - rect.Left

myBmp.Height := rect.Bottom - rect.Top

myBmp.Canvas.CopyRect(rect

myCanvas

Rect);

count :=count+1;


if count< 10 then
name := '000' + Inttostr(count)

else
if count < 100 then
name := '00'

+ Inttostr(count)

else
if count< 1000 then
name := '0'

+ Inttostr(count);

name := Path + name + '.bmp';

myBmp.SaveToFile(name);


finally

ReleaseDC(0

dc);

myBmp.Free;

myCanvas.Free;

end;


end;



procedure TForm1.TrackBarChange(Sender: TObject);

begin


MdPlayer.Position := TrackBar.Position

Label2.Caption := '当前位置： '

+Inttostr(MdPlayer.Position);

end;



end.

这样做，播放avi没问题，但播放VCD和MPEG不行

to tuzi1125:
先谢谢你的代码,正如gxlzbig所说,活动视频抓下来是黑的.
再者,自己播放自己拍照和抓拍其他程序又不一样.
已有很多类似讨论,都没有一个很完美的答案.
http://www.delphibbs.com/delphibbs/dispq.asp?lid=538683
http://www.delphibbs.com/delphibbs/dispq.asp?lid=603769
http://www.delphibbs.com/delphibbs/dispq.asp?lid=447312

是啊！

普通抓屏肯定不行！

要截取多媒体视频流

这样的抓屏软件有吗？
如果是抓取自己的视频播放程序的图象，倒好办！
别人的，关注！

MediaPlayer图象可以直接截取
DX游戏的图象..可以到显存中。。请参考DIRECTX编程
才不久前结束了一个比较好的讨论 基本DELPHI代码实现：）
请搜索：DIRECTX 截图

请房客提供ID,万分感谢

好像是这一个吧.644869
你自己要这方面的资料,搜索一下DirectX方面的答案,你看了不是更有帮助?

超级解霸2002是怎么实现的，不过好象没有realPaly清晰。
压缩的那么厉害。

一个取巧的方法……把硬件加速关掉，
采用正常的截取方法，就可以截取流媒体的等格式文件了。

先暂停播放mediaplayer1.pause;
截取画面，放下一幅，暂停，抓图如此循环！

DirectX SDK本身带了一个演示程序的.
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, DSFilters, DirectShow, StdCtrls, OleServer, dspack, ExtCtrls,
ComCtrls;

type
TForm1 = class(TForm)
FilterGraph: TDSFilterGraph2;
Button1: TButton;
DSVideoWindow1: TDSVideoWindow;
Image1: TImage;
FilterSampleGrabber: TFilterSampleGrabber;
OpenDialog: TOpenDialog;
StatusBar1: TStatusBar;
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
procedure Button1Click(Sender: TObject);
procedure FilterSampleGrabberBuffer(sender: TComponent;
Buffer: TBufferCB);
private
{ Private declarations }
public
{ Public declarations }
end;


var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin

FilterGraph.Disconnect;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin

if OpenDialog.Execute then

begin

FilterGraph.ClearGraph;
FilterGraph.FilterGraph2.AddFilter(FilterSampleGrabber.BaseFilter, 'Grabber');
FilterSampleGrabber.SetBMPCompatible(nil,24);
FilterGraph.FilterGraph2.RenderFile(StringToOleStr(Opendialog.FileName),nil);
FilterGraph.QueryInterfaces;
FilterGraph.MediaControl.Run;
end;

end;


procedure TForm1.FilterSampleGrabberBuffer(sender: TComponent;
Buffer: TBufferCB);
begin

FilterSampleGrabber.GetBitmap(image1.Picture.Bitmap,Buffer);
StatusBar1.SimpleText := floattostr(buffer.SampleTime);
end;


end.

哥们，自己做播放器当然好截取。

截取别人的VCD画面之类
最简单的方法当然是暂停DIRCTEX加速
/Program Files/directx/setup
暂停加速即可
TOPMAIN的屏幕广播就是这样做的.请注意它目录下的VideoSet.exe

请问jingtao，如何在程序运行中暂停加速，谢谢

to :jingtao，能否把(帖子：691468)DirectX SDK本身带了一个演示程序的给小弟发一份过来？

谢谢~

很好的思路！