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
Printable View
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
Play around with thisCode: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 onceQuote:
Originally Posted by Hack
What do you mean?Quote:
Originally Posted by isnoend07
Thanks I found this:Quote:
Originally Posted by MartinLiss
Code: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