⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 unit1.pas

📁 Direct 9.0的播放器 DirectShowPlay
💻 PAS
字号:
🔍 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, ImgList,IniFiles, StdCtrls, MPlayer,
  OleCtrls, ShockwaveFlashObjects_TLB, mmsystem,DirectShow9,ole2,FileCtrl,
  Menus;

type
  TForm1 = class(TForm)
    ImageList1: TImageList;
    Image_open: TImage;
    OpenDialog1: TOpenDialog;
    Panel1: TPanel;
    Button1: TButton;
    Timer_play: TTimer;
    Image_pause: TImage;
    Image_stop: TImage;
    Image_discard: TImage;
    Image_step: TImage;
    Image_back: TImage;
    Panel_play: TPanel;
    Image_play: TImage;
    Panel3: TPanel;
    frame: TTrackBar;
    volume: TTrackBar;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Button2: TButton;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    Panel2: TPanel;
    GroupBox2: TGroupBox;
    Panel4: TPanel;
    GroupBox1: TGroupBox;
    N6: TMenuItem;
    N7: TMenuItem;
    procedure Image_openClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer_playTimer(Sender: TObject);
    procedure Image_pauseClick(Sender: TObject);
    procedure Image_stopClick(Sender: TObject);
    procedure Image_playMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_playMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image_playMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1Resize(Sender: TObject);
    procedure frameChange(Sender: TObject);
    procedure volumeChange(Sender: TObject);
    procedure Image_playClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
  private
    { Private declarations }
  procedure Directplay();
  procedure CloseDxcom;
  public
    { Public declarations }
    {PositionChange : Boolean;
    FileIndex:integer;          //播放文件的索引
    FileCount:integer;          //列表中文件总数
    FileChange:boolean;         //通知主窗口播放歌曲已改
    FileLength:longint;         //文件长度
    FilePosition:longint;       //当前播放的帧数
    Drive: char;                 //光驱盘符
    CDopen : Boolean;            //光驱是否打开
    FileListName:TIniFile;       //列表文件关联名
    Playingpause : Boolean;      //暂停控制
    }
  end;

var
  Form1: TForm1;
  g_pGraphBuilder: IGraphBuilder = nil;
  g_pMediaControl: IMediaControl = nil; // 播放状态设置.
  g_pMediaSeeking: IMediaSeeking = nil; // 播放位置.
  g_pAudioControl: IBasicAudio = nil; // 音量/平衡设置.
  g_pVideoWindow: IVideoWindow = nil; //设置播放窗体.
  PLAYING: boolean = false; //判断是否正在播放
  a:boolean;
  sss:IAMTVAudio;
  s: string;
implementation

{$R *.dfm}
function   GetFileSize(const   FileName:   string):integer;   
  var   
      f:TFileStream;
      {f_name:string;
      f:file   of   byte;
      size,i:integer;
      }
  begin   
      f   :=   TFileStream.Create(FileName,fmOpenRead   or   fmShareDenyNone);   
      Result   :=f.Size;   
      F.Free;
      {f_name:=opendialog.filename;   
          assignfile(f,f_name);
          Reset(f);
          size:=filesize(f);
          closefile(f);}
  end;   

function Initdxcom: boolean;
begin
  Result := false;  // 初始化COM接口
  if failed(CoInitialize(nil)) then exit;  // 创建DirectShow Graph
  if failed(CoCreateInstance(OLE2.TGUID(CLSID_FilterGraph),nil, CLSCTX_INPROC,
    OLE2.TGUID(IID_IGraphBuilder),g_pGraphBuilder)) then exit;  // 获取IMediaControl 接口
  if failed(g_pGraphBuilder.QueryInterface(IID_IMediaControl,
    g_pMediaControl)) then exit;  // 获取IMediaSeeking 接口
  if failed(g_pGraphBuilder.QueryInterface(IID_IMediaSeeking,
    g_pMediaSeeking)) then exit;  // 获取IBasicAudio 接口
  if failed(g_pGraphBuilder.QueryInterface(IID_IBasicAudio,
    g_pAudioControl)) then exit;  // 获取IVideowindow 接口
  if failed(g_pGraphBuilder.QueryInterface(IID_IVideoWindow,
    g_pVideoWindow)) then exit;  // 所有接口获取成功
  Result := true;
end;
procedure TForm1.Directplay();
begin
  g_pVideoWindow.put_Owner(panel1.handle);
  g_pVideoWindow.put_windowstyle(WS_CHILD or WS_Clipsiblings); //参数类型见WINDOWS API
  g_pVideoWindow.SetWindowposition(0, 0, panel1.width, panel1.height); //播放的图像为整个panel1的ClientRect
  //g_pAudioControl.put_Volume((volume.Position-3000 ) * 100);//设置音量
  g_pAudioControl.put_Volume(volume.Position-3000);
  g_pMediaControl.run;
  Timer_play.enabled := true;
  PLAYING := true;
  Image_play.Enabled:=false;
  Image_pause.Enabled:=true;
