|
フォームの最小化、最大化をアニメーションでやりたい。（DELPHI）
|
過去のＭＬを検索してみましたが案外少ないようです。「最小化」の話題は結構あるのに。このような機能をもつコンポーネントがたくさんあるし、あまり重要な機能でもないということですか。
これは当然ですが、SetBoundsメソッドなんかをいじっていてもダメですね。
また、WM_SYSCOMMANDメッセージをとらえて
procedure TForm1.WMSysCommand(var msg: TWMSysCommand);
begin
if msg.CMdType = SC_MINIMIZE then
WindowState := wsMinimized;
inherited;
end;
としてもだめですね。[Delphi-ML:939] 原
結論的に言うと、MovWindowというＡＰＩを使うんですが、このためのちょっとした工夫が、メッセージの理解やその処理の仕方について大変勉強になります。（コンポーネント貼り付けるだけが能ではない！）
ということで、今回はちょっと解説を。
・フォーム（メインも含めて）とApplicationの同期を考慮しなければならないので、双方のWindProcをオーバーライドしなければならない。
・自分のメソッドのWindProcは、オーバーライドは簡単ですよね、
・では、ApplicationのWndProcはどうすればオーバーライドのようにできるのか。
というようなことを考えて下さい。
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem; // ボタンではなく、メニューでテストがミソ
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
private
NewAppWndProc: Pointer;
OldAppWndProc: Pointer;
protected
procedure WndProc(var Msg: TMessage); override;
procedure AppWndProc(var Msg: TMessage); virtual;
public
end;
// 途中省略
uses MMSystem;
{$R *.DFM}
// AppliCationのWndProcをすり替えている
procedure TForm1.FormCreate(Sender: TObject);
begin
if Application.MainForm = nil then
begin
// WndProcのインスタンスを作成
NewAppWndProc := MakeObjectInstance(AppWndProc);
// 元のApplicationのWndProcアドレスを保存
OldAppWndProc := Pointer(GetWindowLong(Application.Handle, GWL_WNDPROC));
// ApplicationのWndProcアドレスをNewAppWndProcに変更
SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(NewAppWndProc));
end;
end;
// 終わる時は後始末をする
procedure TForm1.FormDestroy(Sender: TObject);
begin
if (Application.Handle <> 0) and (OldAppWndProc <> nil) then
begin
// 元のWndProcに戻す
SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(OldAppWndProc));
// インスタンスを解放
FreeObjectInstance(NewAppWndProc);
end;
end;
//ウィンドウプロシージャを書き直す
procedure TForm1.WndProc(var Msg: TMessage);
var
SaveTitle: string;
begin
with Msg do // ここでメッセージを横取り
begin
if (Msg = WM_SYSCOMMAND) and (WParam = SC_MINIMIZE) then
with Application do
begin
SaveTitle := Title;
Title := Caption;
// 再び手前に表示−−おまじない
NormalizeTopMosts;
// トップ レベルでアクティブ ウィンドウ化
SetActiveWindow(Handle);
// ウィンドウの位置と寸法を変更
MoveWindow(Handle, Left, Top, Width, Height, True);
// サウンドを再生 ふろくだから無視してください
PlaySound('Minimize', 0, Snd_Alias or Snd_NoDefault or Snd_ASync);
// 表示状態を設定
ShowWindow(Handle, SW_MINIMIZE);
Title := SaveTitle;
end
end;
inherited WndProc(Msg);
end;
//アップリケーションプロシージャに置き換えられた偽のWndProc
procedure TForm1.AppWndProc(var Msg: TMessage);
begin
with Msg do // ここでも横取りする
begin
if (Msg = WM_ERASEBKGND) then
Result := 1
else if (Msg = WM_SYSCOMMAND) and (WParam = SC_RESTORE) then
with Application do
begin // 戻す
PlaySound('RestoreUp', 0, Snd_Alias or Snd_NoDefault or Snd_ASync);
// トップ レベルでアクティブ ウィンドウ化
SetActiveWindow(Handle);
ShowWindow(Handle, SW_RESTORE);
// わり算を大きくするとスム−ス
MoveWindow(Handle, Screen.Width div 4, Screen.Width div 4, 0, 0, False);
Result := 1;
end
else if (Msg = WM_SYSCOMMAND) and (WParam = SC_MINIMIZE) then
begin // 最小化
PlaySound('Minimize', 0, Snd_Alias or Snd_NoDefault or Snd_ASync);
// フォーム
Perform(WM_SYSCOMMAND, SC_MINIMIZE, 0);
end
else
Result := CallWindowProc(OldAppWndProc, Application.Handle, Msg, WParam, LParam);
end;
end;
これをヒントに自分でコンポーネント化するのは簡単でしょう。
もう一つ、フォームへのメッセージを横取りするWndProcをコンポーネントで書くということです。
ＭＬで話題になっていたので、ひとこと。ボタンやメニューで最小化する時は
procedure TForm1.N1Click(Sender: TObject);
begin
Application.minimize; // これはダメ アニメーションしない（当然）
end;
procedure TForm1.N2Click(Sender: TObject);
begin
Perform(WM_SYSCOMMAND, SC_MINIMIZE, 0); // これでうまくいく
end;
逆のRestoreの場合は、
Application.minimize;
Perform(WM_SYSCOMMAND, SC_RESTORE, 0);
でも似たようなものになります。
なぜか？ → ＭＬを再読されたし。
|
|
