USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Dicas

  Visual Basic    (Forms/MDI)

Título da Dica:  Controle de opacidade do form
Postada em 27/6/2007 por Alexandre      Clique aqui para enviar email para o autor  alexandre7937@bol.com.br
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 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_ALPHA = &H2
Private Const WS_EX_LAYERED = &H80000

Public Function Is_Transparent(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
          Is_Transparent = True
       Else
          Is_Transparent = False
       End If
    If Err Then
       Is_Transparent = False
    End If
End Function

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

If Err Then
   Aplicar_Transparencia = 2
End If

End Function






'------------------------------ATIVANDO--no-form--seu-controle--------------------------





Call Aplicar_Transparencia(Me.hWnd, CByte("VALOR_DE_50_A_255"))
 


CyberWEB Network Ltda.    © Copyright 2000-2024   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página