unit myWindowsMediaPlayer; //{$DEFINE DEBUG} {$DEFINE MYLIB} interface uses Classes, Controls, Messages, Windows, WMPLib_TLB; type { TMyCustomWindowsMediaPlayer 2008-12-01: MediaLengthの秒数で小数点以下切捨てていたのを切り上げに変更。 2008-11-28: WidthFromHeight、HeightFromWidth関数、DisplayWidth、DisplayHeightプロ パティ実装。 } TMyWMPuiMode = (uiNone, uiMini, uiFull, uiInvisible); TMyCustomWindowsMediaPlayer = class(TWindowsMediaPlayer) private F_bSetBounds: Boolean; {$WARN SYMBOL_PLATFORM OFF} F_INewPlayer: IWMPPlayer4Disp; F_INewControls: IWMPControls3Disp; {$WARN SYMBOL_PLATFORM ON} F_bMinCancel, F_bMinFlag: Boolean; function F_GetFullScreen: Boolean; procedure F_SetFullScreen(const bFullScreen: Boolean); function F_GetEnableContextMenu: Boolean; procedure F_SetEnableContextMenu(const bEnabled: Boolean); function F_GetUiMode: TMyWMPuiMode; procedure F_SetUiMode(Mode: TMyWMPuiMode); function F_GetStretchToFit: Boolean; procedure F_SetStretchToFit(bStretchToFit: Boolean); function F_GetWindowlessVideo: Boolean; procedure F_SetWindowlessVideo(const bWindowlessVideo: Boolean); function F_GetDvd: IWMPDVD; procedure F_SetDisplayWidth (iWidth: Integer); procedure F_SetDisplayHeight(iHeight: Integer); function F_GetDisplayWidth : Integer; function F_GetDisplayHeight : Integer; function F_GetAssigned : Boolean; function F_GetAspect : Extended; function F_GetFileName : WideString; function F_GetFileSizeString : WideString; function F_GetHasVideo : Boolean; function F_GetHeight : Integer; function F_GetWidth : Integer; function F_GetLength : Integer; function F_GetLengthString : WideString; function F_GetMedia : IWMPMedia; function F_GetMediaDir : WideString; function F_GetMediaDrive : WideString; function F_GetMediaExt : WideString; function F_GetMediaIsCD : Boolean; function F_GetMediaIsDVD : Boolean; function F_GetMediaName : WideString; function F_GetMediaPath : WideString; function F_GetMediaPosition : Integer; procedure F_SetMediaPosition(iPos : Integer); function F_GetCurrentPosition : Double; procedure F_SetCurrentPosition(fPos : Double); function F_GetDuration : Double; function F_GetMediaAlbum: WideString; function F_GetMediaAuthor: WideString; function F_GetMediaComposer: WideString; function F_GetMediaConductor: WideString; function F_GetMediaWriter: WideString; function F_GetMediaTitle: WideString; protected property MinFlag: Boolean read F_bMinFlag write F_bMinFlag; //最小化処理を行ったかどうかのフラグ {$WARN SYMBOL_PLATFORM OFF} property NewPlayer: IWMPPlayer4Disp read F_INewPlayer; property NewControls: IWMPControls3Disp read F_INewControls; {$WARN SYMBOL_PLATFORM ON} property fullScreen: Boolean read F_GetFullScreen write F_SetFullScreen default False; property enableContextMenu: Boolean read F_GetEnableContextMenu write F_SetEnableContextMenu default True; property uiMode: TMyWMPuiMode read F_GetUiMode write F_SetUiMode default uiFull; property stretchToFit: Boolean read F_GetStretchToFit write F_SetStretchToFit default True; property windowlessVideo: Boolean read F_GetWindowlessVideo write F_SetWindowlessVideo default False; property dvd: IWMPDVD read F_GetDvd; public constructor Create(AOwner: TComponent); override; // destructor Destroy; override; procedure SetBounds(rcRect: TRect); reintroduce; overload; procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); overload; override; function newMedia(sFile: WideString): IWMPMedia; //ビデオに合わせて幅と高さを計算 function WidthFromHeight(iHeight: Integer): Integer; function HeightFromWidth(iWidth: Integer): Integer; function IsCD (sFile: WideString) : Boolean; overload; function IsCD (Media: IWMPMedia) : Boolean; overload; function IsDVD(sFile: WideString) : Boolean; overload; function IsDVD(Media: IWMPMedia) : Boolean; overload; function IsDVD : Boolean; overload; function QueryInterface(const IID: TGUID; out Obj): HResult; override; procedure Minimize; property MinimizeCancel : Boolean read F_bMinCancel write F_bMinCancel; property FileName : WideString read F_GetFileName; property MediaDrive : WideString read F_GetMediaDrive; property MediaPath : WideString read F_GetMediaPath; property MediaDir : WideString read F_GetMediaDir; property MediaName : WideString read F_GetMediaName; property MediaExt : WideString read F_GetMediaExt; property MediaHasVideo : Boolean read F_GetHasVideo; property VideoHeight : Integer read F_GetHeight; property VideoWidth : Integer read F_GetWidth; property DisplayHeight : Integer read F_GetDisplayHeight write F_SetDisplayHeight; property DisplayWidth : Integer read F_GetDisplayWidth write F_SetDisplayWidth; property FileSizeString : WideString read F_GetFileSizeString; property Media : IWMPMedia read F_GetMedia; property MediaLength : Integer read F_GetLength; property MediaLengthString : WideString read F_GetLengthString; property Duration : Double read F_GetDuration; property MediaPosition : Integer read F_GetMediaPosition write F_SetMediaPosition; property CurrentPosition : Double read F_GetCurrentPosition write F_SetCurrentPosition; property MediaIsCD : Boolean read F_GetMediaIsCD; property MediaIsDVD : Boolean read F_GetMediaIsDVD; property MediaAlbum : WideString read F_GetMediaAlbum; property MediaArtist : WideString read F_GetMediaAuthor; property MediaAspect : Extended read F_GetAspect; property MediaAssigned : Boolean read F_GetAssigned; property MediaComposer : WideString read F_GetMediaComposer; property MediaConductor : WideString read F_GetMediaConductor; property MediaTitle : WideString read F_GetMediaTitle; property MediaWriter : WideString read F_GetMediaWriter; published property Anchors; end; type { TMyWindowsMediaPlayer } TMyWindowsMediaPlayer = class(TMyCustomWindowsMediaPlayer) public property NewPlayer; property NewControls; property dvd; published property fullScreen; property enableContextMenu; property uiMode; property stretchToFit; property windowlessVideo; end; procedure Register; //------------------------------------------------------------------------------ function gfnbAppReadyWMP(iVer: Integer; sTitle: WideString): Boolean; //============================================================================== implementation uses {$IFDEF DEBUG} myDebug, myDebugWMP, {$ENDIF} ActiveX, Forms, MultiMon, StdCtrls, {$IFDEF MYLIB} myFile, myNum, myWindow, {$ENDIF} SysUtils; procedure Register; begin RegisterComponents('Samples', [TMyWindowsMediaPlayer]); end; //------------------------------------------------------------------------------ {$IFNDEF MYLIB} //myNum.pas function gfniStrToInt(sNum: WideString): Int64; //sNumを整数にして返す。 var li_Pos, i: Integer; ls_Tmp: AnsiString; begin // sNum := WideUpperCase(gfnsStrToHalf(Trim(sNum))); //全角の算用数字もOkなように半角にする sNum := WideUpperCase(Trim(sNum)); try Result := StrToInt64(sNum); except ls_Tmp := ''; for i := 1 to Length(sNum) do begin li_Pos := Pos(sNum[i], '$X-+0123456789ABCDEF'); if (li_Pos >= 15) then begin if (ls_Tmp[1] = '$') then begin ls_Tmp := ls_Tmp + sNum[i]; end else begin //頭に'$'を付け加えて変換できるようにする //頭に$がないと16進表記はエラーになるのでそれへの対処 ls_Tmp := '$' + ls_Tmp + sNum[i]; end; end else if (li_Pos >= 5) then begin ls_Tmp := ls_Tmp + sNum[i]; end else if ((li_Pos = 1) or (li_Pos = 2)) and (ls_Tmp = '') then begin //16進表記 ls_Tmp := '$'; //'x'や'X'ではだめ end else if ((li_Pos = 3) or (li_Pos = 4)) and (ls_Tmp = '') then begin //and (i = 1) でもよい //sNum[i]は'-+'のどれか ls_Tmp := sNum[i]; end else begin Break; end; end; if (ls_Tmp = '') then begin Result := 0; end else begin Result := StrToInt64Def(ls_Tmp, 0); end; end; end; function lfniCeil(X: Extended): Int64; begin Result := Trunc(X); if Frac(X) > 0 then Inc(Result); end; function lfniFloor(X: Extended): Int64; begin Result := Trunc(X); if Frac(X) < 0 then Dec(Result); end; function gfniRoundUp(fNum: Extended): Int64; //fNumを切り上げて返す begin if (fNum >= 0) then begin Result := lfniCeil(fNum); end else begin Result := lfniFloor(fNum); end; end; function gfniRoundDown(fNum: Extended): Int64; //fNumを切り下げて返す begin if (fNum >= 0) then begin Result := lfniFloor(fNum); end else begin Result := lfniCeil(fNum); end; end; function gfnsTimeZeroSuppress(sValue: WideString): WideString; //時間表示のゼロサプレス var i: Integer; ls_WSep: WideString; begin //余計なゼロを取り除く Result := ''; ls_WSep := TimeSeparator; for i := 1 to Length(sValue) do begin if (sValue[i] = '0') or (sValue[i] = ls_WSep) then begin //何もしない end else begin Result := Copy(sValue, i, Length(sValue)); Break; end; end; if (Result = '') then Result := '0'; //空になっちゃったら0にする end; function gfnsSecToTimeStr(iSec: Integer): WideString; //秒数から'2:04:55'のような形式の文字列を返す var li_Hour, li_Min, li_Sec: Integer; begin li_Hour := iSec div 60 div 60; li_Min := iSec div 60 mod 60; li_Sec := iSec mod 60; Result := gfnsTimeZeroSuppress(Format('%d:%.2d:%.2d', [li_Hour, li_Min, li_Sec])); end; //------------------------------------------------------------------------------ //myFile.pas function gfnsFileDriveGet(sFile: WideString): WideString ; //ドライブ名を返す。 function lfns_DriveGet(sDrive: WideString; iIndex: Integer): WideString; begin if (WideUpperCase(sDrive[iIndex])[1] in [WideChar('A')..WideChar('Z')]) then begin Result := Copy(sFile, iIndex, 2) end else begin Result := ''; end; end; function lfns_UncGet(sDrive: WideString; iIndex, iLen: Integer): WideString; //UNC名を返す。 var i: Integer; iServer: Integer; begin Result := ''; i := iIndex; iServer := -1; while (i < iLen) do begin if (sDrive[i] = PathDelim) then begin if (i = iIndex) then begin Exit; //サーバー名が'' end else begin if (iServer <> -1) then begin if ((iServer + 1) = i) then begin Exit; //共有フォルダ名が'' end else begin Break; end; end else begin iServer := i; end; end; end; Inc(i); end; if (iServer <> -1) and (iServer < iLen) then begin if (sDrive[i] = PathDelim) then Dec(i); Result := Copy(sDrive, iIndex, i - iIndex + 1); if (Result <> '') then Result := '\\' + Result; end; end; var li_Len: Integer; begin Result := ''; li_Len := Length(sFile); if (li_Len >= 2) then begin if (sFile[2] = DriveDelim) then begin //C:〜 Result := lfns_DriveGet(sFile, 1); end else if (sFile[1] = PathDelim) and (sFile[2] = PathDelim) then begin if (li_Len >= 8) and (WideUpperCase(Copy(sFile, 1, 8)) = '\\?\UNC\') then begin //\\?\UNC\〜 Result := lfns_UncGet(sFile, 9, li_Len); end else if (li_Len >= 3) and (sFile[3] = '?') then begin //\\?\〜 if (li_Len >= 6) and (sFile[6] = DriveDelim) then begin Result := lfns_DriveGet(sFile, 5); end; end else begin //\\〜 UNC Result := lfns_UncGet(sFile, 3, li_Len); end; end; end; end; function gfnsFileDirGet(sFile: WideString): WideString; //Unicode対応ExtractFileDir。 //末尾の'\'はつかない。 //ドライブ名のみの場合も'\'はつかない。 //'\temp'このような場合空文字が返る。 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 -1); Break; end else if (sFile[i] = ':') then begin Result := Copy(sFile, 1, i); Break; end; end; end; end; function gfnsFilePathGet(sFile: WideString): WideString; //Unicode対応ExtractFilePath。 //末尾の'\'はつく。 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 gfnsFileNameGet(sFile: WideString): WideString; //パスを除いたファイル名を返す //拡張子はつく 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 gfnsFileMainGet(sFile: WideString): WideString; {2007-08-05,10-26: ファイル名のうちパスと拡張子を除いた部分を返す メインファイル名の拡張子のないもの \ と . はつかない 2007-10-26:ピリオドつきの主ファイル名の処理がうまくいっていなかったのを修正 lb_Extを判定に追加 } var i: Integer; lb_Ext: Boolean; //2007-10-26 begin Result := ''; lb_Ext := True; 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] = '.') and (lb_Ext) then begin; //2007-10-26 //拡張子であったので今までのをチャラにする Result := ''; lb_Ext := False; end else begin Result := sFile[i] + Result; end; end; end; function gfnsFileExtGet(sFile: WideString): WideString; //Unicode対応ExtractFileExt。 //'.'は返る 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; function gfniFileSizeGet(sFile: WideString): Int64; //sFileのサイズをByte単位で返す //http://delwiki.info/?Tips%2F%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB%E3%82%B5%E3%82%A4%E3%82%BA%E3%81%AF%20Int64%20%E3%81%A7 var lh_File: Cardinal; lr_Info: TWin32FindDataW; begin Result := 0; FillChar(lr_Info, SizeOf(lr_Info), 0); lh_File := FindFirstFileW(PWideChar(sFile), lr_Info); try if (lh_File <> INVALID_HANDLE_VALUE) then begin repeat if not(BOOL(lr_Info.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)) then begin //2008-05-28: Result := lr_Info.nFileSizeHigh * (Int64(MAXDWORD) +1) + lr_Info.nFileSizeLow; Break; end; until not(FindNextFileW(lh_File, lr_Info)); end; finally Windows.FindClose(lh_File); end; end; function gfnsFileSizeStringGet(sFile: WideString): WideString; //sFileのサイズをエクスプローラのプロパティの表示に合わせて単位(B,KB,MB,GB)つきで返す var li_Size: Int64; begin li_Size := gfniFileSizeGet(sFile); if (li_Size >= (1024 * 1024 * 1024)) then begin //GByte //精度指定子がある場合WideFormatはNG Result := WideString(Format('%.2f GB', [gfniRoundDown((gfniRoundUp(li_Size / 1024) / (1024 * 1024)) * 100) / 100])); end else if (li_Size >= (1024 * 1024)) then begin //MByte Result := WideString(Format('%.1f MB', [gfniRoundDown((gfniRoundUp(li_Size / 1024) / 1024) * 10) / 10])); end else if (li_Size >= 1024) then begin //KByte Result := WideFormat('%d KB', [gfniRoundUp(li_Size / 1024)]); end else begin //Byte Result := WideFormat('%d B', [li_Size]); end; end; function gfnbFileExists(sFile: WideString): Boolean; //FileExitsのUnicode対応版 var li_Attr: DWORD; begin if (sFile = '') then begin Result := False; end else begin li_Attr := GetFileAttributesW(PWideChar(sFile)); Result := (li_Attr <> $FFFFFFFF) and ((li_Attr and FILE_ATTRIBUTE_DIRECTORY) = 0); end; end; { var lh_Handle: THandle; lr_Info: TWin32FindDataW; begin if (sFile = '') then begin Result := False; end else begin Result := False; FillChar(lr_Info, SizeOf(lr_Info), 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) <> '..') 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; end; } //------------------------------------------------------------------------------ function gfnsSystem32DirGet: WideString; //System32ディレクトリを返す var li_Size: UINT; lp_Buff: PWideChar; begin Result := ''; li_Size := GetSystemDirectoryW(nil, 0); if (li_Size > 0) then begin lp_Buff := AllocMem(li_Size * 2); try li_Size := GetSystemDirectoryW(lp_Buff, li_Size); if (li_Size > 0) then begin Result := WideString(lp_Buff); end; finally FreeMem(lp_Buff); end; end; end; function gfnsFileVersionGet(sFile: WideString): WideString; //ファイルのバージョン情報を返す //http://www2.big.or.jp/~osamu/Delphi/Tips/key.cgi?key=13#0226.txt type TLangAndCodePage = record iLanguage: WORD; iCodePage: WORD; end; PLangAndCodePage = ^TLangAndCodePage; var li_Size, li_Reserved, li_Len: DWORD; lp_Buff, lp_Dat: Pointer; lp_LangPage: PLangAndCodePage; ls_FileInfo: WideString; begin Result := ''; // 必要なバッファのサイズを取得 li_Size := GetFileVersionInfoSizeW(PWideChar(sFile), li_Reserved); if (li_Size > 0) then begin //メモリ確保 lp_Buff := AllocMem((li_Size +1) * 2); try if (GetFileVersionInfoW(PWideChar(sFile), 0, li_Size, lp_Buff)) then begin //変数情報ブロック内の変換テーブルを指定 if (VerQueryValueW(lp_Buff, '\VarFileInfo\Translation', Pointer(lp_LangPage), li_Len) and (li_Len > 0)) then begin ls_FileInfo := WideString(Format('\StringFileInfo\%.4x%.4x\', [lp_LangPage^.iLanguage, lp_LangPage^.iCodePage])); //ファイルバージョン if (VerQueryValueW(lp_Buff, PWideChar(ls_FileInfo + 'FileVersion'), lp_Dat, li_Len) and (li_Len > 0)) then begin Result := WideString(PWideChar(lp_Dat)); end; end; end; finally // 解放 FreeMem(lp_Buff); end; end; end; //myMonitor.pas function gfnrcMonitorRectGet(hHandle: HWND): TRect; var lh_Handle: HMONITOR; lr_Info: TMonitorInfo; begin lh_Handle := MultiMon.MonitorFromWindow(hHandle, MONITOR_DEFAULTTONEAREST); FillChar(lr_Info, SizeOf(lr_Info), 0); lr_Info.cbSize := SizeOf(lr_Info); GetMonitorInfo(lh_Handle, @lr_Info); Result := lr_Info.rcMonitor; end; {$ENDIF} //------------------------------------------------------------------------------ function gfnbAppReadyWMP(iVer: Integer; sTitle: WideString): Boolean; {2009-02-23: WindowsMediaPlayerのiVer以上がインストールされていればTrueを返す。 そうでなければエラーメッセージを出しFalseを返す。 } const lcs_WMPDLL = 'wmp.dll'; var ls_Wmpdll, ls_Ver: WideString; li_Major, li_Code: Integer; begin Result := True; ls_Wmpdll := gfnsSystem32DirGet + '\' + lcs_WMPDLL; if not(gfnbFileExists(ls_Wmpdll)) then begin MessageBoxW(Application.Handle, PWideChar(WideFormat('必要なコンポーネントがインストールされていません。'#13'WindowsMediaPlayerのVer %d 以上がインストールされている必要があります', [iVer])), PWideChar(sTitle), MB_OK or MB_SETFOREGROUND); Result := False; end else begin ls_Ver := gfnsFileVersionGet(ls_Wmpdll); Val(ls_Ver, li_Major, li_Code); // if (gfniStrToInt(ls_Ver) < iVer) then begin if (li_Major < iVer) then begin MessageBoxW(Application.Handle, PWideChar(WideFormat('WindowsMediaPlayerのVer %d 以上がインストールされている必要があります'#13'現在インストールされているWindowsMediaPlayerのバージョンは %s です', [iVer, ls_Ver])), PWideChar(sTitle), MB_OK or MB_SETFOREGROUND); Result := False; end; end; end; //============================================================================== {$IFDEF DEBUG} function gfnsFillStr(sStr: WideString; iCount: Integer): WideString; //FillCharのWideString版のようなもの var i: Integer; begin Result := ''; for i := 1 to iCount do begin Result := Result + sStr; end; end; var liIndent: Integer = 0; procedure lpcDebug(sMsg: WideString); overload; begin myDebug.gpcDebugAdd(gfnsFillStr(' ', liIndent), sMsg); end; procedure lpcDebug(sMsg, sValue: WideString); overload; begin myDebug.gpcDebugAdd(gfnsFillStr(' ', liIndent), WideFormat('%s %s', [sMsg, sValue])); end; procedure lpcDebug(sMsg: WideString; iValue: Integer); overload; begin myDebug.gpcDebugAdd(gfnsFillStr(' ', liIndent), WideFormat('%s %d', [sMsg, iValue])); end; {$ENDIF} //------------------------------------------------------------------------------ { TMyCustomWindowsMediaPlayer } const lciWMPCONTROL_HEIGHT = 64; //メディアプレーヤーのシークバーやコントロールボタンのある部分の高さ constructor TMyCustomWindowsMediaPlayer.Create(AOwner: TComponent); begin F_bSetBounds := False; inherited; if (ControlInterface <> nil) then begin {$WARN SYMBOL_PLATFORM OFF} //新しいPlayerオブジェクト if (ControlInterface.QueryInterface(IWMPPlayer4Disp, F_INewPlayer) <> S_OK) then begin F_INewPlayer := nil; //インターフェース取得に失敗 end; //新しいControlsオブジェクト if (ControlInterface.controls.QueryInterface(IWMPControls3Disp, F_INewControls) <> S_OK) then begin F_INewControls := nil; //インターフェース取得に失敗 end; {$WARN SYMBOL_PLATFORM ON} end else begin F_INewPlayer := nil; F_INewControls := nil; end; settings.volume := 100; settings.autoStart := False; settings.invokeURLs := False; F_SetFullScreen(False); F_SetEnableContextMenu(True); F_SetUiMode(uiFull); F_SetStretchToFit(True); F_SetWindowlessVideo(False); F_bSetBounds := True; F_bMinFlag := False; end; (* destructor TMyCustomWindowsMediaPlayer.Destroy; begin //複数のTMyCustomWindowsMediaPlayerがあると異常終了してしまう { if (MediaAssigned) and (PlayState = wmppsPlaying) then begin // controls.stop; controls.pause; end; // close; } inherited; end; *) procedure TMyCustomWindowsMediaPlayer.SetBounds(rcRect: TRect); begin Self.SetBounds(rcRect.Left, rcRect.Top, rcRect.Right - rcRect.Left, rcRect.Bottom - rcRect.Top); end; procedure TMyCustomWindowsMediaPlayer.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); const lcID_IOLE_INPLACEOBJECT: TGUID = '{00000113-0000-0000-C000-000000000046}'; var lI_Obj: IOleInPlaceObject; lrc_Rect: TRect; begin if (F_bSetBounds) and (ComponentState = []) then begin //inheritedとlrc_Rectの両方ALeft+AWidth,ATop+AHeightにしないといけない { これをコメントアウトしないとTMyWindowsMediaPlayerのLeftとTopが0の時におかしなサイ ズにリサイズされてしまう。 ビデオのオリジナルサイズに合わせてしまったり音声メディアの時は小さくなったり… // inherited SetBounds(ALeft, ATop, ALeft + AWidth, ATop + AHeight); } lrc_Rect := Rect(ALeft, ATop, ALeft + AWidth, ATop + AHeight); IDispatch(Self.OleObject).QueryInterface(lcID_IOLE_INPLACEOBJECT, lI_Obj); lI_Obj.SetObjectRects(lrc_Rect, lrc_Rect); //↓はあった方がちらつきが少ない //Application.ProcessMessages; Sleep(1); end else begin inherited; end; end; function TMyCustomWindowsMediaPlayer.QueryInterface(const IID: TGUID; out Obj): HResult; begin Result := inherited QueryInterface(IID, Obj); end; function TMyCustomWindowsMediaPlayer.newMedia(sFile: WideString): IWMPMedia; begin if (Assigned(F_INewPlayer)) then begin Result := F_INewPlayer.newMedia(sFile); end else begin Result := nil; end; end; function TMyCustomWindowsMediaPlayer.IsCD(sFile: WideString): Boolean; begin Result := IsCD(newMedia(sFile)); end; function TMyCustomWindowsMediaPlayer.IsCD(Media: IWMPMedia): Boolean; begin Result := Assigned(Media) and (Copy(Media.sourceURL, 1, 8) = 'wmpcd://'); end; function TMyCustomWindowsMediaPlayer.IsDVD(sFile: WideString): Boolean; begin Result := IsDVD(newMedia(sFile)); end; function TMyCustomWindowsMediaPlayer.IsDVD(Media: IWMPMedia): Boolean; begin Result := Assigned(Media) and (Copy(Media.sourceURL, 1, 9) = 'wmpdvd://'); end; function TMyCustomWindowsMediaPlayer.IsDVD : Boolean; begin Result := IsDVD(Self.currentMedia); end; function TMyCustomWindowsMediaPlayer.F_GetMediaIsCD: Boolean; begin Result := IsCD(currentMedia); end; function TMyCustomWindowsMediaPlayer.F_GetMediaIsDVD: Boolean; begin Result := IsDVD(currentMedia); end; function TMyCustomWindowsMediaPlayer.F_GetMediaAlbum: WideString; //タグ・アルバム begin if (MediaAssigned) then begin Result := currentMedia.getItemInfo('Album'); end else begin Result := ''; end; end; function TMyCustomWindowsMediaPlayer.F_GetMediaAuthor: WideString; //タグ・演奏者 begin if (MediaAssigned) then begin Result := currentMedia.getItemInfo('Author'); end else begin Result := ''; end; end; function TMyCustomWindowsMediaPlayer.F_GetMediaComposer: WideString; //タグ・作曲家 begin if (MediaAssigned) then begin Result := currentMedia.getItemInfo('WM/Composer'); end else begin Result := ''; end; end; function TMyCustomWindowsMediaPlayer.F_GetMediaConductor: WideString; //タグ・指揮者 begin if (MediaAssigned) then begin Result := currentMedia.getItemInfo('WM/Conductor'); end else begin Result := ''; end; end; function TMyCustomWindowsMediaPlayer.F_GetMediaTitle: WideString; //タグ・タイトル begin if (MediaAssigned) then begin Result := currentMedia.getItemInfo('Title'); if (Result = '') then begin Result := gfnsFileMainGet(F_GetFileName); end; end else begin Result := ''; end; end; function TMyCustomWindowsMediaPlayer.F_GetMediaWriter: WideString; //タグ・作詞家 begin if (MediaAssigned) then begin Result := currentMedia.getItemInfo('WM/Writer'); end else begin Result := ''; end; end; procedure TMyCustomWindowsMediaPlayer.F_SetDisplayWidth (iWidth: Integer); //幅のセット。 begin if (uiMode <> uiNone) then begin Width := iWidth; end; end; procedure TMyCustomWindowsMediaPlayer.F_SetDisplayHeight(iHeight: Integer); { 高さのセット。 iHeight はWindowsMediaPlayer全体の高さではなくビデオ表示部の高さ。 } begin if (uiMode = uiNone) then begin Height := iHeight; end else if (uiMode <> uiInvisible) then begin Height := Height + lciWMPCONTROL_HEIGHT; end; end; function TMyCustomWindowsMediaPlayer.F_GetDisplayWidth: Integer; //ビデオ表示部の幅を返す begin if (uiMode = uiInvisible) then begin Result := 0; end else begin Result := Width; end; end; function TMyCustomWindowsMediaPlayer.F_GetDisplayHeight: Integer; //ビデオ表示部の高さを返す begin if (uiMode = uiInvisible) then begin Result := 0; end else if (uiMode = uiNone) then begin Result := Height; end else begin Result := Height - lciWMPCONTROL_HEIGHT; end; end; //ビデオに合わせて幅と高さを計算 function TMyCustomWindowsMediaPlayer.WidthFromHeight(iHeight: Integer): Integer; begin if (MediaHasVideo) then begin if (uiMode = uiMini) or (uiMode = uiFull) then begin Dec(iHeight, lciWMPCONTROL_HEIGHT); end; Result := gfniRound(iHeight * MediaAspect); end else begin Result := 0; end; end; function TMyCustomWindowsMediaPlayer.HeightFromWidth(iWidth: Integer): Integer; begin if (MediaHasVideo) then begin Result := gfniRoundUp(iWidth / MediaAspect); end else begin Result := 0; end; if (uiMode = uiMini) or (uiMode = uiFull) then begin Inc(Result, lciWMPCONTROL_HEIGHT); end; end; //フルスクリーンモード function TMyCustomWindowsMediaPlayer.F_GetFullScreen: Boolean; begin Result := F_INewPlayer.fullScreen; end; procedure TMyCustomWindowsMediaPlayer.F_SetFullScreen(const bFullScreen: Boolean); begin F_INewPlayer.fullScreen := bFullScreen; end; //ポップアップメニューの有効・無効 function TMyCustomWindowsMediaPlayer.F_GetEnableContextMenu: Boolean; begin Result := F_INewPlayer.enableContextMenu; end; procedure TMyCustomWindowsMediaPlayer.F_SetEnableContextMenu(const bEnabled: Boolean); begin F_INewPlayer.enableContextMenu := bEnabled; end; //メディアプレーヤーの外観モード function TMyCustomWindowsMediaPlayer.F_GetUiMode: TMyWMPuiMode; begin if (WideCompareText(F_INewPlayer.uiMode, 'none') = 0) then begin Result := uiNone; end else if (WideCompareText(F_INewPlayer.uiMode, 'mini') = 0) then begin Result := uiMini end else if (WideCompareText(F_INewPlayer.uiMode, 'invisible') = 0) then begin Result := uiInvisible; end else begin Result := uiFull; end; end; procedure TMyCustomWindowsMediaPlayer.F_SetUiMode(Mode: TMyWMPuiMode); begin case Mode of uiNone: F_INewPlayer.uiMode := 'none'; uiMini: F_INewPlayer.uiMode := 'mini'; uiInvisible: F_INewPlayer.uiMode := 'invisible'; {uiFull: F_INewPlayer.uiMode := 'full';} else begin F_INewPlayer.uiMode := 'full'; end; end; end; //オリジナルサイズ以上に拡大するか function TMyCustomWindowsMediaPlayer.F_GetStretchToFit: Boolean; begin Result := F_INewPlayer.stretchToFit; end; procedure TMyCustomWindowsMediaPlayer.F_SetStretchToFit(bStretchToFit: Boolean); begin F_INewPlayer.stretchToFit := bStretchToFit; end; //オーバーレイウィンドウを使わないか //Trueで使わない function TMyCustomWindowsMediaPlayer.F_GetWindowlessVideo: Boolean; begin Result := F_INewPlayer.windowlessVideo; end; procedure TMyCustomWindowsMediaPlayer.F_SetWindowlessVideo(const bWindowlessVideo: Boolean); begin F_INewPlayer.windowlessVideo := bWindowlessVideo; end; //DVDオブジェクト function TMyCustomWindowsMediaPlayer.F_GetDvd: IWMPDVD; begin Result := F_INewPlayer.dvd; end; function TMyCustomWindowsMediaPlayer.F_GetMedia: IWMPMedia; var l_CdPlayer: IWMPCdrom; ls_Path: WideString; begin if (F_GetAssigned) then begin if (F_GetMediaIsCD) then begin //'wmpcd://n/' ls_Path := F_GetMediaPath; l_CdPlayer := cdromCollection.Item(gfniStrToInt(Copy(ls_Path, 9, Length(ls_Path) - 9))); //CDプレーヤー Result := l_CdPlayer.Playlist.Item[gfniStrToInt(F_GetMediaName)]; end else if (F_GetMediaIsDVD) then begin //'wmpdvd// Result := currentMedia; end else begin Result := currentMedia; end; end else begin Result := nil; end; end; //currentMediaがあるか function TMyCustomWindowsMediaPlayer.F_GetAssigned: Boolean; begin Result := Assigned(currentMedia); end; //メディアにビデオがあるか function TMyCustomWindowsMediaPlayer.F_GetHasVideo: Boolean; begin Result := F_GetAssigned and (currentMedia.imageSourceHeight > 0) and (currentMedia.imageSourceWidth > 0); end; //ビデオのアスペクト比 function TMyCustomWindowsMediaPlayer.F_GetAspect: Extended; begin //Width / Height なので幅から高さを出すには gfniRound(Width / F_GetAspect); // 高さから幅を出すには gfniRound(Height * F_GetAspect); if (F_GetHasVideo) then begin Result := currentMedia.imageSourceWidth / currentMedia.imageSourceHeight; end else begin //ビデオなし Result := 1; end; end; //ビデオの幅 function TMyCustomWindowsMediaPlayer.F_GetWidth: Integer; begin if (F_GetAssigned) and (F_GetHasVideo) then begin Result := currentMedia.imageSourceWidth; end else begin Result := 0; end; end; //ビデオの高さ function TMyCustomWindowsMediaPlayer.F_GetHeight: Integer; begin if (F_GetAssigned) and (F_GetHasVideo) then begin Result := currentMedia.imageSourceHeight; end else begin Result := 0; end; end; //メディアの長さ(秒数) function TMyCustomWindowsMediaPlayer.F_GetLength: Integer; begin if (F_GetAssigned) then begin //2008-12-01:TruncからgfniRoundUpへ変更(1秒未満の場合もあるので) Result := gfniRoundUp(currentMedia.duration); end else begin Result := 0; end; end; function TMyCustomWindowsMediaPlayer.F_GetLengthString: WideString; //メディアの長さを文字列で返す //durationStringは0でパディングされるのでそれを避けるため実装 begin if (F_GetLength > 0) then begin Result := gfnsSecToTimeStr(F_GetLength); end else begin Result := ''; end; end; //メディアの再生位置 function TMyCustomWindowsMediaPlayer.F_GetMediaPosition: Integer; begin if (F_GetAssigned) then begin Result := Trunc(controls.currentPosition); end else begin Result := 0; end; end; procedure TMyCustomWindowsMediaPlayer.F_SetMediaPosition(iPos: Integer); begin if (F_GetAssigned) then begin controls.currentPosition := iPos; end; end; function TMyCustomWindowsMediaPlayer.F_GetCurrentPosition : Double; begin if (F_GetAssigned) then begin Result := controls.currentPosition; end else begin Result := 0; end; end; procedure TMyCustomWindowsMediaPlayer.F_SetCurrentPosition(fPos : Double); begin if (F_GetAssigned) then begin controls.currentPosition := fPos; end; end; function TMyCustomWindowsMediaPlayer.F_GetDuration : Double; begin if (F_GetAssigned) then begin Result := currentMedia.duration; end else begin Result := 0; end; end; //メディアのフルパスのファイル名 function TMyCustomWindowsMediaPlayer.F_GetFileName: WideString; begin if (F_GetAssigned) then begin Result := currentMedia.sourceURL; end else begin Result := ''; end; end; function TMyCustomWindowsMediaPlayer.F_GetMediaDrive: WideString; //ドライブを返す begin Result := gfnsFileDriveGet(F_GetFileName); end; function TMyCustomWindowsMediaPlayer.F_GetMediaDir: WideString; //末尾に'\'のつかないパス部分を返す begin Result := gfnsFileDirGet(F_GetFileName); end; function TMyCustomWindowsMediaPlayer.F_GetMediaPath: WideString; //パス部分を返す begin Result := gfnsFilePathGet(F_GetFileName); end; function TMyCustomWindowsMediaPlayer.F_GetMediaName: WideString; //ファイル名を返す(拡張子はつく) begin Result := gfnsFileNameGet(F_GetFileName); end; function TMyCustomWindowsMediaPlayer.F_GetMediaExt: WideString; //拡張子部分を返す begin Result := gfnsFileExtGet(F_GetFileName); end; function TMyCustomWindowsMediaPlayer.F_GetFileSizeString: WideString; //ファイルサイズを単位つきで返す begin Result := gfnsFileSizeGet(F_GetFileName); if (Result = '0B') then begin Result := ''; end; end; procedure TMyCustomWindowsMediaPlayer.Minimize; //var // lrc_Rect: TRect; begin //最小化したときに画面に映像が残らないようにスクリーン外に移動させる //サブモニターにフォームがあるときにはメインモニターの左上に一部が写りこんでし //まう不具合あり。 //ただし本家のWMPでもそうなるので、まぁ仕様かと。 F_bMinFlag := True; SetBounds(GetSystemMetrics(SM_XVIRTUALSCREEN) - ClientOrigin.X + Left - Width, GetSystemMetrics(SM_YVIRTUALSCREEN) - ClientOrigin.Y + Top - Height, Width, Height); { 以下の処理のように行うとサブモニターにフォームがあるとき最小化すると再生中のビデ オ次のビデオが終わるまで次のビデオの再生が始まらない不具合がでる。 lrc_Rect := gfnrcMonitorRectGet(Self.Handle); SetBounds(lrc_Rect.Left - ClientOrigin.X, lrc_Rect.Bottom - ClientOrigin.Y -2, 2, 2); SetBounds(GetSystemMetrics(SM_XVIRTUALSCREEN) - ClientOrigin.X + Left - Width, GetSystemMetrics(SM_YVIRTUALSCREEN) - ClientOrigin.Y + Top - Height, 2, 2); //最小の幅、高さにする SetBounds(GetSystemMetrics(SM_XVIRTUALSCREEN) -2, GetSystemMetrics(SM_YVIRTUALSCREEN) -2, 2, 2); //最小の幅、高さにする SetBounds(0, 0, 2, 2); //最小の幅、高さにする SetBounds(-2, -2, 2, 2); //最小の幅、高さにする } end; initialization {$IFDEF DEBUG} myDebug.gpcMessageModeSet(True); {$ENDIF} end.