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