How to run video files continuously in Delphi?

Question

I am using Delphi 5.

I want to know when avi file play is completed using 'TFilterGraph'. I want to run number of avi file one after another automatically. So I have downloaded DSPack and used 'TFilterGraph' and 'TVideoWindow' component. avi file video is displaying properly. How do I know the avi video or any video has completed playing so I can select next avi or any other video file to play?

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

I have overcome the video completion time another way.

Here, I have providing the code for .pas file as well as .dfm file.

Of course, there should be DSPack installed already. I have downloaded from the link you provided above. Thanks a lot for that.

Everything works, only you need to change the file type and the file path in the 'ListFileDir' procedure. Rest works fine.

Just save .PAS file with 'NewPlayerSource' name, else you would get an error while compiling the project.

.PAS File Code:

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 File Code:

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

Once again thanks You soooo much TLama for everything.

Let me know if something is missing or something could be improved.