end;
procedure TForm1.CloseDxcom; // 停止播放
begin
  if Assigned(g_pMediaControl) then g_pMediaControl.Stop;  // 释放所有用到的接口。
  if Assigned(g_pAudioControl) then g_pAudioControl := nil;
  if Assigned(g_pMediaSeeking) then g_pMediaSeeking := nil;
  if Assigned(g_pMediaControl) then g_pMediaControl := nil;
  if Assigned(g_pVideoWindow) then g_pVideoWindow := nil;
  if Assigned(g_pGraphBuilder) then g_pGraphBuilder := nil;
  frame.Position:=0;
  CoUninitialize;
end;
procedure TForm1.Image_openClick(Sender: TObject);
var
  i:integer;
  d:double;
   _hr: Hresult;
  wFile: array[0..(Max_path * 2) - 1] of char;
begin
   s:='';
   Image_play.Enabled:=false;
        OpenDialog1.Filter :='音频文件(*.WAV,*.MP3,*.WMA,*.MID,*.RMI,*.CDA)|*.WAV;*.MP3;*.WMA;*.MID;*.RMI;*.CDA|视频文件(*.MPG,*.AVI,*.DAT,*.ASF,*.MPEG,*.WMV,*.RM,*.RMVB)|*.MPG;*.AVI;*.DAT;*.ASF;*.MPEG;*.WMV;*.RM;*.RMVB|所有文件(*.*)|*.*';
    if OpenDialog1.execute then //获取指定视频文件
      begin
      s := OpenDialog1.filename;
      PLAYING:=false;
      i:=Round(GetFileSize(s)/1024);
      //if s='' then exit;
      //if i>6240 then
      //begin
      // showmessage('打开文件应小于6M');
      //    exit;
      //end;
          CloseDxcom;
          Initdxcom;
        MultiByteToWideChar(CP_ACP, 0, pchar(s), -1, @wFile, MAX_PATH); //转换格式
      _hr := g_pGraphBuilder.renderfile(@wfile, nil); // 建立了一个能够播放文件的Filter Graph。第一个参数是文件名，第二个参数必须为nil

      if failed(_hr) then
        begin
          showmessage('打开文件错误');
          exit;
        end;
      Image_play.Enabled:=true;
      Image_pause.Enabled:=false;
      Image_stop.Enabled:=true;
      g_pAudioControl.put_Balance(0);
      volume.Enabled:=true;
      frame.Enabled:=true;
      Directplay();
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
  tempname: String;
begin
if Initdxcom() = false then showmessage('初始化DIRECTX SHOW接口出错');
volume.Position:=volume.Max;
volume.SelStart:=0;
volume.SelEnd:=volume.Position;
end;

procedure TForm1.Timer_playTimer(Sender: TObject);
var
_current11,_current, _stop: LONGLONG;
_newpos: longlong;
begin

  if not PLAYING then exit;
  g_pMediaSeeking.GetCurrentPosition(_current11);
  g_pMediaSeeking.GetPositions(_current, _stop); //获得当前位置
  a:=false;
  if _stop <> 0  then
  begin
  frame.Position := Trunc((_current * 100)/_stop);//
  end;
  if _current = _stop then
  begin
  frame.Position := 0;
  g_pMediaSeeking.GetStopPosition(_stop); // 获得当前播放帧数
  _newpos := (_stop * frame.position) div 100;  // 范围检查
  if _newpos < 0 then _newpos := 0;
  if _newpos > _stop then _newpos := _stop;  // 设置新播放帧数位置
  g_pMediaSeeking.SetPositions(_newpos, AM_SEEKING_AbsolutePositioning,
    _newpos, AM_SEEKING_NoPositioning);
    
  Directplay();
  //Image_play.Enabled:=true;
  end;
  a:=true;
end;


procedure TForm1.Image_pauseClick(Sender: TObject);
begin
  g_pMediaControl.pause;
  Timer_play.enabled:=false;
  Image_play.Enabled:=true;
  Image_pause.Enabled:=false;
end;

procedure TForm1.Image_stopClick(Sender: TObject);
begin
  g_pMediaControl.stop;
  PLAYING:=false;
  Timer_play.enabled := false;
  Image_play.Enabled:=false;
  Image_pause.Enabled:=false;
  Image_stop.Enabled:=false;
  g_pVideoWindow.put_visible(false);
  g_pVideoWindow.put_Owner(0);
  g_pVideoWindow.put_Width(0);
  g_pVideoWindow.put_Height(0);
  CloseDxcom;
end;

procedure TForm1.Image_playMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Image_play.left := Image_play.Left +1;
Image_play.top := Image_play.Top +1;
end;

procedure TForm1.Image_playMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
   Image_play.Hint := '播放';
end;

procedure TForm1.Image_playMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Image_play.left := Image_play.Left -1;
Image_play.top := Image_play.Top -1;
end;

