unit myMPlayer;

interface
uses
	Classes, MMSystem, Windows, Messages, MPlayer;

type
{MyPlayer}
{2007-09-26:
Delphi MPlayer.pasのTMediaPlayerから必要なものだけを抽出。
ファイル名のUnicode対応。
ビデオディスプレイの指定にウィンドウハンドルを指定するようにしているので他のプロ
グラムのウィンドウを指定することも可能。
だからどうしたということでもあるけれど。
}
	TMyPlayer = class(TComponent)
	private
		F_iCmdError,
		F_iError:         MCIERROR;
		F_hHandle:        HWND;
		F_iDeviceID:      Integer;
		F_iLength:        Longint;
		F_iTimeFormat:    Longint;
		F_bHasVideo:      Boolean;
		F_hDisplayWindow: HWND;	//ウィンドウハンドルなら何でもOK。
		F_rcDisplayRect:  TRect;
		F_iVideoWidth,
		F_iVideoHeight:   Integer;
		F_sFileName:      WideString;	//メディアのファイル名。

		function F_GetMediaAssigned: Boolean;
		function F_GetMediaAspect:   Extended;
		function F_GetPlayMode:      DWORD;
		function F_GetMode:          TMPModes;
		function F_GetMediaPosition: Longint;
		function F_GetMediaLength:   Longint;
		function F_GetFilePath:      WideString;
		function F_GetFileName:      WideString;
		function F_GetFileExt:       WideString;
		procedure F_SetMediaPosition(const iPos: Longint);
		procedure F_SetTimeFormat   (const iFormat: Longint);
		procedure F_SetDisplayWindow(const hHandle: HWND);
		procedure F_SetDisplayRect  (const rcRect: TRect);
		procedure F_SetVideoShow    (const bShow: Boolean);
	public
		constructor Create(AOwner: TComponent); override;
		destructor  Destroy; override;
		function Open(sFile: WideString): Boolean; overload;
		function Open:      Boolean; overload;
		function Close:     Boolean;
		function Play:      Boolean;
		function Pause:     Boolean;
		function Rewind:    Boolean;
		function Replay:    Boolean;
		function Stop:      Boolean;

		property DisplayRect: TRect      read F_rcDisplayRect    write F_SetDisplayRect;
		property FileName:    WideString read F_sFileName        write F_sFileName;
		property Length:      Longint    read F_iLength;
		property Mode:        TMPModes   read F_GetMode;
		property Position:    Longint    read F_GetMediaPosition write F_SetMediaPosition;

		property DisplayWindow: HWND       read F_hDisplayWindow write F_SetDisplayWindow;
		property PlayMode:      DWORD      read F_GetPlayMode;
		property TimeFormat:    Longint    read F_iTimeFormat    write F_SetTimeFormat;
		property VideoShow:     Boolean                          write F_SetVideoShow;

		property MediaAssigned: Boolean    read F_GetMediaAssigned;
		property MediaPosition: Longint    read F_GetMediaPosition write F_SetMediaPosition;
		property MediaLength:   Longint    read F_iLength;
		property MediaHasVideo: Boolean    read F_bHasVideo;
		property MediaWidth:    Integer    read F_iVideoWidth;
		property MediaHeight:   Integer    read F_iVideoHeight;
		property MediaAspect:   Extended   read F_GetMediaAspect;
		property MediaFileName: WideString read F_sFileName;
		property MediaPath:     WideString read F_GetFilePath;
		property MediaName:     WideString read F_GetFileName;
		property MediaExt:      WideString read F_GetFileExt;
	end;



//==============================================================================
implementation
uses
//	myDebug,
	Controls,
//	myFile,
//	mySize;
	Forms;


//==============================================================================
//汎用ルーチン始まり

