[AccessD] Rocky's translation tool finished.

jwcolby jwcolby at colbyconsulting.com
Sat Feb 21 00:40:32 CST 2009


Roughly 1.5 hours from receipt of email to back out the door to Rocky

Two classes, clsXlateFrm and clsXlateSupervisor and a simple module for initialization.  Each form 
loads the form class from its open event.  Translation happens then and there.  Strings cached to a 
collection for that form and will load from the cache each time.

Understand this is just the basics, no fancy error handling or interface around the translation. 
The important thing for me is to have the code for the system in a known place to add functionality 
(additional properties such as tool tip etc.) should there ever be a need.  Neatly organized, easy 
to understand, fast, efficient, easy to program.

'---------------------------------------------------------------------------------------
' Module    : clsXlateFrm
' Author    : jwcolby
' Date      : 2/21/2009
' Purpose   : This class loads all of the phrase strings into a collection for a single form
'               the first time the form loads, keyed on control name.  It ignores control
'               names not in the language table.
'
'               It then uses those strings in the collection to translate the form.
'               The second and subsequent times the form loads, the class already has the
'               strings in the collection so the collection load does not happen again (cached)
'               and the translation happens from the collection.
'---------------------------------------------------------------------------------------
Const cstrModule As String = "clsXlateFrm"
Option Compare Database
Option Explicit

Private mcolPhrase As Collection
Private mstrName As String
Private mstrLanguageFldName As String

Private Sub Class_Initialize()
     Set mcolPhrase = New Collection
End Sub

Private Sub Class_Terminate()
     Set mcolPhrase = Nothing
End Sub

'---------------------------------------------------------------------------------------
' Procedure : mInit
' Author    : jwcolby
' Date      : 2/21/2009
' Purpose   : Called the first time the form loads.  Loads the translation phrases from the table
'               and translates the form.
'---------------------------------------------------------------------------------------
'
Function mInit(lfrm As Form, lstrLanguageFldName As String)
     mstrName = lfrm.Name
     mstrLanguageFldName = lstrLanguageFldName
     '
     'If nothing in the collection then load the collection
     '
     If Not mcolPhrase.Count Then
         mLoadColPhrase
     End If
     '
     'Now translate the form
     '
     mXlateFrm lfrm
End Function

Property Get pName() As String
     pName = mstrName
End Property

Function colPhrase() As Collection
     Set colPhrase = mcolPhrase
End Function
'---------------------------------------------------------------------------------------
' Procedure : mXlateFrm
' Author    : jwcolby
' Date      : 2/21/2009
' Purpose   : This function trnaslates the form.  By the time this function is called the
'               collection already contains all of the translation strings keyed by the
'               control name.  All it has to do is attempt to index into the collection
'               using each control name.  If there is something in the collection for that
'               control name then the string is returned from the collection and placed in
'               the control property.
'
'               if nothing there, the error is ignored and the next control is tried.
'---------------------------------------------------------------------------------------
'
Function mXlateFrm(frm As Form)
Dim ctl As Control
On Error GoTo Err_mXlateFrm

     '
     'Check every control on the form
     'Expand this case to add new control types.
     For Each ctl In frm.Controls
         Select Case ctl.ControlType
         Case acLabel
             '
             'Try to get a translation phrase from the collection
             'Any errors will be ignored
             ctl.Caption = mcolPhrase(ctl.Name)
         Case acCommandButton
             ctl.Caption = mcolPhrase(ctl.Name)
         Case Else
         End Select
     Next ctl

Exit_mXlateFrm:
     On Error Resume Next
     Exit Function
Err_mXlateFrm:
     Select Case Err
     Case 0      '.insert Errors you wish to ignore here
         Resume Next
     Case 5      'Control name not in translation table, ignore the error
         Resume Next
     Case Else   '.All other errors will trap
         Beep
         MsgBox Err.Number & ":" & Err.Description
         Resume Exit_mXlateFrm
     End Select
     Resume 0    '.FOR TROUBLESHOOTING
End Function
'---------------------------------------------------------------------------------------
' Procedure : mLoadColPhrase
' Author    : jwcolby
' Date      : 2/21/2009
' Purpose   : Loads the translation phrase strings out of the table for one form
'               Builds a query dynamically based on the form name and the translation
'               language field name
'---------------------------------------------------------------------------------------
'
Private Function mLoadColPhrase()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String

