PDA

View Full Version : Solved: Fade Away Userform doesnt work properly when closing userform



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

Bob Phillips
05-12-2009, 04:21 AM
Try setting Cancel = True in and hide the form from the queryclose event?

Bob Phillips
05-12-2009, 04:35 AM
ACtually, that doesn't work, but neither does you button click, not for me.

aziztt
05-12-2009, 05:21 AM
Ive made a new userform with the above code and works fine with a default commandbutton

Please try again

aziztt
05-12-2009, 06:04 AM
Code works fine, tested again

GTO
05-12-2009, 06:09 AM
Admittedly the code pre-empts 2000 (seems like a nice check at a glance), but w/changing to accept 2000 -

As I believe Bob inferred, button fades form, but code appears to keep running ad infinitum.

As Bob suggested...

If CloseMode = 0 Then
Cancel = True
Call CommandButton1_Click
End If
FadeAway

...would seem to simulate the button (including unfortunately, the 'runs forever').

But putting FadeAway under QueryClose just gets it called twice. Even at my laymen's/half-a-clue level, this seems less than stellar.

To unload the form if dismissed thru the "x", I believe you could use:


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Clicked = False
End Sub


You may wish to look at:
http://www.vbaexpress.com/kb/getarticle.php?kb_id=166

as DRJ's seems to work flawlessly. Reading thru quickly and thru bleary eyes, it appeared to me that the code if awfully similar, but DRJ gets it unloaded close to when visibility has dropped to zero.

I also recall several nice splash screen examples at Ivan's site, which could easily be used to contrive a fade only routine

http://www.xcelfiles.com/

Hope this helps,

Mark

Edit: Sorry, pathetically slow typist, I did not get to check yours at #5, and must hit the rack. Check out DRJ's KB entry would remain my suggestion.

A great day to all.

aziztt
05-12-2009, 06:14 AM
GTO, your a star!

I'll look into this....

aziztt
05-12-2009, 06:27 AM
I still cant figue out how to ammend mine to fade away when using the userforms close button

GTO
05-12-2009, 07:15 AM
Okay, you may wish to change 'If CInt(numVersion) >= 9 Then' back to 'If CInt(numVersion) >= 10 Then', but this seems to run okay in 2000 (even in my POL).

From your original, modified as per above, as well as tossed in an Exit Sub in Transparency(), namely:

If Transparancy < 0 Then
Unload Me
Exit Sub
Else

....(the Unload Me seems to get ignored even with a DoEvents), and of course the code under 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) >= 9 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
Exit Sub
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)
If closemode = 0 Then
Clicked = True
Transparancy = 120
Call SemiTransparent(100)
DoEvents
Running = True
Call Transparency
Else
Running = False
End If
End Sub


Hope this helps, I am OUT,

Mark

aziztt
05-12-2009, 07:30 AM
Your a legend GTO (mark)

Appreciate your efforts

Im sure this will be used by alot of vb useform users for cool closedowns!