Notifications
Clear all

Userform Trasparente

1 Posts
1 Usuários
0 Reactions
1,481 Visualizações
(@fernandofernandes)
Posts: 43750
Illustrious Member
Topic starter
 

Nesse tópico será mostrado como controlar a transparência de um UserForm.

1) Crie um UserForm

2) Crie um UserForm Insira no UserForm uma barra de rolagem ScrollBar na vertical de preferência.

3) Crie um UserForm Abra a edição de código do Formulário e insira o seguinte código:

Option Explicit
'FindWindows: Retorna a Handle (nº que identifica a janela)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'GetWindowLong: Retorna configurações da janela em questão, como estilo da janela
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal lngWinIdx As Long) As Long

'SetWindowLong: Altera configurações da janela em questão, como estilo da janela
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal lngWinIdx As Long, ByVal dwNewLong As Long) As Long

'SetLayeredWindowAttributes: Função que vamos utilizar para controlar a trasparencia do UserForm
Private Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hWnd As Long, ByVal crKey As Integer, ByVal bAlpha As Integer, ByVal dwFlags As Long) As Long
'Declarando constantes
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = &HFFEC

'Declarando variavel que poderar ser usada durante a execução do UserForm
'em qualquer evento ou controle.
Dim lngHwnd As Long

'Inserindo código na inicialização do UserForm
'Vamos aqui alterar o tipo da janela para que possamos dar efeito de trasparencia
Private Sub UserForm_Initialize()
Dim lngStyle As Long
Dim strClassName As String
strClassName = "ThunderDFrame"
lngHwnd = FindWindow(strClassName, Me.Caption)
lngStyle = GetWindowLong(lngHwnd, GWL_EXSTYLE)
SetWindowLong lngHwnd, GWL_EXSTYLE, lngStyle Or WS_EX_LAYERED
ScrollBar1.Value = 50
End Sub

'Executando código quando o scrollBar for alterado
Private Sub ScrollBar1_Change()
Dim I As Long
I = ScrollBar1.Value
SetLayeredWindowAttributes lngHwnd, 0, I * 255 / 100, LWA_ALPHA
End Sub

'Ao click no UserForm alterar o ScrollBar1.Value para 100
'que tornara o userform 100% visivel...
Private Sub UserForm_Click()
ScrollBar1.Value = 100
End Sub

By Mitsueda

 
Postado : 14/10/2009 4:29 pm