[AccessD] Rocky's translation tool finished.

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




More information about the AccessD mailing list