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 seperti
efek transisi. Jadi perpindahan form akan terasa lebih mengasikan.
Langkah-langkahnya :
Siapkan 1 form dengan 1 command button
Kemudian copikan coding dibawah ini ke form
'----------------------------------------------------------------------------
Private
Sub Command1_Click()
'Ganti '10000' di bawah dengan kecepatan dari
efek ledakan form.
Call ImplodeForm(Me, 10000)
End
Set Form1 = Nothing
End
Sub
Private
Sub Form_Load()
Call ExplodeForm(Me, 10000) 'ledakan form
End
Sub
Private
Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call ImplodeForm(Me, 10000) 'pengembalian form
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
Tidak ada komentar:
Posting Komentar
Ayo gan Komentarnya jangan lupa,,,biar Mas Mukhlas tambah semangat nulis postingan-nya, kalau ada pertanyaan atau link yang mati laporkan juga disini ya...