Membuat Efek Slide Form

Pada posting kali ini Ane mau berbagi tips memperindah tampilan form khususnya pada proses pembukaan form, yaitu dengan membuat sebuah efek seperti transisi yang dimana nanti jika form dijalankan atau dipanggil maka form tersebut akan membuka sedikit demi sedikit dari samping seperti efek transisi slide. Jadi perpindahan form akan terasa lebih mengasikan.

Langkah-langkahnya :

Siapkan 1 form dan 1 timer

Kemudian copikan coding ini ke form

'----------------------------------------------------------------------------

Private Sub Form_Load()

Form1.Width = 1

Timer1.Interval = 1

Timer1.Enabled = True

End Sub

Private Sub Timer1_Timer()

Form1.Width = Form1.Width + 100

If Form1.Width >= 5550 Then

' Set Ukuran Form yang sekecil - kecilnya

' Catatan Interval Timer Pada Properti di set = 0

Timer1.Enabled = False

End If

End Sub

'----------------------------------------------------------------------------

Kemudian buatlah satu module dan copikan coding dibawah ini ke 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

'----------------------------------------------------------------------------

Klik gambar untuk memperbesar

Sekarang coba jalankan program, Selamat Mencoba.

Untuk memudahkan proses belajar Anda, Ane sudah siapkan file tersebut.

Silahkan download DISINI