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