[RESOLVED] fade a form to invisible

[isnoend07]

I want to replace some of my msgboxs with a form that displays messages then fades out with out user interaction. Such as File Saved. Not fade in just fade out. I have tried a few without success. How

[Hack]

Play around with this

Option Explicit

Private Sub FadeScreen(fForm As Form, WhichWay As String)
        
        Dim sngVertSize As Single
        Dim sngHorizSize As Single
        Dim sngMoveMeToTheRight As Single
        Dim sngMoveMyTop As Single
        Dim i As Integer
        Const TheStep = 1000
        
        sngVertSize = fForm.Width / TheStep
        
        Select Case UCase(WhichWay)
          Case "TR"
            'fade to top right                '
            sngMoveMeToTheRight = fForm.Height / TheStep
            sngHorizSize = sngMoveMeToTheRight
          Case "BL"
            'fade to bottom left
            sngMoveMyTop = fForm.Height / TheStep
            sngVertSize = sngMoveMyTop
            sngHorizSize = fForm.Height / TheStep
          Case "BR"
            'fade to bottom right
            sngMoveMyTop = fForm.Height / TheStep
            sngVertSize = sngMoveMyTop
            sngMoveMeToTheRight = fForm.Height / TheStep
            sngHorizSize = fForm.Height / TheStep
          Case Else
            'default to top left if you put something else in
            sngHorizSize = fForm.Height / TheStep 'size of horizontal steps
        End Select
       SaveSetting "FormName", "Unload Screen", "Direction", WhichWay
        For i = 1 To TheStep - 1
            fForm.Move fForm.Left + sngMoveMeToTheRight, fForm.Top + sngMoveMyTop, _
            fForm.Width - sngHorizSize, fForm.Height - sngVertSize
        Next
        
        Unload Me
        
    End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim Regsetting As String
Dim NewDirection As String
Regsetting = GetSetting("FormName", "Unload Screen", "Direction")
        If Regsetting = vbNullString Then
           FadeScreen Me, "BR"  'bottom right
           Exit Sub
        Else
          Select Case Regsetting
            Case "BR"
              NewDirection = "BL"   'bottom left
            Case "BL"
              NewDirection = "TR"   'top right
            Case "TR"
              NewDirection = "BR"
          End Select
        End If
        FadeScreen Me, NewDirection
End Sub

[isnoend07]

Play around with this

Option Explicit

Private Sub FadeScreen(fForm As Form, WhichWay As String)
        
        Dim sngVertSize As Single
        Dim sngHorizSize As Single
        Dim sngMoveMeToTheRight As Single
        Dim sngMoveMyTop As Single
        Dim i As Integer
        Const TheStep = 1000
        
        sngVertSize = fForm.Width / TheStep
        
        Select Case UCase(WhichWay)
          Case "TR"
            'fade to top right                '
            sngMoveMeToTheRight = fForm.Height / TheStep
            sngHorizSize = sngMoveMeToTheRight
          Case "BL"
            'fade to bottom left
            sngMoveMyTop = fForm.Height / TheStep
            sngVertSize = sngMoveMyTop
            sngHorizSize = fForm.Height / TheStep
          Case "BR"
            'fade to bottom right
            sngMoveMyTop = fForm.Height / TheStep
            sngVertSize = sngMoveMyTop
            sngMoveMeToTheRight = fForm.Height / TheStep
            sngHorizSize = fForm.Height / TheStep
          Case Else
            'default to top left if you put something else in
            sngHorizSize = fForm.Height / TheStep 'size of horizontal steps
        End Select
       SaveSetting "FormName", "Unload Screen", "Direction", WhichWay
        For i = 1 To TheStep - 1
            fForm.Move fForm.Left + sngMoveMeToTheRight, fForm.Top + sngMoveMyTop, _
            fForm.Width - sngHorizSize, fForm.Height - sngVertSize
        Next
        
        Unload Me
        
    End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim Regsetting As String
Dim NewDirection As String
Regsetting = GetSetting("FormName", "Unload Screen", "Direction")
        If Regsetting = vbNullString Then
           FadeScreen Me, "BR"  'bottom right
           Exit Sub
        Else
          Select Case Regsetting
            Case "BR"
              NewDirection = "BL"   'bottom left
            Case "BL"
              NewDirection = "TR"   'top right
            Case "TR"
              NewDirection = "BR"
          End Select
        End If
        FadeScreen Me, NewDirection
End Sub

Thanks That works good, would be even better if i could get it to fade in both directions at once

[MartinLiss]

Thanks That works good, would be even better if i could get it to fade in both directions at once

What do you mean?

[isnoend07]

What do you mean?

Thanks I found this:

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 Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2

Private Sub Form_Load()
    Call fade(True)
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
   
    If Not show Then
        Me.Hide
    End If
End Sub