我以另一种方式克服了视频完成时间。
在这里,我提供了 .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.
.DFM 文件代码:
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
再次感谢您对 TLama 所做的一切。
让我知道是否缺少某些内容或可以改进的内容。