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
Code: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





Reply With Quote