[RESOLVED] flicker on fading form

[isnoend07]

I am trying to work out the kinks on a form that fades to replace my OK message boxs. It does a slight flicker randomly when the fade starts. It does not do it all the time, in testing
Flickered 5 out of 10 times.
Flickered 3 out of 10 times.
Flickered 4 out of 10 times.
I can not determine what is causing this. Help Please

Private Sub Command2_Click()
    gMsg = "The John Doe bid has been saved"
    Load frmMessageBox
    Set frmMessageBox = Nothing 'had to add this to allow rerunning the this code with out unloading this form

End Sub

Option Explicit
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 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2

Private Sub Form_Initialize()
    Call SetLabelMessage
    Call FormLoadSub
    End Sub
    
    
Sub FormLoadSub()
    Dim dTime1 As Date
    DoEvents
    GradObj Me 'fills form with gradient
    Me.show
     
      dTime1 = Now
      
        Do
          DoEvents
        Loop Until DateDiff("s", dTime1, Now) >= 3
      Unload Me
      
      End Sub


Sub SetLabelMessage()
DoEvents
  If gMsg <> "" Then 'change the message if needed
    lblMessage.Caption = gMsg
     lblMessage.Left = (Me.Width - lblMessage.Width) / 2 'Center the message
    Me.Refresh
  End If
   End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call fade(False)
End Sub

Public Sub fade(ByVal show As Boolean)
    Dim lngStyle As Long, bytLoop As Integer
    Dim min As Integer, max As Integer, stepVal As Integer
   
    lngStyle = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
    lngStyle = lngStyle Xor WS_EX_LAYERED
    If (lngStyle And WS_EX_LAYERED) <> 0 Then
        Call SetWindowLong(Me.hWnd, GWL_EXSTYLE, lngStyle)
    End If
   
    If show Then
        min = 0
        max = 255
        stepVal = 1
        Me.show
        DoEvents
    Else
        min = 255
        max = 0
        stepVal = -1
    End If
   
    For bytLoop = min To max Step stepVal
        Call SetLayeredWindowAttributes(Me.hWnd, 0, bytLoop, LWA_ALPHA)
        DoEvents
    Next bytLoop
   
gMsg = ""
    Unload Me
End Sub

[dee-u]

To prevent flickering use LockWindowUpdate API.

Declare Function LockWindowUpdate Lib "user32" Alias "LockWindowUpdate" (ByVal hwndLock As Long) As Long

[isnoend07]

To prevent flickering use LockWindowUpdate API.

Declare Function LockWindowUpdate Lib "user32" Alias "LockWindowUpdate" (ByVal hwndLock As Long) As Long

Thanks
I have used that for dragging, but it doesn't work in this case

[Edgemeal]

Thanks
I have used that for dragging, but it doesn't work in this case

Try calling the translucent API routine on form load, that's what seems to fixed it for me, without doing that I had same flicker problem. Here's basically what I been using....

Option Explicit

Private Sub Form_Load()
    TranslucentForm Me, 0 ' make me transparent ' 255 = solid
    Me.Show
    DoEvents
    DoFade Me, True ' fade in
End Sub

Private Sub Command2_Click()
    ' fade out
    DoFade Me, False
End Sub

Option Explicit

' Translucent
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2

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

'Zzzzzz___
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Sub DoFade(Frm As Form, FadeIn As Boolean)
    ' // Fade form in or out //
    Dim X As Integer
    
    Frm.Enabled = False
    
    If FadeIn = False Then
        For X = 145 To 0 Step -5
            TranslucentForm Frm, X
            Sleep 5
            DoEvents
        Next X
    Else
        For X = 0 To 255 Step 15
            TranslucentForm Frm, X
            Sleep 5
            DoEvents
        Next X    
    End If    
    Frm.Enabled = True
End Sub

Public Sub TranslucentForm(Frm As Form, TranslucenceLevel As Integer)
    SetWindowLong Frm.hwnd, GWL_EXSTYLE, WS_EX_LAYERED
    SetLayeredWindowAttributes Frm.hwnd, 0, TranslucenceLevel, LWA_ALPHA
End Sub

[isnoend07]

Try calling the translucent API routine on form load, that's what seems to fixed it for me, without doing that I had same flicker problem. Here's basically what I been using....

Option Explicit

Private Sub Form_Load()
    TranslucentForm Me, 0 ' make me transparent ' 255 = solid
    Me.Show
    DoEvents
    DoFade Me, True ' fade in
End Sub

Private Sub Command2_Click()
    ' fade out
    DoFade Me, False
End Sub

Option Explicit

' Translucent
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2

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

'Zzzzzz___
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Sub DoFade(Frm As Form, FadeIn As Boolean)
    ' // Fade form in or out //
    Dim X As Integer
    
    Frm.Enabled = False
    
    If FadeIn = False Then
        For X = 145 To 0 Step -5
            TranslucentForm Frm, X
            Sleep 5
            DoEvents
        Next X
    Else
        For X = 0 To 255 Step 15
            TranslucentForm Frm, X
            Sleep 5
            DoEvents
        Next X    
    End If    
    Frm.Enabled = True
End Sub

Public Sub TranslucentForm(Frm As Form, TranslucenceLevel As Integer)
    SetWindowLong Frm.hwnd, GWL_EXSTYLE, WS_EX_LAYERED
    SetLayeredWindowAttributes Frm.hwnd, 0, TranslucenceLevel, LWA_ALPHA
End Sub

Thanks, that works better than mine