Clock

Jumat, 09 Desember 2011

Membuat efek fade VB

Yang Perlu Di Siapkan... :




1 buah Form Kosong terserah dink mo di isi apaan
2 buah Timer
1 Command Button (exit button)

oke kalo udah pertama Buat Declare dari Fungsi" fade codenya kek Gini...

Option Explicit

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
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal color As Long, ByVal x As Byte, ByVal alpha As Long) As Boolean

Const LWA_BOTH = 3
Const LWA_ALPHA = 2
Const LWA_COLORKEY = 1
Const GWL_EXSTYLE = -20
Const WS_EX_LAYERED = &H80000

Dim iTransparant As Integer

Sub MakeTransparan(hWndBro As Long, iTransp As Integer)
On Error Resume Next

Dim ret As Long
ret = GetWindowLong(hWndBro, GWL_EXSTYLE)

SetWindowLong hWndBro, GWL_EXSTYLE, ret Or WS_EX_LAYERED
SetLayeredWindowAttributes hWndBro, RGB(255, 255, 0), iTransp, LWA_ALPHA
Exit Sub
End Sub

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Form_Load()

Timer1.Enabled = False
Timer2.Enabled = False
Timer1.Interval = 1
Timer2.Interval = 1
Me.Visible = False
Timer1.Enabled = True

End Sub

Private Sub Form_Unload(Cancel As Integer)
Cancel = 1
Timer1.Enabled = False
Timer2.Enabled = True
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
iTransparant = iTransparant + 5
If iTransparant > 255 Then
iTransparant = 255
Timer1.Enabled = False
End If
MakeTransparan Me.hWnd, iTransparant
Me.Show
End Sub

Private Sub Timer2_Timer()
On Error Resume Next
iTransparant = iTransparant - 5
If iTransparant < 0 Then
iTransparant = 0
Timer2.Enabled = False
End
End If
MakeTransparan Me.hWnd, iTransparant
End Sub

*coco_nk4l*

Tidak ada komentar:

Posting Komentar