Attribute VB_Name = "LG"
Option Explicit


' This is the string to search for when substituting a parameter
Const MG_PARAM_TOKEN = "<p>"

' These values represent the buttons on a three button dialogue
Global Const gMG_ASK_YES = 1
Global Const gMG_ASK_NO = 2
Global Const gMG_ASK_CANCEL = 3

' Associated constants for the message severity
Global Const gMG_SEV_FATAL = 1
Global Const gMG_SEV_WARN = 2
Global Const gMG_SEV_INFO = 3
Global Const gMG_SEV_ERROR = 4
Global Const gMG_SEV_NONE = 0

' Global constants for Visual Basic error numbers
Global Const gERR_NO_SELTEXT_PROP = 438
Global Const gERR_CANNOT_CREATE_OBJECT = 429
Global Const gERR_NO_TIMER = 260
Global Const gERR_NO_NOPANEL = 438


' These are PUBLIC constants for the validation routines,
' used to determine, by the caller, what kind
' of case the text should be forced to.
Global Const gVL_CASE_MIXED = 0
Global Const gVL_CASE_UPPER = 1
Global Const gVL_CASE_LOWER = 2   ' Not yet implemented
Global Const gVL_CASE_PROPER = 3  ' Not yet implemented


' This constant is used to determine the character used for the decimal
' place. This *can* be changed from the Control Panel, so as a consequence
' this will have to be changed here as well.
Global Const gVL_DECIMAL_POINT = "."


' Type to hold the size and position of a control or form
Type lgRect
  sngLeft As Long
  sngTop As Long
  sngWidth As Long
  sngHeight As Long
End Type

' Constants for use in a call to lgRszAddControl to indicate the
' resizing / repositioning requirements
Global Const gRszRESIZE_HORIZ = 1  ' Resize the width of the control
Global Const gRszRESIZE_VERT = 2   ' Resize the height of the control
Global Const gRszREPOS_HORIZ = 4     ' Move the control's Left coordinate
Global Const gRszREPOS_VERT = 8      ' Move the control's Right coordinate


' Constant offset value for positioning of mulitiple (modeless) property sheet dialogs.
Global Const gDLG_OFFSET = 327


' Type to hold the value, abberviation and meaning within a domain
Type lgDomain
   Value   As String
   Abbrev  As String
   Meaning As String
End Type

' Domain Validation Constants
Global Const gDV_UNKNOWN_OPT_CODE = "?"
Global Const gDV_NO_ROWS_MATCH = -1
Global Const gDV_TOO_MANY_ROWS_MATCH = -2


' Constants for use in a call to zone Validate pseudo-event to indicate
' action being performed
Global Const gACTION_INSERT = 1
Global Const gACTION_UPDATE = 2
Global Const gACTION_QUERY = 3

' Zone Coordination constants
Global Const gZC_DETAIL_FORM_CLEAR = 0
Global Const gZC_DETAIL_FORM_COORDINATED = 1
Global Const gZC_DETAIL_FORM_AWAITING_COORD = 2

' ShortCut key for invoking LOV dialog (KeyAscii parameter in KeyPress event)
Global Const gLOVKeyAscii = 12 ' Asc("L") - 64 = Ctrl+L

' Constants used by WinHelp
Global Const gHELP_CONTENTS = &H3
Global Const gHELP_PARTIALKEY = &H105

' WINDOWS API FUNCTIONS
#If Win32 Then
  ' Used in getting/setting radio group values
   Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
  ' Used for reading and writing the runtime ini file
  Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
  Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
  Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
  Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hWnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long
#Else
  ' Used in getting/setting radio group values
  Declare Function GetParent Lib "User" (ByVal hWnd As Integer) As Integer
  ' Used for reading and writing the runtime ini file
  Declare Function GetPrivateProfileInt Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Integer, ByVal lpFileName As String) As Integer
  Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lplFileName As String) As Integer
  Declare Function WinHelp Lib "User" (ByVal hWnd As Integer, ByVal lpHelpFile As String, ByVal wCommand As Integer, dwData As Integer) As Integer
#End If
  
' Runtime location used for saving username/database in logon form,
' plus other runtime options.
Global Const gDfltSection = "General"
      
' Runtime options whose values we track during the session, and
' typically initialise at startup from the runtime ini file
Public gbAutoCommit As Integer
Public gbCoordOnActivate As Integer
Public gbCloseDetailsOnDisable As Integer

' ini file parameter definitions
Global Const gINI_AUTO_COMMIT = "AutoCommit"
Global Const gINI_COORD_ON_ACTIVATE = "CoordOnActivate"
Global Const gINI_CLOSE_DETAILS_ON_DISABLE = "CloseDetailsOnDisable"
Global Const gINI_HINT_TIMER_DELAY = "HintTimerDelay"
Global Const gINI_GIVE_TRACE_OPTION = "LogonSQLTrace"
Global Const gINI_LAST_USERNAME = "LogonLastUsername"
Global Const gINI_LAST_DATABASE = "LogonLastDatabase"
Global Const gINI_PASSWORD_IS_USER = "LogonPasswordIsUsername"
Global Const gINI_LOV_POS = "LovPos"

' VB code for OLE Automation Error
Global Const gOLE_AUTOMATION_ERROR = 440

' Global to turn off the firing of LostFocus validation
Public gNoLostFocusValidation As Integer

' Globals, Constants and API calls used for hint text
Public gintHintTimerDelay As Integer
Global Const gHT_SHORT_DELAY = 250
Global Const gHT_LONG_DELAY = 2000

#If Win32 Then
    Type RECT
            Left As Long
            Top As Long
            Right As Long
            Bottom As Long
    End Type
    Type POINTAPI
            X As Long
            Y As Long
    End Type
    Type memoryStatus
            dwLength As Long         ' sizeof(MEMORYSTATUS)
            dwMemoryLoad As Long     ' percent of memory in use
            dwTotalPhys As Long      ' bytes of physical memory
            dwAvailPhys As Long      ' free physical memory bytes
            dwTotalPageFile As Long  ' bytes of paging file
            dwAvailPageFile As Long  ' free bytes of paging file
            dwTotalVirtual As Long   ' user bytes of address space
            dwAvailVirtual As Long   ' free user bytes
    End Type

#Else
    Type RECT
            Left As Integer
            Top As Integer
            Right As Integer
            Bottom As Integer
    End Type
    
    Type POINTAPI
            X As Integer
            Y As Integer
    End Type
#End If

#If Win32 Then
  Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
  Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
#Else
  Declare Sub GetWindowRect Lib "User" (ByVal hWnd As Integer, lpRect As RECT)
  Declare Sub GetCursorPos Lib "User" (lpPoint As POINTAPI)
  Declare Function WindowFromPoint Lib "User" (ByVal yPoint As Integer, ByVal xPoint As Integer) As Integer
#End If

' Constant used in building Row Caption
Global Const gCURRENT_ROW_CAPTION = -1

' Constants to represent difference in form size and its Client Area
Global Const gHEIGHT_ADJUSTMENT = 400
Global Const gWIDTH_ADJUSTMENT = 100

Sub lgCallDVLOV(ByVal pstrTitle As String, paDomain() As lgDomain, _
                pctrlCode As Control, pctrlMeaning As Control, _
                pstrRestrictBy As String)
'
' DESCRIPTION
' This routine is used to offer a list of values based on a domain to the user
' for selection.  The routine populates and then displays the form frmlgDVLOV
' as an LOV form.  If the parameter pctrlMeaning is not null, then the meanings
' of the domain are displayed, otherwise the codes.
' On return from the LOV form, if a value was selected, it is copied into the
' code, and optionally the meaning, controls.
'
' PARAMETERS
' pstrTitle        IN  The LOV title
' paDomain         IN  The domain array of values and meanings
' pstrRestrictBy   IN  Restrict list by this string
' pctrlCode        OUT The control to hold the domain value
' pctrlMeaning     OUT The control to hold the domain meaning, (Optional)

Dim i As Integer
Dim intNumAdded As Integer
Dim strListVal As String
Dim ctlLOVList As Control
Dim bUseMeaning As Boolean
Dim bAddToList As Boolean

   ' If a meaning control is specified, then use the meanings
   If pctrlMeaning Is Nothing Then
     bUseMeaning = False
   Else
     bUseMeaning = True
   End If

   ' Populate the list box in the LOV form with the codes or meanings
   ' of the domain
   Set ctlLOVList = frmlgDVLOV!lstLOV
   ctlLOVList.Clear
   intNumAdded = 0
   For i = LBound(paDomain) To UBound(paDomain)

     If bUseMeaning Then
       strListVal = paDomain(i).Meaning
     Else
       strListVal = paDomain(i).Value
     End If

     bAddToList = True
     If (strListVal = "") Then
        bAddToList = False
     Else
        If pstrRestrictBy <> "" Then
           If InStr(strListVal, pstrRestrictBy) <> 1 Then
              bAddToList = False
           End If
        End If
     End If

     If bAddToList Then
       intNumAdded = intNumAdded + 1
       ctlLOVList.AddItem strListVal
     End If

   Next i

   ' If nothing was added to the list, try again with no restriction
   If intNumAdded = 0 And pstrRestrictBy <> "" Then
      Call lgCallDVLOV(pstrTitle, paDomain(), pctrlCode, pctrlMeaning, "")

   ' If only one entry matches the restriction, skip LOV invocation
   ElseIf intNumAdded = 1 And pstrRestrictBy <> "" Then
     frmlgDVLOV.mintSelection = 0
     frmlgDVLOV.mstrAction = "OK"

   ' Otherwise, invoke LOV
   Else
      ' Set the LOV title
      frmlgDVLOV.mstrTitle = pstrTitle

      ' Reposition and resize the form to its previous runtime location/size
      ' by reading in the values saved in the runtime ini file.
      frmlgDVLOV.Position

      ' Invoke the LOV
      frmlgDVLOV.Show vbModal
   End If

   ' If the OK button was pressed and an item was selected,
   ' copy the value, and optionally meaning, to the controls
   If frmlgDVLOV.mstrAction = "OK" And frmlgDVLOV.mintSelection <> -1 Then
     
     ' Find the matching value
     For i = LBound(paDomain) To UBound(paDomain)
        If bUseMeaning Then
          strListVal = paDomain(i).Meaning
        Else
          strListVal = paDomain(i).Value
        End If
        If (strListVal = ctlLOVList.List(frmlgDVLOV.mintSelection)) Then
           Exit For
        End If
     Next i

     pctrlCode = paDomain(i).Value
     If bUseMeaning Then
       pctrlMeaning = paDomain(i).Meaning
     End If
   End If

End Sub

Sub lgCentralizeForm(pfrm As Form, Optional pfrmMain As Variant)
'
' DESCRIPTION
' This routine positions the given form
' in the centre of the screen.
'
' PARAMETERS
' pfrm     IN  Form to be centralized
' pfrmMain IN  The Main form if MDI
'
' if the second parameter is missing, assume non-MDI form

Dim intHeight As Integer
Dim intWidth As Integer
Dim intTop As Integer
Dim intLeft As Integer
Dim intLeftOffSet As Integer
Dim intTopOffSet As Integer

  If Not IsMissing(pfrmMain) Then
    intHeight = pfrmMain.ScaleHeight
    intWidth = pfrmMain.ScaleWidth
    intTop = pfrmMain.Top
    intLeft = pfrmMain.Left
  Else
    intHeight = Screen.Height
    intWidth = Screen.Width
    intTop = 0
    intLeft = 0
  End If
        
  ' Get left offset
  intLeftOffSet = ((intWidth - pfrm.Width) / 2) + intLeft
  If (intLeftOffSet + pfrm.Width > Screen.Width) Or intLeftOffSet < 100 Then
    intLeftOffSet = 100
  End If

  ' Get top offset
  intTopOffSet = ((intHeight - pfrm.Height) / 2) + intTop
  If (intTopOffSet + pfrm.Height > Screen.Height) Or intTopOffSet < 100 Then
    intTopOffSet = 100
  End If

  ' Centre the form
  pfrm.Move intLeftOffSet, intTopOffSet

End Sub

Function lgCtrlCheckBoxGet(pctl As Control, ByVal pstrTrue As String, ByVal pstrFalse As String) As Variant
'
' DESCRIPTION
' This gets a checkbox control's value.  The values that
' represent the checkbox's true and false values are passed in.
' If the checkbox is set to its 'Grayed' state (if it supports one),
' then Null is returned.
'
' PARAMETERS
' pctl         IN   The control we are getting the value of
' pvarTrue     IN   The checkbox's true value
' pvarFalse    IN   The checkbox's false value
'
' RETURNS
' True  - The control is set to true
' False - The control is set to false
' Null  - The control is set to its 'Grayed' state

  ' Handle True/False SS checkbox
  If TypeOf pctl Is SSCheck Then
    If pctl = True Then
      lgCtrlCheckBoxGet = pstrTrue
    Else
      lgCtrlCheckBoxGet = pstrFalse
    End If

  ' Else assume checkbox has 0,1,2 values for Checked,Unchecked,Grayed
  Else
    If pctl = 1 Then                 ' Checked
      lgCtrlCheckBoxGet = pstrTrue
    ElseIf pctl = 0 Then             ' Unchecked
      lgCtrlCheckBoxGet = pstrFalse
    Else                             ' Grayed State
      lgCtrlCheckBoxGet = Null
    End If
  End If

End Function

Function lgCtrlCheckBoxGetQD(pctl As Control, ByVal pstrTrue As String, ByVal pstrFalse As String) As Variant
'
' DESCRIPTION
' This gets a checkbox control's value when used in a Query Dialog, i.e.
' the value to be encorporated into the SQL where clause.  The values that
' represent the checkbox's true and false values are passed in.
' The value Null should be returned if the control is not to participate
' in the query.  The value "IS NULL" should be returned if a query for NULL
' values is to be performed.
'
' PARAMETERS
' pctl         IN   The control we are getting the value of
' pvarTrue     IN   The checkbox's true value
' pvarFalse    IN   The checkbox's false value
'
' RETURNS
' True      - The control is set to true
' False     - The control is set to false
' Null      - The control is not to participate in the query
' "IS NULL" - A query for null values is to be performed

Dim varReturn As Variant

  ' Handle True/False SS checkbox.    Note if a 2 state checkbox
  ' is used in a query dialog, then we can only support a search for the
  ' true value (unchecked state representing 'dont include in query').
  If TypeOf pctl Is SSCheck Then
    If pctl = True Then
      varReturn = pstrTrue
    Else
      varReturn = Null
    End If

  ' Else assume checkbox has 0,1,2 values for Checked,Unchecked,Grayed
  Else
    If pctl = 1 Then                 ' Checked
      varReturn = pstrTrue
    ElseIf pctl = 0 Then             ' Unchecked
      varReturn = pstrFalse
    Else                             ' Grayed State
      varReturn = Null
    End If
  End If

  ' If the checkbox's true or false value is an empty string, then we return
  ' 'IS NULL' to allow search for null values'
  If varReturn = "" Then
    lgCtrlCheckBoxGetQD = gSQL_KEYWD_ISNULL
  Else
    lgCtrlCheckBoxGetQD = varReturn
  End If

End Function

Sub lgCtrlCheckBoxSet(pctl As Control, ByVal pstrTrue As String, ByVal pstrFalse As String, pvarValue As Variant)
'
' DESCRIPTION
' This sets a checkbox control to the given value.  The values that
' represent the checkbox's true and false values are also passed in.
' If Null is passed in, the checkbox should be set to its 'Grayed'
' state (if it supports one) to indicate the value of the checkbox is
' unknown (rather than either of the true/false values.
'
' PARAMETERS
' pctl         IN     The control we are setting
' pvarTrue     IN     The checkbox's true value
' pvarFalse    IN     The checkbox's false value
' pvarValue    INOUT  The value to set the checkbox - Should be either
'                     the True value, False value, or Null.


  ' Handle True/False SS checkbox
  If TypeOf pctl Is SSCheck Then
    If IsNull(pvarValue) Then
      pctl = False   ' Unchecked
    ElseIf CStr(pvarValue) = pstrTrue Then
      pctl = True    ' Checked
    ElseIf CStr(pvarValue) = pstrFalse Then
      pctl = False   ' Unchecked
    ElseIf CStr(pvarValue) = "" Then
      pctl = False   ' Unchecked
    Else
      pctl = False   ' Unchecked
      Call lgMsg(glmgCTRL_CHECKBOX & lgMsgSubst(glmgCTRL_SET_BAD_VALUE, CStr(pvarValue)), gMG_SEV_WARN)
    End If

  ' Else assume checkbox has 0,1,2 values for Checked,Unchecked,Grayed
  Else
    If IsNull(pvarValue) Then
      pctl = 2   ' Grayed State
    ElseIf CStr(pvarValue) = pstrTrue Then
      pctl = 1   ' Checked
    ElseIf CStr(pvarValue) = pstrFalse Then
      pctl = 0   ' Unchecked
    ElseIf CStr(pvarValue) = "" Then
      pctl = 0   ' Unchecked
    Else
      pctl = 2   ' Grayed State
      Call lgMsg(glmgCTRL_CHECKBOX & lgMsgSubst(glmgCTRL_SET_BAD_VALUE, CStr(pvarValue)), gMG_SEV_WARN)
    End If
  End If

End Sub

Function lgCtrlDVListGet(pctlListCtrl As Control, paDomain() As lgDomain) As Variant
'
' DESCRIPTION
' This function returns the code associated with the current selected item
' in the given list control.  This may be the value of the list control
' itself, but to allow for the list control displaying meanings rather than
' the code, the code is obtained from the associated domain array.
' If no item is selected then Null is returned.  If the unknown value is
' selected then an empty string is returned, otherwise just the code section
' of the selected item is returned.
' This function is called by generated code, and function lgCtrlDVListGetQD.
'
' PARAMETERS
' pctlListCtrl  IN  The list control containing the selected code string
' paDomain      IN  The domain array of values and meanings

' RETURNS
' Null          - If no item selected
' String        - The code section of the selected item
' Empty string  - If the unknown option was chosen


  ' If no item selected from
  ' the list, return NULL.
  If pctlListCtrl.ListIndex = -1 Then
    lgCtrlDVListGet = Null
  Else
    ' Return the code section
    lgCtrlDVListGet = paDomain(pctlListCtrl.ListIndex + LBound(paDomain)).Value
  End If

End Function

Function lgCtrlDVListGetQD(pctlListCtrl As Control, paDomain() As lgDomain) As Variant
'
' DESCRIPTION
' This routine gets a list control's value when used in a Query Dialog, i.e.
' the value to be encorporated into the SQL where clause.
' This function is called by generated code.
'
' PARAMETER
' pctlListCtrl  IN  The list control from which to obtain the value
' paDomain      IN  The domain array of values and meanings
'
' RETURNS
' Null      -  If no item is selected in the given list control
' "IS NULL" -  If the selected value of the given list control
'              represents a NULL value
' String    -  The selected value of the given list control otherwise

Dim varValue As Variant

  ' Get the selected value of the given control
  varValue = lgCtrlDVListGet(pctlListCtrl, paDomain())

  ' If no value was selected then return NULL
  ' elseif the value is unknown then return
  ' "IS NULL" otherwise return the selected value.
  If IsNull(varValue) Then
    lgCtrlDVListGetQD = Null
  ElseIf varValue = "" Then
    lgCtrlDVListGetQD = gSQL_KEYWD_ISNULL
  Else
    lgCtrlDVListGetQD = varValue
  End If


End Function

Sub lgCtrlDVListPopulate(paDomain() As lgDomain, ByVal pbUseMeaning As Integer, pctrlList As Control)
'
' DESCRIPTION
' This routine populates the given list control with values from the
' given domain array.  The text added to the list will be either the
' value or meaning of the domain as defined by the parameter pbUseMeaning.
' An empty string in the domain will be represented in the list as the
' "Unknown Option" code or string.  This procedure is called by generated code.
'
' PARAMETERS
' paDomain      IN  The domain array of values and meanings
' pbUseMeaning  IN  Populate with meanings or codes
' pctrlList     OUT The list control to be populated

Dim i As Integer
Dim strListVal As String

   For i = LBound(paDomain) To UBound(paDomain)
      If pbUseMeaning Then
         strListVal = paDomain(i).Meaning
         If strListVal = "" Then
            strListVal = glmgDV_UNKNOWN_OPT_STRING
         End If
      Else
         strListVal = paDomain(i).Value
         If strListVal = "" Then
            strListVal = gDV_UNKNOWN_OPT_CODE
         End If
      End If
      pctrlList.AddItem strListVal
   Next i

End Sub

Sub lgCtrlDVListSet(pctlListCtrl As Control, paDomain() As lgDomain, ByVal pvarValue As Variant)
'
' DESCRIPTION
' This routine sets the given list control to the given value.
' If Null is passed in, then no listitem is highlighed,
' otherwise the domain is searched for the given value, and if
' found, the item is selected.  This procedure is called by
' generated code.
'
' PARAMETERS
' pctlListCtrl  IN  The list control to be set
' paDomain      IN  The domain array of values and meanings
' pvarValue     IN  The value to be selected

Dim i As Integer
Dim strListItem As String

  ' Attempt to set the list control to the given value,
  ' only if the given value is not null.
  If IsNull(pvarValue) Then

    ' Deselect any selected list entry.
    pctlListCtrl.ListIndex = -1
  Else
    ' Look at the code of each item in the domain.
    ' If find a code that matches the given value, select the listitem.
    For i = LBound(paDomain) To UBound(paDomain)
      strListItem = paDomain(i).Value
      If strListItem = pvarValue Then
        pctlListCtrl.ListIndex = i - LBound(paDomain)
        Exit Sub
      End If
    Next i
    
    If CStr(pvarValue) <> "" Then
      ' Message to the user that the value is not one
      ' of the allowed values and deselect any selected list entry.
      Call lgMsg(glmgCTRL_LIST & lgMsgSubst(glmgCTRL_SET_BAD_VALUE, CStr(pvarValue)), gMG_SEV_WARN)
    End If
      
    ' Deselect any selected list entry.
    pctlListCtrl.ListIndex = -1
  End If

End Sub

Sub lgCtrlDVMeaningSet(pctlValue As Control, pctlMeaning As Control, paDomain() As lgDomain, ByVal pstrValue As String)
'
' DESCRIPTION
' This routine is used to set the value of a control which is in a domain
' and has an associated meaning control
'
' PARAMETERS
' pctlValue     IN  The value control
' pctlMeaning   IN  The meaning control
' paDomain      IN  The domain array of values and meanings
' pstrValue     IN  The value to be set

Dim i As Integer

  ' Set the value control
  pctlValue = pstrValue

  ' If clearing the code, just clear the meaning and return
  If pstrValue = "" Then
     pctlMeaning = ""
     Exit Sub
  End If
  
  ' Look at the code of each item in the domain.
  ' If find a code that matches the given value, display the
  ' meaning and exit the function with True.
  For i = LBound(paDomain) To UBound(paDomain)

     If pstrValue = paDomain(i).Value Then
        pctlMeaning = paDomain(i).Meaning
        Exit Sub
     End If

  Next i

  ' Message to the user that the value is not one
  ' of the allowed values and  just display the code.
  pctlMeaning = pctlValue
  Call lgMsg(glmgCTRL_LIST & lgMsgSubst(glmgCTRL_SET_BAD_VALUE, CStr(pstrValue)), gMG_SEV_WARN)
    
End Sub

Function lgCtrlRadioGet(pfrm As Form, pctl As Control) As Variant
'
' DESCRIPTION
' This gets a radio group's value.  The Tag property of each button in
' the group is used to record the database value that the button
' represents.  If no button is selected, then Null is returned.
'
' PARAMETERS
' pfrm         IN   The control's owning form
' pctl         IN   The frame control we are getting the value of
'
' RETURNS
' Null   - No buttons selected
' String - Tag value of the selected control

Dim i As Integer
Dim intCountControls As Integer
Dim ctlOption As Control
Dim bDoCheck As Boolean

  On Error GoTo lgCtrlRadioGet_Err

  ' If no button in the group is selected, we return Null
  lgCtrlRadioGet = Null

  ' How many controls are there in the form
  intCountControls = pfrm.Controls.Count

  ' Loop through each control in the form
  For i = 0 To intCountControls - 1
    Set ctlOption = pfrm.Controls(i)

    ' Is this control a child of the frame passed in ?
    If (pctl.hWnd = GetParent(ctlOption.hWnd)) Then
      If ctlOption = True Then
        lgCtrlRadioGet = ctlOption.Tag
        Exit For
      End If
    End If

lgTryNextControl:
  Next i
Exit Function

lgCtrlRadioGet_Err:
  If (Err.Number = 422 Or Err.Number = 438) Then
      Resume lgTryNextControl
  End If
  Call lgMsgVBError("lg.bas", "lgCtrlRadioGet", Err)

End Function

Function lgCtrlRadioGetQD(pfrm As Form, pctl As Control) As Variant
'
' DESCRIPTION
' This gets a radio group's value when used in a Query Dialog, i.e.
' the value to be encorporated into the SQL where clause.
' The value Null should be returned if the group is not to participate
' in the query (i.e. if none of the buttons are selected).
' The value "IS NULL" should be returned if a query for NULL
' values is to be performed (i.e. the button corresponding to null has
' been selected).   The Tag property of each button in
' the group is used to record the database value that the button
' represents.
'
' PARAMETERS
' pfrm         IN   The control's owning form
' pctl         IN   The frame control we are getting the value of
'
' RETURNS
' Null      - Radio group not to participate in the query
' String    - Tag value of the selected control
' "IS NULL" - A query for null values is to be performed

Dim varValue As Variant

  ' Get the value of the radio group
  varValue = lgCtrlRadioGet(pfrm, pctl)

  ' If no button has been selected, return null
  If IsNull(varValue) Then
    lgCtrlRadioGetQD = Null

  ' If button corresponding to null has been selected, return "IS NULL"
  ElseIf varValue = "" Then
    lgCtrlRadioGetQD = gSQL_KEYWD_ISNULL

  ' Else return the value correspinding to this button
  Else
    lgCtrlRadioGetQD = varValue
  End If

End Function

Sub lgCtrlRadioSet(pfrm As Form, pctl As Control, pvarValue As Variant)
'
' DESCRIPTION
' This sets a radio group's value.  The Tag property of each button in
' the group is used to record the database value that the button
' represents.
'
' PARAMETERS
' pfrm         IN   The control's owning form
' pctl         IN   The frame control we are setting the value of
' pvarValue    IN   The value to set the control to

Dim i As Integer
Dim intCountControls As Integer
Dim ctlOption As Control
Dim bDoCheck As Boolean
Dim bSetOne As Boolean

  On Error GoTo lgCtrlRadioSet_Err

  ' How many controls are there in the form
  intCountControls = pfrm.Controls.Count

  ' Loop through each control in the form
  bSetOne = False
  For i = 0 To intCountControls - 1
    Set ctlOption = pfrm.Controls(i)
 
    ' Is this control a child of the frame passed in ?
    If (pctl.hWnd = GetParent(ctlOption.hWnd)) Then
        If IsNull(pvarValue) Then
            ctlOption = False
        ElseIf CStr(pvarValue) = ctlOption.Tag Then
            ctlOption = True
            bSetOne = True
            Exit For  ' setting to True will automatically clear others
        Else
            ctlOption = False
        End If
    End If
    
lgTryNextControl1:
  Next i
  
  ' Check that the value passed in was valid
  If (Not IsNull(pvarValue)) And (Not bSetOne) Then
    If (CStr(pvarValue)) <> "" Then
      Call lgMsg(glmgCTRL_RADIO & lgMsgSubst(glmgCTRL_SET_BAD_VALUE, CStr(pvarValue)), gMG_SEV_WARN)
    End If
  End If

Exit Sub
lgCtrlRadioSet_Err:
  If (Err.Number = 422 Or Err.Number = 438) Then
      Resume lgTryNextControl1
  End If
  Call lgMsgVBError("lg.bas", "lgCtrlRadioSet", Err)
  
End Sub

Sub lgEditCopyProc(pctl As Control)
'
' DESCRIPTION
' This procedure copies the selected text of the given
' control, to the clipboard.
'
' PARAMETERS
' pctl  IN  The control from which to copy the text
  
  On Error GoTo lgEditCopyProc_Err

  ' Copy selected text to Clipboard
  If Not pctl Is Nothing Then
    Clipboard.SetText pctl.SelText
  End If
 
  Exit Sub
  
lgEditCopyProc_Err:
  If Err = gERR_NO_SELTEXT_PROP Then
    Call lgMsg(glmgNO_SELTEXT_PROP, gMG_SEV_ERROR)
    Exit Sub
  Else
    Error Err
  End If
End Sub

Sub lgEditCutProc(pctl As Control)
'
' DESCRIPTION
' This procedure copies the selected text of the given
' control, to the clipboard and then removes the selected
' text from the control.
'
' PARAMETERS
' pctl  IN OUT  The control from which to cut the text from

  On Error GoTo lgEditCutProc_Err

  If Not pctl Is Nothing Then
    ' Copy selected text to Clipboard
    Clipboard.SetText pctl.SelText

    ' Delete selected text
    pctl.SelText = ""
  End If

  Exit Sub
  
lgEditCutProc_Err:
  If Err = gERR_NO_SELTEXT_PROP Then
    Call lgMsg(glmgNO_SELTEXT_PROP, gMG_SEV_ERROR)
    Exit Sub
  Else
    Error Err
  End If

End Sub

Sub lgEditPasteProc(pctl As Control)
'
' DESCRIPTION
' This procedure copies the text from the clipboard into
' the given control.
'
' PARAMETERS
' pctl  IN  The control in which to paste the text

  On Error GoTo lgEditPasteProc_Err

  ' Place text from Clipboard into given control
  If Not pctl Is Nothing Then
    pctl.SelText = Clipboard.GetText()
  End If

  Exit Sub
  
lgEditPasteProc_Err:
  If Err = gERR_NO_SELTEXT_PROP Then
    Call lgMsg(glmgNO_SELTEXT_PROP, gMG_SEV_ERROR)
    Exit Sub
  Else
    Error Err
  End If

End Sub

Function lgFormLoaded(ByVal pstrCaption As String) As Boolean
'
' DESCRIPTION
' This function looks to see if the given form instance is already loaded
' If the form with the given caption is in memory then it is displayed
' and the function returns true, otherwise the function returns false,
' so that the form can be loaded.
'
' PARAMETER
' pstrCaption  IN  The caption of the form to find
'
' RETURNS
' True  - If form is already loaded
' False - If form was not found

Dim i As Integer

  ' Assume that the form is not already loaded
  lgFormLoaded = False

  ' Search through the loaded forms.
  ' If the given form is already loaded
  ' display it and return true, otherwise
  ' false is returned.
  For i = 0 To Forms.Count - 1
    If Forms(i).Caption = pstrCaption And Forms(i).Caption <> "" Then
      Forms(i).Show
      lgFormLoaded = True
      Exit Function
    End If
  Next i

End Function

Sub lgHighlightTextBox(pctlTextBox As Control)
'
' DESCRIPTION
' Highlights the text in the given text box.
' This is called from a GotFocus event.
'
' PARAMETER
' pctlTextBox  IN  The text box on which to perform the action

  If TypeOf pctlTextBox Is TextBox Then
    If pctlTextBox.Visible Then
      pctlTextBox.SelStart = 0
      pctlTextBox.SelLength = Len(pctlTextBox)
    End If
  End If

End Sub

Sub lgHintText(pctrlHintControl As Control, pctrlUnderCursor As Control, ByVal pstrHint As String)
'
' DESCRIPTION
' This routine controls the display and hiding of hint text/tool tip text.
' It is called from the MouseMove event of those controls requiring tool tips
' in order to set up the text/size/position of the tooltip control, and kick
' off a timer.
' It is then called from the timer's event (i.e. once the timer has expired) in
' order to make the hint control visible (if we are still over the same control)
' or hide it (once we have moved off).

' NOTE
' This routine relies on the hint control returning accurate positioning
' information via GetWindowRect, and on being positioned whilst in an invisible
' state, and hence may not give the desired behaviour unless the hint text
' control is of type TextBox.

'
' PARAMETERS
' pctrlHintControl  IN  The control used to display the hint
' pctrlUnderCursor  IN  The control to which the hint applies
' pstrHint          IN  The hint text

  Dim frm As Form
  Dim p As POINTAPI
  Dim rctControl As RECT
  Dim rctHint As RECT
  Dim rctForm As RECT
  Dim intXOffset As Integer
  Dim intYOffset As Integer
  Dim fntCurrForm As New StdFont

  
  #If Win32 Then
    Static ghWndLastUnderCursor As Long
  #Else
    Static ghWndLastUnderCursor As Integer
  #End If
    Static gctrlHintControl As Control

  ' If Hint is turned off on the options dialog, just exit sub
  If (frmldLogon!timHintTimer.Interval = 0) Then
    Exit Sub
  End If

  ' If a control has been passed in, this is being called from the MouseMove
  ' event of that control.
  If (Not pctrlUnderCursor Is Nothing) Then
    ' If it is a new control (ie the mouse hasn't just moved within the previous
    '   control, start the timer, and set up the text, size and
    '   position of the hint text control ready for when the timer expires
    '   and the hint control will be made visible
    If (ghWndLastUnderCursor <> pctrlUnderCursor.hWnd) And _
       (ghWndLastUnderCursor <> GetParent(pctrlUnderCursor.hWnd)) Then

      ' restart the delay timer
      frmldLogon!timHintTimer.Enabled = False
      frmldLogon!timHintTimer.Enabled = True

      Set frm = pctrlHintControl.Parent

      ' Set the hint text caption
      pctrlHintControl = pstrHint

      ' Find the required size of the hint text control
      Set fntCurrForm = frm.Font
      Set frm.Font = pctrlHintControl.Font
      pctrlHintControl.Width = frm.TextWidth(pstrHint) + 100
      pctrlHintControl.Height = frm.TextHeight(pstrHint) + 50
      Set frm.Font = fntCurrForm

      ' Find the position to place the Hint text control.  Note we have to use
      '   GetWindowRect and apply offsets because the hint control's left/top
      '   will be relative to the form, but the underlying control's left/top
      '   may be relative to an encolsing control.
      Call GetWindowRect(pctrlUnderCursor.hWnd, rctControl)
      Call GetWindowRect(pctrlHintControl.hWnd, rctHint)
      intXOffset = (rctHint.Left * Screen.TwipsPerPixelX) - pctrlHintControl.Left
      intYOffset = (rctHint.Top * Screen.TwipsPerPixelY) - pctrlHintControl.Top
      pctrlHintControl.Left = (rctControl.Left * Screen.TwipsPerPixelX) - intXOffset
      pctrlHintControl.Top = (rctControl.Bottom * Screen.TwipsPerPixelY) - intYOffset

      ' Check the hint text control is fully visible, and adjust if not
      Call GetWindowRect(pctrlHintControl.hWnd, rctHint)
      Call GetWindowRect(frm.hWnd, rctForm)
      If (rctHint.Right > rctForm.Right) And (pctrlHintControl.Width < frm.Width) Then
        pctrlHintControl.Left = frm.Width - pctrlHintControl.Width - 128
      End If
      If (rctHint.Bottom > rctForm.Bottom) Then
        pctrlHintControl.Top = pctrlHintControl.Top - pctrlHintControl.Height - pctrlUnderCursor.Height
      End If

      ' save the hWnd of the control under the cursor and the hint ctrl
      ghWndLastUnderCursor = pctrlUnderCursor.hWnd
      Set gctrlHintControl = pctrlHintControl

    Else
      ' Mouse Move event within the same control - no action required
    End If
  Else
  ' No control passed in indicating that we have been called
  '   from the Hint Delay Timer, so check if we're still over the
  '   same control and display the hint if so, and clear if not
    Call GetCursorPos(p)

    ' Check to see if we have moved off the control we were displaying
    '   hint for - if so, hide the hint control, and re-initialise the timer
    #If Win32 Then
    If (WindowFromPoint(p.X, p.Y) <> ghWndLastUnderCursor) And _
       (GetParent(WindowFromPoint(p.X, p.Y)) <> ghWndLastUnderCursor) Then
    #Else
    If (WindowFromPoint(p.Y, p.X) <> ghWndLastUnderCursor) And _
       (GetParent(WindowFromPoint(p.Y, p.X)) <> ghWndLastUnderCursor) Then
    #End If
      ' Check that the control still exists, eg not on a window that's
      ' been closed, to avoid imlicitly reloading the form during the
      ' unsetting of the visible property
      Call GetWindowRect(ghWndLastUnderCursor, rctControl)
      If rctControl.Top <> 0 And rctControl.Bottom <> 0 And rctControl.Left <> 0 And rctControl.Right <> 0 Then
         gctrlHintControl.Visible = False
      End If
      frmldLogon.timHintTimer.Enabled = False
      frmldLogon.timHintTimer.Interval = gintHintTimerDelay
      ghWndLastUnderCursor = 0
    Else
    ' Else we are on the same control after the timer expired, so display
    '   the hint control, and move it to the required location/size.
      If gctrlHintControl.Visible = False Then
        gctrlHintControl.Visible = True
        gctrlHintControl.ZOrder
      End If
    End If
  End If

End Sub


Function lgSettingReadBoolean(ByVal pstrSection As String, ByVal pstrParam As String, ByVal pbDefault As Long) As Boolean
'
' DESCRIPTION
' This function gets the value of a parameter from the runtime ini file
' (under 16 bit operating systems), or the registry (for 32 bit operating
' systems)
'
' PARAMETERS
' pstrSection     IN  The ini file section or registry key that the parameter
'                     is contained in.
'                     Note, if empty, this defaults to a Default section.
' pstrParam       IN  The parameter name
' pbDefault       IN  The default value to return if parameter not present, either
'                     True or False
' RETURNS
' Integer         The value of the setting (either True or False)

Dim strSect As String
Dim strValue As String
  
  ' Set up the section name we will look in
  If (pstrSection <> "") Then
    strSect = pstrSection
  Else
    strSect = gDfltSection
  End If

  ' Under 16 bit Operating Systems returns the ini file
  ' setting, on 32 bit Operating Systems returns the registry
  ' setting
  strValue = GetSetting(App.EXEName, strSect, pstrParam, pbDefault)
  If IsEmpty(strValue) Or strValue = "0" Then
    lgSettingReadBoolean = False
  Else
   lgSettingReadBoolean = True
  End If

End Function

Function lgSettingReadString(ByVal pstrSection As String, ByVal pstrParam As String, ByVal pstrDefault As String) As String
'
' DESCRIPTION
' This function gets the value of a parameter from the runtime ini file
' (16 bit operating systems) or the registry (32 bit operating systems)
'
' PARAMETERS
' pstrSection     IN  The ini file section or registry key that the parameter
'                     is contained in.
'                     Note, if empty, this defaults to a Default section.
' pstrParam       IN  The parameter name
' pstrDefault     IN  The default value to return if parameter not present
'
' RETURNS
' String          The value of the ini/reg file entry

Dim strSect As String
Dim strValue As String

  ' Set up the section name we will look in
  If (pstrSection <> "") Then
    strSect = pstrSection
  Else
    strSect = gDfltSection
  End If

  ' Under 16 bit Operating Systems returns the ini file
  ' setting, on 32 bit Operating Systems returns the registry
  ' setting
  Dim strVal As String
  Dim intchars As Integer
  strVal = Space$(128)
  intchars = Len(GetSetting(App.EXEName, strSect, pstrParam, pstrDefault))
  strVal = GetSetting(App.EXEName, strSect, pstrParam, pstrDefault)
  lgSettingReadString = Left$(strVal, intchars + 1)
  
  
End Function

Sub lgSettingWriteBoolean(ByVal pstrSection As String, ByVal pstrParam As String, ByVal pbValue As Integer)
'
' DESCRIPTION
' This function sets the value of a parameter in the runtime ini file
' (16 bit operating systems) or the registry (32 bit operating systems)
'
' PARAMETERS
' pstrSection     IN  The ini file section or registry key that the parameter
'                     is contained in.
'                     Note, if empty, this defaults to a Default section.
' pstrParam       IN  The parameter name
' pbValue         IN  The value to return set the parameter to.  Either True or False

Dim strSect As String
Dim strSetValue As String

  ' Set up the section name we will look in
  If (pstrSection <> "") Then
    strSect = pstrSection
  Else
    strSect = gDfltSection
  End If

  If pbValue = False Then
    strSetValue = "0"
  Else
    strSetValue = "1"
  End If

  ' Under 16 bit Operating Systems returns the ini file
  ' setting, on 32 bit Operating Systems returns the registry
  ' setting
  Call SaveSetting(App.EXEName, strSect, pstrParam, strSetValue)

End Sub

Sub lgSettingWriteString(ByVal pstrSection As String, ByVal pstrParam As String, ByVal pstrValue As String)
'
' DESCRIPTION
' This function sets the value of a parameter in the runtime ini file
' (16 bit operating systems) or the registry (32 bit operating systems)
'
' PARAMETERS
' pstrSection     IN  The ini file section or registry key that the parameter
'                     is contained in.
'                     Note, if empty, this defaults to a Default section.
' pstrParam       IN  The parameter name
' pstrValue       IN  The value to return set the parameter to.

Dim strSect As String

  ' Set up the section name we will look in
  If (pstrSection <> "") Then
    strSect = pstrSection
  Else
    strSect = gDfltSection
  End If

  ' Under 16 bit Operating Systems returns the ini file
  ' setting, on 32 bit Operating Systems returns the registry
  ' setting
  SaveSetting App.EXEName, strSect, pstrParam, pstrValue

End Sub

Sub lgMsg(ByVal pstrMessage As String, Optional ByVal pintSeverity As Variant)
'
' DESCRIPTION
' This routine displays the given text, in a MsgBox with an icon and title
' that is appropriate to the given severity.
'
' PARAMETERS
' pstrMessage  IN  The text of the message to display
' pintSeverity IN  The severity of the message
'

' If pintSeverity is missing than assuming not important and use gMG_SEV_NONE

Dim intIcon      As Integer
Dim strTitle     As String
  If IsMissing(pintSeverity) Then pintSeverity = gMG_SEV_NONE
  ' Display the appropriate Icon based on the severity of the message
  Select Case pintSeverity
    Case gMG_SEV_FATAL              ' Give STOP sign and make it system modal
      intIcon = vbCritical + vbSystemModal
      strTitle = glmgTITLE_FATAL
    Case gMG_SEV_INFO               ' Give INFORMATION sign
      intIcon = vbInformation + vbApplicationModal
      strTitle = glmgTITLE_INFO
    Case gMG_SEV_WARN               ' Give EXCLAMATION sign
      intIcon = vbExclamation + vbApplicationModal
      strTitle = glmgTITLE_WARN
    Case gMG_SEV_ERROR              ' Give STOP sign, but application modal
      intIcon = vbCritical + vbApplicationModal
      strTitle = glmgTITLE_ERROR
    Case gMG_SEV_NONE               ' Give no sign
      strTitle = glmgTITLE_INFO
      intIcon = vbApplicationModal
  End Select

  ' Display the message box
  MsgBox pstrMessage, vbOKOnly + intIcon, strTitle
    
End Sub

Function lgMsgAsk(ByVal pstrMessage As String, Optional ByVal pintDefault As Variant) As Boolean
'
' DESCRIPTION
' This function displays a two button dialogue (with the labels
' YES and NO). It uses the text that is passed into this
' function and the specified default button for the dialogue.
' It returns to the caller the button that was pressed in order
' for the caller to deal with it.
'
' PARAMETERS
' pstrMessage IN  The text to display in the dialogue
' pintDefault IN  The button to set as the default button (True or False)
'
' RETURNS
' True  - If the 'YES' button was pressed
' False - If the 'NO' button was pressed
'
' If pintDefault is missing then the first button is set to be the default button
'
Dim intButton    As Integer
Dim intMsgType   As Integer
Dim intDefButton As Integer

  ' Set the default button as specified
  If IsMissing(pintDefault) Then pintDefault = True

  If (pintDefault = True) Then
    intDefButton = vbDefaultButton1
  Else
    intDefButton = vbDefaultButton2
  End If

  ' Display standard dialogue with YES and NO buttons
  intMsgType = vbYesNo + vbQuestion + vbApplicationModal
  intButton = MsgBox(pstrMessage, intMsgType + intDefButton, glmgTITLE_QUESTION)

  ' Check to see what button was pressed on the dialogue, and convert the
  ' value into that which is expected by the caller
  If (intButton = vbYes) Then
    lgMsgAsk = True
  Else
    lgMsgAsk = False
  End If

End Function

Function lgMsgAsk3Button(ByVal pstrMessage As String, Optional ByVal pintDefault As Variant) As Integer
'
' DESCRIPTION
' This function displays a three button dialogue (with the labels
' YES, NO and CANCEL). It uses the text that is passed into this
' function and returns to the caller the button that was pressed
' in order for the caller to deal with it.
'
' PARAMETERS
' pstrMessage IN  The text to display in the dialogue
' pintDefault IN  The button to set as the default button
'
' RETURNS
' gMG_ASK_YES    - If the 'Yes' button was pressed
' gMG_ASK_NO     - If the 'No' button was pressed
' gMG_ASK_CANCEL - If the 'Cancel' button was pressed
  
Dim intButton    As Integer
Dim intDefButton As Integer
Dim intMsgType   As Integer
  If IsMissing(pintDefault) Then pintDefault = gMG_ASK_NO
  ' Set the default button as specified
  Select Case pintDefault
    Case gMG_ASK_YES
      intDefButton = vbDefaultButton1
    Case gMG_ASK_NO
      intDefButton = vbDefaultButton2
    Case Else
      intDefButton = vbDefaultButton3
  End Select

  ' Display standard dialogue with YES,NO and CANCEL buttons
  intMsgType = vbYesNoCancel + vbQuestion + vbApplicationModal
  intButton = MsgBox(pstrMessage, intMsgType + intDefButton, glmgTITLE_QUESTION)

  ' Check to see what button was pressed on the dialogue, and convert the
  ' value into that which is expected by the caller
  Select Case intButton
    Case vbYes
      lgMsgAsk3Button = gMG_ASK_YES
    Case vbNo
      lgMsgAsk3Button = gMG_ASK_NO
    Case vbCancel
      lgMsgAsk3Button = gMG_ASK_CANCEL
  End Select

End Function


Sub lgMsgServerError(ByVal pstrModule As String, ByVal pstrLocation As String, ByVal pintErrNum As Integer, _
                     ByVal pstrMsgText As String, ByVal pstrSql As String, Optional ByVal pvarPosition As Variant)
'
' DESCRIPTION
' This routine is responsible for displaying detailed information about an
' unknown server error, to the user.
'
' PARAMETERS
' pstrModule    IN  The current module where the error occurred
' pstrLocation  IN  The location in the application code where the error occurred
' pintErrNum    IN  The error number returned by the Server
' pstrMsgText   IN  The text of the error message that needs to be displayed
' pstrSql       IN  The Sql statement in which the error occurred (if known)
' pintPosition  IN  The start position of the text in the Sql statement that caused the error (if known)

  ' Reset mouse pointer (as maybe set in calling routine)
  Screen.MousePointer = vbDefault

  ' Pass the parameters to the Server Error dialog box
  frmlgSE!lblLocation = pstrModule & " - " & pstrLocation
  frmlgSE!lblErrNum = pintErrNum
  frmlgSE!lblErrText = pstrMsgText
  frmlgSE!txtSql = pstrSql
  
  ' If no position passed in, we do not want to attempt to
  ' highlight the SQL statement position
  If IsMissing(pvarPosition) Then
    frmlgSE.mintPos = -1
  Else
    frmlgSE.mintPos = pvarPosition + 1
  End If

  ' Display the Server Error dialog box as modal
  frmlgSE.Show vbModal
  
End Sub

Function lgMsgSubst(ByVal pstrMsgText As String, ByVal pstrParam As String) As String
'
' DESCRIPTION
' This function finds the parameter substitution token, and replaces
' it with the parameter supplied to this routine.  It then returns the
' message text with the parameter replaced with the parameter value.
'
' PARAMETERS
' pstrMsgText IN  The message text with the parameter
' pstrParam   IN  The parameter value to replace in the message text
'
' RETURN VALUE
' String - The message text with the parameter replaced with the parameter
'          value
    
Dim intStartPos As Integer

  ' Find the start position of the token in the message text
  intStartPos = InStr(pstrMsgText, MG_PARAM_TOKEN)
  
  If (intStartPos <> 0) Then
    ' Did find the parameter token, so replace it
    lgMsgSubst = Mid$(pstrMsgText, 1, intStartPos - 1) & pstrParam & Mid$(pstrMsgText, intStartPos + Len(MG_PARAM_TOKEN))
  Else
    ' No parameter token found, so return the message text as it was
    ' given to this routine
    lgMsgSubst = pstrMsgText
  End If

End Function

Sub lgMsgVBError(ByVal pstrModule As String, ByVal pstrLocation As String, ByVal pobjErr As Object)
'
' DESCRIPTION
' This routine is responsible for displaying a standard VB error with
' the module and location (routine name) of where the error occurred.
' If the error is an unknown OLE Automation error then the message is
' presented differently.  If gEND_EVENT was raised then this routine
' will do nothing.
'
' PARAMETERS
' pstrModule    IN  The current module where the error occurred
' pstrLocation  IN  The location in the application code where the error occurred
' pintErrNum    IN  The error number
' pstrErrText   IN  The error text to be displayed

  ' Reset mouse pointer (as maybe set in calling routine)
  Screen.MousePointer = vbDefault

  ' Provided that the err is a standard VB error
  ' call lgMsg to display the message.
  ' First make sure this is not an OLE automation error
  If pobjErr.Number <> gEND_EVENT Then
    If pobjErr.Number = gOLE_AUTOMATION_ERROR Then
      Call lgMsg(pobjErr.Description & " (" & glmgERR_LOCATION & pstrModule & "/" & pstrLocation & ")", gMG_SEV_FATAL)
    ElseIf pobjErr.Number > 0 Then
      Call lgMsg(glmgVB_ERROR & pobjErr.Number & " " & pobjErr.Description & " (" & glmgERR_LOCATION & pstrModule & "/" & _
                 pstrLocation & ")", gMG_SEV_FATAL)
    Else ' We report the error
      Call lgMsg(pobjErr.Number & " " & pobjErr.Description & " (" _
             & glmgERR_LOCATION & pstrModule & "/" & pstrLocation & ")", gMG_SEV_FATAL)
    End If
  End If
End Sub

Function lgNow(ByVal pbTime As Integer) As String
'
' DESCRIPTION
' This function returns the current Date or Date/Time in standard
' formats.
'
' PARAMETER
' pbTime  IN  Should time be included
'
' RETURNS
' String        - The current date/time

  If (pbTime) Then
     lgNow = Now
  Else
     lgNow = Date
  End If

End Function

Function lgNvl(ByVal pvarTestVal As Variant, ByVal pvarSubVal As Variant) As Variant
'
' DESCRIPTION
' This function is passed two values (the test value and a substitue value).
' The purpose of this function is to return the substitute value if the value
' to be tested is null.  If the test value is not null then it is simply returned.
'
' *Note* - when passing in an array to this function, the array statement must be
' enclosed in brackets to avoid the "Parameter Type Mismatch" error.
'
' PARAMETERS
' pvarTestVal  IN  The value to be tested
' pvarSubVal   IN  Substitute value to be returned if varTestVal is null
'
' RETURN
' Variant     If the test value is not null then this is returned otherwise
'             the substitute value is returned.

  If IsNull(pvarTestVal) Then
    lgNvl = pvarSubVal
  Else
    lgNvl = pvarTestVal
  End If

End Function

Sub lgQDAddPredEqual(ByVal pstrLHS As String, pvarValue As Variant, ByVal pstrDtype As String, pstrWhere As String)
'
' DESCRIPTION
' This adds a WHERE clause predicate to the given where clause, for
' a straightforward equality or like operator.  This procedure is called
' by the BuildWhere procedure.
'
' PARAMETERS
' pstrLHS    IN      The column/expression to compare with
' pvarValue  IN OUT  The control value (RHS).  To test for NULL, pass in
'                    the string "IS NULL"
' pstrDtype  IN      Database datatype - 'C'har, 'N'umeric or 'D'ate.
' pstrWhere  IN OUT  Where clause to add it to.

Dim strRHS As String, bUseLike As Integer

  If Not IsNull(pvarValue) Then

    ' Check for and remove surrounding quotes in the string
    pvarValue = lgQDStripQuotes(pvarValue)

    If pvarValue <> "" Then
      Dim strPredicate As String

      ' Handle NULL search, NOTNULL search or wildcard search
      If UCase(pvarValue) = gSQL_KEYWD_ISNULL Then
        strPredicate = pstrLHS & " " & gSQL_KEYWD_ISNULL
      ElseIf UCase(pvarValue) = gSQL_KEYWD_IS_NOTNULL Then
        strPredicate = pstrLHS & " " & gSQL_KEYWD_IS_NOTNULL
      Else
        bUseLike = (InStr(pvarValue, gSQL_KEYWD_WILDCHAR) > 0)
        ' Check that pVarValue is a valid value
        ' if it is then the value will be assigned to strRHSu
        ' otherwise gEND_EVENT is raised
        strRHS = lgQDRHS(pvarValue, pstrDtype, bUseLike)
        strPredicate = pstrLHS & " " & IIf(bUseLike, gSQL_KEYWD_LIKE, "=") & " " & strRHS
      End If
      pstrWhere = pstrWhere & IIf(pstrWhere <> "", gSQL_KEYWD_AND, "") & strPredicate
    End If
  End If

End Sub

Sub lgQDAddPredRange(ByVal pstrLHS As String, pVarValuel As Variant, pVarValueu As Variant, ByVal pstrDtype As String, pstrWhere As String)
'
' DESCRIPTION
' This adds a WHERE clause predicate to the given where clause, for
' a range search.  If both values are supplied, then a BETWEEN search
' is performed, otherwise a <= or >= search is performed.
' Exceptions to this rule is that if both upper and lower are the
' same, then an equality search is performed, and if the lower value
' has been used to specify a search for null values, or a wildcard
' search, then this request is actioned.  This procedure is called by
' the BuildWhere procedure.
'
' PARAMETERS
' pstrLHS    IN      The column/expression to compare with
' pvarValuel IN OUT  The control value for the lower bound.
'                    To test for NULL, pass in the string "IS NULL"
' pvarValueu IN OUT  The control value for the upper bound.
' pstrDtype  IN      Database datatype - 'C'har, 'N'umeric or 'D'ate.
' pstrWhere  IN OUT  Where clause to add it to.

  ' Check for and remove surrounding quotes in the two values
  pVarValuel = lgQDStripQuotes(pVarValuel)
  pVarValueu = lgQDStripQuotes(pVarValueu)

  ' Check that at least one value has been supplied
  If pVarValuel = "" And pVarValueu = "" Then
    Exit Sub
  End If

  ' If lower and upper are both specified, and both equal to each other,
  ' then call lgQDAddPredEqual and let it handle it.
  If pVarValuel <> "" And pVarValueu <> "" Then
    If pVarValuel = pVarValueu Then
      Call lgQDAddPredEqual(pstrLHS, pVarValuel, pstrDtype, pstrWhere)
      Exit Sub
    End If
  End If

  ' If we have a lower value but no upper, and it's a 'special case', i.e.
  ' a search for NULLs, NOTNULLs or wildcard search, then call lgQDAddPredEqual
  ' and let it handle it.
  If pVarValuel <> "" And pVarValueu = "" Then
    If (UCase(pVarValuel) = gSQL_KEYWD_ISNULL) _
    Or (UCase(pVarValuel) = gSQL_KEYWD_IS_NOTNULL) _
    Or (InStr(pVarValuel, gSQL_KEYWD_WILDCHAR) > 0) Then
      Call lgQDAddPredEqual(pstrLHS, pVarValuel, pstrDtype, pstrWhere)
      Exit Sub
    End If
  End If

  ' OK, we have a bonafide range search, so build up the RHS
  Dim strPredicate As String, strRHSl As String, strRHSu As String

  ' If there is a lower range value
  If pVarValuel <> "" Then
    ' Check that pVarValuel is a valid value
    ' if it is then the value will be assigned to strRHSl
    ' otherwise gEND_EVENT is raised
    strRHSl = lgQDRHS(pVarValuel, pstrDtype, False)
  Else
    strRHSl = ""
  End If

  ' If there is an upper range value
  If pVarValueu <> "" Then
    ' Check that pVarValueu is a valid value
    ' if it is then the value will be assigned to strRHSu
    ' otherwise gEND_EVENT is raised
    strRHSu = lgQDRHS(pVarValueu, pstrDtype, False)
  Else
    strRHSu = ""
  End If

  ' Build the where statement
  If strRHSl <> "" And strRHSu <> "" Then
    strPredicate = pstrLHS & gSQL_KEYWD_BETWEEN & strRHSl & gSQL_KEYWD_AND & strRHSu
  ElseIf strRHSl <> "" Then
    strPredicate = pstrLHS & " >= " & strRHSl
  Else
    strPredicate = pstrLHS & " <= " & strRHSu
  End If

  pstrWhere = pstrWhere & IIf(pstrWhere <> "", gSQL_KEYWD_AND, "") & strPredicate

End Sub

Sub lgQDHighlightTextBox(pfrmForm As Form)
'
' DESCRIPTION
' Highlights the first non-empty text box in the form,
' if none, sets the focus to the first visible, enabled
' text box
'
' PARAMETERS
' pfrmForm  IN  The form to perform the action on

Dim i As Integer, C As Control
Dim bFocusSet As Boolean
 
  bFocusSet = False

  For i = 0 To pfrmForm.Controls.Count - 1
    Set C = pfrmForm.Controls(i)

    If TypeOf C Is TextBox Then
      If C.Visible And C.Enabled And (Not bFocusSet) Then
        C.SetFocus
        bFocusSet = True
      End If
      If C.Visible And C.Enabled And C.Text <> "" Then
        C.SetFocus
        C.SelStart = 0
        C.SelLength = Len(C.Text)
        Exit For
      End If
    End If
  Next i

End Sub

Function lgQDRHS(pvarValue As Variant, ByVal pstrDtype As String, ByVal pbUseLike As Integer) As Variant
'
' DESCRIPTION
' This function validates and constructs the RIGHT HAND SIDE value of the
' where clause for both the lgQDPredAddEqual & lgQDPredAddRange procedures.
' It checks that the given value is of the given datatype, and delivers an
' invalid datatype message to the user where applicable.
' It also converts a valid date into the oracle date format.
'
' PARAMETERS
' pVarValue  IN OUT The value to be validated
' pstrDtype  IN     The datatype of the user entry control
' pbUseLike  IN     Whether the value is a wildcard

' RETURN VALUE
' Variant - The validated value


  ' If the value is a wildcard statement or has the character datatype
  ' then return the value in single quotes.
  If (pstrDtype = "C") Or pbUseLike Then
    lgQDRHS = ldQDBuildLiteral(pvarValue, "C")

  ' If the value has a numeric datatype, check whether the value is a valid number.
  ' If it is not a valid number then provide a message to the user and raise the
  ' gEND_EVENT error otherwise pass back the value.
  ElseIf pstrDtype = "N" Then
    If lgValIsNumber(pvarValue, Nothing) = False Then
      ' Pass control back up to top level function
      Error gEND_EVENT
    Else
       lgQDRHS = ldQDBuildLiteral(pvarValue, "N")
    End If
  ' If the value has a date datatype then check whether the value is a valid date.
  ' If it is not a valid date then provide a message to the user and raise the
  ' gEND_EVENT error otherwise pass back the formatted value.
  ElseIf pstrDtype = "D" Then
    If lgValIsDate(pvarValue, Nothing) = False Then
      ' Pass control back up to top level function
      Error gEND_EVENT
    Else
      ' Convert the date to the required format
      lgQDRHS = ldQDBuildLiteral(pvarValue, "D")
    End If
  Else
    lgQDRHS = pvarValue
  End If

End Function

Function lgQDStripQuotes(ByVal pstrValue As Variant) As String
'
' DESCRIPTION
' This function checks for and removes surrounding quotes (double or single)
' of a given string.  It is used by the lgQDAddPredEqual and
' lgQDAddPredRange procedures in building up the where clause.
'
' PARAMETER
' pstrValue  IN  The string value to convert
'
' RETURN VALUE
' String - The given string without surrounding quotes


  ' Return the string as it was, if no surrounding quotes found
  lgQDStripQuotes = pstrValue
  
  ' if pstrValue only contains ' or "" then no need to remove quote
  If pstrValue Like "['""',']" Then
    lgQDStripQuotes = ""
  Else
    ' If the string has surrounding quotes then remove them
    If Left$(pstrValue, 1) = Chr$(34) Or Left$(pstrValue, 1) = "'" Then
      If Right$(pstrValue, 1) = Chr$(34) Or Right$(pstrValue, 1) = "'" Then
        lgQDStripQuotes = Mid$(pstrValue, 2, (Len(pstrValue) - 2))
      End If
    End If
  End If

End Function

Sub lgRemoveSelectedFromList(pctlList As Control)
'
' DESCRIPTION
' Removes the selected rows from the given list control
'
' PARAMETERS
' pctlList  IN  The list from which to remove the rows

Dim intRemoved As Integer
Dim i As Integer

  Do
    intRemoved = False
    For i = 0 To pctlList.ListCount - 1
      If pctlList.Selected(i) Then
        pctlList.RemoveItem i
        intRemoved = True
        Exit For
      End If
    Next i
  Loop While intRemoved

End Sub

Function lgRPad(ByVal pstrString As String, ByVal pintLen As Integer) As String
'
' DESCRIPTION
' This function right pads the given string with spaces
' to return the string to the required length.  If the length
' specified is smaller than the length of the given string,
' the string is simply returned.
'
' PARAMETERS
' pstrString IN   The string to be padded
' pintLen    IN   The required string length
'
' RETURN VALUE
' String - The padded string

  Dim intPadLen As Integer
  Dim strString As String

  strString = pstrString

  ' Assume that the string is not to be modified
  lgRPad = strString

  ' Calculate the padding needed
  intPadLen = pintLen - Len(strString)

  ' If padding is required then create the pad string,
  ' add this to the given string and return the padded string.
  If intPadLen > 0 Then
    strString = strString & Space$(intPadLen)
    lgRPad = strString
  End If

End Function

Sub lgRszAddControl(actrl() As Control, aOrig() As lgRect, pintCount As Integer, ctl As Control, ByVal bResizeType As Integer)
'
' DESCRIPTION
' This is to be called from the Load event of the form in
' order to 'register' a control for resizing and/or
' repositioning if the form is resized to be larger than
' its original size.
'
' PARAMETERS
' actrl         IN  Array of controls we are adding to
' aOrig         IN  Array of lgRects we are adding to
' pintCount     MOD Number already in the array
' ctl           IN  Control to Add
' bResizeType   IN  Resize/Repositioning requirements.  One of:
'   lgRszRESIZE_HORIZ - Increase width of the control
'   lgRszRESIZE_VERT  - Increase height of the control
'   lgRszREPOS_HORIZ    - Move the control horizontally
'   lgRszREPOS_VERT     - Move the control vertically
'
' NOTES
' For each of the bResizeType bitflags set, we record the
' controls original (design time) corresponding property.
'
Dim intIndex As Integer
  
  ' Dont add if currently not visible
  If (ctl.Left + ctl.Width > ctl.Parent.Width) Or (ctl.Top + ctl.Height > ctl.Parent.Height) Then
    Exit Sub
  End If

  ' Add an extra entry to the arrays
  intIndex = pintCount
  pintCount = pintCount + 1
  ReDim Preserve actrl(pintCount)
  ReDim Preserve aOrig(pintCount)

  ' Save the control itself
  Set actrl(intIndex) = ctl
  
  ' Save the original size/position for those properties
  ' we wish to dynamically resize according to a change in the form size.
  '
  If bResizeType And gRszRESIZE_HORIZ Then
    aOrig(intIndex).sngWidth = ctl.Width
  End If
  If bResizeType And gRszRESIZE_VERT Then
    aOrig(intIndex).sngHeight = ctl.Height
  End If
  If bResizeType And gRszREPOS_HORIZ Then
    aOrig(intIndex).sngLeft = ctl.Left
  End If
  If bResizeType And gRszREPOS_VERT Then
    aOrig(intIndex).sngTop = ctl.Top
  End If

End Sub

Sub lgRszResize(actrl() As Control, aOrig() As lgRect, ByVal pintCount As Integer, pFormInitRect As lgRect, _
                ByVal psngFormWidth As Long, ByVal psngFormHeight As Long)
'
' DESCRIPTION
' This is to be called from the Resize event of the form in
' order to resize/move the given set of controls according to
' the new form size, and the original form/control characteristics.
'
' PARAMETERS
' actrl          IN Array of controls we moving/resizing
' aOrig          IN Array of corresponding Original properties
' pintCount       IN Count of number of entries in the array
' pFormInitRect  IN Form's original (design time) size
' psngFormWidth  IN Form's new width
' psngFormHeight IN Form's new height

Dim i As Integer
Dim sngDeltaWidth As Long    ' Width Increase to apply
Dim sngDeltaHeight As Long   ' Height Increase to apply

  ' Work out width increase (if any)
  If psngFormWidth > pFormInitRect.sngWidth Then
    sngDeltaWidth = psngFormWidth - pFormInitRect.sngWidth
  Else
    sngDeltaWidth = 0
  End If

  ' Work out height increase (if any)
  If psngFormHeight > pFormInitRect.sngHeight Then
    sngDeltaHeight = psngFormHeight - pFormInitRect.sngHeight
  Else
    sngDeltaHeight = 0
  End If

  ' Loop through controls, and resize/reposition those controls
  ' we need to.
  For i = 0 To pintCount - 1
    If aOrig(i).sngWidth <> 0 Then   ' needs resizing
      actrl(i).Width = aOrig(i).sngWidth + sngDeltaWidth
    End If
    
    If aOrig(i).sngHeight <> 0 Then   ' needs resizing
      actrl(i).Height = aOrig(i).sngHeight + sngDeltaHeight
    End If

    If aOrig(i).sngLeft <> 0 Then   ' needs moving
      actrl(i).Left = aOrig(i).sngLeft + sngDeltaWidth
    End If
    
    If aOrig(i).sngTop <> 0 Then   ' needs moving
      actrl(i).Top = aOrig(i).sngTop + sngDeltaHeight
    End If
  Next i

End Sub

Function lgSetFocus(pctrl As Control) As Integer
'
' DESCRIPTION
' This function attempts to set focus to the given control.
' If this fails, eg because the control was disabled, focus
' is simply set to the form
'
' PARAMETERS
' pctrl      IN   The Control
'
' RETURN VALUE
' True    - Focus set successfully
' False   - Focus not set successfully
  
  On Error GoTo lgSetFocus_Err
  
  lgSetFocus = True
  
  pctrl.SetFocus
  Exit Function

lgSetFocus_Err:

  On Error GoTo 0
  If pctrl.Parent.Visible And pctrl.Parent.Enabled Then
    pctrl.Parent.SetFocus
  End If
  lgSetFocus = False
  Exit Function

End Function

Sub lgSetFocusTextBox(pfrmForm As Form)
'
' DESCRIPTION
' Sets the focus of the first non-empty text box in the form.
' If all of the text boxes are empty then the focus is set to the
' first empty text box in the form.
'
' PARAMETERS
' pfrmForm  IN  The form to perform the action on

Dim i As Integer, C As Control

  ' Look for the first non-empty textbox
  For i = 0 To pfrmForm.Controls.Count - 1
    Set C = pfrmForm.Controls(i)

    If TypeOf C Is TextBox Then
      If C.Visible And C.Enabled And C.Text <> "" Then
        C.SetFocus
        Exit Sub
      End If
    End If
  Next i

  ' Look for the first empty textbox
  For i = 0 To pfrmForm.Controls.Count - 1
    Set C = pfrmForm.Controls(i)

    If TypeOf C Is TextBox Then
      If C.Visible And C.Enabled Then
        C.SetFocus
        Exit For
      End If
    End If
  Next i

End Sub

Function lgSetLength(ByVal pstrString As String, ByVal pintLen As Integer) As String
'
' DESCRIPTION
' This function takes the given string and sizes it
' to the given length (by padding out with spaces or shortening).
'
' PARAMETERS
' pstrString IN   The string to be padded
' pintLen    IN   The required string length
'
' RETURN VALUE
' String - The modified string

  Dim intPadLen As Integer
  Dim strString As String

  strString = pstrString

  ' Calculate the padding needed
  intPadLen = pintLen - Len(strString)

  ' If padding is required then create the pad string,
  ' add this to the given string and return the padded string,
  ' otherwise return the string shortened.
  If intPadLen > 0 Then
    strString = strString & Space$(intPadLen)
    lgSetLength = strString
  Else
    lgSetLength = Mid$(strString, 1, pintLen)
  End If

End Function

Sub lgShowRecordStatus(ByVal pintCurRecord As Integer, ByVal pintTotalRecords As Integer, pctlStatus As Control)
'
' DESCRIPTION
' This routine is responsible for displaying the record
' status e.g. Record 1 of 5, in the given control, using
' the given record number and record total.
'
' PARAMETERS
' pintCurRecord     IN  The number of the current record
' pintTotalRecords  IN  The total number of records
' pctlStatus        IN  The status control in which to display the text

  pctlStatus = glmgRECORD_N & pintCurRecord & glmgOF_M & pintTotalRecords

End Sub

Sub lgStatusDate(pctlStatusDate As Control)
'
' DESCRIPTION
' This routine sets the Caption of the given control to the
' current date and time
'
' PARAMETERS
' pctlStatusDate     IN  The control to be set

   pctlStatusDate.Caption = "  " & glmgDATE & Date & "       " & glmgTIME & Format(Time, "hh:mm")

End Sub

Function lgValCheckRange(pdblValue As Double, pctl As Control, ByVal pdblLowValue As Double, ByVal pdblHighValue As Double, _
                         ByVal pstrCaption As String) As Boolean
'
' DESCRIPTION
' This function checks a given value is in the specified range.
' If not, then the user is provided with a message and false is
' returned, otherwise true is returned.  If the value is empty
' true is returned.
'
' PARAMETERS
' pdblValue     IN  The value to check is in range
' pctl          IN  The control to check
' pdblLowValue  IN  The low value in the range
' pdblHighValue IN  The high value in the range
' pstrCaption   IN  The caption of the control
'
' RETURNS
' True  - If the value is in range
' False - If the value is out of range

  ' Assume that the value is in range
  lgValCheckRange = True

  If pctl <> "" Then
    If (pdblValue < pdblLowValue) Or (pdblValue > pdblHighValue) Then
      lgValCheckRange = False
      Call lgMsg(pstrCaption & ": " & lgMsgSubst(glmgERROR_RANGE, CStr(pdblLowValue) & " - " & CStr(pdblHighValue)), gMG_SEV_ERROR)
      pctl.SetFocus
    End If
  End If

End Function

Function lgValChkNumPrecision(pstrValue As String, pctl As Control, ByVal pintLength As Integer, ByVal pintScale As Integer, _
                              ByVal pstrCaption As String) As Boolean
'
' DESCRIPTION
' This function checks whether the given value exceeds
' the specifed maximum length and scale.
' If is does then the user is provided with a message and
' false is returned, otherwise true is returned.
' If the value is empty, true is returned.
'
' PARAMETERS
' pstrValue   IN  The value to check
' pctl        IN  The control to check
' pintLength  IN  The maximum length of the item
' pintScale   IN  The scale
' pstrCaption IN  The caption of the control
'
' RETURNS
' True  - If value conforms
' False - If the value does not conform

