[AccessD] Rocky's translation tool finished.

William Hindman wdhindman at dejpolsystems.com
Sat Feb 21 00:56:04 CST 2009


...thank you ...another toy to play with ...just what I needed :)

William

--------------------------------------------------
From: "jwcolby" <jwcolby at colbyconsulting.com>
Sent: Saturday, February 21, 2009 1:40 AM
To: "Access Developers discussion and problem solving" 
<accessd at databaseadvisors.com>
Subject: [AccessD] Rocky's translation tool finished.

> 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
> -- 
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
> 




More information about the AccessD mailing list