Transperant Form

[Zeka]

Is there any way that I can make the form transperant (invisible), but can still see the controls I place on there e.g pictures command buttons etc. I use to have an example but it recently got deleted. So can anybody point me in the right direction? Thanks

[manavo11]

Here we go

[Wokawidget]

Or check out the "Skin a form" example in my sig.

Woka

[DarkX_Greece]

Here we go

Nice example Manavo11, i needed too!!!

[RobDog888]

Here is another method for semi-transparent forms.

Option Explicit
'Add a slider control to the project (Slider1)
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _
(ByVal lpLibFileName As String) As Long
 
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
ByVal lpProcName As String) As Long
 
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule 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 Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, _
ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
 
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
 
Public Sub AlphaBlendForm(ByVal lHwnd As Long, ByVal intTranslucenceLevel As Integer)
    If APIExists("SetLayeredWindowAttributes", "User32") Then
        SetWindowLong lHwnd, GWL_EXSTYLE, WS_EX_LAYERED
        SetLayeredWindowAttributes lHwnd, 0, intTranslucenceLevel, LWA_ALPHA
    Else
        MsgBox "Your OS does not support Alpha Blending.", vbExclamation, "Alpha Blend"
    End If
End Sub
 
Public Function APIExists(ByVal pstrFunctionName As String, ByVal pstrDllName As String) As Boolean
    Dim lngHandle   As Long
    Dim lngAddr     As Long
    lngHandle = LoadLibrary(pstrDllName)
    If Not (lngHandle = 0) Then
        lngAddr = GetProcAddress(lngHandle, pstrFunctionName)
        FreeLibrary lngHandle
    End If
    APIExists = Not (lngAddr = 0)
End Function
 
Private Sub Form_Load()
    Slider1.Max = 255
    Slider1.Min = 10
    Slider1.LargeChange = 5
    AlphaBlendForm Me.hwnd, 255 'MAX VALUE = OPAIC/ MIN VALUE = 0 CANT SEE
    Slider1.Value = 255
End Sub
 
Private Sub Slider1_Scroll()
    AlphaBlendForm Me.hwnd, Slider1.Value
End Sub

[DarkX_Greece]

Yes, but it makes transparent and the controls!

Zeka needs an example to tranparent the form and still show the controls inside the form!!!

[RobDog888]

Oh, I missed that. I have another example for that but its basically the same APIs that manavo11 posted.

If you guys want to see it I can post it.

[manavo11]

Nice example Manavo11, i needed too!!!

Thanks, although I can't take credit for it

Rob, I'd like to see an example

[RobDog888]

Here you go. Only four APIs .

Now that will be $1,000,000.00

[Davoay]

you think you could make a demo of this form?? casue i tried using your code you posted but i get an error.

[/img]http://www.vbforums.com/attachment.php?attachmentid=30635[/img]

[RobDog888]

Whats your error? Are you running Windows 2000+? The code I posted is a demo.
You just need to add a slider control to your project and paste all the code behind the form.

Project > Components > Controls tab > select "Microsoft Windows Common Controls 6.0", click ok.

Then in your toolbox add a slider to your form.

[Davoay]

ok thankz.. lets say i want it on 60.. but i dont want the slider there. how can i make it 60 withload the transparent slider

[RobDog888]

Ok, take the Slider1_Scroll code procedure out and this will replace your Form_Load code.

Private Sub Form_Load()
    AlphaBlendForm Me.hwnd, 60 'MAX VALUE = OPAIC/ MIN VALUE = 0 CANT SEE
End Sub

[VBfang]

WOW! that is really fun code, but i was woundering, is there any way to remove the box around a lable? i mean so that you could just have words on the screen with out that ugly box?

[moeur]

Here's an example that gets rid of the label background that I copied from
Karl E. Peterson http://www.mvps.org/vb
Anything you want yo make transparent, set color to vbGreen
Make a project with a form and put a label in the form

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 Declare Sub SetWindowPos Lib "user32" ( _
    ByVal hWnd As Long, _
    ByVal hWndInsertAfter As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal cx As Long, _
    ByVal cy As Long, _
    ByVal wFlags As Long _
)
 
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 Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1&
Private Const LWA_ALPHA = &H2&
Private Const LWA_OPAQUE = &HFF&
 
Private Const GWL_STYLE = (-16)
Private Const WS_CAPTION = &HC00000
Private Const WS_THICKFRAME = &H40000
 
Private Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const SWP_NOZORDER = &H4
Private Const SWP_FRAMECHANGED = &H20
 
Private m_ColorKey As OLE_COLOR
 
Private Declare Function GetSysColor Lib "user32" ( _
    ByVal nIndex As Long _
) As Long
 
Private Function CheckSysColor(ByVal ColorRef As OLE_COLOR) As Long
   Const HighBit = &H80000000
   If ColorRef And HighBit Then
      CheckSysColor = GetSysColor(ColorRef And Not HighBit)
   Else
      CheckSysColor = ColorRef
   End If
End Function
 
Private Function MakeTransparent(ByVal hWnd As Long) As Boolean
   Dim nStyle As Long
   If hWnd Then
      nStyle = GetWindowLong(hWnd, GWL_EXSTYLE) And Not WS_EX_LAYERED
         If SetWindowLong(hWnd, GWL_EXSTYLE, nStyle) Then
            nStyle = nStyle Or WS_EX_LAYERED
            If SetWindowLong(hWnd, GWL_EXSTYLE, nStyle) Then
                     MakeTransparent = CBool(SetLayeredWindowAttributes( _
                     hWnd, CheckSysColor(m_ColorKey), _
                     0, _
                     LWA_COLORKEY))
            End If
         End If
   End If
End Sub
 
Private Function ToggleCaption(ByVal Value As Boolean) As Boolean
   Dim nStyle As Long
   
   ' Retrieve current style bits.
   nStyle = GetWindowLong(Me.hWnd, GWL_STYLE)
   ' Set WS_SYSMENU On or Off as requested.
   If Value Then
      nStyle = nStyle Or WS_CAPTION Or WS_THICKFRAME
   Else
      nStyle = nStyle And Not WS_CAPTION
      nStyle = nStyle And Not WS_THICKFRAME
   End If
   
   ' Try to set new style.
   If SetWindowLong(Me.hWnd, GWL_STYLE, nStyle) Then
      If nStyle = GetWindowLong(Me.hWnd, GWL_STYLE) Then
         ToggleCaption = True
      End If
   End If
   ' Redraw window with new style.
   SetWindowPos hWnd, 0, 0, 0, 0, 0, SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOZORDER Or SWP_NOSIZE
End Function
 
Private Sub Command1_Click()
Unload Me
 
End Sub
 
Private Sub Form_Load()
'setup label
    Label1.AutoSize = True
    Label1.Caption = "Click Me"
 
'make transparent
     'Toggle titlebar off.
      Call ToggleCaption(False)
            
      m_ColorKey = vbGreen
      MakeTransparent Me.hWnd
      
      ' Set backgrounds to green so they
      ' become transparent too.
      Me.BackColor = vbGreen
      Label1.BackColor = vbGreen
      
End Sub
 
Private Sub Label1_Click()
  Unload Me
End Sub

[VBfang]

wow! cool, thanks alot, that is some realy usefull code