Translucent Forms & Fade Effects

[tristanlbailey]

I have been attempting to solve this problem for a few weeks now, but I'm not having much luck...

I would like to create a seamless fading effect on each form/window in my program; one that, when an image is clicked with a mouse and held, the window fades away by approximately 50% transparency, and when the mouse button is released, fades back to opaque.

I have been able to do this to an extent, with the SetLayeredWindo wAttributes function, by using the following code:

Declarations

Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
 
Public Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
 
Public Const GWL_EX_STYLE = -20
Public Const LWA_ALPHA = &H2
Public Const WS_EX_LAYERED = &H80000
 
Public BlendVal As Long
Public LayWinAttribRef As Long
Public WinVer As OSVERSIONINFO
 

(The version check is included, so that the program can be used in Windows operating systems prior to Windows 2000, without the program causing errors. The initial call to SetLayeredWindo wAttributes in the Form_Activate procedure prevents a black-fade effect from occurring)

General Code

Private Sub Form_Activate()
 
    If WinVer.dwMajorVersion >= 5 Then
        BlendVal = GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
        LayWinAttribRef = SetWindowLong(hWnd, GWL_EXSTYLE, BlendVal)
        SetLayeredWindowAttributes hWnd, 0, 255, LWA_ALPHA
    End If
 
End Sub
 
Private Sub imgTitleStetch_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
    Select Case Button
    Case 1
        ...
        If WinVer.dwMajorVersion >= 5 Then Call TransFormOut(hWnd, 7)
    End Select
 
End Sub
 
Private Sub imgTitleStetch_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
    Select Case Button
    Case 1
        If WinVer.dwMajorVersion >= 5 Then Call TransFormIn(hWnd, 7)
    End Select
 
End Sub
 
Public Sub TransFormIn(frmHWND As Long, FazeSpeed As Long)
 
    For Faze = 90 To 255 Step FazeSpeed
        SetLayeredWindowAttributes frmHWND, 0, Faze, LWA_ALPHA
    Next Faze
 
    If Faze <> 255 Then
        SetLayeredWindowAttributes frmHWND, 0, 255, LWA_ALPHA
    End If
 
End Sub
 
Public Sub TransFormOut(frmHWND As Long, FazeSpeed As Long)
 
    For Faze = 255 To 90 Step -FazeSpeed
        SetLayeredWindowAttributes frmHWND, 0, Faze, LWA_ALPHA
    Next Faze
 
    If Faze <> 90 Then
        SetLayeredWindowAttributes frmHWND, 0, 90, LWA_ALPHA
    End If
 
End Sub

The above methods works to a degree. Mid-range computers or slower will perform the fade effect fine, but fast computers change the speed of the effect, so that it becomes slower to fade in and out (which doesn't make any sense).

Another method of achieving the fading windows effect is to use the UpdateLayeredWi ndow function (in theory). At current, the best code I have managed to produce using this function is as follows:

Declarations

Public 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
Public Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function UpdateLayeredWindow Lib "user32" (ByVal hWnd As Long, ByVal hdcDst As Long, pptDst As Any, psize As Any, ByVal hdcSrc As Long, pptSrc As Any, ByVal crKey As Long, ByRef pblend As BLENDFUNCTION, ByVal dwFlags As Long) As Long
 
Public Type BLENDFUNCTION
    BlendOp As Byte
    BlendFlags As Byte
    SourceConstantAlpha As Byte
    AlphaFormat As Byte
End Type
 
Public Type POINT
    x As Long
    y As Long
End Type
 
Public Type SIZE
    cx As Long
    cy As Long
End Type
 
Public Const GWL_EX_STYLE = -20
Public Const ULW_ALPHA = &H2
Public Const WS_EX_LAYERED = &H80000
 
Public BlendFunc As BLENDFUNCTION
Public BlendPic As Long
Public BlendVal As Long
Public SourceDC As Long
Public SourcePoint As POINT
Public WindowSize As SIZE
 

For the following code to work properly, the form's "AutoRedraw " property and "HasDC" property must be set to True, and the form's '"ScaleMode" property must be set to Pixels.

General Code

Private Sub Form_Activate()
 
    BlendVal = GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
    SetWindowLong hWnd, GWL_EXSTYLE, BlendVal
 
    SourceDC = CreateCompatibleDC(hDC)
 
    BlendPic = CreateCompatibleBitmap(hDC, ScaleWidth, ScaleHeight)
 
    SelectObject SourceDC, BlendPic
 
    BitBlt SourceDC, 0, 0, ScaleWidth, ScaleHeight, hDC, 0, 0, SRCCOPY
 
    With BlendFunc
        .AlphaFormat = 0
        .BlendFlags = 0
        .BlendOp = AC_SRC_OVER
        .SourceConstantAlpha = 90
    End With
 
    WindowSize.cx = ScaleWidth
    WindowSize.cy = ScaleHeight
 
    UpdateLayeredWindow hWnd, 0, ByVal 0, WindowSize, SourceDC, SourcePoint, 0, BlendFunc, ULW_ALPHA
    ScaleMode = 1 'Change back to twips
 
End Sub

As claimed by Microsoft, using the UpdateLayeredWi ndow function is supposedly more efficient than using the SetLayeredWindo wAttributes function.

At the moment, I'm testing the translucent effect (on Windows XP) by starting the program with the first window at a translucency of 90. The code appears to only replicate the background picture of the window, but not the form's controls.

If anyone knows how to use the UpdateLayeredWi ndow function to achieve translucency on an entire form (controls included), I would very much appreciate any answers offered.