delphi - 如何在Delphi中连续运行视频文件？

Question

我使用的是 Delphi 5。

我想知道使用“TFilterGraph”何时完成 avi 文件播放。我想自动运行多个avi文件。所以我下载了 DSPack 并使用了“TFilterGraph”和“TVideoWindow”组件。 avi 文件视频正常显示。我如何知道 avi 视频或任何视频已完成播放，以便我可以选择下一个 avi 或任何其他视频文件进行播放？

procedure TForm1.Button2Click(Sender: TObject);
begin
  videowindow1.FilterGraph:=filtergraph1; //query interfaces to video window
  filtergraph1.Active:=true;
  filtergraph1.RenderFile('I:\Project Part 1\Clips\More Clips\D.avi');
  filtergraph1.Play;
end;

Answer 1

我通过另一种方式克服了视频完成时间。

在这里，我提供了 .pas 文件和 .dfm 文件的代码。

当然，应该已经安装了 DSPack。我已经从您上面提供的链接下载了。非常感谢。

一切正常，只需更改“ListFileDir”过程中的文件类型和文件路径。休息一下就好了。

只需使用“NewPlayerSource”名称保存 .PAS 文件，否则编译项目时会出现错误。

.PAS 文件代码:

unit NewPlayerSource;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, MPlayer, StdCtrls, Buttons, FileCtrl, ComCtrls, DSPack,
  DirectShow9;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    MediaPlayer1: TMediaPlayer;
    Panel1: TPanel;
    FileListBox1: TFileListBox;
    ListBox1: TListBox;
    Button1: TButton;
    Animate1: TAnimate;
    VideoWindow1: TVideoWindow;
    FilterGraph1: TFilterGraph;
    Label1: TLabel;
    Label2: TLabel;
    ProgressBar1: TProgressBar;
    Label3: TLabel;
    btnPlaySelectedFile: TButton;
    btnPause: TButton;
    btnResume: TButton;
    procedure FormShow(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);                            
    procedure Button1Click(Sender: TObject);
    procedure ListFileDir(Path: string; var FileList: TListBox);
    procedure FilterGraph1GraphComplete(sender: TObject; Result: HRESULT;
      Renderer: IBaseFilter);
    procedure btnPlaySelectedFileClick(Sender: TObject);
    procedure btnPauseClick(Sender: TObject);
    procedure btnResumeClick(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }

    bVideoCompleted, bPlaySelectedVideo, bPuseButtonPressed : Boolean;

    procedure PlayVideo;
    procedure SetupProgressBar;
    function SecToTime(Sec: Integer): string;
  end;

var
  Form1: TForm1;
  iCount, iSeconds: Integer;

implementation

{$R *.dfm}
procedure TForm1.ListFileDir(Path: string; var FileList: TListBox);
var
  SR: TSearchRec;
