[VB6 ]T ransparent Form Example(TRansparencia en vb6)

domingo, 6 de noviembre de 2011
[VB6 ]T ransparent Form Example

Coder:┌∩┐(◣_◢)┌∩┐



Lo primero es lo primero agregue un módulo al proyecto y luego pegan el siguiente codigo
Citar
    Option Explicit

    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 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
    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 Const GWL_EXSTYLE = (-20)
    Private Const LWA_COLORKEY = &H1
    Private Const LWA_ALPHA = &H2
    Private Const ULW_COLORKEY = &H1
    Private Const ULW_ALPHA = &H2
    Private Const ULW_OPAQUE = &H4
    Private Const WS_EX_LAYERED = &H80000

    Public Function isTransparent(ByVal hWnd As Long) As Boolean
    On Error Resume Next
    Dim Msg As Long
    Msg = GetWindowLong(hWnd, GWL_EXSTYLE)
    If (Msg And WS_EX_LAYERED) = WS_EX_LAYERED Then
      isTransparent = True
    Else
      isTransparent = False
    End If
    If Err Then
      isTransparent = False
    End If
    End Function

    Public Function MakeTransparent(ByVal hWnd As Long, Perc As Integer) As Long
    Dim Msg As Long
    On Error Resume Next
    If Perc < 0 Or Perc > 255 Then
      MakeTransparent = 1
    Else
      Msg = GetWindowLong(hWnd, GWL_EXSTYLE)
      Msg = Msg Or WS_EX_LAYERED
      SetWindowLong hWnd, GWL_EXSTYLE, Msg
      SetLayeredWindowAttributes hWnd, 0, Perc, LWA_ALPHA
      MakeTransparent = 0
    End If
    If Err Then
      MakeTransparent = 2
    End If
    End Function

    Public Function MakeOpaque(ByVal hWnd As Long) As Long
    Dim Msg As Long
    On Error Resume Next
    Msg = GetWindowLong(hWnd, GWL_EXSTYLE)
    Msg = Msg And Not WS_EX_LAYERED
    SetWindowLong hWnd, GWL_EXSTYLE, Msg
    SetLayeredWindowAttributes hWnd, 0, 0, LWA_ALPHA
    MakeOpaque = 0
    If Err Then
      MakeOpaque = 2
    End If
    End Function
A continuación, agregue un formulario y llama al modulo con el siguiente codigo agregandolo en su proyecto

Citar
    Code:
    Private Sub Form_Load()
    MakeTransparent Me.hWnd, 100
    End Sub


pueden cambiar el valor de transparencia desde 0 hasta 255 y que funciona para todos los otros controles, etc añadido en el formulario y formularios saludos..

Fuente: http://www.anonimosx.net/index.php/topic,1245.0.html

0 comentarios:

Publicar un comentario