Explode or Implode a Form
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
Special Instructions
This code originally appeared on AndreaVB.com, and has been republished here with the permission of Andrea Tincani.
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.