北京上地信息中路
傅强

返回

---- 目前，随着计算机的逐渐普及，人们在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 Mdplayer do 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;
var DoDefault: 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.