Attribute VB_Name = "mLanguage"
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Módulo para tradução do programa
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Guarda o nome do módulo
Private Const ST_MY_NAME As String = "mLanguage"

' Section de info
Private Const ST_INFO_SECTION As String = "info"

' Section de language
Private Const ST_OBJECTS_SECTION As String = "objects"

' Section de mensagens
Private Const ST_MSG_SECTION As String = "msg"

' Tipo caption
Private Const ST_OBJECTS_CAPTION As String = ".caption"

' Tipo ToolTipText
Private Const ST_OBJECTS_TOOLTIPTEXT As String = ".tooltiptext"

' Tipo mutável
Private Const ST_STR_REPLACE As String = "%%"

' Tipo nova linha
Private Const ST_STR_NEW_LINE As String = "\n"

' Alinhamento da linguagem no arquivo .ini
Private Const ST_LANGUAGE_ALIGNMENT As String = "alignment"

' Se objeto está em RTL ou LTR
Private Const ST_RTL_ALLIGNMENT As String = "RTL"
Private Const ST_LTR_ALLIGNMENT As String = "LTR"

' API externa
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nsize As Long, ByVal lpFileName As String) As Long


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Busca informação do objeto no INI de linguagem
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function stReadIni(ItemName As String, Section As String) As String
    Dim stBuff As String
    Dim stBuffLen As Long
    
    ' Inicia buff
    stBuff = String(LN_API_BUFF_SIZE, 0)
    
    ' Busca no INI
    stBuffLen = GetPrivateProfileString(Section, ItemName, ST_INVALID_VALUE, stBuff, LN_API_BUFF_SIZE, st_LanguageFile)
    
    ' Retorna dados
    stReadIni = Mid(stBuff, 1, stBuffLen)
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Traduz um objeto
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub LoadLanguage(objInput As Object, Optional stSubName As String)
    Dim stObjName As String
    Dim stAux As String
    Dim object As Object
    On Error GoTo ErrTreat:
    
    ' Atualiza alinhamento
    UpdateAlignment objInput
    
    ' Monta string de tradução do objeto
    stObjName = stSubName + ST_OBJECT_DOT + objInput.Name
    
    ' Recupera tradução do caption
    stAux = stReadIni(stObjName + ST_OBJECTS_CAPTION, ST_OBJECTS_SECTION)
    
    ' Se possui
    If (Len(stAux) > 0) Then
        
        ' Seta caption do objeto
        objInput.Caption = stAux
    End If
    
    ' Recupera tradução do tooltiptext
    stAux = stReadIni(stObjName + ST_OBJECTS_TOOLTIPTEXT, ST_OBJECTS_SECTION)
    
    ' Se possui
    If (Len(stAux) > 0) Then
        
        ' Seta caption do objeto
        objInput.ToolTipText = stAux
    End If
    
    ' Busca todos os sub-ojetos deste
    For Each object In objInput
        
        ' Chama por recursividade
        LoadLanguage object, stObjName
    Next
    
    Exit Sub
ErrTreat:
    Exit Sub
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retorna a tradução de um texto
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function Msg(stInput As String, Optional vtstInput) As String
    
    ' Busca e retorna do INI
    Msg = FormatStr(stReadIni(stInput, ST_MSG_SECTION), vtstInput)
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Formata um texto
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function FormatStr(stInput As String, Optional vtstInput) As String
    Dim stAux As String
    Dim itI As Long
    Dim itPos As Long
    
    ' Quebras de linhas
    stAux = Replace(stInput, ST_STR_NEW_LINE, ST_LINESEP)
    
    ' Se foi passado um vetor de strings
    If (VarType(vtstInput) = vbArray + vbString) Then
        
        ' Varre o vetor
        For itI = 0 To (VtSize(vtstInput) - 1)
            
            ' Encontra o próximo item a ser substituído
            itPos = InStr(1, stAux, ST_STR_REPLACE)
            
            ' Se encontrou
            If (itPos > 0) Then
                
                ' Substitui
                stAux = Mid(stAux, 1, itPos - 1) + CStr(vtstInput(itI)) + Mid(stAux, itPos + Len(ST_STR_REPLACE))
            End If
        Next itI
    End If
    
    ' Retorna
    FormatStr = stAux
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Atualiza alinhamento de sub-objetos contidos neste
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub UpdateAlignment(objInput As Object)
    On Error GoTo ErrTreat:
    
    ' Verifica qual o alinhamento do objeto
    Select Case objInput.Tag
    
    ' Se estiver RTL
    Case ST_RTL_ALLIGNMENT
        
        ' Mas se global for LTR
        If Not bl_LanguageRTL Then
            
            ' Guarda atual
            objInput.Tag = ST_LTR_ALLIGNMENT
            
            ' Ajusta left
            UpdateObjAlignment objInput
        End If
    
    ' Se estiver LTR
    Case ST_LTR_ALLIGNMENT
        
        ' Mas se global for RTL
        If bl_LanguageRTL Then
            
            ' Guarda atual
            objInput.Tag = ST_RTL_ALLIGNMENT
            
            ' Ajusta left
            UpdateObjAlignment objInput
        End If
    End Select
    
    Exit Sub
ErrTreat:
    Exit Sub
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Atualiza alinhamento de objetos
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub UpdateObjAlignment(objInput As Object)
    On Error GoTo ErrTreat:
    
    ' Calcula novo left
    objInput.Left = objInput.Container.Width - (objInput.Left + objInput.Width)
    
    ' Verifica disposição do texto
    Select Case objInput.Alignment
        
    ' Se for esquerda
    Case 0
        
        ' Seta direita
        objInput.Alignment = 1
    
    ' Se for direita
    Case 1
        
        ' Seta esquerda
        objInput.Alignment = 0
    End Select
    
    Exit Sub
ErrTreat:
    Exit Sub
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Busca informação de alinhamento da linguagem
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub RefreshLanguageAlignment()
    On Error GoTo ErrTreat:
    
    ' Recupera Alinhamento do arquivo INI
    bl_LanguageRTL = charTObool(stReadIni(ST_LANGUAGE_ALIGNMENT, ST_INFO_SECTION))
    
    Exit Sub
ErrTreat:
    Exit Sub
End Sub