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

Soyez le premier à donner votre avis sur cette source.

Vue 10 834 fois - Téléchargée 1 341 fois

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

Ajouter un commentaire Commentaires
cs_mickei Messages postés 15 Date d'inscription vendredi 10 janvier 2003 Statut Membre Dernière intervention 3 octobre 2007
5 avril 2007 à 15:55
En fait ca ne ferait cela (suppression des champs ds le fichier default) que quand je n'ai aucune langue de choisie.
cs_mickei Messages postés 15 Date d'inscription vendredi 10 janvier 2003 Statut Membre Dernière intervention 3 octobre 2007
5 avril 2007 à 15:45
Vraiment super comme code, j'ai mis 9 car perso j'ai un petit soucis quand danss mon code je modifie les captions de mes contrôles.
Je me sers de LoadMsgLanguage avec : XXX.caption = LoadMsgLanguage("dsd")
sauf que lors de la création du fichier il se passe une couille, dsd est égale à vide ds le fichier même si j'ai fait la sauvegarde avec une valeur par défaut.
En gros ton code ne différencie pas une attribution du caption par défaut et quand on fait la modification de façon dynamique dans le programme.
Pour contourner le problème j'ai utilisé une variable.
greffierjc Messages postés 13 Date d'inscription vendredi 21 mars 2003 Statut Membre Dernière intervention 21 novembre 2009
6 juin 2006 à 12:46
Bonjour,

Merci, quand même de votre réponse.

Amicalement.

Greffier.
Icem@n Messages postés 34 Date d'inscription jeudi 29 juin 2000 Statut Membre Dernière intervention 27 octobre 2003
6 juin 2006 à 12:05
Bonjour,
déjà merci pour vos nombreux commentaires ;)

C17 >
Je ne sais ce qu'il est des limites des Fichiers INI je ne les ai pas encore atteinte ;), mais une solution serais alors de splitter en plusieurs fichiers ini, par exemple par Formulaire ... ;)

greffierjc >
Je n'ai jamais reporté ça en VBA, et je doute que ce soit utilisable sans de nombreuse modification ...

BàV,
Icem@n
greffierjc Messages postés 13 Date d'inscription vendredi 21 mars 2003 Statut Membre Dernière intervention 21 novembre 2009
6 juin 2006 à 11:55
Bonjour,

Tout le monde vous félicite, mois aussi, c'est un papy qui vous le dit. Mais j'aimerais que vous me disiez si votre programmation peut s'appliquer à un programme access en séquence VBA, et si vous l'aviez déjà fait.
Dans le cas contraire comment adapter votre programmation aux formulaires d'access.

Merci, pour votre réponse.

Greffier.
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)