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
'----------------------------------------------------------------------------
Sekarang coba jalankan
program, Selamat Mencoba.
Untuk memudahkan proses
belajar Anda, saya sudah siapkan file tersebut.



0 comments:
Post a Comment