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
>