yg dibutuhkan :
1 buah form
2 buah kewelbulton
1 buah module
1 buah Timer1
Oke neh code nya Tingal Copy Paste aja
General
-------->
Option Explicit
Private Declare Function MCISendString Lib _
"winmm.dll" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long
Dim Ret As Long
Dim RetStr As String
-------->
Private Sub Form_Load()
Transparan = 150
SetTrans Me.hwnd, Transparan
End Sub
-------->
Private Sub TblBuka_Click()
Ret = MCISendString("set CDAudio door open", _
RetStr, 127, 0)
End Sub
------->
Private Sub TBlKeluar_Click()
Ret = MCISendString("set CDAudio door closed", _
RetStr, 127, 0)
End Sub
------->
Private Sub Timer1_Timer()
On Error Resume Next
If (Label2.Left + Label2.Width) <= 0 Then
Label2.Left = Me.Width
End If
Label2.Left = Label2.Left - 25
End Sub
------->
Module
------>
Option Explicit
Public Transparan As Integer
Private Const LWA_COLORKEY = 1
Private Const LWA_ALPHA = 2
Private Const LWA_BOTH = 3
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = -20
Private Declare Function SetLayeredWindowAttributes _
Lib "user32" (ByVal hwnd As Long, _
ByVal color As Long, ByVal x As Byte, _
ByVal alpha As Long) As Boolean
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 GetWindowLong _
Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
Sub SetTrans(hwnd As Long, Trans As Integer)
Dim Tcall As Long
Tcall = GetWindowLong(hwnd, GWL_EXSTYLE)
SetWindowLong hwnd, GWL_EXSTYLE, Tcall _
Or WS_EX_LAYERED
SetLayeredWindowAttributes hwnd, RGB(255, 255, 0), _
Trans, LWA_ALPHA
Exit Sub
End Sub
09 December 2009
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment