unit main;

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

const
	WM_GRAPH_NOTIFY = (WM_APP +1);

type
	TForm1 = class(TForm)
		RadioGroup1:   TRadioGroup;
		Button_Open:   TButton;
		Button_Play:   TButton;
		Button_Pause:  TButton;
		Button_Stop:   TButton;
		CheckBox_Mute: TCheckBox;
		OpenDialog1:   TOpenDialog;
		procedure FormCreate (Sender: TObject);
		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 CheckBox_MuteClick(Sender: TObject);
	private
		{ Private 宣言 }
		F_GraphBuilder : IGraphBuilder;
		F_Wallpaper    : IBaseFilter;
		F_MediaEventEx : IMediaEventEx;

		procedure WMGraphNotify(var Msg: TMessage); message WM_GRAPH_NOTIFY;
		procedure F_Close;
	public
		{ Public 宣言 }
	end;

var
	Form1: TForm1;

implementation
uses
	ActiveX,
	WallpaperTypeLib_TLB;

{$R *.dfm}


const
	//壁紙ビデオレンダラのGUID
	CLSID_Wallpaper: TGUID = '{9A1585D2-CECD-432D-B8AA-F1F91F217D47}';

procedure TForm1.FormCreate(Sender: TObject);
begin
	//グラフ作成
	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);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
	F_Close;
	F_MediaEventEx  := nil;
	F_Wallpaper     := nil;
	F_GraphBuilder  := nil;
end;

procedure TForm1.F_Close;
var
	l_MediaControl : IMediaControl;
	l_EnumFilters  : IEnumFilters;
	l_BaseFilter   : IBaseFilter;
begin
	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;
		F_Wallpaper   := nil;
	end;
end;

procedure TForm1.WMGraphNotify(var Msg: TMessage);
var
	li_EventCode, li_Param1, li_Param2: Longint;
begin
	if not(Assigned(F_MediaEventEx)) then begin
		Exit;
	end;

	//イベントを全て取得
	while (Succeeded(F_MediaEventEx.GetEvent(li_EventCode, li_Param1, li_Param2, 0))) do begin
		case (li_EventCode) of
			EC_COMPLETE
			:begin
				//再生完了
				//繰り返し再生
				Button_StopClick(nil);
				Button_PlayClick(nil);
			end;
		end;
		F_MediaEventEx.FreeEventParams(li_EventCode, li_Param1, li_Param2);
	end;
end;

procedure TForm1.Button_OpenClick(Sender: TObject);
var
	l_WallConfig : IWallpaperConfig;
begin
	if (OpenDialog1.Execute) then begin
		F_Close;

		if (F_Wallpaper = nil) then begin
			{レンダラ追加}
			CoCreateInstance(
				CLSID_Wallpaper,
				nil,
				CLSCTX_INPROC_SERVER,
				IID_IBaseFilter,
				F_Wallpaper
			);
			if (F_Wallpaper = nil) then begin
				Beep;
				ShowMessage('壁紙ビデオレンダラが登録されていません');
				F_Close;
				Exit;
			end;
			F_GraphBuilder.AddFilter(F_Wallpaper, 'Video Renderer');
		end;

		{表示位置設定}
		F_Wallpaper.QueryInterface(IID_IWallpaperConfig, l_WallConfig);
		case RadioGroup1.ItemIndex of
			1:   l_WallConfig.SetStyle(WallpaperStyle_Tile);    //タイル
			2:   l_WallConfig.SetStyle(WallpaperStyle_Stretch); //全画面
//			else l_WallConfig.SetStyle(WallpaperStyle_Center);  //中央(デフォルト)
		end;
		l_WallConfig := nil; //後始末

		if not(Succeeded(F_GraphBuilder.RenderFile(PWideChar(WideString(OpenDialog1.FileName)), nil))) then begin
			ShowMessage(OpenDialog1.FileName + #13'は開けません');
			Exit;
		end;

		CheckBox_MuteClick(nil); //ミュート
		Button_PlayClick(nil);   //再生
	end;
end;

procedure TForm1.Button_PlayClick(Sender: TObject);
//Play
var
	l_MediaControl: IMediaControl;
begin
	if (Assigned(F_GraphBuilder)) then begin
		F_GraphBuilder.QueryInterface(IMediaControl, l_MediaControl);
		l_MediaControl.Run;
		l_MediaControl := nil; //後始末
	end;
end;

procedure TForm1.Button_PauseClick(Sender: TObject);
//Pause
var
	l_MediaControl: IMediaControl;
begin
	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);
//Stop
var
	l_MediaControl  : IMediaControl;
	l_MediaPosition : IMediaPosition;
begin
	if (Assigned(F_GraphBuilder)) then begin
		F_GraphBuilder.QueryInterface(IMediaControl, l_MediaControl);
		l_MediaControl.Stop;

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

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

procedure TForm1.CheckBox_MuteClick(Sender: TObject);
//ミュート
var
	l_BasicAudio: IBasicAudio;
begin
	if (Assigned(F_GraphBuilder)) then begin
		F_GraphBuilder.QueryInterface(IID_IBasicAudio, l_BasicAudio);
		if (Assigned(l_BasicAudio)) then begin
			if (CheckBox_Mute.Checked) then begin
				l_BasicAudio.put_Volume(-10000);
			end else begin
				l_BasicAudio.put_Volume(0);
			end;
			l_BasicAudio := nil;
		end;
	end;
end;


end.