unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls,
DirectShow9;
const
//イベントを受け取るためのユニークなメッセージ番号
WM_GRAPH_NOTIFY = (WM_APP +1);
type
TForm1 =
class(TForm)
ComboBox1: TComboBox;
Button_Open: TButton;
Button_Delete: TButton;
Button_Clear: TButton;
Button_Play: TButton;
Button_Pause: TButton;
Button_Stop: TButton;
TrackBar1: TTrackBar;
Label_Size: TLabel;
Label_Time: TLabel;
CheckBox_Event: TCheckBox;
Timer1: TTimer;
OpenDialog1: TOpenDialog;
Panel_Video: TPanel;
CheckBox_KeepAspect: TCheckBox;
procedure FormCreate (Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button_OpenClick (Sender: TObject);
procedure Button_DeleteClick (Sender: TObject);
procedure Button_ClearClick (Sender: TObject);
procedure Button_PlayClick (Sender: TObject);
procedure Button_PauseClick (Sender: TObject);
procedure Button_StopClick (Sender: TObject);
procedure ComboBox1Select (Sender: TObject);
procedure TrackBar1Change (Sender: TObject);
procedure Timer1Timer (Sender: TObject);
procedure CheckBox_KeepAspectClick(Sender: TObject);
procedure Panel_VideoResize (Sender: TObject);
procedure Panel_VideoDblClick (Sender: TObject);
private
{ Private 宣言 }
F_GraphBuilder : IGraphBuilder;
F_MediaEventEx : IMediaEventEx;
F_MediaPosition : IMediaPosition;
F_fDuration : TRefTime;
F_VideoRenderer : IBaseFilter;
//イベント通知のためのメッセージ番号を受け取れるようにする
procedure WMGraphNotify(
var Msg: TMessage);
message WM_GRAPH_NOTIFY;
procedure F_Close;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses
ActiveX,
BaseClass,
debug_msg;
//デバッグ出力用
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Label_Size.Caption := '';
Label_Time.Caption := '';
//グラフ作成
CoCreateInstance(
CLSID_FilterGraph,
nil,
CLSCTX_INPROC_SERVER,
IID_IGraphBuilder,
F_GraphBuilder
);
//イベント通知ウィンドウをセット。
F_GraphBuilder.QueryInterface(IMediaEventEx, F_MediaEventEx);
F_MediaEventEx.SetNotifyWindow(Self.Handle, WM_GRAPH_NOTIFY, 0);
//時間取得のため
F_GraphBuilder.QueryInterface(IMediaPosition, F_MediaPosition);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
F_Close;
F_MediaPosition :=
nil;
F_MediaEventEx :=
nil;
F_VideoRenderer := nil;
F_GraphBuilder :=
nil;
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あるいはStopWhenReadyを呼ぶ。
l_MediaControl.StopWhenReady;
l_MediaControl :=
nil;
Timer1.Tag := 1;
TrackBar1.Position := 0;
Timer1.Tag := 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_Pos : TRefTime;
begin
if (Assigned(F_GraphBuilder))
then begin
Timer1.Tag := 1;
F_MediaPosition.get_CurrentPosition(lf_Pos);
Label_Time.Caption := Format('%s/%s', [FloatToTime(lf_Pos), FloatToTime(F_fDuration)]);
if not(IsDragThumb)
then begin
//トラックバーのスライダーを触っていなかったらスライダーを現在位置に移動させる。
TrackBar1.Position := Trunc(lf_Pos);
end;
Timer1.Tag := 0;
end;
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
//トラックバー移動
var
l_MediaPosition : IMediaPosition;
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_GraphBuilder.QueryInterface(IMediaPosition, l_MediaPosition);
l_MediaPosition.put_CurrentPosition(TrackBar1.Position);
l_MediaPosition :=
nil;
end;
end;
end;
//--------
procedure TForm1.WMGraphNotify(
var Msg: TMessage);
//イベント処理
var
li_EventCode : Longint;
li_Param1 : Longint;
li_Param2 : Longint;
begin
if (F_MediaEventEx =
nil)
then begin
Exit;
end;
// イベントを全て取得
while (Succeeded(F_MediaEventEx.GetEvent(li_EventCode, li_Param1, li_Param2, 0)))
do begin
if (CheckBox_Event.Checked)
then begin
debug_msg.ShowEvent(li_EventCode, li_Param1, li_Param2);
end;
case (li_EventCode)
of
EC_COMPLETE
:
begin
//再生が終わりに来た
//連続再生
if (ComboBox1.Items.Count = 0)
then begin
F_Close;
end else begin
if (ComboBox1.ItemIndex < ComboBox1.Items.Count -1)
then begin
ComboBox1.ItemIndex := ComboBox1.ItemIndex +1;
end else begin
ComboBox1.ItemIndex := 0;
end;
ComboBox1Select(
nil);
end;
end;
end;
F_MediaEventEx.FreeEventParams(li_EventCode, li_Param1, li_Param2);
end;
end;
procedure TForm1.F_Close;
var
l_MediaControl : IMediaControl;
l_EnumFilters : IEnumFilters;
l_BaseFilter : IBaseFilter;
begin
Timer1.Enabled := False;
Label_Size.Caption := '';
Label_Time.Caption := '';
if (F_GraphBuilder <>
nil)
then begin
F_GraphBuilder.QueryInterface(IMediaControl, l_MediaControl);
l_MediaControl.Stop;
l_MediaControl :=
nil;
//Sotpしただけではフィルタはまだ接続されたままなのでフィルタを列挙して削除する。
//http://msdn.microsoft.com/ja-jp/library/cc973418.aspx
F_GraphBuilder.EnumFilters(l_EnumFilters);
while (l_EnumFilters.Next(1, l_BaseFilter,
nil) = S_OK)
do begin
F_GraphBuilder.RemoveFilter(l_BaseFilter);
l_BaseFilter :=
nil;
l_EnumFilters.Reset;
end;
l_EnumFilters :=
nil;
end;
end;
procedure TForm1.Button_OpenClick(Sender: TObject);
//開く
var
li_Count : Integer;
begin
if (OpenDialog1.Execute)
then begin
li_Count := ComboBox1.Items.Count;
ComboBox1.Items.AddStrings(OpenDialog1.Files);
ComboBox1.ItemIndex := li_Count;
ComboBox1Select(
nil);
//再生開始
end;
end;
procedure TForm1.Button_DeleteClick(Sender: TObject);
//リストから再生中のファイルを削除
var
li_Index : Integer;
begin
li_Index := ComboBox1.ItemIndex;
F_Close;
ComboBox1.Items.Delete(li_Index);
ComboBox1.ItemIndex := li_Index;
ComboBox1Select(
nil);
end;
procedure TForm1.Button_ClearClick(Sender: TObject);
//リストクリア
begin
ComboBox1.Items.Clear;
end;
procedure TForm1.ComboBox1Select(Sender: TObject);
//ファイル選択→再生
var
ls_FileName :
String;
l_VideoWindow : IVideoWindow;
l_BasicVideo : IBasicVideo;
li_Width : Integer;
li_Height : Integer;
begin
F_Close;
if (ComboBox1.Items.Count = 0)
then begin
Exit;
end;
if (ComboBox1.ItemIndex < 0)
then begin
ComboBox1.ItemIndex := 0;
end;
ls_FileName := ComboBox1.Items[ComboBox1.ItemIndex];
//ビデオレンダラー作成 (VMR7)
F_VideoRenderer := nil;
CoCreateInstance(
CLSID_VideoMixingRenderer,
nil,
CLSCTX_INPROC,
IID_IBaseFilter,
F_VideoRenderer
);
F_GraphBuilder.AddFilter(F_VideoRenderer, 'Video Mixing Renderer');
//読み込み
if not(Succeeded(F_GraphBuilder.RenderFile(POLESTR(
WideString(ls_FileName)),
nil)))
then begin
ShowMessage(ls_FileName + #13'は開けません');
ComboBox1.Items.Delete(ComboBox1.ItemIndex);
ComboBox1.Text := '';
Exit;
end;
//アスペクト比保持
//ファイルを開いた後でないとデスクトップがちらつく
CheckBox_KeepAspectClick(nil);
//パネルにビデオを表示させる
//ファイルを読み込んでからでないと別ウィンドウが開いてしまう。
F_GraphBuilder.QueryInterface(IVideoWindow, l_VideoWindow);
l_VideoWindow.put_Owner(Panel_Video.Handle);
l_VideoWindow.put_WindowStyle(WS_CHILD or WS_CLIPSIBLINGS);
l_VideoWindow.put_MessageDrain(Panel_Video.Handle); //マウスメッセージを拾えるようにする
l_VideoWindow.SetWindowForeground(OAFALSE); //タスクバーがフラッシュするのを防ぐ
l_VideoWindow := nil;
//ビデオのサイズをパネルに合わせる。
Panel_VideoResize(nil);
//タイトルバーにファイル名を表示
Caption := ExtractFileName(ls_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_Size.Caption := Format('%d×%d', [li_Width, li_Height]);
end else begin
Label_Size.Caption := '';
end;
//長さ取得
F_fDuration := 0;
F_MediaPosition.get_Duration(F_fDuration);
//この後CurrentPositionが変わってしまうことがある
TrackBar1.Max := Trunc(F_fDuration);
//長さを取得した後CurrentPositionが終わりに移動してしまうことがあるので頭に戻す
//F_MediaPosition.put_CurrentPosition(0);
//Button_StopClickの中でやっている
//再生開始
Button_StopClick(
nil);
Button_PlayClick(
nil);
end;
procedure TForm1.Panel_VideoResize(Sender: TObject);
//ビデオのサイズをパネルに合わせる。
var
l_VideoWindow : IVideoWindow;
begin
if (F_GraphBuilder <> nil)
and (F_VideoRenderer <> nil)
then begin
F_GraphBuilder.QueryInterface(IVideoWindow, l_VideoWindow);
{
ここでやるとちらつく
l_VideoWindow.put_Owner(Panel_Video.Handle);
l_VideoWindow.put_WindowStyle(WS_CHILD or WS_CLIPSIBLINGS);
l_VideoWindow.put_MessageDrain(OATRUE);
l_VideoWindow.SetWindowForeground(OAFALSE);
}
l_VideoWindow.SetWindowPosition(0, 0, Panel_Video.Width, Panel_Video.Height);
l_VideoWindow := nil;
end;
end;
procedure TForm1.Panel_VideoDblClick(Sender: TObject);
//フルスクリーンモード
//マルチモニターに対応
//他のウィンドウを触ると解除される
var
l_VideoWindow : IVideoWindow;
lb_FullScreen : LongBool;
begin
if (F_GraphBuilder <> nil)
and (F_VideoRenderer <> nil)
then begin
F_GraphBuilder.QueryInterface(IVideoWindow, l_VideoWindow);
l_VideoWindow.get_FullScreenMode(lb_FullScreen);
l_VideoWindow.put_FullScreenMode(not(lb_FullScreen));
l_VideoWindow := nil;
end;
end;
procedure TForm1.CheckBox_KeepAspectClick(Sender: TObject);
//アスペクト比保持
var
l_VMRAspectRatioControl : IVMRAspectRatioControl;
begin
if (F_VideoRenderer = nil) then begin
Exit;
end;
F_VideoRenderer.QueryInterface(IVMRAspectRatioControl, l_VMRAspectRatioControl);
if (CheckBox_KeepAspect.Checked) then begin
//アスペクト比保持
l_VMRAspectRatioControl.SetAspectRatioMode(VMR_ARMODE_LETTER_BOX);
end else begin
//アスペクト比可変
l_VMRAspectRatioControl.SetAspectRatioMode(VMR_ARMODE_NONE);
end;
l_VMRAspectRatioControl := nil;
end;
end.