ホーム >プログラム >Delphi 6 ローテクTips

DirectShowを利用して再生・その2

前回はとりあえず再生させるだけでした。
今回は再生、一時停止、停止ボタンをつけます。
シークバーもつけます。
合わせてビデオサイズの表示と時間の表示も行います。

ビデオの表示は別ウィンドウのままです。
連続再生も行いません。

DirectShow関係の処理は簡単です。
難しいことはありません。

ただシークバーを実装するのにトラックバーを利用するのですがその扱いがややこしくて面倒だったりします。

操作ボタン

前回は「開く」ボタンだけでしたが今回は「再生」と「一時停止」それに「停止」ボタンをつけます。

procedure TForm1.Button_PlayClick(Sender: TObject);
//再生開始
var
  l_MediaControl : IMediaControl;
begin
  if (Assigned(F_GraphBuilder)) then begin
    F_GraphBuilder.QueryInterface(IMediaControl, l_MediaControl);
    l_MediaControl.Run;
    l_MediaControl := nil;
    Timer1.Enabled := True;
  end;
end;

procedure TForm1.Button_PauseClick(Sender: TObject);
//一時停止
var
  l_MediaControl : IMediaControl;
begin
  Timer1.Enabled := False;
  if (Assigned(F_GraphBuilder)) then begin
    F_GraphBuilder.QueryInterface(IMediaControl, l_MediaControl);
    l_MediaControl.Pause;
    l_MediaControl := nil;
  end;
end;

procedure TForm1.Button_StopClick(Sender: TObject);
//停止
var
  l_MediaControl : IMediaControl;
begin
  Timer1.Enabled := False;
  if (Assigned(F_GraphBuilder)) then begin
    F_GraphBuilder.QueryInterface(IMediaControl, l_MediaControl);
    l_MediaControl.Stop;

    //ただ停止させただけではPauseと変わらない。
    //先頭に戻すにはIMediaPositionを使う。
    F_MediaPosition.put_CurrentPosition(0);

    //移動させただけでは現在位置のフレームが描画されない。
    //現在位置のフレームを描画させるためにPauseを呼ぶ。
    l_MediaControl.Pause;
    l_MediaControl := nil;
  end;
end;

再生、一時停止は問題ないと思います。
停止はただStopを呼ぶだけだと、停止した後で再生させると停止した位置から再生が始まります。
つまりPauseとなんら変わらない動作になってしまいます。
なので停止ボタンを押したら先頭に戻す処理を入れています。
再生位置を移動させるためにはIMediaPositionインターフェースを使います。
同じような用途のIMediaSeekingインターフェースというのもありますがIMediaPositionの方が簡単です。
上のサンプルではF_MediaPositionを使っていますがこれはフォームのprivate部で宣言していて「開く」時に作成済みのものです。

コメントにもあるように停止後にput_CurrentPositionで現在位置を移動させても画面の表示は変わりません。
停止した時点の映像のままです。
これを移動した後の映像（今回は先頭のフレーム）にするにはPauseかStopWhenReadyを呼びます。

シークバー

シークバーの実装は少しややこしいです。

まずファイルを開く時にIMediaPositionのget_Durationで得たメディアの長さを（小数点以下切り捨てて）トラックバーのMaxプロパティにします。
そしてタイマーでIMediaPositionのget_CurrentPositionメソッドで得た再生位置を（小数点以下切捨てて）トラックバーのPositionプロパティにセットします。
こうすることでトラックバーのつまみの位置がファイルの再生位置と同期します。
ここまでは簡単です。
ややこしいことはありません。

トラックバーのつまみを掴んで好きな位置に移動させる処理を入れるとややこしくなってきます。
つまみを掴んでいる間はタイマーでつまみの位置を調整しないようにしないとつまみが再生位置と掴んで移動させている位置との間を行ったり来たりして見苦しくなります。
それを避けるためにはつまみを掴んでいるかどうかの判定をしなければならないのですが、シークバーとして利用しようというトラックバーあるいはスクロールバーにはつまみを掴んでいるかどうかを判定するプロパティはありません。
それどころかマウスダウンやマウスアップなどのイベントがありません。

なので今回はマウスの左ボタンが押されていてトラックバーがマウスをキャプチャしている時にはタイマーでトラックバーのつまみの位置を調整しないという簡易な方法を取ります。

またトラックバーのつまみをユーザーが動かすとOnChangeイベントが起きるのですが、これがタイマーでトラックバーのPositionをセットした時にも起きます。
つまりトラックバーのつまみをユーザーが動かした場合だけでなく、タイマーでつまみの表示位置を調整するたびにもOnChangeイベントが起きるということです。
そのためOnChangeイベントの内容は単にファイルの再生位置を変更するだけの処理ではうまくありません。
何も対策を施さないとタイマーでトラックバーのPositionを変更するたびにファイルの再生位置を変更する処理が実行されてしまいます。
ファイルの再生位置を変更するのには結構時間がかかるため表示がブツブツ途切れてしまいます。

この問題はタイマーでトラックバーのPositionを変更する時にはタイマーのTagを1にセットして、トラックバーのOnChangeイベントではタイマーのTagをチェックして0以外だったら処理を抜けるという方法で対処します。

procedure TForm1.Timer1Timer(Sender: TObject);
//現在位置表示
  function FloatToTime(fTime : TRefTime) : String;
  var
    li_Time, li_Hour, li_Min, li_Sec : Integer;
  begin
    li_Time := Trunc(fTime);
    li_Hour := li_Time div 60 div 60;
    li_Min  := li_Time div 60 mod 60;
    li_Sec  := li_Time mod 60;
    Result := Format('%d:%.2d:%.2d', [li_Hour, li_Min, li_Sec]);
  end;
  function IsDragThumb: Boolean;
  //トラックバーのつまみを触っているか。
  //実際はトラックバーがマウスキャプチャしているか。
  begin
    if not(BOOL(Hi(GetAsyncKeyState(VK_LBUTTON)))) then begin
      Result := False;
      Exit;
    end;
    Result := (GetCapture = TrackBar1.Handle);
  end;
var
  lf_Len : TRefTime;
  lf_Pos : TRefTime;
begin
  if (Assigned(F_GraphBuilder)) then begin
    //TagをタイマーからトラックバーのPositionを変更させたフラグとして使う。
    Timer1.Tag := 1;

    F_MediaPosition.get_Duration(lf_Len);
    F_MediaPosition.get_CurrentPosition(lf_Pos);
    Label_Time.Caption := Format('%s/%s', [FloatToTime(lf_Pos), FloatToTime(lf_Len)]);

    if not(IsDragThumb) then begin
      //トラックバーのつまみを触っていなかったらつまみを現在位置に移動させる。
      TrackBar1.Position := Trunc(lf_Pos);
    end;
    Timer1.Tag := 0;
  end;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
//トラックバー移動
begin
  if (Timer1.Tag <> 0) then begin
    //タイマーのTagが0でなければタイマーでトラックバーのPositionが変更した結果起きたイベントなので以下の処理に入らない。
    Exit;
  end;

  if (Assigned(F_GraphBuilder)) then begin
    if not(BOOL(Hi(GetAsyncKeyState(VK_LBUTTON)))) then begin
      //左ボタンが押されていなければ現在位置を変更。
      //左ボタンが押されている場合はつまみを掴んで(動かして)いる状態なので変更しない。
      F_MediaPosition.put_CurrentPosition(TrackBar1.Position);
    end;
  end;
end;

トラックバーのつまみを掴んで移動させている（マウスの左ボタンが押されている）間はメディアの現在位置を変更しないのは、メディアの現在位置を変更するのには結構時間がかかり追従性が悪くなるからです。

ソースコード

dplay_2.zip ソースコードと実行ファイル詰め合わせ。

unit main;

interface

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

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    Button_Open: TButton;
    Button_Play: TButton;
    Button_Pause: TButton;
    Button_Stop: TButton;
    TrackBar1: TTrackBar;
    Label_Time: TLabel;
    Label_VideoSize: TLabel;
    Timer1: TTimer;
    procedure FormDestroy(Sender: TObject);
    procedure Button_OpenClick (Sender: TObject);
    procedure Button_PlayClick (Sender: TObject);
    procedure Button_PauseClick(Sender: TObject);
    procedure Button_StopClick (Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private 宣言 }
    F_GraphBuilder  : IGraphBuilder;
    F_MediaPosition : IMediaPosition;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation
uses
  ActiveX;

{$R *.dfm}


procedure TForm1.FormDestroy(Sender: TObject);
begin
  F_GraphBuilder  := nil;
  F_MediaPosition := nil;
end;

procedure TForm1.Button_OpenClick(Sender: TObject);
var
  li_Ret : HResult;
  lf_Len : TRefTime;
  l_BasicVideo : IBasicVideo;
  li_Width  : Integer;
  li_Height : Integer;