procedure TForm1.Panel1Resize(Sender: TObject);
begin
  g_pVideoWindow.put_Width(panel1.width);
  g_pVideoWindow.put_Height(panel1.height);
end;

procedure TForm1.frameChange(Sender: TObject);
var
  _stop: LONGLONG;
  _newpos: longlong;
begin
 if not PLAYING then exit;
  if a=false then exit;
  g_pMediaSeeking.GetStopPosition(_stop); // 获得当前播放帧数
  _newpos := (_stop * frame.position) div 100;  // 范围检查
  if _newpos < 0 then _newpos := 0;
  if _newpos > _stop then _newpos := _stop;  // 设置新播放帧数位置
  g_pMediaSeeking.SetPositions(_newpos, AM_SEEKING_AbsolutePositioning,
    _newpos, AM_SEEKING_NoPositioning);
end;

procedure TForm1.volumeChange(Sender: TObject);
begin
 if not PLAYING then exit;
  g_pAudioControl.put_Volume(volume.Position-3000);
  //g_pAudioControl.put_Volume((volume.Position-3000 ) * 100);
  volume.SelStart:=0;
  volume.SelEnd:=volume.Position;
end;

procedure TForm1.Image_playClick(Sender: TObject);
begin
Directplay();
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if s='' then exit;
copyfile(pchar(s),pchar(edit1.Text),false);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  {g_pVideoWindow.put_Owner(panel1.handle);
  g_pVideoWindow.put_windowstyle(WS_CHILD or WS_Clipsiblings); //参数类型见WINDOWS API
  g_pVideoWindow.SetWindowposition(0, 0, panel1.width, panel1.height); //播放的图像为整个panel1的ClientRect
  }
end;

procedure TForm1.N1Click(Sender: TObject);
begin
g_pVideoWindow.put_Owner(panel2.handle);
  g_pVideoWindow.put_windowstyle(WS_CHILD or WS_Clipsiblings); //参数类型见WINDOWS API
  g_pVideoWindow.SetWindowposition(0, 0, panel2.width, panel2.height); //播放的图像为整个panel1的ClientRect
end;

procedure TForm1.N2Click(Sender: TObject);
begin
g_pVideoWindow.put_Owner(panel1.handle);
  g_pVideoWindow.put_windowstyle(WS_CHILD or WS_Clipsiblings); //参数类型见WINDOWS API
  g_pVideoWindow.SetWindowposition(0, 0, panel1.width, panel1.height); //播放的图像为整个panel1的ClientRect
end;

procedure TForm1.N3Click(Sender: TObject);
begin
Directplay();
end;

procedure TForm1.N4Click(Sender: TObject);
begin
 g_pMediaControl.pause;
  Timer_play.enabled:=false;
  Image_play.Enabled:=true;
  Image_pause.Enabled:=false;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
 g_pMediaControl.stop;
  PLAYING:=false;
  Timer_play.enabled := false;
  Image_play.Enabled:=false;
  Image_pause.Enabled:=false;
  Image_stop.Enabled:=false;
  g_pVideoWindow.put_visible(false);
  g_pVideoWindow.put_Owner(0);
  g_pVideoWindow.put_Width(0);
  g_pVideoWindow.put_Height(0);
  CloseDxcom;
end;

procedure TForm1.N6Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.N7Click(Sender: TObject);
var
  i:integer;
  d:double;
   _hr: Hresult;
  wFile: array[0..(Max_path * 2) - 1] of char;
begin
   s:='';
   Image_play.Enabled:=false;
        OpenDialog1.Filter :='音频文件(*.WAV,*.MP3,*.WMA,*.MID,*.RMI,*.CDA)|*.WAV;*.MP3;*.WMA;*.MID;*.RMI;*.CDA|视频文件(*.MPG,*.AVI,*.DAT,*.ASF,*.MPEG,*.WMV,*.RM,*.RMVB)|*.MPG;*.AVI;*.DAT;*.ASF;*.MPEG;*.WMV;*.RM;*.RMVB|所有文件(*.*)|*.*';
    if OpenDialog1.execute then //获取指定视频文件
      begin
      s := OpenDialog1.filename;
      PLAYING:=false;
      i:=Round(GetFileSize(s)/1024);
      //if s='' then exit;
      //if i>6240 then
      //begin
      // showmessage('打开文件应小于6M');
      //    exit;
      //end;
          CloseDxcom;
          Initdxcom;
        MultiByteToWideChar(CP_ACP, 0, pchar(s), -1, @wFile, MAX_PATH); //转换格式
      _hr := g_pGraphBuilder.renderfile(@wfile, nil); // 建立了一个能够播放文件的Filter Graph。第一个参数是文件名，第二个参数必须为nil

      if failed(_hr) then
        begin
          showmessage('打开文件错误');
          exit;
        end;
      Image_play.Enabled:=true;
      Image_pause.Enabled:=false;
      Image_stop.Enabled:=true;
      g_pAudioControl.put_Balance(0);
      volume.Enabled:=true;
      frame.Enabled:=true;
      Directplay();
   end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -