VBLM_RTR.bas

'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