And, just for fun, here's how to do something similar in W98/Me (will also work on 2000/XP, but the SetLayeredWindowAttributes method is preferable and cleaner on them). Note this is purely a demo of the technique. It sure as heck isn't production code (there's a noticeable flicker during the 'snapshot' setup phase, which can probably be reduced although not eliminated by some restructuring).
[tt]
Option Explicit
Const AC_SRC_OVER = &H0
Private Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type
Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Private Sub Form_Load()
Fader 1
End Sub
Private Sub Form_Unload(Cancel As Integer)
Fader 0
End Sub
Private Function Fader(Direction As Long)
Dim ScreenCopyDC As Long
Dim myDC As Long
Dim myBMP As Long
Dim oldBMP As Long
Dim myrect As RECT
Dim BF As BLENDFUNCTION
Dim lBF As Long
Dim fade As Long
GetWindowRect Me.hwnd, myrect
If Direction = 0 Then
Me.Hide
Else
Me.Show
End If
DoEvents
' Snapshot the either the form or the desktop under the form, depending on whether
' fade in or fade out is required
myDC = GetWindowDC(GetDesktopWindow())
ScreenCopyDC = CreateCompatibleDC(myDC)
myBMP = CreateCompatibleBitmap(myDC, myrect.Right - myrect.Left, myrect.Bottom - myrect.Top) ' Me.ScaleWidth, Me.ScaleHeight)
oldBMP = SelectObject(ScreenCopyDC, myBMP)
BitBlt ScreenCopyDC, 0, 0, myrect.Right - myrect.Left + 100, myrect.Bottom - myrect.Top + 100, myDC, myrect.Left, myrect.Top, SRCCOPY
If Direction = 0 Then
Me.Show
Else
Me.Hide
End If
DoEvents
For fade = 0 To 127 Step 4
With BF
.BlendOp = AC_SRC_OVER
.BlendFlags = 0
.SourceConstantAlpha = fade
.AlphaFormat = 0
End With
RtlMoveMemory lBF, BF, 4
AlphaBlend myDC, myrect.Left, myrect.Top, myrect.Right - myrect.Left, myrect.Bottom - myrect.Top, ScreenCopyDC, 0, 0, myrect.Right - myrect.Left, myrect.Bottom - myrect.Top, lBF
Next
'Clean up
SelectObject ScreenCopyDC, oldBMP
DeleteObject myBMP
ReleaseDC GetDesktopWindow(), myDC
DeleteDC myDC
DeleteDC ScreenCopyDC
If Direction = 0 Then
Me.Hide
Else
Me.Show
End If
End Function