Explode or Implode a Form

By | 2019-09-19

Rather than have a form simply appear or disappear, you can use this module to add an explode or implode effect when a form appears or disappears.

Module

Insert the following code to your module.

If Win16 Then
   Type RECT
      Left As Integer
      Top As Integer
      Right As Integer
      Bottom As Integer
   End Type
Else
   Type RECT
      Left As Long
      Top As Long
      Right As Long
      Bottom As Long
   End Type
End If

If Win16 Then
   Declare Sub GetWindowRect Lib "user.dll" (ByVal hwnd As Integer, lpRect As RECT)

   Declare Function GetDC Lib "user.dll" (ByVal hwnd As Integer) As Integer

   Declare Function ReleaseDC Lib "user.dll" (ByVal hwnd As Integer, ByVal hdc As _
      Integer) As Integer

   Declare Sub SetBkColor Lib "gdi.dll" (ByVal hdc As Integer, ByVal crColor As Long)

   Declare Sub Rectangle Lib "gdi.dll" (ByVal hdc As Integer, ByVal X1 As Integer, _
      ByVal Y1 As Integer, ByVal X2 As Integer, ByVal Y2 As Integer)

   Declare Function CreateSolidBrush Lib "gdi.dll" (ByVal crColor As Long) As Integer

   Declare Sub DeleteObject Lib "gdi.dll" (ByVal hObject As Integer)
Else
   Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, _
      lpRect As RECT) As Long

   Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long

   Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal _
      hdc As Long) As Long

   Declare Function SetBkColor Lib "gdi32.dll" (ByVal hdc As Long, ByVal _
      crColor As Long) As Long

   Declare Function Rectangle Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, _
      ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

   Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long

   Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
End If

Sub ExplodeForm(f As Form, Movement As Integer)
   Dim myRect As RECT
   Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy%
   Dim TheScreen As Long
   Dim Brush As Long
   
   GetWindowRect f.hwnd, myRect
   formWidth = (myRect.Right - myRect.Left)
   formHeight = myRect.Bottom - myRect.Top
   TheScreen = GetDC(0)
   Brush = CreateSolidBrush(f.BackColor)
   For i = 1 To Movement
      Cx = formWidth * (i / Movement)
      Cy = formHeight * (i / Movement)
      X = myRect.Left + (formWidth - Cx) / 2
      Y = myRect.Top + (formHeight - Cy) / 2
      Rectangle TheScreen, X, Y, X + Cx, Y + Cy
      DoEvents
   Next i
   X = ReleaseDC(0, TheScreen)
   DeleteObject (Brush)
End Sub

Public Sub ImplodeForm(f As Form, Movement As Integer)
   Dim myRect As RECT
   Dim formWidth%, formHeight%, i%, X%, Y%, Cx%, Cy%
   Dim TheScreen As Long
   Dim Brush As Long
   
   GetWindowRect f.hwnd, myRect
   formWidth = (myRect.Right - myRect.Left)
   formHeight = myRect.Bottom - myRect.Top
   TheScreen = GetDC(0)
   Brush = CreateSolidBrush(f.BackColor)
   For i = Movement To 1 Step -1
      Cx = formWidth * (i / Movement)
      Cy = formHeight * (i / Movement)
      X = myRect.Left + (formWidth - Cx) / 2
      Y = myRect.Top + (formHeight - Cy) / 2
      Rectangle TheScreen, X, Y, X + Cx, Y + Cy
      DoEvents
   Next i
   X = ReleaseDC(0, TheScreen)
   DeleteObject (Brush)
End Sub

Usage

Insert this code in to your form.

Option Explicit

Private Sub Command1_Click()
   'Replace all the '500' below with the Speed of the Explode\Implode Effect.
   Call ImplodeForm(Me, 500)
   End
   Set Form1 = Nothing
End Sub

Private Sub Form_Load()
   Call ExplodeForm(Me, 500)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   Call ImplodeForm(Me, 500)
End Sub

Author: dwirch

Derek Wirch is a seasoned IT professional with an impressive career dating back to 1986. He brings a wealth of knowledge and hands-on experience that is invaluable to those embarking on their journey in the tech industry.

Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.