Membuat alphablended formMembuat alphablended form

Sabtu, 13 November 2010

Membuat alphablended form


apa itu yg dimaksud alphablended form??? AlphaBlend merupakan sebuah animasi ketika proses atau aplikasi mulai load atau berjalan. Dengan berupa muncul sedikit demi sedikit ataupun menghilang sedikit demi sedikit, sehingga akan mempercantik program yg anda buat, project kali ini kita buat dengan visual basic 06
langsung saja

pertama2 buka dulu vb06 nya, ya iyalah masak mau koding pake photoshop hehehehe
sebagai contoh :
1. masukkan sebuah form dengan komponen timer, misalkan saja kita beri nama form1 dan timer1
2. buat sebuah modul

untuk script kodingnya pada bagian form1 :
Option Explicit
Dim Transparan As Integer
Dim mulai As Boolean

Private Sub Form_Load()
mulai = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
Cancel = True: mulai = False
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
If mulai Then
Transparan = Transparan + 5
If Transparan > 255 Then Transparan = 255: Timer1.Enabled = False
Else
Transparan = Transparan - 5
If Transparan < 0 Then Transparan = 0: End End If SetTransparan Form1.hwnd, Transparan End Sub

untuk script kodingnya pada bagian module:
Option Explicit
Public Const LWA_COLORKEY = 1
Public Const LWA_ALPHA = 2
Public Const LWA_BOTH = 3
Public Const WS_EX_LAYERED = &H80000
Public Const GWL_EXSTYLE = -20
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal color As Long, ByVal x As Byte, ByVal alpha As Long) As Boolean
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Sub SetTransparan(frm As Long, nilai As Integer)
On Error GoTo Err
Dim attrib As Long
attrib = GetWindowLong(frm, GWL_EXSTYLE)
SetWindowLong frm, GWL_EXSTYLE, _ attrib Or WS_EX_LAYERED SetLayeredWindowAttributes frm, RGB(255, 255, 0), nilai, LWA_ALPHA
Exit Sub
Err:
MsgBox Err.Description & " Source : " & Err.Source
End Sub

sekian dari saya selamat mencoba,,,,,,, happy coding :)

Tidak ada komentar:

Posting Komentar