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.

(编辑:aniston)