TWindowsMediaPlayerはDelphi標準のTMediaPlayerよりもずっとパワフルなのですが、なぜかリサイズが効かないという地雷がありました。
これがまた本当にうんともすんとも言わない代物で。
でもきっと何か解決策はあるはずだ！ということで試行錯誤を繰り返した結果あっけなく解決。
何故そうなのかはよく解らないんだけれども。
その後まともな解決策が示され安定動作。
TWindowsMediaPlayerの導入方法、使い方は↓に詳しいので一読をお勧めします。
ernさんという、かなり詳しいと思われる方が書かれてます。
なんか呪文のような定数が出てきてるんですが、、こんなん一体どうやって調べればいいんだ？ってな話でもありますが。
まぁ何にせよ安定して動いているしDivXなどの重いファイルを開いた後でもきちんとサイズ変更に追従してくれているので一件落着と。
procedure TForm1.FormCreate(Sender: TObject);
begin
WindowsMediaPlayer1.Align := alClient;
end;
procedure TForm1.FormResize(Sender: TObject);
const
IID_IOleInPlaceObject: TGUID = '{00000113-0000-0000-C000-000000000046}';
var
IOIPObj: IOleInPlaceObject;
begin
IDispatch(WindowsMediaPlayer1.OleObject).QueryInterface(IID_IOleInPlaceObject,
IOIPObj);
IOIPObj.SetObjectRects(WindowsMediaPlayer1.BoundsRect, WindowsMediaPlayer1.BoundsRect);
end;
↑これを関数にまとめてみました。
procedure gpcWMPSetBounds(plyWMP: TWindowsMediaPlayer;
const rcRect: TRect);
overload;
procedure gpcWMPSetBounds(plyWMP: TWindowsMediaPlayer;
const iLeft, iTop, iWidth, iHeight: Integer);
overload;
procedure gpcWMPSetBounds(plyWMP: TWindowsMediaPlayer;
const rcRect: TRect);
//Rect指定版
begin
with rcRect
do begin
gpcWMPSetBounds(plyWMP, Left, Top, Right - Left, Bottom -
Top);
end;
end;
procedure gpcWMPSetBounds(plyWMP: TWindowsMediaPlayer;
const iLeft, iTop, iWidth, iHeight: Integer);
//メディアプレーヤーのサイズをセット
const
IID_IOleInPlaceObject: TGUID = '{00000113-0000-0000-C000-000000000046}';
var
IOIPObj: IOleInPlaceObject;
begin
plyWMP.SetBounds(iLeft, iTop, iWidth, iHeight);
IDispatch(plyWMP.OleObject).QueryInterface(IID_IOleInPlaceObject, IOIPObj);
IOIPObj.SetObjectRects(plyWMP.BoundsRect, plyWMP.BoundsRect);
end;
↓これで親ウィンドウいっぱいに広がります。
procedure TForm1.FormResize(Sender: TObject);
begin
gpcWMPSetBounds(WindowsMediaPlayer1, WindowsMediaPlayer1.Parent.ClientRect);
end;
親ウィンドウいっぱいにする以外でもクライアント座標で指定すればOKです。
当然FormResize以外の任意のところで呼ぶことも可能です。いつでもOK!ってな感じです。
ついでなので、ちょっと便利かなと思う関数を二つほど。
function gfnbWMPMediaHasVideo(plyWMP: TWindowsMediaPlayer): Boolean;
//メディアに映像があるかを返す
begin
Result := Assigned(plyWMP.currentMedia)
and ((plyWMP.currentMedia.imageSourceHeight > 0)
or (plyWMP.currentMedia.imageSourceWidth > 0));
end;
function gfnfWMPAspectRatioGet(plyWMP: TWindowsMediaPlayer): Extended;
//映像のアスペクト比を返す
begin
//Width / Height なので幅から高さを出すには Trunc(Width / gfnfWMPAspectRatioGet(WindowsMediaPlayer1))
if (gfnbWMPMediaHasVideo(plyWMP))
then begin
Result := plyWMP.currentMedia.imageSourceWidth / plyWMP.currentMedia.imageSourceHeight;
end else begin
//ビデオなし。
Result := 1;
end;
end;
ActiveX.pasのソースを見てみたら呪文のような定数がちゃんとあるんですね。
ほほぅ、なるほどなるほど、、
と1/10くらい分かったような気になるところがミソ。
あるいは落とし穴。
結局何のことだかは良く分かっていない。
{ IOleInPlaceObject interface }
{$EXTERNALSYM IOleInPlaceObject}
IOleInPlaceObject = interface(IOleWindow)
['{00000113-0000-0000-C000-000000000046}']
function InPlaceDeactivate: HResult; stdcall;
function UIDeactivate: HResult; stdcall;
function SetObjectRects(const rcPosRect: TRect; const rcClipRect: TRect): HResult; stdcall;
function ReactivateAndUndo: HResult; stdcall;
end;
以下はここにたどり着くまでの右往左往。
- STEP.1 - Form2.CreateのあとManual.Dock
- フォームを作成した直後であればWindowsMediaPlayerのサイズはきちんと変更されています。
ならばForm2にTWindowsMediaPlayerを貼り付けてAlignをalClientにしておきプログラム実行中にForm1からサイズを指定して動的に生成してしまえばよいのではないかと。
そう思ってやってみたら狙いどおりいきました。
で、できれば（見た目だけでも）シングルフォームでやりたかったのでForm2をForm1にドッキングさせてしまおうと。
そう思ってやったらこれもすんなりいきました。
ただしサイズ変更するにはそのつど生成したフォームを廃棄して再び生成し直さなければなりません。
そして再生していた曲を再び読み込んで途中から再生し直さなければなりません。
結構時間掛かります。
スムーズな再生には到底なりません。
なので曲のつながり目にしか使えない技かなぁ、と。
- STEP.2 - EnabledのOn/OffとVisibleのOn/Off
- Delphiのコンポーネントは何か不具合があった時に、状態を変化させるプロパティをOn/Offすると正常動作になることがあります。
もしかしたらこれでいけるか？と思いTWindowsMediaPlayerでも何か状態を変化させるプロパティをOn/Offしてからサイズ変更してみようと、とりあえず手軽なEnabledから初めてみました。
と、これが大正解。
今まで頑としてサイズ変更を受け付けなかったのがあっさりサイズ変更に追従してくれました。
ただEnabledのOn/Offだけではだめで、その後フォームのVisibleをOn/Offしないといけないので実用性はあまりないかなと。
まぁ、サイズ変更のたびにフォームを破棄・再生成するよりはずっとましではあるのだけれど。
procedure TForm1.FormCreate(Sender: TObject);
begin
WindowsMediaPlayer1.Align := alClient;
Show;
Tag := 1;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
if (Tag <> 0) then begin
WindowsMediaPlayer1.Enabled := False;
WindowsMediaPlayer1.Enabled := True;
Visible := False;
Visible := True;
end;
end;
FormResizeでif (Tag <> 0) で囲っているのはこれをしないとFormCreateの時にフォームのOnShow/OnHideの時にVisibleをいじるのはだめ〜と怒られるので。
最大化しようとしても同じように怒られるので対策としてメニューから最大化を削除するなり無効にするなりした方が良い。
ちなみにVisibleのOn/OffではなくHide/Showでも良い。
- STEP.3 - ちらつきを目立たないようにForm2を使用
- フォームのVisibleのOn/Off（非表示にしてから再び表示させる）で問題になるのはやはりちらつき。
それとマウスホイールの上下でビデオを拡大・縮小させようとするとフォームが非表示にになったとき一瞬他のアプリにフォーカスが行ってしまうこと。
この二つを解決しようというのでForm2を作成しておいてリサイズの時にForm1の上にかぶせてしまおうと。
そうすればフォーカスは他のアプリに行くことはなくちらつきも少しはましになるはずだと。
procedure TForm1.FormCreate(Sender: TObject);
begin
WindowsMediaPlayer1.Align := alClient;
Form2 := TForm2.Create(Self);
Form2.SetBounds(0, 0, 0, 0);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
WindowsMediaPlayer1.Enabled := False;
WindowsMediaPlayer1.Enabled := True;
Form2.SetBounds(Left, Top, Width, Height);
Form2.BringToFront;
Form2.Show;
Self.Hide;
Self.Show;
Form2.Hide;
end;
- STEP.4 - 更なるちらつき防止へ向けて
-
Form2.SetBounds(Left, Top, Width, Height - ClientHeight);
Form2の高さをHeight - ClientHeightとすることでタイトルバーと枠だけの高さにして、それをForm1のタイトルバーと重ねることでForm1がフォーカスを失ったときのタイトルバーの色の変化を最小限（でしかもお手軽）に抑えようというもくろみ。
しかもビデオ画面の内容はForm1の状態のままなのでForm2の画面が一瞬覆っていたSTEP.3よりはいくぶんましであろうと。
- STEP.5 - SetFocus
- STEP.4のときに実はForm1を非表示にしなくてもサイズ変更できていることに気づき、ということはVisibleのOn/OffやShow/Hideでなくてもいけるのじゃないかと。
そう思ってSetFocusを使ってみたらばこれまた大正解。
procedure TForm1.FormCreate(Sender: TObject);
begin
WindowsMediaPlayer1.Align := alClient;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
WindowsMediaPlayer1.Enabled := False;
WindowsMediaPlayer1.Enabled := True;
Windows.SetFocus(Application.Handle);
Windows.SetFocus(Self.Handle);
end;
- STEP.6 - SetActiveWindow
- STEP.5でSetFocusをやって大成功と思っていたら、連続で再生させていたときに曲の変わり目で他のアプリで作業していてもメディアプレーヤーにフォーカスを奪われてしまうことに気づき、SetFocusは使えないなぁと。
そこで関連しそうなAPIのうちSetForegroundWindowとSetActiveWindowを試してみたところSetActiveWindowが一番副作用がなさそうという結論に。
SetForegroundWindowは他のアプリで作業中であっても問題はないのだけれどもタスクバーが点滅してしまうので今ひとつ。
それに比べてSetActiveWindowはそういうことがなくしかも他のアプリで作業中であっても問題なし。
procedure TForm1.FormCreate(Sender: TObject);
begin
WindowsMediaPlayer1.Align := alClient;
end;
procedure Form1.FormResize(Sender: TObject);
begin
plyMedia.Enabled := False;
plyMedia.Enabled := True;
SetActiveWindow(Application.Handle);
end;
その後色々やってるうちにうんともすんともサイズ変更しなくなる現象に遭遇。
新しくフォームを作って一からやり直せばOKなのだけれどもこれまた色々作りこんでいくうちにいつの間にかサイズ変更できなくなるというドツボ。
2008-06-07: リサイズ用関数と映像用関数を二つ追加記述。