//myFile.pas
//ファイル属性
{
faReadOnly	$00000001	読み出し専用ファイル
faHidden	  $00000002	非表示ファイル
faSysFile	  $00000004	システムファイル
faVolumeID	$00000008	ボリュームファイル
faDirectory	$00000010	ディレクトリファイル
faArchive	  $00000020	アーカイブファイル
faAnyFile	  $0000003F	すべてのファイル

FILE_ATTRIBUTE_READONLY		ファイルは書き込み禁止属性です。アプリケーションは､ ファイルの読み取りはできますが､ 書き込みや削除はできません。
FILE_ATTRIBUTE_HIDDEN			ファイルは隠し属性です。通常のディレクトリ リスティングには､ このファイルは含まれません。
FILE_ATTRIBUTE_SYSTEM			ファイルはオペレーティング システムの一部です。または､ オペレーティング システム専用のファイルとして使われます。

FILE_ATTRIBUTE_DIRECTORY	ファイルはディレクトリです。
FILE_ATTRIBUTE_ARCHIVE		ファイルはアーカイブ ファイルです。アプリケーションはこのフラグを､ バックアップまたは削除のためにファイルをマークするのに使います。

FILE_ATTRIBUTE_NORMAL			ファイルには､ これ以外のほかの属性はありません。この属性は､ 単独で指定したときだけ有効です。
FILE_ATTRIBUTE_TEMPORARY	ファイルは一時的な記憶域として使用されています。アプリケーションはファイルへの書き込みができますが､ どうしても必要なときだけに限られます。一時ファイルはある程度時間が経過すると削除されてしまうため､ ファイルのデータのほとんどはメモリ内に残され､ ディスクなどのメディアにフラッシュされることはありません。
FILE_ATTRIBUTE_COMPRESSED
FILE_ATTRIBUTE_OFFLINE
}
function gfniFileAttrGet(sFile: WideString; bFileOnly: Boolean): Integer; overload;
{2007-08-28,2008-02-20,12-26:
sFileのファイル属性を返す。
ドライブ名のみは無効(-1を返す)。
bFileOnlyがTrueならディレクトリは無視する。

2008-12-26:FileGetAttrに合わせた仕様に変更。
2008-02-20:ワイルドカードを指定した時に正しい値を返さない不具合を修正。
}
var
	lh_Handle: THandle;
	lr_Info:   TWin32FindDataW;
	li_Len:    Integer;
