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

我使用的是Delphi5

我想知道何时使用“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;

---

我用另一种方法克服了视频完成时间

在这里，我提供了.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.

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

再次感谢你所做的一切

---

请告诉我是否缺少某些内容或某些内容可以改进。

TFilterGraph具有此的

OnGraphComplete

事件。在该事件中，“过程FilterGraph1GraphComplete（发送者：ToObject；结果：HRESULT；呈现者：IBaseFilter）；”我将错误作为“未声明的标识符”IBaseFilter“。我不知道如何克服这个错误将

DirectShow9

添加到您的

uses

子句中。是的，这对我很有帮助。非常感谢你，特拉玛，你是伟大的。现在，我将提供完整的代码，说明如何一个接一个地连续运行视频列表。给我一些时间…当然，特拉玛，我会为你做的。。。一次又一次的无限感谢…嗨，特拉玛，我把上面的代码和过程给了另一个人，他使用Windows Vista作为操作系统，他说代码正在编译，当他运行项目时，所有文件路径都显示在列表框中，但没有文件显示视频，也没有声音。。。猜猜看？需要安装任何编解码器吗？嗨，特拉玛，问题已经解决，我让他将“TVideoWindow”组件的“Mode”属性设置为“vmVMR”，现在应用程序显示视频的效果更好。再观察一次，我已经安装了“klmcodec140”编解码器，我将“TVideoWindow”组件的“Mode”属性保留为“vmNormal”，然后它可以很好地播放视频、mp3和所有其他文件，但当我将“Mode”属性设置为“vmVMR”时，只有声音出现，没有视频显示，下一个视频出现错误。因此，只有在没有安装任何编解码器或支持软件时，我们才需要将“Mode”属性设置为“vmVMR”，否则必须将“TVideoWindow”组件的“Mode”属性设置为“vmNormal”。这就是我观察到的。我有Windows8.1 64位。我已经安装了Delphi5。我还通过Delphi 5安装了DS Pack最新版本。当我尝试运行任何.MP4文件时，会出现类似“由于引脚未连接，无法执行操作。（$80040209）。“我已通过此链接安装了DirectX11.2”。还是一样的错误。顺便说一下，安装后DirectX版本显示为“DirectX 11”，而不是“DirectX 11.2”。有什么建议吗？