Créer une application multilangue (.ini) v 1.1.5

Télécharger le projet
Commenter

Description

Permets de faire une application multi-langue fort simplement ... ;-)
Grâce à des fichiers de type .ini
Votre application est donc très ouverte pour les changements de langues, n'importe qui peut traduire l'application dans son language

Source / Exemple : 


' 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

Conclusion :


Une Version un peu plus intelligente est en projet.
mais hélas le temps me manque ;-)

Historique Version :
Version 1.1.1 :
Ajout de la reconnaisait des contrôles multi-instance ;-) (ayant un index)
Version 1.1.5 :
Ajout support des textes multi-ligne grâce au caractère d'escape.
Ajout de CONSTANTE Pour personnalisé plus facilement le module.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (Icem@n)