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 SetLayeredWindowAttributes function, by using the following code:
Declarations
Expand|Select|Wrap|Line Numbers
- 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
General Code
Expand|Select|Wrap|Line Numbers
- 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
Another method of achieving the fading windows effect is to use the UpdateLayeredWindow function (in theory). At current, the best code I have managed to produce using this function is as follows:
Declarations
Expand|Select|Wrap|Line Numbers
- 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
General Code
Expand|Select|Wrap|Line Numbers
- 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
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 UpdateLayeredWindow function to achieve translucency on an entire form (controls included), I would very much appreciate any answers offered.