On Error GoTo Err_mLoadColPhrase

     '
     'Dynamically build the query to pull the translation strings for a specific form and language
     '
     strSQL = "SELECT fldLanguageForm, fldLanguageControl, " & mstrLanguageFldName & " " & _
                 "FROM [tblLanguage-Controls] " & _
                 "WHERE ((([tblLanguage-Controls].fldLanguageForm)='" & mstrName & "'));"
     Set db = CurrentDb
     Set rst = db.OpenRecordset(strSQL)
     With rst
         While Not .EOF
             '
             'Drop all phrases found into the phrase collection
             'Keyed on the control name fldLanguageControl
             '
             mcolPhrase.Add .Fields(mstrLanguageFldName).Value, .Fields("fldLanguageControl").Value
             .MoveNext
         Wend
     End With

Exit_mLoadColPhrase:
     On Error Resume Next
     Exit Function
Err_mLoadColPhrase:
     Select Case Err
     Case 0      '.insert Errors you wish to ignore here
         Resume Next
     Case Else   '.All other errors will trap
         Beep
         MsgBox Err.Number & ":" & Err.Description
         Resume Exit_mLoadColPhrase
     End Select
     Resume 0    '.FOR TROUBLESHOOTING
End Function

Option Compare Database
Option Explicit

Private mcolClsXlateFrm As Collection

Private Sub Class_Initialize()
     Set mcolClsXlateFrm = New Collection
End Sub

Private Sub Class_Terminate()
     Set mcolClsXlateFrm = Nothing
End Sub

'---------------------------------------------------------------------------------------
' Procedure : mTranslateFrm
' Author    : jwcolby
' Date      : 2/21/2009
' Purpose   : Performs the translation for one form passed in.
'---------------------------------------------------------------------------------------
'
Function mTranslateFrm(lfrm As Form, lstrLanguageFldName As String)
Dim lclsXlateFrm As clsXlateFrm
On Error GoTo Err_mTranslateFrm

     On Error Resume Next
     '
     'Try to get an instance of the clsXlateFrm from the collection for this form
     '
     Set lclsXlateFrm = mcolClsXlateFrm(lfrm.Name)
     If Err Then
         '
         'If that fials then this is the first time so perform the initialize
         '
         Set lclsXlateFrm = New clsXlateFrm
         '
         'Now that we have an instance for this form perform the load and translation
         '
         lclsXlateFrm.mInit lfrm, lstrLanguageFldName
         '
         'And save the instance to the collection for the next time
         '
         mcolClsXlateFrm.Add lclsXlateFrm, lfrm.Name
     Else
         '
         'We have already loaded this form once so perform the translation
         '
         lclsXlateFrm.mXlateFrm lfrm
     End If

Exit_mTranslateFrm:
     On Error Resume Next
     Exit Function
Err_mTranslateFrm:
     Select Case Err
     Case 0      '.insert Errors you wish to ignore here
         Resume Next
     Case Else   '.All other errors will trap
         Beep
         MsgBox Err.Number & ":" & Err.Description
         Resume Exit_mTranslateFrm
     End Select
     Resume 0    '.FOR TROUBLESHOOTING
End Function
'
'Return a pointer to colClsXlateFrm
'
Property Get colClsXlateFrm() As Collection
     Set colClsXlateFrm = mcolClsXlateFrm
End Property


'---------------------------------------------------------------------------------------
' Module    : basXlate
' Author    : jwcolby
' Date      : 2/21/2009
' Purpose   : Functions to initialize, terminate and return a pointer to clsXlateSupervisor
'               as well as a global variable for the translation string field name.
'---------------------------------------------------------------------------------------
Const cstrModule As String = "basXlate"
Option Compare Database
Option Explicit

Private mclsXlateSupervisor As clsXlateSupervisor
'
'Set this variable to the name of the field holding the translation language strings
'
'fldLanguageEnglish
'fldLanguageChineseComplex
'etc
'
Public mstrLanguageFldName As String

Function mXlateSupervisorInit()
     If mclsXlateSupervisor Is Nothing Then
         Set mclsXlateSupervisor = New clsXlateSupervisor
         mstrLanguageFldName = "fldLanguageSpanish"  'Default language to English
     End If
     Set mXlateSupervisorInit = mclsXlateSupervisor
End Function
Function mXlateSupervisorTerm()
     Set mclsXlateSupervisor = Nothing
End Function
Function cXS() As clsXlateSupervisor
     Set cXS = mXlateSupervisorInit()
End Function


-- 
John W. Colby
www.ColbyConsulting.com



More information about the AccessD mailing list