Rocky Smolin at Beach Access Software
rockysmolin at bchacc.com
Sat Feb 21 09:02:52 CST 2009
John:
Thanks so much for your efforts. I'm just hitting the deck here so I
haven't tried it but I have no objection to posting it to AccessD - it's the
least I could do to contribute to the class class.
Rocky Smolin
Beach Access Software
858-259-4334
www.e-z-mrp.com
www.bchacc.com
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of jwcolby
Sent: Friday, February 20, 2009 11:10 PM
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] Rocky's translation tool finished.
We will have to see if Rocky will let us post his database example forms &
tables.
John W. Colby
www.ColbyConsulting.com
William Hindman wrote:
> ...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
>>
>
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com