CRÉER UNE APPLICATION MULTILANGUE (.INI) V 1.1.5

' Dans les versions à venir :
'  Support de parametre multiple genre %param% dans une phrase
'   pour pouvoir faire des phrases personnalisable
'
'


Option Explicit
' Extension que vous donnerez à vos fichiers de langue (de type INI)
Const EXTENSION = ".ini" ' peut etre par exemple : ".lng" ou ".lang", ...

' sous répertoire qui contient les fichiers de langues
'  eg : "lang\ ou "", ...
Const PATHOFLANG = "lang\"

' nom du fichier actuellement utilisé
' si vide alors pas de langue choisie !!!
Dim mstrFileLang As String


' **************************************
' * Permets de crée le fichier default *
' *  sur base d'une Form               *
' **************************************
Public Sub SaveFormLanguage(frmForSave As Form)
    On Error Resume Next
    Dim cntEach As Control
    Dim strValue As String
    Dim strIndexMult As String
    Dim strFileName As String

    strFileName = PathAddBackslash(App.Path) & PATHOFLANG & "default" & EXTENSION

    ' sauve la caption de la feuille
    strValue = frmForSave.Caption
    INIProfileWrite "Caption", StringEscape(strValue), frmForSave.Name, strFileName

    ' sauve la caption et le nom de chaque feuille
    For Each cntEach In frmForSave
        strIndexMult = ""
        ' pour les Instances multiple d'un controle ...
        strIndexMult = IIf(cntEach.Index <> 0, "_" & cntEach.Index, "")
        
        strValue = ""
        strValue = cntEach.Caption
        If strValue <> "" Then INIProfileWrite cntEach.Name & "_Caption" & strIndexMult, StringEscape(strValue), frmForSave.Name, strFileName

        strValue = ""
        strValue = cntEach.Text
        If strValue <> "" Then INIProfileWrite cntEach.Name & "_Text" & strIndexMult, StringEscape(strValue), frmForSave.Name, strFileName
    Next
End Sub

Public Sub SaveMsgLanguage(strMsgId As String, strMsg As String)
    On Error Resume Next
    Dim strFileName As String
    
    strFileName = PathAddBackslash(App.Path) & PATHOFLANG & "default" & EXTENSION

    INIProfileWrite strMsgId, StringEscape(strMsg), "other", strFileName
End Sub


' **********************
' * Choix de la langue *
' **********************
Public Function SetLanguage(strLang As String) As Boolean
    SetLanguage = False

    ' vérifie l'existence du fichier
    If Dir(PathAddBackslash(App.Path) & PATHOFLANG & strLang & EXTENSION) <> "" Then
        mstrFileLang = PathAddBackslash(App.Path) & PATHOFLANG & strLang & EXTENSION
        SetLanguage = True
    ElseIf strLang = "" Then
        mstrFileLang = ""
    End If
End Function

Public Sub LoadFormLanguage(frmForSave As Form)
    If mstrFileLang = "" Then Exit Sub
    On Error Resume Next
    Dim cntEach As Control
    Dim strValue As String
    Dim strIndexMult As String

    ' récupere le nom de la fenetre Principale
    strValue = ""
    strValue = INIProfileRead("Caption", "", frmForSave.Name, mstrFileLang)
    If strValue <> "" Then
        frmForSave.Caption = StringUnEscape(strValue)
    End If

    ' pour chaque controle de la feuille
    For Each cntEach In frmForSave
        strIndexMult = ""
        ' pour les Instances multiple d'un controle ...
        strIndexMult = IIf(cntEach.Index <> 0, "_" & cntEach.Index, "")

        strValue = ""
        strValue = cntEach.Caption
        If strValue <> "" Then
            strValue = INIProfileRead(cntEach.Name & "_Caption" & strIndexMult, "", frmForSave.Name, mstrFileLang)
            If strValue <> "" Then
                cntEach.Caption = StringUnEscape(strValue)
            End If
        End If
        
        strValue = ""
        strValue = cntEach.Text
        If strValue <> "" Then
            strValue = INIProfileRead(cntEach.Name & "_Text" & strIndexMult, "", frmForSave.Name, mstrFileLang)
            If strValue <> "" Then
                cntEach.Text = StringUnEscape(strValue)
            End If
        End If
    Next
End Sub

' reprend un Msg qui est sauvegarder dans la Section [other]
Public Function LoadMsgLanguage(strMsgId As String, Optional strDefault As String = "") As String
    On Error Resume Next

    ' récupere le nom de la fenetre Principale
    LoadMsgLanguage = StringUnEscape(INIProfileRead(strMsgId, "", "other", mstrFileLang))
    If LoadMsgLanguage = "" Then
        SaveMsgLanguage strMsgId, strDefault
        LoadMsgLanguage = strDefault
    End If
End Function


' ***************************************
' * Renvoie un tableau de string        *
' * qui contient les langues disponible *
' ***************************************
Public Function GetChangeLang() As String()
    Dim strLang() As String
    Dim strTemp As String
    Dim i As Integer

    i = 0
    strTemp = Dir(PathAddBackslash(App.Path) & PATHOFLANG & "*" & EXTENSION)
    
    Do While strTemp <> ""
        ReDim Preserve strLang(i)
        strLang(i) = Left(strTemp, Len(strTemp) - 4)
        strTemp = Dir
        i = i + 1
    Loop
    
    GetChangeLang = strLang
End Function

Public Function StringEscape(strMsg As String) As String
    StringEscape = strMsg
    StringEscape = Replace(StringEscape, "\", "\\")
    StringEscape = Replace(StringEscape, vbCr, "\r")
    StringEscape = Replace(StringEscape, vbLf, "\f")
End Function

Public Function StringUnEscape(strMsg As String) As String
    StringUnEscape = strMsg
    StringUnEscape = Replace(StringUnEscape, "\r", vbCr)
    StringUnEscape = Replace(StringUnEscape, "\f", vbLf)
    StringUnEscape = Replace(StringUnEscape, "\\", "\")
End Function

Public Function PathAddBackslash(strPath As String) As String
    PathAddBackslash = strPath & IIf(Right(strPath, 1) = "\", "", "\")
End Function