Friday, June 29, 2012

Membuat Efek Ledakan Form di VB6

Coding ini digunakan untuk memberikan efek ledakan di Form pada VB6

Ikuti langkah-langkah berikut ini
- Siapkan 1 form baru
- Siapkan pula 1 command button

Klik gambar untuk memperbesar




copy kan coding berikut ini di form

Private Sub Command1_Click()
  'Ganti '20000' di bawah dengan kecepatan dari efek ledakan form.
  Call ImplodeForm(Me, 20000)
  End
  Set Form1 = Nothing
End Sub

Private Sub Form_Load()
  Call ExplodeForm(Me, 20000)  'ledakan form
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  Call ImplodeForm(Me, 20000)  'pengembalian form
End Sub






dan buatlah satu module kemudian copy kan coding berikut ini di 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" (ByVal hwnd As Integer, lpRect As RECT)
  Declare Function GetDC Lib "User" (ByVal hwnd As Integer) As Integer
  Declare Function ReleaseDC Lib "User" (ByVal hwnd As Integer, ByVal hdc As _
  Integer) As Integer
  Declare Sub SetBkColor Lib "GDI" (ByVal hdc As Integer, ByVal crColor As Long)
  Declare Sub Rectangle Lib "GDI" (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" (ByVal crColor As Long) As Integer
  Declare Function SelectObject Lib "GDI" (ByVal hdc As Integer, ByVal hObject _
  As Integer) As Integer
  Declare Sub DeleteObject Lib "GDI" (ByVal hObject As Integer)
#Else
  Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, _
  lpRect As RECT) As Long
  Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal _
  hdc As Long) As Long
  Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal _
  crColor As Long) As Long
  Declare Function Rectangle Lib "gdi32" (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" (ByVal crColor As Long) As Long
  Declare Function SelectObject Lib "user32" (ByVal hdc As Long, ByVal hObject _
  As Long) As Long
  Declare Function DeleteObject Lib "gdi32" (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
  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
  Next i
  X = ReleaseDC(0, TheScreen)
  DeleteObject (Brush)
End Sub
'--- Batas coding di Module...

No comments:

Post a Comment

Ayo gan Komentarnya jangan lupa,,,biar Mas Mukhlas tambah semangat nulis postingan-nya, kalau ada pertanyaan atau link yang mati laporkan juga disini ya...

LinkWithin

Related Posts Plugin for WordPress, Blogger...