フォームのフェードイン・フェードアウト
プログラムの開始や終了のときにフォームがフェードインやフェードアウトするとちょっとかっこいいかなと思いました。
で、それがTFormのAlphaBlendプロパティとAlphaBlendValueプロパティを利用することで簡単にできてしまいます。
と、思ったらそんなことをするまでもなくAPI一発でもっと簡単に済んでしまうことが分かりました。
更にWindows 7(Vistaからなのかな?)では何もしなくてもプログラムの開始と終了の時にフェードインやフェードアウトするようになってました。
参考サイト
AnimateWindow API
フェードイン
procedure TForm1.FormCreate(Sender: TObject);
begin
AnimateWindow(Handle, 200, AW_BLEND or AW_ACTIVATE);
end;
フェードアウト
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
AnimateWindow(Handle, 200, AW_BLEND or AW_HIDE);
end;
こんな便利なAPIがあったとは、、というくらいあっけなくスムーズにできてしまいます。
このAPIを知る前に書いたAlphaBlendValueを調整しながらループを回すやり方のようにWindowsMediaPlayerコンポーネントを非表示にしておく必要もありません。
注意点
- フォームのフェードインの時にAW_ACTIVATEを指定しないとフォームの右上のボタンのスタイルが一時的におかしくなってしまうことがあります。
procedure TForm1.FormCreate(Sender: TObject);
begin
AnimateWindow(Handle, 200, AW_BLEND {or AW_ACTIVATE});
end;
AW_ACTIVATEをセットしなかった場合。
右上のボタンのスタイルがクラシックスタイルのものになっています。
フォームを触ったりすると戻ります。
- フォームにパネルやボタンを置いていた場合、フェードインした後に描画されます。
あらかじめ描画された状態でフェードインさせるにはShowWindow APIを使います。
procedure TForm1.FormCreate(Sender: TObject);
begin
ShowWindow(Panel1.Handle, SW_SHOW);
AnimateWindow(Handle, 200, AW_BLEND or AW_ACTIVATE);
end;
Panel1のVisibleプロパティを操作したりPanel1.Show;などとしても効果はありません。
- TImageやTLabel、TSpeedButtonなどの、TWinControlを継承していないコントロールはAnimateWindowでフェードインさせると表示されなくなります。
フェードインしたあとRepaintする必要があります。
procedure TForm1.FormCreate(Sender: TObject);
begin
AnimateWindow(Handle, 200, AW_BLEND or AW_ACTIVATE);
Self.Repaint;
end;
Image1.Repaint;などとしても良いのですが、全部のコントロールをいちいち呼ぶのも面倒なのでSelf.Repaint;一発で済ませてしまっています。
- TImageやTLabel、TSpeedButtonなどの、TWinControlを継承していないコントロールはフェードイン・フェードアウト中は表示されません。
- フォームのTransparentColorプロパティは無効になります。
フェードインしたあとにセットする必要があります。
procedure TForm1.FormCreate(Sender: TObject);
begin
AnimateWindow(Handle, 200, AW_BLEND or AW_ACTIVATE);
Self.TransparentColor := False;
Self.TransparentColor := True;
end;
オブジェクトインスペクタでTransparentColorをTrueにセットしていた場合、一度FalseにしてからTrueにセットし直さないと反映されません。
これはフォームのprivate変数でTransparentColorの値を保持しており、セットしようとしている値が保持している値と一緒の場合は無駄な処理をしないように、何もしないような実装になっているためと思われます。
なので一度FalseにセットしてからTrueにセットし直すというやり方が必要になります。
Delphiのプロパティではそういうものが多くあります。
- MSDN ライブラリにはAW_BLENDとAW_HIDEを同時に指定するなと書いてあります。
つまりフェードアウトには使うなということのようなのですが、指定してみると問題なくフェードアウトしているように思えます。
XPのSP3でしか確認していないのでもしかしたら他の環境ではアウトなのかもしれません。
以前のやり方
以下の記述はAnimateWindow APIを知る前に書いたものです。
AnimateWindow APIに比べて何のメリットもありません。
ただ、ループの処理を指定時間内に収めようと努力してる部分は後々参考になるであろうということで残してあるものです。
フェードイン
まず設計時にフォームのAlphaBlendプロパティをTrueに、AlphaBlendValueプロパティを0にセットしておきます。
そしてフォームのOnCreateイベントで徐々にAlphaBlendValueプロパティの値を増やしていきます。
それだけです。
procedure TForm1.FormCreate(Sender: TObject);
const
lci_STEP = 50;
var
i: Integer;
begin
Show;
for i := 0 to lci_STEP do begin
AlphaBlendValue := Trunc(i * (255 / lci_STEP));
Application.ProcessMessages;
end;
AlphaBlendValue := 255;
AlphaBlend := False;
end;
例ではフェードインのステップを50にしていますが、そのへんは適当に調整してください。
ループ中で時間を取得して各ステップごとに必要な時間まで待機させる方が丁寧で良いのかも知れません。
procedure TForm1.FormCreate(Sender: TObject);
const
lci_STEP = 50;
lci_FADETIME = 1000; //フェードインにかける時間。
var
i: Integer;
li_Start: DWORD;
li_Sleep: Integer;
begin
Show;
li_Start := GetTickCount;
for i := 0 to lci_STEP do begin
AlphaBlendValue := Trunc(i * (255 / lci_STEP));
Application.ProcessMessages;
li_Sleep := Trunc(li_Start + i * (lci_FADETIME / lci_STEP)
- GetTickCount);
if (li_Sleep > 0) then begin
Sleep(li_Sleep);
end;
end;
AlphaBlendValue := 255;
AlphaBlend := False;
end;
フェードアウト
フェードアウトするにはフォームのOnCloseイベントに処理を書きます。
OnDestroyイベントはNGです。
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
const
lci_STEP = 50;
var
i: Integer;
begin
AlphaBlendValue := 255;
AlphaBlend := True;
Application.ProcessMessages; //必須。ないと一瞬ブラックアウトする。
for i := lci_STEP downto 0 do begin
AlphaBlendValue := Trunc(i * (255 / lci_STEP));
Application.ProcessMessages;
end;
AlphaBlendValue := 0;
Hide;
end;
ループ終了後の2行は実は余計なのですが、一応念のため。
これも丁寧にやるには
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
const
lci_STEP = 50;
lci_FADETIME = 1000; //フェードアウトにかける時間。
var
i: Integer;
li_Start: DWORD;
li_Sleep: Integer;
begin
AlphaBlendValue := 255;
AlphaBlend := True;
Application.ProcessMessages; //必須。ないと一瞬ブラックアウトする。
li_Start := GetTickCount;
for i := lci_STEP downto 0 do begin
AlphaBlendValue := Trunc(i * (255 / lci_STEP));
Application.ProcessMessages;
li_Sleep := Trunc(li_Start + (lci_STEP - i) * (lci_FADETIME / lci_STEP) - GetTickCount);
if (li_Sleep > 0) then begin
Sleep(li_Sleep);
end;
end;
AlphaBlendValue := 0;
Hide;
end;
などとします。
アンダーラインを引いた部分はフェードインの場合と違っています。
フェードアウトの場合ステップが50から小さくなっていくのでフェードインと同じ要領でやるとうまくきません。
注意点
TWindowsMediaPlayerやTMediaPlayerなどを利用してフォーム上で動画を再生させているときにそのフォームをフェードアウトさせるとフェードアウトした後にフォームの後ろにあった他のアプリケーションの一部に黒い痕跡が残ってしまうことがあります。
多分ビデオオーバーレイがらみだとは思うのですが、ビデオオーバーレイ用の色(RGBで
16, 0, 16)が残ってしまいます。
それを防ぐにはフェードアウトする前にTWindowsMediaPlayerやTMediaPlayerを非表示にします。
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
const
lci_STEP = 50;
lci_FADETIME = 1000; //フェードアウトにかける時間。
var
i: Integer;
li_Start: DWORD;
li_Sleep: Integer;
begin
AlphaBlendValue := 255;
AlphaBlend := True;
WindowsMediaPlayer1.Visible := False; //この位置がベスト
Application.ProcessMessages;
li_Start := GetTickCount;
for i := lci_STEP downto 0 do begin
AlphaBlendValue := Trunc(i * (255 / lci_STEP));
Application.ProcessMessages;
li_Sleep := Trunc(li_Start + (lci_STEP - i) * (lci_FADETIME
/ lci_STEP) - GetTickCount);
if (li_Sleep > 0) then begin
Sleep(li_Sleep);
end;
end;
AlphaBlendValue := 0;
Hide;
end;
あるいはフェードアウトの処理中にApplication.ProcessMessagesを呼ばないようにし、最後のHideを削除することでも防ぐことができるようです。
この場合一度ブラックアウトしてから徐々に色が薄れていくことになるので若干不自然さはあります。
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
const
lci_STEP = 50;
lci_FADETIME = 1000; //フェードアウトにかける時間。
var
i: Integer;
li_Start: DWORD;
li_Sleep: Integer;
begin
AlphaBlendValue := 255;
AlphaBlend := True;
//Application.ProcessMessages;
li_Start := GetTickCount;
for i := lci_STEP downto 0 do begin
AlphaBlendValue := Trunc(i * (255 / lci_STEP));
//Application.ProcessMessages;
li_Sleep := Trunc(li_Start + (lci_STEP - i) * (lci_FADETIME
/ lci_STEP) - GetTickCount);
if (li_Sleep > 0) then begin
Sleep(li_Sleep);
end;
end;
AlphaBlendValue := 0;
//Hide;
end;
2010-02-10:AnimateWindow API一発でループを回す必要もなく済んでしまうことが判明。