フォームをアニメーション起動・終了(T) <TOP>
通常のフォーム表示じゃ物足りない?ではフェード効果を・・・
例では、メインフォームをフェードイン表示、さらにフォーム2をセンターからアニメート表示
AnimateWindow アニメートウィンドウ
'================================================================ '= フォームをアニメーション起動・終了 '= (AnimateWindow.bas) '================================================================ #include "Windows.bi" ' フォームをアニメーション表示 Declare Function Api_AnimateWindow& Lib "user32" Alias "AnimateWindow" (ByVal hWnd&, ByVal dwTime&, ByVal dwFlags&) #define AW_HOR_POSITIVE &H1 '左から右に向かってアニメート #define AW_HOR_NEGATIVE &H2 '右から左に向かってアニメート #define AW_VER_POSITIVE &H4 '上から下に向かってアニメート #define AW_VER_NEGATIVE &H8 '下から上に向かってアニメート #define AW_CENTER &H10 '中心からアニメート #define AW_HIDE &H10000 '非表示にする。既定値は表示 #define AW_ACTIVATE &H20000 'アクティブに #define AW_SLIDE &H40000 'スライドアニメーションを使う。既定値はロールアニメーション #define AW_BLEND &H80000 'フェードイン効果 #define FORM_HIDE &H80000 Or &H10000 '複合操作 Var Shared MainForm As Object Var Shared Form2 As Object Var Shared Button1 As Object Var Shared Button2 As Object MainForm.attach GethWnd Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14 Var Shared hWnd2 As Long '================================================================ '= '================================================================ Declare Sub MainForm_Start edecl () Sub MainForm_start() Var Ret As Long Ret = Api_AnimateWindow(GethWnd, 1000, AW_BLEND) Cls SetFocus Form2.CreateWindow "Form2", 0 hWnd2 = Form2.GethWnd Button2.Attach Form2.GetDlgItem("Button2") : Button2.SetFontSize 14 End Sub '================================================================ '= Form2 ShowWindow '================================================================ Declare Sub Button1_on edecl () Sub Button1_on() Var Ret As Long Ret = Api_AnimateWindow(hWnd2, 1000, AW_CENTER) If Not(Ret <> 0) Then Ret = MessageBox("", "失敗", 0, 2) End If Form2.Cls Form2.SetFocus End Sub '================================================================ '= Form2 HideWindow '================================================================ Declare Sub Button2_on edecl () Sub Button2_on() Var Ret As Long Ret = Api_AnimateWindow(hWnd2, 1000, FORM_HIDE) If Not(Ret <> 0) Then Ret = MessageBox("", "失敗", 0, 2) End If Form2.ShowWindow 0 MainForm.SetFocus End Sub '================================================================ '= 終了 '================================================================ Declare Sub MainForm_QueryClose edecl (Cancel%, ByVal Mode%) Sub MainForm_QueryClose(Cancel%, ByVal Mode%) Var Ret As Long If Cancel% = 0 Then Ret = Api_AnimateWindow(GethWnd, 1000, FORM_HIDE) End End If End Sub '================================================================ '= '================================================================ While 1 WaitEvent Wend Stop End