merlin_the_magician
Active Member
- Joined
- Jul 31, 2002
- Messages
- 480
Ivan,
first of all i have to thank you for sending me an example workbook on fading userforms. It's lovely, exactly what i meant.
I have been playing with it a little, but i think i will need a lity little bit of help.
I cut parts of you code, and pasted them together like the code underneath. It seems to be working fine at first, but then it somehow gets stuck on the last piece of the code, Private Function MakeTransparent(lIndex As Long) As Long what is wrong?
Private Sub UserForm_Activate()
'// Main routine to FadeIn/FadeOut
Application.Wait (Now + TimeValue("0:00:03"))
Call FadeOut(256 * 4)
Image1.Visible = False
Me.BackColor = &H8000000F
Call FadeIn(256 * 4)
Application.Wait (Now + TimeValue("0:00:06"))
Unload Me
End Sub
' MODIFIED: Ivan F Moala 2/6/2002
Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'// Leave this here as your backdoor, incase you have NO CLOSE BUTTON
Unload Me
End Sub
''//
Private Function ShowTitleBar(ByVal bState As Boolean)
Dim lStyle As Long
Dim tR As RECT
'// Get the window's position:
GetWindowRect lFrmHdl, tR
'// Modify whether title bar will be visible:
lStyle = GetWindowLong(lFrmHdl, GWL_STYLE)
'
If Not bState Then
lStyle = lStyle And Not WS_SYSMENU
lStyle = lStyle And Not WS_MAXIMIZEBOX
lStyle = lStyle And Not WS_MINIMIZEBOX
lStyle = lStyle And Not WS_CAPTION
blnTitleVisible = True
Else
lStyle = lStyle Or WS_SYSMENU
lStyle = lStyle Or WS_MAXIMIZEBOX
lStyle = lStyle Or WS_MINIMIZEBOX
lStyle = lStyle Or WS_CAPTION
blnTitleVisible = False
End If
SetWindowLong lFrmHdl, GWL_STYLE, lStyle
'// Ensure the style takes and make the window the
'// same size, regardless that the title bar
'// is now a different size:
SetWindowPos lFrmHdl, 0, tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top, _
SWP_NOREPOSITION Or SWP_NOZORDER Or SWP_FRAMECHANGED
Me.Repaint
End Function
Private Sub FadeIn(Fin As Long)
Dim X As Long
MakeTransparent 0
X = 0
Do Until X = Fin
DoEvents
X = X + 1
MakeTransparent X / 2
Loop
End Sub
Private Function FadeOut(Fin As Long)
Dim Y As Long
Call MakeTransparent(255)
Y = Fin '1000
Do Until Y = 0
DoEvents
Y = Y - 1
Call MakeTransparent(Y / 2)
Loop
End Function
Private Function MakeTransparent(lIndex As Long) As Long
End Function
On Error Resume Next
If lIndex < 0 Or lIndex > 255 Then
MakeTransparent = 0 '1
Else
lResult = GetWindowLong(lFrmHdl, GWL_EXSTYLE)
lResult = lResult Or WS_EX_LAYERED
SetWindowLong lFrmHdl, GWL_EXSTYLE, lResult
SetLayeredWindowAttributes lFrmHdl, 0, lIndex, LWA_ALPHA
MakeTransparent = 0
End If
If Err Then MakeTransparent = 2
End Function
first of all i have to thank you for sending me an example workbook on fading userforms. It's lovely, exactly what i meant.
I have been playing with it a little, but i think i will need a lity little bit of help.
I cut parts of you code, and pasted them together like the code underneath. It seems to be working fine at first, but then it somehow gets stuck on the last piece of the code, Private Function MakeTransparent(lIndex As Long) As Long what is wrong?
Private Sub UserForm_Activate()
'// Main routine to FadeIn/FadeOut
Application.Wait (Now + TimeValue("0:00:03"))
Call FadeOut(256 * 4)
Image1.Visible = False
Me.BackColor = &H8000000F
Call FadeIn(256 * 4)
Application.Wait (Now + TimeValue("0:00:06"))
Unload Me
End Sub
' MODIFIED: Ivan F Moala 2/6/2002
Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'// Leave this here as your backdoor, incase you have NO CLOSE BUTTON
Unload Me
End Sub
''//
Private Function ShowTitleBar(ByVal bState As Boolean)
Dim lStyle As Long
Dim tR As RECT
'// Get the window's position:
GetWindowRect lFrmHdl, tR
'// Modify whether title bar will be visible:
lStyle = GetWindowLong(lFrmHdl, GWL_STYLE)
'
If Not bState Then
lStyle = lStyle And Not WS_SYSMENU
lStyle = lStyle And Not WS_MAXIMIZEBOX
lStyle = lStyle And Not WS_MINIMIZEBOX
lStyle = lStyle And Not WS_CAPTION
blnTitleVisible = True
Else
lStyle = lStyle Or WS_SYSMENU
lStyle = lStyle Or WS_MAXIMIZEBOX
lStyle = lStyle Or WS_MINIMIZEBOX
lStyle = lStyle Or WS_CAPTION
blnTitleVisible = False
End If
SetWindowLong lFrmHdl, GWL_STYLE, lStyle
'// Ensure the style takes and make the window the
'// same size, regardless that the title bar
'// is now a different size:
SetWindowPos lFrmHdl, 0, tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top, _
SWP_NOREPOSITION Or SWP_NOZORDER Or SWP_FRAMECHANGED
Me.Repaint
End Function
Private Sub FadeIn(Fin As Long)
Dim X As Long
MakeTransparent 0
X = 0
Do Until X = Fin
DoEvents
X = X + 1
MakeTransparent X / 2
Loop
End Sub
Private Function FadeOut(Fin As Long)
Dim Y As Long
Call MakeTransparent(255)
Y = Fin '1000
Do Until Y = 0
DoEvents
Y = Y - 1
Call MakeTransparent(Y / 2)
Loop
End Function
Private Function MakeTransparent(lIndex As Long) As Long
End Function
On Error Resume Next
If lIndex < 0 Or lIndex > 255 Then
MakeTransparent = 0 '1
Else
lResult = GetWindowLong(lFrmHdl, GWL_EXSTYLE)
lResult = lResult Or WS_EX_LAYERED
SetWindowLong lFrmHdl, GWL_EXSTYLE, lResult
SetLayeredWindowAttributes lFrmHdl, 0, lIndex, LWA_ALPHA
MakeTransparent = 0
End If
If Err Then MakeTransparent = 2
End Function