Form fade in and out by changing opacity 1

[wabtrainer]

I have a form I am trying to fade in and out.
I saw some code somewhere on the net and copied the routine and all seemed to work.
At least the form fades out as expected.
But the fade does not work for fade in. Just a delay then the form appears.

I think I need a fresh pair of eyes on it!

Here is the code:

On the Form:

Private Sub Form_Open(Cancel As Integer)
'Fade the form in

FadeForm Me, Fadein, 1, 5

End Sub



Private Sub Form_Close()

'Fade the form in

FadeForm Me, Fadeout, 1, 255


End Sub


In a Module:

'Declare the APIs needed for this to work.

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hWnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Const GWL_EXSTYLE = (-20)

Public Const WS_EX_LAYERED = &H80000

Public Const WS_EX_TRANSPARENT = &H20&

Public Const LWA_ALPHA = &H2&

'Enum for determining the direction of the fade.

Public Enum FadeDirection

Fadein = -1

Fadeout = 0

SetOpacity = 1

End Enum

Public Sub FadeForm(frm As Form, Optional Direction As FadeDirection = FadeDirection.Fadein, _
Optional iDelay As Integer = 0, Optional StartOpacity As Long = 5)

Dim lOriginalStyle As Long
Dim iCtr As Integer
'You can only set a form's opacity if it's Popup property = True.
If (frm.PopUp = True) Then
'Get the form window’s handle, and remember its original style.
lOriginalStyle = GetWindowLong(frm.hWnd, GWL_EXSTYLE)
SetWindowLong frm.hWnd, GWL_EXSTYLE, lOriginalStyle Or WS_EX_LAYERED
'If the form’s original style = 0, it hasn’t been faded since it was opened.
'To get fading to work, we have to set its style to something other than zero.
If (lOriginalStyle = 0) And (Direction <> FadeDirection.SetOpacity) Then
'Recursively call this same procedure to set the value.
FadeForm frm, SetOpacity, , StartOpacity
End If
'Depending on the direction of the fade...
Select Case Direction
Case FadeDirection.Fadein
'Just in case.
If StartOpacity < 1 Then StartOpacity = 1
'Fade the form in by varying its opacity
'from the value supplied in 'StartOpacity'
'to 255 (completely opaque).
For iCtr = StartOpacity To 255 Step 1
SetLayeredWindowAttributes frm.hWnd, 0, CByte(iCtr), LWA_ALPHA
'Process any outstanding events.
DoEvents
'Wait a while, so the user can see the effect.
Sleep iDelay
Next
Case FadeDirection.Fadeout
'Just in case.
If StartOpacity < 6 Then StartOpacity = 255
'Fade the form out by varying its opacity
'from 255 to 1 (almost transparent).
For iCtr = StartOpacity To 1 Step -1
SetLayeredWindowAttributes frm.hWnd, 0, CByte(iCtr), LWA_ALPHA
'Process any outstanding events.
DoEvents
'Wait a while, so the user can see the effect.
Sleep iDelay
Next
Case Else 'FadeDirection.SetOpacity.
'Just in case.
Select Case StartOpacity
Case Is < 1: StartOpacity = 1
Case Is > 255: StartOpacity = 255
End Select
'Set the form's opacity to a specific value.
SetLayeredWindowAttributes frm.hWnd, 0, CByte(StartOpacity), LWA_ALPHA
'Process any outstanding events.
DoEvents
'Wait a while, so the user can see the effect.
Sleep iDelay
End Select
Else
'The form’s Popup property MUST = True
DoCmd.Beep
MsgBox "The form's Popup property must be set to True.", vbOKOnly, vbInformation, "Cannot fade form"
End If

End Sub



If you want to be a bear:
Be a Grizzly!

 

[Remou]

The only way I could get this to work was to tamper considerably, I hope that it is not in violation of copyrights.

Form:

Option Compare Database
Dim gintC

Private Sub Form_Load()
Me.TimerInterval = 2
FadeForm Me, Fadezero, 1, 5
End Sub

Private Sub Form_Timer()
If IsEmpty(gintC) Then
    FadeForm Me, Fadein, 1, 15
End If
gintC = 1
Me.TimerInterval = 0
End Sub

Module:

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
   
Public Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hWnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Const GWL_EXSTYLE = (-20)

Public Const WS_EX_LAYERED = &H80000

Public Const WS_EX_TRANSPARENT = &H20&

Public Const LWA_ALPHA = &H2&

'Enum for determining the direction of the fade.

Public Enum FadeDirection

   Fadein = -1

   Fadeout = 0

   Fadezero = 1

   SetOpacity = 1

End Enum

Public Sub FadeForm(frm As Form, Optional Direction As FadeDirection = FadeDirection.Fadein, _
Optional iDelay As Integer = 0, Optional StartOpacity As Long = 5)

   Dim lOriginalStyle As Long
   Dim iCtr As Integer
   'You can only set a form's opacity if it's Popup property = True.
   If (frm.PopUp = True) Then
       'Get the form window’s handle, and remember its original style.
       lOriginalStyle = GetWindowLong(frm.hWnd, GWL_EXSTYLE)
       SetWindowLong frm.hWnd, GWL_EXSTYLE, lOriginalStyle Or WS_EX_LAYERED
       'If the form’s original style = 0, it hasn’t been faded since it was opened.
       'To get fading to work, we have to set its style to something other than zero.
       If (lOriginalStyle = 0) And (Direction <> FadeDirection.SetOpacity) Then
          'Recursively call this same procedure to set the value.
          FadeForm frm, SetOpacity, , StartOpacity
       End If
       'Depending on the direction of the fade...
       Select Case Direction
          Case FadeDirection.Fadezero
              iCtr = StartOpacity
              SetLayeredWindowAttributes frm.hWnd, 0, CByte(iCtr), LWA_ALPHA
          Case FadeDirection.Fadein
              'Just in case.
              If StartOpacity < 1 Then StartOpacity = 1
              'Fade the form in by varying its opacity
              'from the value supplied in 'StartOpacity'
              'to 255 (completely opaque).
              For iCtr = StartOpacity To 255 Step 1
                 SetLayeredWindowAttributes frm.hWnd, 0, CByte(iCtr), LWA_ALPHA
                 'Process any outstanding events.
                 DoEvents
                 'Wait a while, so the user can see the effect.
                 Sleep iDelay
              Next
          Case FadeDirection.Fadeout
              'Just in case.
              If StartOpacity < 6 Then StartOpacity = 255
              'Fade the form out by varying its opacity
              'from 255 to 1 (almost transparent).
              For iCtr = StartOpacity To 1 Step -1
                 SetLayeredWindowAttributes frm.hWnd, 0, CByte(iCtr), LWA_ALPHA
                 'Process any outstanding events.
                 DoEvents
                 'Wait a while, so the user can see the effect.
                 Sleep iDelay
              Next
          Case Else 'FadeDirection.SetOpacity.
              'Just in case.
              Select Case StartOpacity
                 Case Is < 1: StartOpacity = 1
                 Case Is > 255: StartOpacity = 255
              End Select
              'Set the form's opacity to a specific value.
              SetLayeredWindowAttributes frm.hWnd, 0, CByte(StartOpacity), LWA_ALPHA
                 'Process any outstanding events.
                 DoEvents
                 'Wait a while, so the user can see the effect.
                 Sleep iDelay
       End Select
   Else
       'The form’s Popup property MUST = True
       DoCmd.Beep
       MsgBox "The form's Popup property must be set to True.", vbOKOnly & vbInformation, "Cannot fade form"
   End If

End Sub