Attribute VB_Name = "mTransparence"
Option Explicit

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Módulo responsável por aplicar efeitos de transparência nos forms/picturebox
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' API's externas
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) 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 Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long

' Constantes
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Aplica transparência num form
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub ApplyTransparence(Who As Form, Margin As Long)
    On Error Resume Next
    Dim mRGN As Long
    Dim lnWidth As Long, lnHeight As Long
    
    ' Define dimensões em pixel do formulário
    lnWidth = Who.Width / Screen.TwipsPerPixelX
    lnHeight = Who.Height / Screen.TwipsPerPixelY
    
    ' Desenha
    mRGN = CreateRoundRectRgn(0, 0, lnWidth, lnHeight, Margin, Margin)
    
    ' Seta região
    SetWindowRgn Who.hWnd, mRGN, True
    
    ' Limpeza
    DeleteObject mRGN
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Aplica efeito alpha (efeito fantasma) num form
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub ApplyAlpha(Who As Form, Alpha As Byte)
    On Error Resume Next
    Dim ret As Long
    
    ' Pega o tipo de janela
    ret = GetWindowLong(Who.hWnd, GWL_EXSTYLE)
    
    ' Verifica se é para ativar o layer alpha sobre ela
    If (Alpha <> BT_INVALID_VALUE) Then
        
        ' Aplica layer
        ret = ret Or WS_EX_LAYERED
    Else
        
        ' Retira layer (se tiver)
        ret = ret And (Not WS_EX_LAYERED)
    End If
    
    ' Aplica na janela
    SetWindowLong Who.hWnd, GWL_EXSTYLE, ret
    
    'Seta a transparência da janela
    SetLayeredWindowAttributes Who.hWnd, 0, Alpha, LWA_ALPHA
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Preenche um retângulo num picturebox
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub FillRect(pbInput As PictureBox, cdRec As cDelta, cColor As COLORS)
    On Error Resume Next
    Dim lnX As Integer
    Dim lnY As Integer
    
    ' Seta cor
    pbInput.ForeColor = GetColor(cColor)
    
    ' Percorre em X
    For lnX = cdRec.Initial.X To cdRec.Final.X
        
        ' Percorre em Y
        For lnY = cdRec.Initial.Y To cdRec.Final.Y
            
            ' Seta ponto
            pbInput.PSet (lnX, lnY)
        Next lnY
    Next lnX
End Sub