フォームをアニメーション起動・終了(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