Dim strValue     As String
Dim strPrecision As String
Dim strScale     As String
Dim intDecPoint  As Integer

  ' Assume that the value does not conform
  lgValChkNumPrecision = False

  ' If the control is empty just return True
  If pstrValue = "" Then
    lgValChkNumPrecision = True
    Exit Function
  End If

  ' First find the absolute value of the item (ie remove any sign)
  strValue = CStr(Abs(CVar(pstrValue)))
    
  ' Find where the decimal point starts
  intDecPoint = InStr(strValue, gVL_DECIMAL_POINT)
  
  ' Set up the strings that contain the precision and scale
  If (intDecPoint = 0) Then
    strPrecision = strValue
    strScale = ""
  Else
    strPrecision = Mid$(strValue, 1, intDecPoint - 1)
    strScale = Mid$(strValue, intDecPoint + 1)
  End If
    
  ' Check if the precision or scale exceed the spec
  If (Len(strPrecision) > pintLength - pintScale) Then
    Call lgMsg(pstrCaption & ": " & lgMsgSubst(glmgERROR_PRECISION, CStr(pintLength - pintScale)), gMG_SEV_ERROR)
    pctl.SetFocus
    Exit Function
  ElseIf (Len(strScale) > pintScale) Then
    If pintScale = 0 Then
      Call lgMsg(pstrCaption & ": " & glmgERROR_NO_SCALE, gMG_SEV_ERROR)
    Else
      Call lgMsg(pstrCaption & ": " & lgMsgSubst(glmgERROR_LARGE_SCALE, CStr(pintScale)), gMG_SEV_ERROR)
    End If
    pctl.SetFocus
    Exit Function
  End If

  ' The value conforms
  lgValChkNumPrecision = True

End Function

Function lgValDVCode(pctlValue As Control, paDomain() As lgDomain, ByVal pintSeverity As Integer, _
                     pstrTitle As String) As Boolean
'
' DESCRIPTION
' This routine validates a value against the given domain issuing
' an Error or Warning as appropriate if validation fails.
'
' PARAMETERS
' pctlValue     IN  The control to be validated
' paDomain      IN  The domain array of values and meanings
' pintSeverity  IN  The severity
' pstrTitle     IN  Title of LOV if validation fails
'
' RETURNS
' True  - If the value is in the domain
' False - If the value is not in the domain

Dim i As Integer

  ' Assume validation will fail
  lgValDVCode = False

  ' If the control is blank just return True
  If pctlValue = "" Then
      lgValDVCode = True
      Exit Function
  Else
      ' Look at the code of each item in the domain.
      ' If find a code that matches the given value, exit the function with True.
      For i = LBound(paDomain) To UBound(paDomain)
         If pctlValue = paDomain(i).Value Then
            lgValDVCode = True
            Exit Function
         End If
      Next i
        
      ' Look at the abbreviation of each item in the domain.
      ' If we find a match, replace with the value and
      ' exit the function with True.
      For i = LBound(paDomain) To UBound(paDomain)
         If pctlValue = paDomain(i).Abbrev Then
            lgValDVCode = True
            pctlValue = paDomain(i).Value
            Exit Function
         End If
      Next i
      
      If pintSeverity = gMG_SEV_ERROR Then
        ' Message to the user that the value is not allowed
        Call lgMsg(lgMsgSubst(glmgERROR_NOT_IN_LIST, pctlValue), pintSeverity)
        If Not frmlgDVLOV.Visible Then
           pctlValue.SetFocus
        End If
      Else
        Call lgCallDVLOV(pstrTitle, paDomain(), pctlValue, Nothing, CStr(pctlValue))
      End If

  End If

End Function

Function lgValDVMeaning(pctlMeaning As Control, paDomain() As lgDomain, ByVal pintSeverity As Integer, pctlValue As Control, _
                        pstrTitle As String) As Boolean
'
' DESCRIPTION
' This routine validates a value against the given domain issuing
' an Error or Warning as appropriate if validation fails.
'
' PARAMETERS
' pctlMeaning   MOD The meaning control to be validated
' paDomain      IN  The domain array of values and meanings
' pintSeverity  IN  The severity
' pctlValue     OUT The value control
' pstrTitle     IN  Title of LOV if validation fails
'
' RETURNS
' True  - If the value is in the domain
' False - If the value is not in the domain

Dim i As Integer

  ' Assume validation will fail
  lgValDVMeaning = False

  ' If the control is blank just return True
  If pctlMeaning = "" Then
      lgValDVMeaning = True
      pctlValue = ""
      Exit Function
  Else
      ' Look at the meaning of each item in the domain.
      ' If we find a match, exit the function with True.
      For i = LBound(paDomain) To UBound(paDomain)
         If pctlMeaning = paDomain(i).Meaning Then
            lgValDVMeaning = True
            pctlValue = paDomain(i).Value
            Exit Function
         End If
      Next i
      
      ' Look at the abbreviation of each item in the domain.
      ' If we find a match, replace with the meaning and
      ' exit the function with True.
      For i = LBound(paDomain) To UBound(paDomain)
         If pctlMeaning = paDomain(i).Abbrev Then
            lgValDVMeaning = True
            pctlMeaning = paDomain(i).Meaning
            pctlValue = paDomain(i).Value
            Exit Function
         End If
      Next i


      
      ' Clear the value control
      pctlValue = ""
      
      If pintSeverity = gMG_SEV_ERROR Then
        ' Message to the user that the value is not allowed
        Call lgMsg(lgMsgSubst(glmgERROR_NOT_IN_LIST, pctlMeaning), pintSeverity)
        pctlMeaning.SetFocus
      Else
        Call lgCallDVLOV(pstrTitle, paDomain(), pctlValue, pctlMeaning, CStr(pctlMeaning))
      End If

  End If
      
End Function

Function lgValForceCaseKey(ByVal pintKeyAscii As Integer, ByVal pintCaseRequired As Integer) As Integer
'
' DESCRIPTION
' This function takes a given Ascii value, and converts it to the
' case specified by the CaseRequired parameter.
' This is called from the _KeyPress event handler in order to
' filter the keyboard input.
'
' PARAMETERS
' pintKeyAscii     IN  The Ascii keycode pressed
' pintCaseRequired IN  The particular case required
'
' RETURN VALUE
' Integer - in the case specified by pstrCaseRequired

  Select Case pintCaseRequired
    Case gVL_CASE_MIXED
      ' Mixed case, so just return the unprocessed value
      lgValForceCaseKey = pintKeyAscii
    Case gVL_CASE_UPPER
      ' Force keycode into upper case value
      lgValForceCaseKey = Asc(UCase$(Chr$(pintKeyAscii)))
    Case gVL_CASE_LOWER
      ' Force keycode to lower case
      lgValForceCaseKey = Asc(LCase$(Chr$(pintKeyAscii)))
  End Select

End Function

Function lgValForceCaseString(pstrValue As String, ByVal pintCaseRequired As Integer) As String
'
' DESCRIPTION
' This routine takes the given control and forces its value to the case specified.
'
' PARAMETERS
' pstrValue        IN OUT  The string containing the value to convert
' pintCaseRequired IN      The particular case required

  Select Case pintCaseRequired
    Case gVL_CASE_UPPER
      ' Force keycode into upper case value
      lgValForceCaseString = UCase$(pstrValue)
    Case gVL_CASE_LOWER
      ' Force keycode to lower case
      lgValForceCaseString = LCase$(pstrValue)
  End Select

End Function

Function lgValIsDate(ByVal pstrValue As String, pctl As Control) As Boolean
'
' DESCRIPTION
' This function checks to see if the given string value contains
' a valid date.  If the value is invalid then the user is provided
' with a message and false is returned, otherwise true is returned.
'
' PARAMETERS
' pstrValue  IN  The string value to check
' pctl       IN  The control containing the value
'
' RETURN VALUE
' True  - If the value contained a valid date
' False - If the value did NOT contain a valid date

  ' Assume that we have a valid date
  lgValIsDate = True

  If (pstrValue <> "") Then
    If Not IsDate(pstrValue) Then
      ' We don't have an empty string, and it did not contain a valid date
      ' so provide the user with a message and set the return value to false.
      lgValIsDate = False
      Call lgMsg(lgMsgSubst(glmgERROR_NOT_A_DATE, pstrValue), gMG_SEV_ERROR)
      If Not pctl Is Nothing Then
        pctl.SetFocus
      End If
    End If
  End If

End Function

Function lgValIsNumber(ByVal pstrValue As String, pctl As Control) As Boolean
'
' DESCRIPTION
' This function checks to see if the given string value contains
' a valid number.  If the value is invalid then the user is provided
' with a message and false is returned, otherwise true is returned.
'
' PARAMETERS
' pstrValue  IN  The string value to check
' pctl       IN  The control containing the value
'
' RETURN VALUE
' True  - If the value contained a valid number
' False - If the value did NOT contain a valid number

  ' Assume that we have a valid number
  lgValIsNumber = True

  If (pstrValue <> "") Then
    If Not IsNumeric(pstrValue) Then
      ' We don't have an empty string, and it did not contain a valid number
      ' so provide the user with a message and set the return value to false.
      lgValIsNumber = False
      Call lgMsg(lgMsgSubst(glmgERROR_NOT_A_NUMBER, pstrValue), gMG_SEV_ERROR)
      If Not pctl Is Nothing Then
        pctl.SetFocus
      End If
    End If
  End If

End Function

Function lgValNotNull(pctl As Control, pstrValue As String, ByVal pstrCaption As String) As Boolean
'
' DESCRIPTION
' This function checks whether the given control is null.
' If it is then the user is provided with a message and false
' is returned, otherwise true is returned.
'
' PARAMETERS
' pctl        IN  The control to check for null
' pstrValue   IN  The value to check for null
' pstrCaption IN  The caption of the given control
'
' RETURNS
' True  - If the user has entered a value
' False - If the given control is null

  ' Assume that the control is not null
  lgValNotNull = True

  If (pctl Is Nothing) Or pstrValue = "" Then
    lgValNotNull = False
    Call lgMsg(pstrCaption & ": " & glmgERROR_MUST_BE_ENTERED, gMG_SEV_ERROR)
    
    ' Go to the control in error.  Ignore any failure whilst attempting
    ' to do this (control may not be able to accept focus)
    On Error Resume Next
    pctl.SetFocus
    On Error GoTo 0
  End If

End Function




Public Function lgCheckFormLoaded(ByVal pstrFormName As String) As Boolean
    
 
 '
' DESCRIPTION
' This function checks to see if a form is already
' loaded.

' PARAMETERS
' pstrFormName         IN  : The Form Name
'
' RETURNS
' True  - If the form is loaded
' False - If the form is not loaded

  ' Counter
  Dim intCounter As Integer
  
  'Loop through all the loaded forms comparing their name
  For intCounter = 0 To Forms.Count - 1
   If Forms(intCounter).Name = pstrFormName Then
     lgCheckFormLoaded = True
     Exit Function
   End If
  Next intCounter

End Function