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