delphidirectshowdelphi-5dspack

How to run video files continuously in Delphi?


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;

Solution

  • 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.