aziztt
05-12-2009, 04:12 AM
Hi, im using a cool userform fadeaway which makes the userform dissapear after few secends. It works flawlessly when you call "FadeAway" on a commandbutton but when you put it in QueryClose Userform, it stalls after. Is there something im doing wrong?
here is my code, commandbutton1 works fine, the userform will loadup again, but doesnt work when used in queryclose :(
Option Explicit
Private Declare Function GetActiveWindow Lib "USER32" () As Long
Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal lngWinIdx As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal lngWinIdx As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "USER32" _
(ByVal hwnd As Long, ByVal crKey As Integer, ByVal bAlpha As Integer, ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = &HFFEC
Dim hwnd As Long
Dim Transparancy As Integer
Dim Running As Boolean
Dim Clicked As Boolean
Sub FadeAway()
Dim numVersion As String
Dim x As Integer
numVersion = ""
If Clicked <> True Then
If IsNumeric(Application.Version) = False Then
For x = 1 To Len(Application.Version)
If IsNumeric(Mid(Application.Version, x, 1)) = True Then
numVersion = numVersion & Mid(Application.Version, x, 1)
Else
Exit For
End If
Next x
Else
numVersion = Application.Version
End If
If numVersion <> "" Then
If CInt(numVersion) >= 10 Then
Clicked = True
Transparancy = 120
Call SemiTransparent(100)
DoEvents
Running = True
Call Transparency
Else
Unload Me
End If
Else
Unload Me
End If
End If
End Sub
Private Sub UserForm_Activate()
If Clicked = True Then
Running = True
Call Transparency
End If
End Sub
Private Sub Transparency()
Dim MyTimer As Double
DoEvents
MyTimer = Timer
Do
Do
Loop While Timer - MyTimer < 0.02
MyTimer = Timer
Transparancy = Transparancy - 2
If Transparancy < 0 Then
Unload Me
Else
Call SemiTransparent(Application.WorksheetFunction.Min(Transparancy, 100))
End If
DoEvents
Loop While Running
End Sub
Private Sub SemiTransparent(ByVal intLevel As Integer)
Dim lngWinIdx As Long
hwnd = GetActiveWindow
lngWinIdx = GetWindowLong(hwnd, GWL_EXSTYLE)
SetWindowLong hwnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED
SetLayeredWindowAttributes hwnd, 0, (255 * intLevel) / 100, LWA_ALPHA
End Sub
Private Sub CommandButton1_Click()
FadeAway
End Sub
Private Sub Userform_QueryClose(Cancel As Integer, closemode As Integer)
FadeAway
End Sub
here is my code, commandbutton1 works fine, the userform will loadup again, but doesnt work when used in queryclose :(
Option Explicit
Private Declare Function GetActiveWindow Lib "USER32" () As Long
Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal lngWinIdx As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal lngWinIdx As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "USER32" _
(ByVal hwnd As Long, ByVal crKey As Integer, ByVal bAlpha As Integer, ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = &HFFEC
Dim hwnd As Long
Dim Transparancy As Integer
Dim Running As Boolean
Dim Clicked As Boolean
Sub FadeAway()
Dim numVersion As String
Dim x As Integer
numVersion = ""
If Clicked <> True Then
If IsNumeric(Application.Version) = False Then
For x = 1 To Len(Application.Version)
If IsNumeric(Mid(Application.Version, x, 1)) = True Then
numVersion = numVersion & Mid(Application.Version, x, 1)
Else
Exit For
End If
Next x
Else
numVersion = Application.Version
End If
If numVersion <> "" Then
If CInt(numVersion) >= 10 Then
Clicked = True
Transparancy = 120
Call SemiTransparent(100)
DoEvents
Running = True
Call Transparency
Else
Unload Me
End If
Else
Unload Me
End If
End If
End Sub
Private Sub UserForm_Activate()
If Clicked = True Then
Running = True
Call Transparency
End If
End Sub
Private Sub Transparency()
Dim MyTimer As Double
DoEvents
MyTimer = Timer
Do
Do
Loop While Timer - MyTimer < 0.02
MyTimer = Timer
Transparancy = Transparancy - 2
If Transparancy < 0 Then
Unload Me
Else
Call SemiTransparent(Application.WorksheetFunction.Min(Transparancy, 100))
End If
DoEvents
Loop While Running
End Sub
Private Sub SemiTransparent(ByVal intLevel As Integer)
Dim lngWinIdx As Long
hwnd = GetActiveWindow
lngWinIdx = GetWindowLong(hwnd, GWL_EXSTYLE)
SetWindowLong hwnd, GWL_EXSTYLE, lngWinIdx Or WS_EX_LAYERED
SetLayeredWindowAttributes hwnd, 0, (255 * intLevel) / 100, LWA_ALPHA
End Sub
Private Sub CommandButton1_Click()
FadeAway
End Sub
Private Sub Userform_QueryClose(Cancel As Integer, closemode As Integer)
FadeAway
End Sub