delphivideodirectshowdspack

How do you loop a video using DSPack?


I've got a very simple program that uses DSPack from within Delphi 2010. I have a form with a TFilterGraph and a TVideoWindow. The video plays and renders nicely. I can't seem to figure out how to make the video loop back to the beginning when it ends.

How do you make a video automatically loop using DSPack?

Code

unit Unit21;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DSPack, ExtCtrls;

type
  TForm21 = class(TForm)
    FilterGraph1: TFilterGraph;
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    VideoWindow1: TVideoWindow;
    Panel2: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form21: TForm21;

implementation

{$R *.dfm}

procedure TForm21.Button1Click(Sender: TObject);
begin
  OpenDialog1.InitialDir := ExtractFilePath(ParamStr(0));
  if OpenDialog1.Execute then
  begin
    if not FilterGraph1.Active then FilterGraph1.Active:= True;
    VideoWindow1.FilterGraph:= FilterGraph1;
    FilterGraph1.RenderFile(OpenDialog1.Filename);
    FilterGraph1.Play;
  end;
end;

procedure TForm21.Button2Click(Sender: TObject);
begin
  FilterGraph1.Stop;
end;

procedure TForm21.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  FilterGraph1.ClearGraph;
  FilterGraph1.Active:= False;
end;

end.

DFM


object Form21: TForm21
  Left = 0
  Top = 0
  Caption = 'Form21'
  ClientHeight = 441
  ClientWidth = 644
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCloseQuery = FormCloseQuery
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 644
    Height = 384
    Align = alClient
    Caption = 'Panel1'
    TabOrder = 0
    object VideoWindow1: TVideoWindow
      Left = 1
      Top = 1
      Width = 642
      Height = 382
      Mode = vmVMR
      FilterGraph = FilterGraph1
      VMROptions.Mode = vmrWindowed
      Color = clWhite
      Align = alClient
    end
  end
  object Panel2: TPanel
    Left = 0
    Top = 384
    Width = 644
    Height = 57
    Align = alBottom
    Caption = 'Panel2'
    TabOrder = 1
    object Button1: TButton
      Left = 24
      Top = 16
      Width = 75
      Height = 25
      Caption = 'Play'
      TabOrder = 0
      OnClick = Button1Click
    end
    object Button2: TButton
      Left = 128
      Top = 16
      Width = 75
      Height = 25
      Caption = 'Stop'
      TabOrder = 1
      OnClick = Button2Click
    end
  end
  object FilterGraph1: TFilterGraph
    GraphEdit = True
    LinearVolume = True
    Left = 424
    Top = 144
  end
  object OpenDialog1: TOpenDialog
    Left = 344
    Top = 128
  end
end

Solution

  • There is no built in support for seamless looping. Yes you certainly can receive completion event, seek playback to the beginning and run the graph again, however this would inevitably have a restart delay and possibly flickering.

    To implement seamless looping you either a multigraph solution, to restart upstream graph while presentation graph is on a short pause and does not flicker. Or otherwise add custom filters into the pipeline to restart streaming internally and present it as continuous stream.