7

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;
mghie
  • 32,028
  • 6
  • 87
  • 129
Vishal Tiwari
  • 739
  • 2
  • 12
  • 28
  • 1
    The `TFilterGraph` has the `OnGraphComplete` event for this. – TLama Oct 23 '13 at 10:38
  • In that event "procedure FilterGraph1GraphComplete(sender: TObject; Result: HRESULT; Renderer: IBaseFilter);" I get error as 'Undeclared identifier 'IBaseFilter' '. I don't know how to overcome this error – Vishal Tiwari Oct 23 '13 at 11:27
  • 1
    Add `DirectShow9` to your `uses` clause. – TLama Oct 23 '13 at 11:34
  • Yessss, that helped me alot. Thank you soooo much TLama, you are the great. Now I would be providing complete code on how to run list of video continuously one by one. Give me some time.... – Vishal Tiwari Oct 23 '13 at 12:04
  • 1
    Sure TLama, I would be doing it for you... Thanks a ton again and again infinitely.... – Vishal Tiwari Oct 23 '13 at 12:06
  • TLama, one more thing, I would like to display the video progress using progress bar. Could you please tell me how could I do this ? And I need to know total time of running video in the beginning of the respective video run. Please help... – Vishal Tiwari Oct 23 '13 at 12:41
  • This could be done by reading `TFilterGraph.Position` and `TFilterGraph.Duration` properties however I don't know when. It seems there is no event notifying about the playback position change, so I think you will need to update that progress bar from a timer with some reasonable interval (e.g. 1 second). But please ask one question per post. Your questions may help to someone else in the future with the same problem and if they would be asked in comments, nobody will find them. – TLama Oct 23 '13 at 13:03
  • Okay TLama, I would keep that in mind. – Vishal Tiwari Oct 23 '13 at 13:55
  • There is no TFilterGraph.Position in Delphi 5. Could you please check. – Vishal Tiwari Oct 23 '13 at 14:00
  • I can see [`it here`](https://code.google.com/p/dspack/source/browse/trunk/src/DSPack/DSPack.pas#388). Note that it's not a published property that can be seen in Object Inspector at design time. It's a public property which you can use just in code. Post that progress bar thing as a new question, please. Something tells me there should be a better way than using a timer and repetitive reading of those properties. Someone more experienced in DSPack (or just DirectShow) will surely help. – TLama Oct 23 '13 at 14:10
  • I have checked my DSPack.pas file the date is same with your DSPack, but Position property is not there. Is thhat possible if I copy entire DSPack code which you shown in link and paste in my DSPack.pas file ? – Vishal Tiwari Oct 23 '13 at 14:34
  • Do you have any link where I could download and install latest DSPack ? – Vishal Tiwari Oct 23 '13 at 14:39
  • It's currently hosted [`here on Google code`](https://code.google.com/p/dspack/). – TLama Oct 23 '13 at 14:45
  • I downloaded and installed, still there is no 'Position' property in DSPack.pas file. It's starts from 'Duration' property. – Vishal Tiwari Oct 23 '13 at 15:03

1 Answers1

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.

mghie
  • 32,028
  • 6
  • 87
  • 129
Vishal Tiwari
  • 739
  • 2
  • 12
  • 28
  • Hi TLama, I gave above code and process to another person, who is having Windows Vista as operating system, he said code is compiling, when he runs the project all file paths are displayed in the list box, but no file is displaying the video and there is no sound... Any guess? any codec needs to be installed ? – Vishal Tiwari Oct 24 '13 at 10:58
  • Hi TLama, the issue has been resolved, I asked him to set 'Mode' property of 'TVideoWindow' component to 'vmVMR' and now the application is displying the video even better. – Vishal Tiwari Oct 24 '13 at 11:50
  • One more observation, I had installed 'klmcodec140' codec and I kept 'Mode' property of 'TVideoWindow' component to 'vmNormal' then it was playing video and mp3 and all other files well, but when I made 'Mode' property to 'vmVMR' then only sound was coming and no vido display, for next video there was an error. So we need to set 'Mode' property to 'vmVMR' only when we don't have any codec or supporting software installed, else we must set 'Mode' property of 'TVideoWindow' component to 'vmNormal'. This is what I got the observation. – Vishal Tiwari Oct 24 '13 at 11:55
  • I have Windows8.1 64-bit. I have Delphi 5 installed. I have also installed DS Pack latest version via Delphi 5. When I try to run any .MP4 file, I get error like "The operation cannot be performed because the pins are not connected. ($80040209)." I have installed DirectX11.2 via this link " http://sh.st/bf0u3 ". Still same error. By the way, after installation DirectX Version shows is "DirectX 11" and not "DirectX 11.2". Any suggestion ? – Vishal Tiwari Dec 19 '15 at 13:16