begin
  if (OpenDialog1.Execute) then begin
    F_MediaPosition := nil;
    F_GraphBuilder  := nil;

    //グラフ作成
    li_Ret := CoCreateInstance(
        CLSID_FilterGraph,
        nil,
        CLSCTX_INPROC_SERVER,
        IID_IGraphBuilder,
        F_GraphBuilder
    );
    if (li_Ret <> S_OK) then begin
      Exit;
    end;

    //読み込み
    if not(Succeeded(F_GraphBuilder.RenderFile(POLESTR(WideString(OpenDialog1.FileName)), nil))) then begin
      Exit;
    end;

    //タイトルバーにファイル名を表示
    Caption := ExtractFileName(OpenDialog1.FileName);

    //ビデオのサイズを取得
    F_GraphBuilder.QueryInterface(IBasicVideo, l_BasicVideo);
    //li_Widthとli_Heightの初期化は必須。
    //やらないと音楽メディアでとんでもない値になる。
    li_Width  := 0;
    li_Height := 0;
    l_BasicVideo.get_VideoWidth (li_Width);
    l_BasicVideo.get_VideoHeight(li_Height);
    l_BasicVideo := nil;
    if (li_Width > 0) and (li_Height > 0) then begin
      Label_VideoSize.Caption := Format('%d×%d', [li_Width, li_Height]);
    end else begin
      Label_VideoSize.Caption := '';
    end;

    //長さ取得
    F_GraphBuilder.QueryInterface(IMediaPosition, F_MediaPosition);
    F_MediaPosition.get_Duration(lf_Len);
    TrackBar1.Max := Trunc(lf_Len);

    //再生開始
    Button_PlayClick(nil);
  end;
end;

procedure TForm1.Button_PlayClick(Sender: TObject);
//再生開始
var
  l_MediaControl : IMediaControl;
begin
  if (Assigned(F_GraphBuilder)) then begin
    F_GraphBuilder.QueryInterface(IMediaControl, l_MediaControl);
    l_MediaControl.Run;
    l_MediaControl := nil;
    Timer1.Enabled := True;
  end;
end;

procedure TForm1.Button_PauseClick(Sender: TObject);
//一時停止
var
  l_MediaControl : IMediaControl;
begin
  Timer1.Enabled := False;
  if (Assigned(F_GraphBuilder)) then begin
    F_GraphBuilder.QueryInterface(IMediaControl, l_MediaControl);
    l_MediaControl.Pause;
    l_MediaControl := nil;
  end;
end;

procedure TForm1.Button_StopClick(Sender: TObject);
//停止
var
  l_MediaControl : IMediaControl;
begin
  Timer1.Enabled := False;
  if (Assigned(F_GraphBuilder)) then begin
    F_GraphBuilder.QueryInterface(IMediaControl, l_MediaControl);
    l_MediaControl.Stop;

    //ただ停止させただけではPauseと変わらない
    //先頭に戻すにはIMediaPositionを使う
    F_MediaPosition.put_CurrentPosition(0);

    //移動させただけでは現在位置のフレームが描画されない。
    //現在位置のフレームを描画させるためにPauseを呼ぶ。
//    l_MediaControl.Pause;
    l_MediaControl.StopWhenReady;
    l_MediaControl := nil;

    TrackBar1.Position := 0;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
//現在位置表示
  function FloatToTime(fTime : TRefTime) : String;
  var
    li_Time, li_Hour, li_Min, li_Sec : Integer;
  begin
    li_Time := Trunc(fTime);
    li_Hour := li_Time div 60 div 60;
    li_Min  := li_Time div 60 mod 60;
    li_Sec  := li_Time mod 60;
    Result  := Format('%d:%.2d:%.2d', [li_Hour, li_Min, li_Sec]);
  end;
  function IsDragThumb: Boolean;
  //トラックバーのスライダーを触っているか。
  //実際はトラックバーがマウスキャプチャしているか。
  begin
    if not(BOOL(Hi(GetAsyncKeyState(VK_LBUTTON)))) then begin
      Result := False;
      Exit;
    end;
    Result := (GetCapture = TrackBar1.Handle);
  end;
var
  lf_Len : TRefTime;
  lf_Pos : TRefTime;
begin
  if (Assigned(F_GraphBuilder)) then begin
    Timer1.Tag := 1;

    F_MediaPosition.get_Duration(lf_Len);
    F_MediaPosition.get_CurrentPosition(lf_Pos);
    Label_Time.Caption := Format('%s/%s', [FloatToTime(lf_Pos), FloatToTime(lf_Len)]);

    if not(IsDragThumb) then begin
      //トラックバーのスライダーを触っていなかったらスライダーを現在位置に移動させる。
      TrackBar1.Position := Trunc(lf_Pos);
    end;
    Timer1.Tag := 0;
  end;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
//トラックバー移動
begin
  if (Timer1.Tag <> 0) then begin
    Exit;
  end;

  if (Assigned(F_GraphBuilder)) then begin
    if not(BOOL(Hi(GetAsyncKeyState(VK_LBUTTON)))) then begin
      F_MediaPosition.put_CurrentPosition(TrackBar1.Position);
    end;
  end;
end;

end.

ビデオの大きさの取得で一つ注意点を。
IBasicVideoのget_VideoWidthとget_VideoHeightはメディアに映像がなかった場合に引数の値を0にすることはしないようです。
なのでローカル変数を与える場合は必ず0に初期化してから与えるようにしないとなりません。