begin
//	Result := Integer(GetFileAttributesW(PWideChar(sFile)));

	Result := -1;

	if (sFile <> '') then begin
		li_Len := Length(sFile);
		if (sFile[li_Len] = '\') then begin
			SetLength(sFile, li_Len -1);
		end;
	end;

	FillChar(lr_Info, SizeOf(TWin32FindDataW), 0);
	lh_Handle:= FindFirstFileW(PWideChar(sFile), lr_Info);
	try
		if (lh_Handle<> INVALID_HANDLE_VALUE) then begin
			repeat
				if  (WideString(lr_Info.cFileName) <> '.')
				and (WideString(lr_Info.cFileName) <> '..')
				then begin
					if (bFileOnly = False)
					or ((bFileOnly) and ((lr_Info.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0))
					then begin
						//bFileOnlyがFalse
						//または bFileOnlyがTrueでかつディレクトリではななかった
						Result := Integer(lr_Info.dwFileAttributes);
						Break;
					end;
				end;
			until not(FindNextFileW(lh_Handle, lr_Info));
		end;
	finally
		Windows.FindClose(lh_Handle);
	end;
end;

function gfniFileAttrGet(sFile: WideString): Integer; overload;
begin
	if (Pos('*', sFile) > 0)
	or (Pos('?', sFile) > 0)
	then begin
		Result := gfniFileAttrGet(sFile, False);
	end else begin
		Result := Integer(GetFileAttributesW(PWideChar(sFile)));
	end;
end;

function gfnsFilePathGet(sFile: WideString): WideString;
{2007-07-27,10-26:
Unicode対応ExtractFilePath。
ドライブ名も含む。
末尾の'\'はつく。
ドライブ名のみの場合も'\'はつく。
ただしパスが空文字の場合のみ'\'はつかない。

2007-10-26:パスが空文字の場合'\'をつけないことにした。
}
var
	i: Integer;
begin
	Result := '';
	if (sFile <> '')
	then begin
		for i := Length(sFile) downto 1
		do begin
			if (sFile[i] = '\')
			or (sFile[i] = '/')
			then begin
				Result := Copy(sFile, 1, i);
		Break;
			end
			else
			if (sFile[i] = ':')
			then begin
				Result := Copy(sFile, 1, i) + '\';
		Break;
			end;
		end;
	end;
end;

function gfnbFolderExists(sFolder: WideString): Boolean;
{2007-07-27,2008-02-20,2008-04-24:
DirectoryExistsのWideString対応版

2008-02-20:sFileにワイルドカードが指定された時の対処
2008-04-24:sFileの末尾に'\'があるとエラーになることへの対処
}
var
	lh_Handle: THandle;
	lr_Info:   TWin32FindDataW;
	li_Len:    Integer;
	li_Attr:   DWORD;
begin
	Result := False;
	if (sFolder = '') then Exit;

	if (Pos('*', sFolder) > 0)
	or (Pos('?', sFolder) > 0)
	then begin
		if (sFolder <> '') then begin
			li_Len := Length(sFolder);
			if (sFolder[li_Len] = '\') then begin
				SetLength(sFolder, li_Len-1);
			end;
		end;

		FillChar(lr_Info, SizeOf(TWin32FindDataW), 0);
		lh_Handle:= FindFirstFileW(PWideChar(sFolder), lr_Info);
		try
			if (lh_Handle<> INVALID_HANDLE_VALUE) then begin
				repeat
					if  (WideString(lr_Info.cFileName) <> '.')
					and (WideString(lr_Info.cFileName) <> '..')
					and ((lr_Info.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0)
					then begin
						Result := True;
						Break;
					end;
				until not(FindNextFileW(lh_Handle, lr_Info));
			end;
		finally
			Windows.FindClose(lh_Handle);
		end;
	end else begin
		li_Attr := GetFileAttributesW(PWideChar(sFolder));
		Result  := (li_Attr <> $FFFFFFFF) and ((li_Attr and FILE_ATTRIBUTE_DIRECTORY) <> 0);
	end;
end;

function gfnbFileExists(sFile: WideString): Boolean;
{2007-07-27:
FileExitsのUnicode対応版
}
var
	li_Attr: DWORD;
begin
	Result := False;
	if (sFile = '') then Exit;

	if (Pos('*', sFile) > 0)
	or (Pos('?', sFile) > 0)
	then begin
		if (gfnbFolderExists(gfnsFilePathGet(sFile))) then begin
			li_Attr := gfniFileAttrGet(sFile, True);
			Result  := (li_Attr <> $FFFFFFFF) and ((li_Attr and FILE_ATTRIBUTE_DIRECTORY) = 0);
		end;
	end else begin
		li_Attr := GetFileAttributesW(PWideChar(sFile));
		Result  := (li_Attr <> $FFFFFFFF) and ((li_Attr and FILE_ATTRIBUTE_DIRECTORY) = 0);
	end;
end;

function gfnsFileNameGet(sFile: WideString): WideString;
{2007-08-05:
パスを除いたファイル名を返す。
拡張子はつく。
'\'はつかない。
}
var
	i, li_Len, li_Pos: Integer;
begin
	Result := '';
	if (sFile <> '') then begin
		li_Len := Length(sFile);
		li_Pos := li_Len + 1;	//sFileの最後が'\'であった場合への対策
		for i := li_Len downto 1 do begin
			if (sFile[i] = '\') or (sFile[i] = '/') or(sFile[i] = ':') then begin
		Break;
			end;
			li_Pos := i;
		end;
		Result := Copy(sFile, li_Pos, MaxInt);
	end;
end;

function gfnsFileExtGet(sFile: WideString): WideString;
{2007-08-05,2008-12-27:
Unicode対応ExtractFileExt。
'.'は返る

2008-12-27:'.'のないファイル名のみの場合sFileすべてを返してしまう間違いを修正。
}
var
	i: Integer;
begin
	Result := '';
	for i := Length(sFile) downto 1 do begin
		if (sFile[i] = '\') or (sFile[i] = '/') or (sFile[i] = ':') then begin
			//拡張子なし
	Break;
		end else if (sFile[i] = '.') then begin
			//拡張子あり
			Result := Copy(sFile, i, MaxInt);
	Break;
		end;
	end;
end;

//mySize.pas
function gfniRectWidth(rtRect: TRect): Integer;
{2007-06-09:
rtRectの幅を返す
}
begin
	with rtRect do begin
		Result := Right - Left;
	end;
end;

function gfniRectHeight(rtRect: TRect): Integer;
{2007-06-09:
rtRectの高さを返す
}
begin
	with rtRect do begin
		Result := Bottom - Top;
	end;
end;


//汎用ルーチンここまで
//==============================================================================


//------------------------------------------------------------------------------
{MyPlayer}
constructor TMyPlayer.Create(AOwner: TComponent);
begin
	inherited;// Create(AOwner);

	if (AOwner is TWinControl) then begin
		F_hHandle := TWinControl(AOwner).Handle;
	end else begin
		F_hHandle := Application.Handle;
	end;

	F_iCmdError      := 0;
	F_iError         := 0;
	F_iDeviceID      := 0;
	F_bHasVideo      := False;
	F_rcDisplayRect  := Rect(0, 0, 0, 0);
	F_hDisplayWindow := 0;
	F_iVideoWidth    := 0;
	F_iVideoHeight   := 0;
	F_iLength        := 0;
	F_iTimeFormat    := MCI_FORMAT_MILLISECONDS;
	F_sFileName      := '';
end;

destructor TMyPlayer.Destroy;
begin
	Close;
	inherited;
end;

//開く
function TMyPlayer.Open: Boolean;
begin
	Result := Open(F_sFileName);
end;
function TMyPlayer.Open(sFile: WideString): Boolean;
var
	lr_Param:     TMCI_Open_ParmsW;
	lr_RectParam: TMCI_Anim_Rect_Parms;
	lrc_Rect: TRect;
begin
	if (F_iDeviceID <> 0) then begin
//この一連の手続きをサブルーチンにして呼び出すとエラーが起きることがある。
//ここに直接Closeの内容を書くと問題もなくいける。何故????
		F_iCmdError     := mciSendCommandW(F_iDeviceID, MCI_CLOSE, MCI_WAIT, 0);
		F_iDeviceID     := 0;
		F_bHasVideo     := False;
		F_iLength       := 0;
		F_rcDisplayRect := Rect(0, 0, 0, 0);
		F_iVideoWidth   := 0;
		F_iVideoHeight  := 0;
	end;

	F_sFileName := sFile;

	if (gfnbFileExists(F_sFileName)) then begin
		FillChar(lr_Param, SizeOf(TMCI_Open_ParmsW), 0);
		lr_Param.lpstrDeviceType  := '';	//オートセレクト
		lr_Param.lpstrElementName := PWideChar(F_sFileName);
		lr_Param.dwCallback       := 0;
		lr_Param.lpstrAlias       := '';

		F_iCmdError := mciSendCommandW(0, MCI_OPEN, MCI_WAIT or MCI_OPEN_ELEMENT {or MCI_ANIM_OPEN_NOSTATIC} {or MCI_WAVE_OPEN_BUFFER}, Longint(@lr_Param));
		Result      := (F_iCmdError = 0);
	end else begin
		Result := False;
	end;

	if (Result) then begin
		F_iDeviceID := lr_Param.wDeviceID;
		//ビデオのサイズを取得
		FillChar(lr_RectParam, SizeOf(TMCI_Anim_Rect_Parms), 0);
		F_iError        := mciSendCommandW(F_iDeviceID, MCI_WHERE, MCI_WAIT or MCI_ANIM_WHERE_SOURCE, Longint(@lr_RectParam));
		F_rcDisplayRect := lr_RectParam.rc;
		//返ってきたRectの大きさが0より大きければビデオがあるという判定
		//2007-12-26:以前は0でなければという判定をしていたのでマイナスの値でもビデオがあることになっていた
		F_bHasVideo := ((gfniRectWidth(F_rcDisplayRect) > 0) and (gfniRectHeight(F_rcDisplayRect) > 0));
		if (F_bHasVideo) then begin
			F_iVideoWidth  := gfniRectWidth (F_rcDisplayRect);
			F_iVideoHeight := gfniRectHeight(F_rcDisplayRect);
			if (F_hDisplayWindow <> 0) and (Windows.GetClientRect(F_hDisplayWindow, lrc_Rect)) then begin
				F_SetDisplayWindow(F_hDisplayWindow);	//いちいちセットしないといけない
				F_SetDisplayRect(lrc_Rect);
			end;
		end else begin
			F_rcDisplayRect := Rect(0, 0, 0, 0);
			F_iVideoWidth   := 0;
			F_iVideoHeight  := 0;
		end;
		F_iLength := F_GetMediaLength;
		F_SetTimeFormat(MCI_FORMAT_MILLISECONDS);
	end;
end;

//閉じる
function TMyPlayer.Close: Boolean;
begin
	Result := False;
	if (F_iDeviceID <> 0) then begin
		Stop;
		F_iCmdError := mciSendCommandW(F_iDeviceID, MCI_CLOSE, MCI_WAIT, 0);
		Result      := (F_iCmdError = 0);
		if (Result) then begin
			F_iDeviceID  := 0;
			F_sFileName := '';
		end;
		F_bHasVideo     := False;
		F_rcDisplayRect := Rect(0, 0, 0, 0);
		F_iVideoWidth   := 0;
		F_iVideoHeight  := 0;
//		F_hDisplayWindow := 0;	//これはコメントアウトしないといけない
		F_iLength      := 0;
	end;
end;

//Play
function TMyPlayer.Play: Boolean;
{
2007-11-12:MIDIが途中で止まってしまう不具合を修正。dwFrom,dwToを設定しない。
}
var
	lr_Param: TMCI_Play_Parms;
begin
	if (F_iDeviceID <> 0) then begin
		FillChar(lr_Param, SizeOf(TMCI_Play_Parms), 0);
		lr_Param.dwCallback := F_hHandle;	//MMNotifyイベントを送るウィンドウ

		F_iCmdError := mciSendCommandW(F_iDeviceID, MCI_PLAY, MCI_NOTIFY, Longint(@lr_Param));
		Result      := (F_iCmdError = 0);
	end else begin
		F_iCmdError := MCIERR_INVALID_DEVICE_NAME;	//指定されたデバイスが､ オープンされていないか､ MCIに認識されていません。
		Result      := False;
	end;
end;

//Stop
function TMyPlayer.Stop: Boolean;
begin
	if (F_iDeviceID <> 0) then begin
		F_iCmdError := mciSendCommandW(F_iDeviceID, MCI_STOP, MCI_WAIT, 0);
		Result      := (F_iCmdError = 0);
		F_SetMediaPosition(0);
	end else begin
		F_iCmdError := MCIERR_INVALID_DEVICE_NAME;	//指定されたデバイスが､ オープンされていないか､ MCIに認識されていません。
		Result      := False;
	end;
end;

//Pause
function TMyPlayer.Pause: Boolean;
var
  li_Mode: DWORD;
begin
	if (F_iDeviceID <> 0) then begin
		li_Mode := F_GetPlayMode;
		if (li_Mode = MCI_MODE_PLAY) then begin
			//Pause
			F_iCmdError := mciSendCommandW(F_iDeviceID, MCI_PAUSE,  MCI_WAIT, 0);
		end else if (li_Mode = MCI_MODE_PAUSE) then begin
			//Resume
			//MCI_NOTIFYだと再生開始できないようだ？
//			F_iCmdError := mciSendCommandW(F_iDeviceID, MCI_RESUME, {MCI_WAIT} MCI_NOTIFY, 0);
			Play;
		end;
		Result := (F_iCmdError = 0);
  end else begin
    F_iCmdError := MCIERR_INVALID_DEVICE_NAME;  //指定されたデバイスが､ オープンされていないか､ MCIに認識されていません。
    Result      := False;
	end;
{
begin
	if (F_iDeviceID <> 0) then begin
		F_iCmdError := mciSendCommandW(F_iDeviceID, MCI_PAUSE, MCI_WAIT, 0);
		Result      := (F_iCmdError = 0);
	end else begin
		F_iCmdError := MCIERR_INVALID_DEVICE_NAME;	//指定されたデバイスが､ オープンされていないか､ MCIに認識されていません。
		Result      := False;
	end;
}
end;

//巻き戻し
//Positionを頭に持っていくだけで再生はしない
function TMyPlayer.Rewind: Boolean;
begin
	if (F_iDeviceID <> 0) then begin
		F_SetMediaPosition(0);
		F_iCmdError := F_iError;
		Result      := (F_iCmdError = 0);
	end else begin
		F_iCmdError := MCIERR_INVALID_DEVICE_NAME;	//指定されたデバイスが､ オープンされていないか､ MCIに認識されていません。
		Result      := False;
	end;
end;

//巻き戻して再生
function TMyPlayer.Replay: Boolean;
begin
	Rewind;
	Result := Play;
end;

//再生状態を取得
function TMyPlayer.F_GetPlayMode: DWORD;
{
	MCI_MODE_NOT_READY	512 + 12
	MCI_MODE_STOP       512 + 13 = 525
	MCI_MODE_PLAY       512 + 14
	MCI_MODE_RECORD     512 + 15
	MCI_MODE_SEEK       512 + 16
	MCI_MODE_PAUSE      512 + 17
	MCI_MODE_OPEN       512 + 18
}
var
	lr_Param: TMCI_Status_Parms;
begin
	Result := MCI_MODE_NOT_READY;
	if (F_iDeviceID <> 0) then begin
		FillChar(lr_Param, SizeOf(TMCI_Status_Parms), 0);
		lr_Param.dwItem := MCI_STATUS_MODE;
		F_iError := mciSendCommandW(F_iDeviceID, MCI_STATUS, MCI_WAIT or MCI_STATUS_ITEM, Longint(@lr_Param));
		if (F_iError = 0) then begin
			Result := lr_Param.dwReturn;
		end;
	end;
end;

function TMyPlayer.F_GetMode: TMPModes;
begin
	case F_GetPlayMode of
		MCI_MODE_NOT_READY: Result := mpNotReady;
		MCI_MODE_STOP     : Result := mpStopped;
		MCI_MODE_PLAY     : Result := mpPlaying;
		MCI_MODE_RECORD   : Result := mpRecording;
		MCI_MODE_SEEK     : Result := mpSeeking;
		MCI_MODE_PAUSE    : Result := mpPaused;
		MCI_MODE_OPEN     : Result := mpOpen;
		else                Result := mpNotReady; //AIU
	end;
end;


//現在位置をセット
procedure TMyPlayer.F_SetMediaPosition(const iPos: Integer);
var
	lr_Param: TMCI_Seek_Parms;
begin
	if (F_iDeviceID <> 0) then begin
		lr_Param.dwTo := iPos;
		F_iError := mciSendCommandW(F_iDeviceID, MCI_SEEK, MCI_WAIT or MCI_TO, Longint(@lr_Param));
	end;
end;

//現在位置を取得
function TMyPlayer.F_GetMediaPosition: Longint;
var
	lr_Param: TMCI_Status_Parms;
begin
	Result := 0;
	if (F_iDeviceID <> 0) then begin
		FillChar(lr_Param, SizeOf(TMCI_Status_Parms), 0);
		lr_Param.dwItem := MCI_STATUS_POSITION;
		F_iError :=mciSendCommandW(F_iDeviceID, MCI_STATUS, MCI_WAIT or MCI_STATUS_ITEM, Longint(@lr_Param));
		if (F_iError = 0) then begin
			Result := lr_Param.dwReturn;
		end;
	end;
end;

//長さを取得
function TMyPlayer.F_GetMediaLength: Longint;
var
	lr_Param: TMCI_Status_Parms;
begin
	Result := 0;
	if (F_iDeviceID <> 0) then begin
		FillChar(lr_Param, SizeOf(TMCI_Status_Parms), 0);
		lr_Param.dwItem := MCI_STATUS_LENGTH;
		F_iError :=mciSendCommandW(F_iDeviceID, MCI_STATUS, MCI_WAIT or MCI_STATUS_ITEM, Longint(@lr_Param));
		if (F_iError = 0) then begin
			Result := lr_Param.dwReturn;
		end;
	end;
end;

//タイムフォーマット指定
procedure TMyPlayer.F_SetTimeFormat(const iFormat: Longint);
var
	lr_Param: TMCI_Set_Parms;
begin
	if (F_iDeviceID <> 0) then begin
		FillChar(lr_Param, SizeOf(TMCI_Set_Parms), 0);
		lr_Param.dwTimeFormat := iFormat;
		F_iError := mciSendCommandW(F_iDeviceID, MCI_SET, MCI_WAIT or MCI_SET_TIME_FORMAT, Longint(@lr_Param));
		if (F_iError = 0) then begin
			F_iTimeFormat := iFormat;
		end;
	end;
end;

{
MCI_ANIM_WINDOW_DEFAULT 結局これは0なのでわざわざ指定しなくてもと思う
}
//ビデオを表示するウィンドウの設定
procedure TMyPlayer.F_SetDisplayWindow(const hHandle: HWND);
var
	lr_Param: TMCI_Anim_Window_ParmsW;
begin
	F_hDisplayWindow := hHandle;
	if (F_iDeviceID <> 0) then begin
		FillChar(lr_Param, SizeOf(TMCI_Anim_Window_ParmsW), 0);
		lr_Param.Wnd := hHandle;
		F_iError := mciSendCommandW(F_iDeviceID, MCI_WINDOW, MCI_WAIT or MCI_ANIM_WINDOW_HWND, Longint(@lr_Param));
	end;
end;

//ビデオ描画領域のセット
procedure TMyPlayer.F_SetDisplayRect(const rcRect: TRect);
var
	lr_Param: TMCI_Anim_Rect_Parms;
begin
	if (F_iDeviceID <> 0) then begin
		FillChar(lr_Param, SizeOf(TMCI_Anim_Rect_Parms), 0);
		lr_Param.rc := rcRect;
		F_iError := mciSendCommandW(F_iDeviceID, MCI_WAIT or MCI_PUT, MCI_ANIM_RECT or MCI_ANIM_PUT_DESTINATION, Longint(@lr_Param));
		if (F_iError = 0) then begin
			F_rcDisplayRect := rcRect;
		end;
	end;
end;

//ビデオのアスペクト比
function TMyPlayer.F_GetMediaAspect: Extended;
begin
	// Width / Height なので幅から高さを出すには gfniRound(Width / gfVideoAspect)
	if (F_iVideoHeight <> 0) and (F_iVideoWidth <> 0) then begin
		Result := F_iVideoWidth / F_iVideoHeight;
	end else begin
		//ビデオなし
		Result := 1;
	end;
end;

//ビデオの表示のON/OFF
procedure TMyPlayer.F_SetVideoShow(const bShow: Boolean);
var
	lr_Param: TMCI_Anim_Window_ParmsW;
begin
	if (F_iDeviceID <> 0) then begin
		FillChar(lr_Param, SizeOf(TMCI_Anim_Window_ParmsW), 0);
		if (bShow) then begin
			lr_Param.nCmdShow := SW_SHOW;
		end else begin
			lr_Param.nCmdShow := SW_HIDE;
		end;
		F_iError := mciSendCommandW(F_iDeviceID, MCI_WINDOW, MCI_WAIT or MCI_ANIM_WINDOW_STATE, Longint(@lr_Param));
	end;
end;

function TMyPlayer.F_GetMediaAssigned: Boolean;
begin
	Result := (F_iDeviceID <> 0);
end;

function TMyPlayer.F_GetFilePath: WideString;
begin
	Result := gfnsFilePathGet(F_sFileName);
end;
function TMyPlayer.F_GetFileName: WideString;
begin
	Result := gfnsFileNameGet(F_sFileName);
end;
function TMyPlayer.F_GetFileExt: WideString;
begin
	Result := gfnsFileExtGet(F_sFileName);
end;


end.