Results 1 to 8 of 8

Thread: Fade In Effect when load

  1. #1

    Thread Starter
    Hyperactive Member DarkX_Greece's Avatar
    Join Date
    Jan 2004
    Location
    Athens (Greece)
    Posts
    315

    Fade In Effect when load

    Hello, I need to make a code for my app, to fade in when it loads and then fade out when it unloads!

    Or something similar to MSN's Messengers Fade in/out!
    Can anyone help me?
    Short CV:
    1. Visual Basic 6 Programmer
    2. Web Expert


    Botonakis Web Services

  2. #2
    Hyperactive Member
    Join Date
    Dec 2004
    Posts
    326

    Re: Fade In Effect when load

    VB Code:
    1. Option Explicit
    2.  
    3. Const VER_PLATFORM_WIN32s = 0
    4. Const VER_PLATFORM_WIN32_WINDOWS = 1
    5. Const VER_PLATFORM_WIN32_NT = 2
    6.  
    7. Private Type OSVERSIONINFO
    8.     dwOSVersionInfoSize As Long
    9.     dwMajorVersion      As Long
    10.     dwMinorVersion      As Long
    11.     dwBuildNumber       As Long
    12.     dwPlatformId        As Long
    13.     szCSDVersion        As String * 128
    14. End Type
    15.  
    16.  
    17. Private Declare Function GetVersionEx Lib "kernel32" Alias _
    18.     "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
    19.  
    20. 'hWnd    - handle to window to layer.
    21. 'crKey   - specifies the color key
    22. 'bAlpha  - value for the blend function
    23. 'dwFlags - action
    24. Private Declare Function SetLayeredWindowAttributes Lib "user32" ( _
    25.     ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Long, _
    26.     ByVal dwFlags As Long) As Long
    27.    
    28. Private Declare Function GetWindowLong Lib "user32" _
    29.     Alias "GetWindowLongA" (ByVal hWnd As Long, _
    30.     ByVal nIndex As Long) As Long
    31.    
    32. Private Declare Function SetWindowLong Lib "user32" _
    33.     Alias "SetWindowLongA" (ByVal hWnd As Long, _
    34.     ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    35.  
    36. Private Const GWL_EXSTYLE = (-20)
    37. Private Const WS_EX_LAYERED = &H80000
    38. Private Const LWA_COLORKEY = &H1&
    39. Private Const LWA_ALPHA = &H2&
    40.  
    41. Private Declare Function GetParent Lib "user32" _
    42.     (ByVal hWnd As Long) As Long
    43.    
    44. Private Declare Function IsWindowVisible Lib "user32" _
    45.     (ByVal hWnd As Long) As Long
    46.  
    47. Private Function fGetOSVersion()
    48. Dim os As OSVERSIONINFO
    49. '
    50. ' Returns True if Win98 or Win2000
    51. '
    52. fGetOSVersion = False
    53. With os
    54.     .dwOSVersionInfoSize = Len(os)
    55.     Call GetVersionEx(os)
    56.  
    57.     ' Windows 2000
    58.     If .dwMajorVersion > 4 Then fGetOSVersion = True
    59.  
    60.     If .dwMajorVersion = 4 And _
    61.        .dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
    62.        .dwMinorVersion > 0 Then
    63.         fGetOSVersion = True
    64.     End If
    65. End With
    66. End Function
    67.  
    68. Private Function fSetTranslucency(ByVal hWnd As Long, ByVal alpha As Byte) As Boolean
    69. Dim lStyle As Long
    70.  
    71. '
    72. ' Layering only works with Win2K or above.
    73. '
    74. If fIsWin2000 Then
    75.     '
    76.     ' Only a top level window can be translucent.
    77.     '
    78.     hWnd = fGetTopLevel(hWnd)
    79.     '
    80.     ' Make the window translucent by setting its
    81.     ' extended style.
    82.     '
    83.     lStyle = GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
    84.     If SetWindowLong(hWnd, GWL_EXSTYLE, lStyle) Then
    85.         fSetTranslucency = CBool(SetLayeredWindowAttributes(hWnd, 0, CLng(alpha), LWA_ALPHA))
    86.     End If
    87. End If
    88. End Function
    89.  
    90. Private Function fClearTranslucency(ByVal hWnd As Long) As Boolean
    91. Dim lStyle As Long
    92.  
    93. '
    94. ' Layering only works with Win2K or above.
    95. '
    96. If fIsWin2000 Then
    97.     '
    98.     ' Only a top level window can be translucent.
    99.     '
    100.     hWnd = fGetTopLevel(hWnd)
    101.     '
    102.     ' Clear translucency - make the window opaque.
    103.     '
    104.     Call SetLayeredWindowAttributes(hWnd, 0, 255&, LWA_ALPHA)
    105.     '
    106.     ' Clear the extended style bit.
    107.     '
    108.     lStyle = GetWindowLong(hWnd, GWL_EXSTYLE) And Not WS_EX_LAYERED
    109.     fClearTranslucency = CBool(SetWindowLong(hWnd, GWL_EXSTYLE, lStyle))
    110. End If
    111. End Function
    112.  
    113.  
    114. Private Function fIsWin2000() As Boolean
    115. Dim os As OSVERSIONINFO
    116. '
    117. ' Returns True if Win98 or Win2000
    118. '
    119. fIsWin2000 = False
    120. With os
    121.     .dwOSVersionInfoSize = Len(os)
    122.     Call GetVersionEx(os)
    123.  
    124.     ' Windows 2000
    125.     If .dwPlatformId = VER_PLATFORM_WIN32_NT Then
    126.         fIsWin2000 = (.dwMajorVersion > 4)
    127.     End If
    128. End With
    129.  
    130. End Function
    131.  
    132. Private Function fGetTopLevel(ByVal hChild As Long) As Long
    133. Dim hWnd As Long
    134.  
    135. hWnd = hChild
    136. Do While IsWindowVisible(GetParent(hWnd))
    137.     hWnd = GetParent(hChild)
    138.     hChild = hWnd
    139. Loop
    140. fGetTopLevel = hWnd
    141. End Function

    And the next code would go in your form load statement

    VB Code:
    1. Private Sub Form_Load()
    2. Dim x As Integer
    3. 'Set it to 0 so its transparent.
    4. Call fSetTranslucency(Me.hWnd, 0)
    5. ' Try values between 0 (completely invisible)
    6. ' to 255 (fully opaque).
    7. '
    8. For x = 0 to 255
    9.   Call fSetTranslucency(Me.hWnd, x)
    10. Next x
    11.  
    12. End Sub

    Try That

  3. #3
    Old Member moeur's Avatar
    Join Date
    Nov 2004
    Location
    Wait'n for Free Stuff
    Posts
    2,712

    Re: Fade In Effect when load

    Now that is cool!
    I had to make one change however; move the loop to the form's Activate event and add a DoEvents call
    VB Code:
    1. Private Sub Form_Activate()
    2.  Dim X As Long
    3.  Static Activated As Boolean
    4.  If Activated Then Exit Sub
    5.  Activated = True
    6.  For X = 1 To 255 Step 2
    7.   Call fSetTranslucency(Me.hWnd, X)
    8.   DoEvents
    9.  Next X
    10. End Sub

  4. #4
    Hyperactive Member
    Join Date
    Dec 2004
    Posts
    326

    Re: Fade In Effect when load

    Glad you liked it. You can also do the same in the Unload event of the form. Just step backwards with it. I used a seperate variable for that.

    VB Code:
    1. Private Sub Form_Unload()
    2. Dim x As Integer
    3. Dim i As Integer
    4. i = 255
    5. For x = 1 To 255
    6.   i = i - 1
    7.   Call fSetTranslucency(Me.hWnd, i)
    8.   DoEvents
    9.  Next x
    10. End Sub

  5. #5

    Thread Starter
    Hyperactive Member DarkX_Greece's Avatar
    Join Date
    Jan 2004
    Location
    Athens (Greece)
    Posts
    315

    Re: Fade In Effect when load

    Thank you zalez for your code! It works fine! I rated your post , because i liked it a lot!
    Last edited by DarkX_Greece; Feb 8th, 2005 at 08:16 AM. Reason: Something that i have forgotten..
    Short CV:
    1. Visual Basic 6 Programmer
    2. Web Expert


    Botonakis Web Services

  6. #6
    Addicted Member DKasler's Avatar
    Join Date
    Jan 2005
    Location
    Brooklyn, NYC
    Posts
    177

    Re: Fade In Effect when load

    Magnificent.
    -----MY SITES-----
    BayRidgeNights.Com - NYC Nightlife Forums

    Fight Communism - Rate Posts!

  7. #7
    New Member
    Join Date
    Oct 2009
    Posts
    1

    Re: Fade In Effect when load

    If there is code in your FORM_LOAD, add the following line at the end of the FORM_LOAD Sub:

    Call fSetTranslucency(Me.hwnd, 0)

    This will prevent the form from blinking before a fade in

  8. #8
    Former Admin/Moderator MartinLiss's Avatar
    Join Date
    Sep 1999
    Location
    San Jose, CA
    Posts
    33,427

    Re: Fade In Effect when load

    Here's another way:

    In a code module
    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 Const GWL_STYLE = (-16)
    Private Const GWL_EXSTYLE = (-20)
    'Requires Windows 2000 or later:
    Private Const WS_EX_LAYERED = &H80000
    
    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 Function GetLayeredwindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
    Private Const LWA_COLORKEY = &H1
    Private Const LWA_ALPHA = &H2
    
    Public Sub MakeWindowTransparent(ByVal hWnd As Long, ByVal alphaAmount As Byte)
        Dim lStyle As Long
        
        lStyle = GetWindowLong(hWnd, GWL_EXSTYLE)
        lStyle = lStyle Or WS_EX_LAYERED
        SetWindowLong hWnd, GWL_EXSTYLE, lStyle
        SetLayeredWindowAttributes hWnd, 0, alphaAmount, LWA_ALPHA
    End Sub
    In the form
    Code:
    Option Explicit
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    
    Private Sub Form_Load()
      Dim iX As Long
       For iX = 10 To 255 Step 10
           MakeWindowTransparent Me.hWnd, iX
           Me.Show
           DoEvents
           Sleep 200
       Next
    
    End Sub
    
    Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
      Dim iX As Long
       For iX = 255 To 0 Step -10
           MakeWindowTransparent Me.hWnd, iX
           DoEvents
           Sleep 200
       Next
    
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width