'VBLM_RTR.BAS: VB Language Manager Runtime Language Switching Support Module
'Copyright 1994-2002 by WhippleWare, All Rights Reserved
'Language Database Format Supported: Resource File
'Support for Runtime Switching of Interface Dimensions: No
'Write Language Selection to Registry: No
'Read Language Selection from Registry: No
Option Explicit
DefLng A-Z
'Language Selected by user or command line
Dim mlSelectedLanguage As Long
'=================================================================
'The VBLM_RTString function is the core of runtime switching (RSV)
'
'All translated strings and properties have been replaced with
'calls to VBLM_RTString
'
'The function is passed an index and returns a string
'The first call initializes the database
'You can also force reinitialization (ie change languages) by passing
'a value of -1 as the Index argument
'
'=================================================================
'
Function VBLM_RTString(Index As Long) As String
'=================================================================
' LOCAL DECLARATIONS
'=================================================================
'REINIT_LDB is the Index value that forces reinitializtion
Const REINIT_LDB = -1
' STATIC VARIABLES
'iInitialized is the initialization flag that causes this
'function to prompt the user for a language choice, but only
'the first time it is called, or when passed REINIT_LDB
Static iInitialized As Integer
'lCurrentOffset is the offset used to return strings from the
'selected language
Static lCurrentOffset As Long
'=================================================================
' TRANSIENT VARIABLES USED ONLY DURING INITIALIZATION
'lNumLanguages = number of languages available
Dim lNumLanguages As Long
'li = iteration index
Dim li As Long
'lEachLanguageOffset is the offset between each language in
'the resource file
Dim lEachLanguageOffset As Long
'sLanguages() = Names of Languages in the the database
Dim sLanguages() As String
'=================================================================
' EXECUTABLE CODE BEGINS HERE
'=================================================================
'INITIALIZATION CODE: EXECUTES ON FIRST CALL OR WHEN INDEX = REINIT_LDB
'=================================================================
'Handle is used as the initialization flag
If iInitialized = False Or Index = REINIT_LDB Then
'Default Error handling
On Error GoTo RTS_Error
'reset language choice (needed for switch-on-the-fly
mlSelectedLanguage = 0
'get the number of languages and redim name and offset arrays
'NOTE: VBLM appends the GetLanguages() routine to this module during
'a build, as it is composed of build-specific information
lNumLanguages = GetLanguages(sLanguages(), lEachLanguageOffset)
'if only one language in database, select it
If lNumLanguages = 1 Then mlSelectedLanguage = 1
'check command line and registry entry for language choice
If mlSelectedLanguage = False Then
For li = 1 To lNumLanguages
If InStr(1, Command$, "/L=" & sLanguages(li), 1) Then mlSelectedLanguage = li
Next
End If
'else if language not specified on command line, query the user
If mlSelectedLanguage = False Then
'load the rts support form, and fill in the list of language choices
Load frmVBLM_RTS
For li = 1 To lNumLanguages
frmVBLM_RTS.lstLanguages.AddItem sLanguages(li)
Next
'center it on the screen, set an arrow cursor, show it modally
frmVBLM_RTS.Move (Screen.Width - frmVBLM_RTS.Width) \ 2, (Screen.Height - frmVBLM_RTS.Height) \ 2
Screen.MousePointer = 1
frmVBLM_RTS.Show 1
'get the selected language and unload
mlSelectedLanguage = frmVBLM_RTS.lstLanguages.ListIndex + 1
Unload frmVBLM_RTS
End If
lCurrentOffset = (mlSelectedLanguage - 1) * lEachLanguageOffset
'mark as Initialized
iInitialized = True
'and bail if just here to reinit
If Index = REINIT_LDB Then Exit Function
End If
'=================================================================
' END OF INITIALIZATION CODE
' FOLLOWING CODE EXECUTES ON ALL CALLS TO RETURN THE STRING
'=================================================================
'only one likely error, so deal with it as needed
On Error Resume Next
'return string from array
VBLM_RTString = LoadResString(lCurrentOffset + Index)
'error: invalid index
If Err Then VBLM_RTString = "Invalid Index"
Exit Function
'=================================================================
' END OF MAIN FUNCTION CODE
'=================================================================
' default error handler
'=================================================================
RTS_Error:
Select Case MsgBox(Error$ & "(Code" & Str$(Err) & ")", vbExclamation + vbAbortRetryIgnore, "VBLM_RTString()")
Case vbABORT
End
Case vbRETRY
Resume
Case vbIGNORE
Resume Next
Case Else
End Select
End Function
Sub VBLM_UserPrefixCode(frm As Form)
'This stub is the default "User Prefix" code that will be called
'in the VBLM_SetProperties event when the "Include User Code"
'RSV option is checked. Code inserted here will be executed whenever
'RSV forms load or are refreshed by VBLM_SwitchOnTheFly.
'
'This allows you to customize the form initialization process.
'
'Note that the prefix code is called FIRST in VBLM_SetProperties.
'If you want your code to execute LAST, put it in VBLM_UserSuffixCode.
'
'Note also that you can change the names of this procedure, call multiple
'procedures, etc etc, by modifying the UserPrefix and/or UserSuffix.
'
End Sub
Sub VBLM_UserSuffixCode(frm As Form)
'This stub is the default "User Suffix" code that will be called
'in the VBLM_SetProperties event when the "Include User Code"
'RSV option is checked. Code inserted here will be executed whenever
'RSV forms load or are refreshed by VBLM_SwitchOnTheFly.
'
'This allows you to customize the form initialization process.
'
'Note that the suffix code is called LAST in VBLM_SetProperties.
'If you want your code to execute FIRST, put it in VBLM_UserPrefixCode.
'
'Note also that you can change the names of this procedure, call multiple
'procedures, etc etc, by modifying the UserPrefix and/or UserSuffix. You
'are given the opportunity to do so whenever you turn on "Include User Code"
'A big HATS OFF to Ron Gordon at GGT for suggesting this feature!
'
End Sub