begin
  if FindFirst(Path + '*.avi', faAnyFile, SR) = 0 then
  begin
    repeat
      if (SR.Attr <> faDirectory) then
      begin
        FileList.Items.Add(Path + SR.Name);
      end;
    until FindNext(SR) <> 0;

    FindClose(SR);
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  bVideoCompleted := False;
  bPlaySelectedVideo := False;
  bPuseButtonPressed := False;

  ListBox1.Items.Clear;
  Label1.Caption := EmptyStr;
  Label2.Caption := EmptyStr;

  ListFileDir('I:\Project Part 1\Clips\More Clips\', ListBox1);

  btnResume.Enabled := False;

  if ListBox1.Items.Count = 0 then
  begin
    btnPlaySelectedFile.Enabled := False;
    btnPause.Enabled := False;
    ShowMessage('No files to play');
    Exit;
  end;

  iCount := 0;
  ListBox1.ItemIndex := iCount;

  PlayVideo;

  {with MediaPlayer1 do
    begin
      Close;
       //DeviceType := dtAVIVideo;
        DeviceType := dtAutoSelect;
        FileName := ListBox1.Items.Strings[iCount];
        ListBox1.ItemIndex := iCount;
        iCount := iCount + 1;
        Open;
        //DisplayRect := Rect(0, 0, Panel1.Width, Panel1.Height);
        Play;
    end;
  }
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if ListBox1.Items.Count = 0 then
    Exit;

  if bPuseButtonPressed = True then
    Exit;

  if bVideoCompleted = True then
  begin
    bVideoCompleted := False;

    if iCount >= ListBox1.Items.Count then
      iCount := 0;

    PlayVideo;
  end;

  Label2.Caption := FormatDateTime('hh:nn:ss', iSeconds / SecsPerDay);
  ProgressBar1.Position := ProgressBar1.Position + 1;

  iSeconds := iSeconds + 1;

  {if MediaPlayer1.Position = MediaPlayer1.Length then
  begin
    if iCount = ListBox1.Items.Count then
      iCount := 0;

    with MediaPlayer1 do
    begin
      Close;
      FileName := ListBox1.Items.Strings[iCount];
      ListBox1.ItemIndex := iCount;
      iCount := iCount + 1;
      Open;
      Play;
    end;
  end;
  }
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FilterGraph1GraphComplete(sender: TObject;
  Result: HRESULT; Renderer: IBaseFilter);
begin
  bVideoCompleted := True;
end;

procedure TForm1.PlayVideo;
begin
  iSeconds := 0;

  SetupProgressBar;

  filtergraph1.Stop;
  filtergraph1.ClearGraph;
  videowindow1.FilterGraph:=filtergraph1;
  filtergraph1.Active:=true;

  if bPlaySelectedVideo = True then
    filtergraph1.RenderFile(ListBox1.Items.Strings[ListBox1.ItemIndex])
  else
    filtergraph1.RenderFile(ListBox1.Items.Strings[iCount]);
  filtergraph1.Play;

  bPlaySelectedVideo := False;

  Label1.Caption :=  FormatDateTime('hh:nn:ss', (filtergraph1.Duration/1000) / SecsPerDay);
  Label2.Caption := FormatDateTime('hh:nn:ss', iSeconds / SecsPerDay);

  ListBox1.ItemIndex := iCount;
  iCount := iCount + 1;

  SetupProgressBar;
end;

procedure TForm1.SetupProgressBar;
begin
  ProgressBar1.Position := 0;
  ProgressBar1.Step := 1;
  ProgressBar1.Min := 0;
  ProgressBar1.Max := StrToInt(FloatToStr(filtergraph1.Duration div 1000)) + 1;
end;

function TForm1.SecToTime(Sec: Integer): string;
var
   H, M, S: string;
   ZH, ZM, ZS: Integer;
begin
   Sec := Sec div 1000;
   ZH := Sec div 3600;
   ZM := Sec div 60 - ZH * 60;
   ZS := Sec - (ZH * 3600 + ZM * 60) ;
   H := IntToStr(ZH) ;
   M := IntToStr(ZM) ;
   S := IntToStr(ZS) ;
   Result := H + ':' + M + ':' + S;
end;

procedure TForm1.btnPlaySelectedFileClick(Sender: TObject);
begin
  bPlaySelectedVideo := True;
  bPuseButtonPressed := False;

  btnPause.Enabled := True;
  btnResume.Enabled := False;

  iCount := ListBox1.ItemIndex;

  PlayVideo;
end;

procedure TForm1.btnPauseClick(Sender: TObject);
begin
  filtergraph1.Pause;

  bPuseButtonPressed := True;

  btnPause.Enabled := False;
  btnResume.Enabled := True;
end;

procedure TForm1.btnResumeClick(Sender: TObject);
begin
  filtergraph1.Play;

  bPuseButtonPressed := False;

  btnResume.Enabled := False;
  btnPause.Enabled := True;
end;

end.

.DFM 文件代码:

object Form1: TForm1
  Left = 305
  Top = 149
  BorderStyle = bsSingle
  Caption = 'overflow'
  ClientHeight = 589
  ClientWidth = 941
  Color = clBtnFace
  Font.Charset = ANSI_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 897
    Top = 568
    Width = 32
    Height = 13
    Alignment = taRightJustify
    Caption = 'Label1'
    Font.Charset = ANSI_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    ParentFont = False
  end
  object Label2: TLabel
    Left = 256
    Top = 568
    Width = 32
    Height = 13
    Caption = 'Label2'
    Font.Charset = ANSI_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    ParentFont = False
  end
  object Label3: TLabel
    Left = 10
    Top = 16
    Width = 73
    Height = 13
    Caption = 'List of files path'
    Font.Charset = ANSI_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    ParentFont = False
  end
  object MediaPlayer1: TMediaPlayer
    Left = 300
    Top = 132
    Width = 113
    Height = 23
    EnabledButtons = [btPlay, btPause, btStop, btNext]
    VisibleButtons = [btPlay, btPause, btStop, btNext]
    AutoOpen = True
    DeviceType = dtAVIVideo
    Display = Panel1
    TabOrder = 0
  end
  object Panel1: TPanel
    Left = 504
    Top = 18
    Width = 139
    Height = 109
    Caption = 'Panel1'
    TabOrder = 1
  end
  object FileListBox1: TFileListBox
    Left = 504
    Top = 198
    Width = 139
    Height = 73
    ItemHeight = 13
    TabOrder = 2
  end
  object ListBox1: TListBox
    Left = 10
    Top = 32
    Width = 231
    Height = 163
    ItemHeight = 13
    TabOrder = 3
  end
  object Button1: TButton
    Left = 312
    Top = 276
    Width = 56
    Height = 19
    Caption = 'CLOSE'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -13
    Font.Name = 'Tahoma'
    Font.Style = [fsBold]
    ParentFont = False
    TabOrder = 4
    OnClick = Button1Click
  end
  object Animate1: TAnimate
    Left = 664
    Top = 48
    Width = 209
    Height = 185
    Active = False
  end
  object VideoWindow1: TVideoWindow
    Left = 256
    Top = 16
    Width = 673
    Height = 521
    FilterGraph = FilterGraph1
    VMROptions.Mode = vmrWindowed
    Color = clBlack
  end
  object ProgressBar1: TProgressBar
    Left = 256
    Top = 544
    Width = 673
    Height = 17
    Min = 0
    Max = 100
    Smooth = True
    Step = 1
    TabOrder = 7
  end
  object btnPlaySelectedFile: TButton
    Left = 8
    Top = 208
    Width = 234
    Height = 25
    Caption = '&Play selected file'
    TabOrder = 8
    OnClick = btnPlaySelectedFileClick
  end
  object btnPause: TButton
    Left = 8
    Top = 240
    Width = 117
    Height = 25
    Caption = 'Pa&use'
    TabOrder = 9
    OnClick = btnPauseClick
  end
  object btnResume: TButton
    Left = 128
    Top = 240
    Width = 117
    Height = 25
    Caption = '&Resume'
    TabOrder = 10
    OnClick = btnResumeClick
  end
  object Timer1: TTimer
    OnTimer = Timer1Timer
    Left = 56
    Top = 352
  end
  object FilterGraph1: TFilterGraph
    GraphEdit = False
    LinearVolume = True
    OnGraphComplete = FilterGraph1GraphComplete
    Left = 128
    Top = 352
  end
end

再次感谢 TLama 所做的一切。

如果有什么遗漏或需要改进的地方，请告诉我。