Search This Blog

October 07, 2009

Window Transparan form VB

Form1.frm

Private t_lAlpha As Long
Private swapTime As Boolean

Private Sub Command1_Click()
'nothing
Form2.Show
End Sub

Private Sub Command2_Click()
Form3.Show
End Sub

Private Sub Command3_Click()
swapTime = True
Timer1.Enabled = True
End Sub

Private Sub Form_Load()
Module1.formInit (Me.hWnd)
If Not Module1.setFormTrans(Me.hWnd, 0) Then
MsgBox "error trans form", vbCritical + vbOKOnly, "Warning"
End If
m_lAlpha = 0
n_lAlpha = 255
swapTime = False
Timer1.Enabled = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
'nothing
End Sub

Private Sub Timer1_Timer()
If Not swapTime Then
t_lAlpha = t_lAlpha + 15
If (t_lAlpha > 255) Then
t_lAlpha = 255
Timer1.Enabled = False
End If
Else
t_lAlpha = t_lAlpha - 15
If (t_lAlpha < 0) Then
t_lAlpha = 0
End If
End If
If Not Module1.setFormTrans(Me.hWnd, t_lAlpha) Then
MsgBox "error trans form", vbCritical + vbOKOnly, "Warning"
End If
If (t_lAlpha = 0) Then
Timer1.Enabled = False
Unload Me
End If
End Sub



Form2.frm

Private t_lAlpha As Long
Private swapTime As Boolean

Private Sub Command1_Click()
swapTime = True
Timer1.Enabled = True
End Sub

Private Sub Form_Initialize()
'nothing
End Sub

Private Sub Form_Load()
Module1.formInit (Me.hWnd)
If Module1.setFormTrans(Me.hWnd, 0) Then
t_lAlpha = 0
swapTime = False
Timer1.Enabled = True
Else
MsgBox "error trans form", vbCritical + vbOKOnly, "Warning"
End If
End Sub

Private Sub Timer1_Timer()
If Not swapTime Then
t_lAlpha = t_lAlpha + 15
If (t_lAlpha > 255) Then
t_lAlpha = 255
Timer1.Enabled = False
End If
Else
t_lAlpha = t_lAlpha - 15
If (t_lAlpha < 0) Then
t_lAlpha = 0
End If
End If
If Not Module1.setFormTrans(Me.hWnd, t_lAlpha) Then
MsgBox "error trans form", vbCritical + vbOKOnly, "Warning"
End If
If (t_lAlpha = 0) Then
Timer1.Enabled = False
Unload Me
End If
End Sub


Form3.frm

Private t_lAlpha As Long
Private swapTime As Boolean

Private Sub Form_Load()
Module1.formInit (Me.hWnd)
If Not Module1.setFormTrans(Me.hWnd, 0) Then
MsgBox "error trans form", vbCritical + vbOKOnly, "Warning"
End If
t_lAlpha = 0
swapTime = False
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
If Not swapTime Then
t_lAlpha = t_lAlpha + 15
If (t_lAlpha > 255) Then
t_lAlpha = 255
swapTime = True
End If
Else
t_lAlpha = t_lAlpha - 15
If (t_lAlpha < 0) Then
t_lAlpha = 0
End If
End If
If Not Module1.setFormTrans(Me.hWnd, t_lAlpha) Then
MsgBox "error trans form", vbCritical + vbOKOnly, "Warning"
End If
If (t_lAlpha = 0) Then
Timer1.Enabled = False
Unload Me
End If
End Sub


Module1.bas

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 crKey As Long, _
ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2

Public Function formInit(ByVal Fhwnd As Long) As Boolean
Dim err As Boolean
On Error GoTo errhandling
err = True
Dim lStyle As Long
lStyle = GetWindowLong(Fhwnd, GWL_EXSTYLE)
lStyle = lStyle Or WS_EX_LAYERED
SetWindowLong Fhwnd, GWL_EXSTYLE, lStyle
err = False
formInit = True
If err Then
errhandling:
formInit = False
End If
End Function

Public Function setFormTrans(ByVal Fhwnd As Long, ByVal VAlpha As Byte)
Dim err As Boolean
On Error GoTo errhandling
err = True
SetLayeredWindowAttributes Fhwnd, 0, VAlpha, LWA_ALPHA
err = False
setFormTrans = True
If err Then
errhandling:
setFormTrans = False
End If
End Function

Sub main()
Form1.Show
End Sub



No comments: