main.pas

Delphi DirectShow lib code to use streaming media. Use these libs to make delphi faster.

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, DSPack, StdCtrls, ComCtrls, dsutil, Buttons, ToolWin,
  ImgList,
  BaseClass;

  
type
  TFormPlayWin = class(TForm)
    FilterGraph: TFilterGraph;
    VideoWindow: TVideoWindow;
    MainMenu: TMainMenu;
    OpenDialog: TOpenDialog;
    FileMenu: TMenuItem;
    OpenMenu: TMenuItem;
    ExitMenu: TMenuItem;
    TrackBar: TDSTrackBar;
    ImageList: TImageList;
    StatusBar: TStatusBar;
    ToolBar: TToolBar;
    btPlay: TToolButton;
    btPause: TToolButton;
    btStop: TToolButton;
    ToolButton1: TToolButton;
    SoundLevel: TTrackBar;
    btFullScreen: TToolButton;
    PopupMenu: TPopupMenu;
    Play1: TMenuItem;
    Pause1: TMenuItem;
    Stop1: TMenuItem;
    FullScreen1: TMenuItem;
    log: TMemo;
    ToolButton2: TToolButton;
    MitCompressed: TMenuItem;
    procedure OpenMenuClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btPlayClick(Sender: TObject);
    procedure btPauseClick(Sender: TObject);
    procedure btStopClick(Sender: TObject);
    procedure TrackBarTimer(sender: TObject; CurrentPos,
      StopPos: Cardinal);
    procedure SoundLevelChange(Sender: TObject);
    procedure ExitMenuClick(Sender: TObject);
    procedure btFullScreenClick(Sender: TObject);
    procedure FilterGraphDSEvent(sender: TComponent; Event, Param1,
      Param2: Integer);
    procedure FormCreate(Sender: TObject);

  private
    { D閏larations priv閑s }
    procedure RenderFilter(AFilter: TBCBaseFilter);
    procedure TestCustomStream(Src: TStream; Compress: boolean);
  public
    { D閏larations publiques }
  end;

var
  FormPlayWin: TFormPlayWin;

implementation
uses
  DirectShow9,
  SrcFilter,
  ZLib;

{$R *.dfm}

procedure TFormPlayWin.OpenMenuClick(Sender: TObject);
begin
  if OpenDialog.Execute then
  begin
    if not FilterGraph.Active then FilterGraph.Active := true;
    FilterGraph.ClearGraph;

    TestCustomStream(TFileStream.Create(OpenDialog.FileName,fmOpenRead or fmShareDenyWrite), MitCompressed.Checked);
    exit;

    FilterGraph.RenderFile(OpenDialog.FileName);
    VideoWindow.PopupMenu := PopupMenu;
    SoundLevel.Position := FilterGraph.Volume;
    FilterGraph.Play;
  end;
end;

procedure TFormPlayWin.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  // Important
  FilterGraph.ClearGraph;
end;

procedure TFormPlayWin.btPlayClick(Sender: TObject);
begin
  if not FilterGraph.Active then OpenMenuClick(nil)
                            else FilterGraph.play;
end;

procedure TFormPlayWin.btPauseClick(Sender: TObject);
begin
  FilterGraph.Pause;
end;

procedure TFormPlayWin.btStopClick(Sender: TObject);
begin
  FilterGraph.Stop;
end;

procedure TFormPlayWin.TrackBarTimer(sender: TObject; CurrentPos,
  StopPos: Cardinal);
begin
  StatusBar.SimpleText := format('Position: %s Duration: %s',
    [TimeToStr(CurrentPos / MiliSecPerDay), TimeToStr(StopPos / MiliSecPerDay)])
end;

procedure TFormPlayWin.SoundLevelChange(Sender: TObject);
begin
  FilterGraph.Volume := SoundLevel.Position;
end;

procedure TFormPlayWin.ExitMenuClick(Sender: TObject);
begin
  FormPlayWin.Close;
end;

procedure TFormPlayWin.btFullScreenClick(Sender: TObject);
begin
  VideoWindow.FullScreen := not VideoWindow.FullScreen;
  btFullScreen.Down := VideoWindow.FullScreen;
end;

procedure TFormPlayWin.FilterGraphDSEvent(sender: TComponent; Event,
  Param1, Param2: Integer);
begin
  log.Lines.Add(GetEventCodeDef(event))
end;

procedure TFormPlayWin.TestCustomStream(Src: TStream; Compress: boolean);
var
  Z : TStream;
  D : TStream;
  TS : TCustomSrcFilter;
  Size: Int64;
begin
  Size := Src.Size;
  //Size := 0;
  if Compress then
  begin
    Z := TMemoryStream.Create;
    D := TCompressionStream.Create(clDefault, Z);
    D.CopyFrom(Src, 0);
    D.Free;
    D := TDecompressionStream.Create(Z);
    D.Position := 0;
    Src.Free;
  end
  else
    D := Src;
  
  TS := TCustomSrcFilter.Create(D, Compress, Size);
  RenderFilter(TS);
end;

procedure TFormPlayWin.RenderFilter(AFilter: TBCBaseFilter);
var
  FG : IFilterGraph2;
  I  : integer;
begin
  FilterGraph.QueryInterface(IFilterGraph2, FG);
  FG.AddFilter(AFilter, 'Test');
  with TPinList.Create(AFilter) do
  try
    for I := 0 to Count - 1 do
      if PinInfo[I].dir = PINDIR_OUTPUT then
        CheckDSError(FG.Render(Items[I]));
  finally
    Free;
  end;
  SoundLevel.Position := FilterGraph.Volume;
end;

procedure TFormPlayWin.FormCreate(Sender: TObject);
begin
  FilterGraph.Active := true;
end;

end.