Drew Wutka
DWUTKA at Marlow.com
Tue Feb 24 12:52:01 CST 2009
No fair, I was sick this weekend! ;)
Looks good. I just posted mine a few minutes ago....
Drew
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of jwcolby
Sent: Saturday, February 21, 2009 12:41 AM
To: Access Developers discussion and problem solving
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
The information contained in this transmission is intended only for the person or entity to which it is addressed and may contain II-VI Proprietary and/or II-VI Business Sensitive material. If you are not the intended recipient, please contact the sender immediately and destroy the material in its entirety, whether electronic or hard copy. You are notified that any review, retransmission, copying, disclosure, dissemination, or other use of, or taking of any action in reliance upon this information by persons or entities other than the intended recipient is prohibited.