Semi-Transparent Apps

[da404LewZer]

I am running windows 2000 pro, and i am aware that you can make programs semi-transparent. I have seen a few programs that can do it, and i was wondering how i could.

now.. i'm not talking about the gay api declarations that make a form mis-shaped. i mean semi-transparent.. -see through- .

if anyone has any comments, or suggestions, i give thanks in advance

i don't remeber where i found this, so i hope i don't offend the one who originaly wrote this:

put the following code in a module:

Public Type POINTAPI
    x As Long
    y As Long
    End Type

Public Type SIZE
    cx As Long
    cy As Long
End Type

Public Type BLENDFUNCTION
    BlendOp As Byte
    BlendFlags As Byte
    SourceConstantAlpha As Byte
    AlphaFormat As Byte
End Type

'**********************************************************************************

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
        (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
        (ByVal hWnd As Long, ByVal nIndex As Long, _
         ByVal dwNewLong As Long) As Long

Declare Function SetLayeredWindowAttributes Lib "user32" _
        (ByVal hWnd As Long, ByVal crKey As Long, _
         ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

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, crKey As Long, ByVal pblend As Long, _
         ByVal dwFlags As Long) As Long

Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
        (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
    
'**********************************************************************************

Public Const WS_EX_LAYERED = &H80000
Public Const GWL_STYLE = (-16)
Public Const GWL_EXSTYLE = (-20)
Public Const AC_SRC_OVER = &H0
Public Const AC_SRC_ALPHA = &H1
Public Const AC_SRC_NO_PREMULT_ALPHA = &H1
Public Const AC_SRC_NO_ALPHA = &H2
Public Const AC_DST_NO_PREMULT_ALPHA = &H10
Public Const AC_DST_NO_ALPHA = &H20
Public Const LWA_COLORKEY = &H1
Public Const LWA_ALPHA = &H2
Public Const ULW_COLORKEY = &H1
Public Const ULW_ALPHA = &H2
Public Const ULW_OPAQUE = &H4

'**********************************************************************************

Public Function CheckLayered(ByVal hWnd As Long) As Boolean
    
    Dim i As Long
    
    i = GetWindowLong(hWnd, GWL_EXSTYLE)

    If (i And WS_EX_LAYERED) = WS_EX_LAYERED Then
        CheckLayered = True
    Else
        CheckLayered = False
    End If

End Function

Public Sub SetLayered(ByVal hWnd As Long, ByVal SetAs As Boolean, _
               ByVal bAlpha As Byte)
    
    Dim i As Long
    
    i = GetWindowLong(hWnd, GWL_EXSTYLE)

    If SetAs = True Then
        i = i Or WS_EX_LAYERED
    Else
        i = i And Not WS_EX_LAYERED
    End If
    
    SetWindowLong hWnd, GWL_EXSTYLE, i
    SetLayeredWindowAttributes hWnd, 0, bAlpha, LWA_ALPHA
    
End Sub

and the following code + the 3 buttons in as form:

Private Const FADE_SPEED = 1

Private mlngHwnd As Long
Private mblnFade As Boolean

'**************************************************************************

Private Sub Form_Load()

    mlngHwnd = Me.hWnd

    SetLayered mlngHwnd, True, 0
    Me.Show
    DoEvents
    
    mblnFade = True
    FadeIn
    mblnFade = False
    
End Sub

Private Sub Form_Unload(Cancel As Integer)

    mblnFade = False
    Me.Hide
    DoEvents
    
End Sub

'**************************************************************************

Private Sub cmdStart_Click()

    mblnFade = True
    
    Do While mblnFade
        FadeOut
        FadeIn
    Loop
    
End Sub

Private Sub cmdStop_Click()

    mblnFade = False
    
End Sub

Private Sub cmdExit_Click()

    Unload Me

End Sub

'**************************************************************************

Private Sub FadeIn()

    Dim i As Integer

    For i = 1 To 255 Step FADE_SPEED
        If Not mblnFade Then Exit For
        SetLayered mlngHwnd, True, i
        DoEvents
    Next
    
End Sub

Private Sub FadeOut()

    Dim i As Integer

    For i = 255 To 0 Step -FADE_SPEED
        If Not mblnFade Then Exit For
        SetLayered mlngHwnd, True, i
        DoEvents
    Next
    
End Sub

good luck

sascha

[da404LewZer]

Thank you so very much!!!

I have been wanting to do that for ever!

Have Fun! (i'll send u da proggie when done) - that is if u want it (not revealing what it is yet tho)