フォームをアニメーションで終了          <TOP>


フォームをアニメーションで終了させます。

SystemParametersInfo システム全体に関するパラメータを取得・設定

GetWindowRect ウィンドウの座標をスクリーン座標系で取得

Rectangle 長方形の描画

GetDC デバイスコンテキストのハンドルを取得

ReleaseDC デバイスコンテキストを解放

 

Rectangleでアニメーション風にフォームを徐々に小さく描画しています。

EditBoxに入力する数値で時間調整をしています。

 
'================================================================
'= フォームをアニメーションで終了
'=    (EndToAnimation.bas)
'================================================================
#include "Windows.bi"

Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type

#define SPI_GETWORKAREA 48              '主モニターの有効なスクリーンのサイズを取得

' システム全体に関するパラメータを取得・設定
Declare Function Api_SystemParametersInfo& Lib "user32" Alias "SystemParametersInfoA" (ByVal uiAction&, ByVal uiParam&, pvParam As Any, ByVal fWinIni&)

' ウィンドウの座標をスクリーン座標系で取得
Declare Function Api_GetWindowRect& Lib "user32" Alias "GetWindowRect" (ByVal hWnd&, lpRect As RECT)

' 長方形の描画
Declare Function Api_Rectangle& Lib "gdi32" Alias "Rectangle" (ByVal hDC&, ByVal X1&, ByVal Y1&, ByVal X2&, ByVal Y2&)

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

' デバイスコンテキストを解放
Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&)

Var Shared Text1 As Object
Var Shared Edit1 As Object
Var Shared Button1 As Object

Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'================================================================
'=
'================================================================
Declare Sub EndToAnimation edecl ()
Sub EndToAnimation()
    Var Scrn As Long
    Var DelObj As Long
    Var rct As RECT
    Var iWidth As Integer
    Var iHeight As Integer
    Var Cnt As Integer
    Var iLeft As Integer
    Var iTop As Integer
    Var x As Integer
    Var y As Integer
    Var iTime As Long
    Var Ret As Long

    '描画時間
    iTime = Val(Edit1.GetWindowtext)
    If iTime > 32767 Then Exit Sub

    'ウィンドウ(フォーム)のサイズ取得
    Ret = Api_GetWindowRect(GethWnd, rct)
    iWidth = (rct.Right - rct.Left)
    iHeight = rct.Bottom - rct.Top

    'スクリーンのデバイスコンテキスト取得(0を指定)
    Scrn = Api_GetDC(0)

    For Cnt = iTime To 1 Step -1
        x = iWidth * (Cnt / iTime)
        y = iHeight * (Cnt / iTime)
        iLeft = rct.Left + (iWidth - x) / 2
        iTop = rct.Top + (iHeight - y) / 2

        '長方形を描画
        Ret = Api_Rectangle(Scrn, iLeft, iTop, iLeft + x, iTop + y)
    Next Cnt

    Ret = Api_ReleaseDC(0, Scrn)
    End
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    EndToAnimation
End Sub

'================================================================
'=
'================================================================
Declare Sub Mainform_QueryClose edecl ()
Sub Mainform_QueryClose()
    EndToAnimation
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End