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?
Printable View
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?
VB Code:
Option Explicit Const VER_PLATFORM_WIN32s = 0 Const VER_PLATFORM_WIN32_WINDOWS = 1 Const VER_PLATFORM_WIN32_NT = 2 Private Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End Type Private Declare Function GetVersionEx Lib "kernel32" Alias _ "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long 'hWnd - handle to window to layer. 'crKey - specifies the color key 'bAlpha - value for the blend function 'dwFlags - action Private Declare Function SetLayeredWindowAttributes Lib "user32" ( _ ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Long, _ ByVal dwFlags As Long) As Long 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_EXSTYLE = (-20) Private Const WS_EX_LAYERED = &H80000 Private Const LWA_COLORKEY = &H1& Private Const LWA_ALPHA = &H2& Private Declare Function GetParent Lib "user32" _ (ByVal hWnd As Long) As Long Private Declare Function IsWindowVisible Lib "user32" _ (ByVal hWnd As Long) As Long Private Function fGetOSVersion() Dim os As OSVERSIONINFO ' ' Returns True if Win98 or Win2000 ' fGetOSVersion = False With os .dwOSVersionInfoSize = Len(os) Call GetVersionEx(os) ' Windows 2000 If .dwMajorVersion > 4 Then fGetOSVersion = True If .dwMajorVersion = 4 And _ .dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _ .dwMinorVersion > 0 Then fGetOSVersion = True End If End With End Function Private Function fSetTranslucency(ByVal hWnd As Long, ByVal alpha As Byte) As Boolean Dim lStyle As Long ' ' Layering only works with Win2K or above. ' If fIsWin2000 Then ' ' Only a top level window can be translucent. ' hWnd = fGetTopLevel(hWnd) ' ' Make the window translucent by setting its ' extended style. ' lStyle = GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED If SetWindowLong(hWnd, GWL_EXSTYLE, lStyle) Then fSetTranslucency = CBool(SetLayeredWindowAttributes(hWnd, 0, CLng(alpha), LWA_ALPHA)) End If End If End Function Private Function fClearTranslucency(ByVal hWnd As Long) As Boolean Dim lStyle As Long ' ' Layering only works with Win2K or above. ' If fIsWin2000 Then ' ' Only a top level window can be translucent. ' hWnd = fGetTopLevel(hWnd) ' ' Clear translucency - make the window opaque. ' Call SetLayeredWindowAttributes(hWnd, 0, 255&, LWA_ALPHA) ' ' Clear the extended style bit. ' lStyle = GetWindowLong(hWnd, GWL_EXSTYLE) And Not WS_EX_LAYERED fClearTranslucency = CBool(SetWindowLong(hWnd, GWL_EXSTYLE, lStyle)) End If End Function Private Function fIsWin2000() As Boolean Dim os As OSVERSIONINFO ' ' Returns True if Win98 or Win2000 ' fIsWin2000 = False With os .dwOSVersionInfoSize = Len(os) Call GetVersionEx(os) ' Windows 2000 If .dwPlatformId = VER_PLATFORM_WIN32_NT Then fIsWin2000 = (.dwMajorVersion > 4) End If End With End Function Private Function fGetTopLevel(ByVal hChild As Long) As Long Dim hWnd As Long hWnd = hChild Do While IsWindowVisible(GetParent(hWnd)) hWnd = GetParent(hChild) hChild = hWnd Loop fGetTopLevel = hWnd End Function
And the next code would go in your form load statement
VB Code:
Private Sub Form_Load() Dim x As Integer 'Set it to 0 so its transparent. Call fSetTranslucency(Me.hWnd, 0) ' Try values between 0 (completely invisible) ' to 255 (fully opaque). ' For x = 0 to 255 Call fSetTranslucency(Me.hWnd, x) Next x End Sub
Try That
Now that is cool! :thumb:
I had to make one change however; move the loop to the form's Activate event and add a DoEvents call
VB Code:
Private Sub Form_Activate() Dim X As Long Static Activated As Boolean If Activated Then Exit Sub Activated = True For X = 1 To 255 Step 2 Call fSetTranslucency(Me.hWnd, X) DoEvents Next X End Sub
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:
Private Sub Form_Unload() Dim x As Integer Dim i As Integer i = 255 For x = 1 To 255 i = i - 1 Call fSetTranslucency(Me.hWnd, i) DoEvents Next x End Sub
Thank you zalez for your code! It works fine! I rated your post , because i liked it a lot!
:) :) :) :) :)
Magnificent.
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
Here's another way:
In a code module
In the formCode: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
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