Dengan menggunakan Fungsi API AnimateWindow ini kita dapat membuat efek animasi yang halus, terutama untuk membuat munculnya Form saat di Load dilayar.
Selain menggunakan fungsi API AnimateWindow juga memerlukan fungsi API yang lain untuk melakukan SubClassing agar form yang ditampilkan secara sempurna dan terhindar dari warna-warna hitam pada Form tersebut akibat efek animasi.
Berikut dibawah ini adalah adalah langkah-langkah untuk menampilkan sebuah animasi menggunakan API AnimateWindow di sebuah Form :
1. Buka Form VB6 Anda pilih Standar EXE
2. Pada Form yang muncul tambahkan sebuah Module dengan cara pilih Project >> Add Module
3. Pada jendela Module ketik kode dibawah ini :
Option Explicit
Const GWL_WNDPROC = (-4)
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Const PROP_PREVPROC = "PrevProc"
Const PROP_FORM = "FormObject"
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hWnd As Long, ByVal lpString As String) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal DestL As Long)
Const WM_PRINTCLIENT = &H318
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function apiOleTranslateColor Lib "oleaut32" Alias "OleTranslateColor" (ByVal lOleColor As Long, ByVal lHPalette As Long, lColorRef As Long) As Long
Enum AnimateWindowFlags
AW_HOR_POSITIVE = &H1
AW_HOR_NEGATIVE = &H2
AW_VER_POSITIVE = &H4
AW_VER_NEGATIVE = &H8
AW_CENTER = &H10
AW_HIDE = &H10000
AW_ACTIVATE = &H20000
AW_SLIDE = &H40000
AW_BLEND = &H80000
End Enum
Private Declare Function apiAnimateWindow Lib "user32" Alias "AnimateWindow" (ByVal hWnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Long
Private Declare Function MulDiv Lib "kernel32" (ByVal Mul As Long, ByVal Nom As Long, ByVal Den As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Enum Animation
'// ACTIVATE
ACTIVATE_SLIDE_FROM_TOP = (AW_ACTIVATE Or AW_SLIDE Or AW_VER_POSITIVE)
ACTIVATE_SLIDE_FROM_BOTTOM = (AW_ACTIVATE Or AW_SLIDE Or AW_VER_NEGATIVE)
ACTIVATE_SLIDE_FROM_LEFT = (AW_ACTIVATE Or AW_SLIDE Or AW_HOR_POSITIVE)
ACTIVATE_SLIDE_FROM_RIGHT = (AW_ACTIVATE Or AW_SLIDE Or AW_HOR_NEGATIVE)
ACTIVATE_SLIDE_EXPAND_FROM_TOP_LEFT = (AW_ACTIVATE Or AW_SLIDE Or AW_HOR_POSITIVE Or AW_VER_POSITIVE)
ACTIVATE_SLIDE_EXPAND_FROM_BOTTOM_RIGHT = (AW_ACTIVATE Or AW_SLIDE Or AW_HOR_NEGATIVE Or AW_VER_NEGATIVE)
ACTIVATE_SLIDE_EXPAND_FROM_TOP_RIGHT = (AW_ACTIVATE Or AW_SLIDE Or AW_HOR_NEGATIVE Or AW_VER_POSITIVE)
ACTIVATE_SLIDE_EXPAND_FROM_BOTTOM_LEFT = (AW_ACTIVATE Or AW_SLIDE Or AW_HOR_POSITIVE Or AW_VER_NEGATIVE)
ACTIVATE_SLIDE_EXPAND_FROM_CENTER = (AW_ACTIVATE Or AW_SLIDE Or AW_CENTER)
ACTIVATE_SLIDE_FADE_TRANSITION = (AW_ACTIVATE Or AW_BLEND)
'// DEACTIVATE
DEACTIVATE_SLIDE_FADE_TRANSITION = (AW_HIDE Or AW_BLEND)
DEACTIVATE_SLIDE_TO_TOP = (AW_HIDE Or AW_SLIDE Or AW_VER_NEGATIVE)
DEACTIVATE_SLIDE_TO_BOTTOM = (AW_HIDE Or AW_SLIDE Or AW_VER_POSITIVE)
DEACTIVATE_SLIDE_TO_LEFT = (AW_HIDE Or AW_SLIDE Or AW_HOR_NEGATIVE)
DEACTIVATE_SLIDE_TO_RIGHT = (AW_HIDE Or AW_SLIDE Or AW_HOR_POSITIVE)
DEACTIVATE_SLIDE_SHRINK_TO_TOP_LEFT = (AW_HIDE Or AW_SLIDE Or AW_HOR_NEGATIVE Or AW_VER_NEGATIVE)
DEACTIVATE_SLIDE_SHRINK_TO_BOTTOM_RIGHT = (AW_HIDE Or AW_SLIDE Or AW_HOR_POSITIVE Or AW_VER_POSITIVE)
DEACTIVATE_SLIDE_SHRINK_TO_TOP_RIGHT = (AW_HIDE Or AW_SLIDE Or AW_HOR_POSITIVE Or AW_VER_NEGATIVE)
DEACTIVATE_SLIDE_SHRINK_TO_BOTTOM_LEFT = (AW_HIDE Or AW_SLIDE Or AW_HOR_NEGATIVE Or AW_VER_POSITIVE)
DEACTIVATE_SLIDE_SHRINK_TO_CENTER = (AW_HIDE Or AW_SLIDE Or AW_CENTER)
End Enum
Function AnimateWindow(ByVal Form As Object, ByVal dwTime As Long, ByVal dwFlags As Animation)
Dim ctl As Control
SetProp Form.hWnd, PROP_PREVPROC, GetWindowLong(Form.hWnd, GWL_WNDPROC)
SetProp Form.hWnd, PROP_FORM, ObjPtr(Form)
Dim i As Integer
SetWindowLong Form.hWnd, GWL_WNDPROC, AddressOf AnimateWinProc
apiAnimateWindow Form.hWnd, dwTime, dwFlags
SetWindowLong Form.hWnd, GWL_WNDPROC, GetProp(Form.hWnd, PROP_PREVPROC)
RemoveProp Form.hWnd, PROP_FORM
RemoveProp Form.hWnd, PROP_PREVPROC
Form.Refresh
For Each ctl In Form.Controls
ctl.Visible = Not ctl.Visible
ctl.Visible = Not ctl.Visible
Next
End Function
Private Function AnimateWinProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim lPrevProc As Long
Dim lForm As Long
Dim oForm As Form
lPrevProc = GetProp(hWnd, PROP_PREVPROC)
lForm = GetProp(hWnd, PROP_FORM)
MoveMemory oForm, lForm, 4&
Select Case Msg
Case WM_PRINTCLIENT
Dim tRect As RECT
Dim hBr As Long
GetClientRect hWnd, tRect
hBr = CreateSolidBrush(OleTranslateColor(oForm.BackColor))
FillRect wParam, tRect, hBr
DeleteObject hBr
If Not oForm.Picture Is Nothing Then
Dim lScrDC As Long
Dim lMemDC As Long
Dim lPrevBMP As Long
lScrDC = GetDC(0&)
lMemDC = CreateCompatibleDC(lScrDC)
ReleaseDC 0, lScrDC
lPrevBMP = SelectObject(lMemDC, oForm.Picture.Handle)
BitBlt wParam, 0, 0, HM2Pix(oForm.Picture.Width), HM2Pix(oForm.Picture.Height), lMemDC, 0, 0, vbSrcCopy
SelectObject lMemDC, lPrevBMP
DeleteDC lMemDC
End If
End Select
MoveMemory oForm, 0&, 4&
AnimateWinProc = CallWindowProc(lPrevProc, hWnd, Msg, wParam, lParam)
End Function
Private Function HM2Pix(ByVal Value As Long) As Long
HM2Pix = MulDiv(Value, 1440, 2540) / Screen.TwipsPerPixelX
End Function
Private Function OleTranslateColor(ByVal Clr As Long) As Long
apiOleTranslateColor Clr, 0, OleTranslateColor
End Function
Public Function AnimationX(frm As Object, lTime As Long, eMode As Animation)
AnimateWindow frm, lTime, eMode
End Function
No comments:
Post a Comment