VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.UserControl CapArchive 
   ClientHeight    =   8235
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   15090
   ScaleHeight     =   8235
   ScaleWidth      =   15090
   Begin VB.Frame frm_main 
      Caption         =   "#Capture archive"
      Height          =   7980
      Left            =   0
      TabIndex        =   0
      Tag             =   "frm_main"
      Top             =   0
      Visible         =   0   'False
      Width           =   14925
      Begin VB.Frame frm_project 
         Caption         =   "#Pojects"
         Height          =   3870
         Left            =   285
         TabIndex        =   3
         Tag             =   "frm_project"
         Top             =   1470
         Width           =   8640
         Begin Project1.ArmGrid grd_projects 
            Height          =   2115
            Left            =   135
            TabIndex        =   4
            Tag             =   "grd_projects"
            Top             =   300
            Width           =   6795
            _ExtentX        =   11986
            _ExtentY        =   3731
         End
      End
      Begin VB.Frame frm_customer 
         Caption         =   "#Customers"
         Height          =   3870
         Left            =   3045
         TabIndex        =   1
         Tag             =   "frm_customer"
         Top             =   1800
         Width           =   8640
         Begin Project1.ArmGrid grd_customers 
            Height          =   2115
            Left            =   150
            TabIndex        =   2
            Tag             =   "grd_customers"
            Top             =   285
            Width           =   6795
            _ExtentX        =   11986
            _ExtentY        =   3731
         End
      End
      Begin MSComctlLib.TabStrip tb_navig 
         Height          =   375
         Left            =   120
         TabIndex        =   5
         Tag             =   "tb_navig"
         Top             =   990
         Width           =   11715
         _ExtentX        =   20664
         _ExtentY        =   661
         _Version        =   393216
         BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
            NumTabs         =   2
            BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
               Caption         =   "#Projects"
               Object.Tag             =   "PROJECTS"
               ImageVarType    =   2
            EndProperty
            BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
               Caption         =   "#Customers"
               Object.Tag             =   "CUSTOMERS"
               ImageVarType    =   2
            EndProperty
         EndProperty
      End
      Begin Project1.ToolbarControl tlb_main 
         Height          =   690
         Left            =   150
         TabIndex        =   6
         Top             =   225
         Width           =   14535
         _ExtentX        =   25638
         _ExtentY        =   1217
      End
   End
End
Attribute VB_Name = "CapArchive"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'**********************************************************************************************************************************
'**********************************************************************************************************************************
' FRAMEWORK API FUNCTION DECLARES
'**********************************************************************************************************************************
'**********************************************************************************************************************************
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwnd As Long) As Long

'**********************************************************************************************************************************
'**********************************************************************************************************************************
' FRAMEWORK CONSTANTS
'**********************************************************************************************************************************
'**********************************************************************************************************************************

Private Const SEP = "®©"
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"

Private Const SCREEN_NAME As String = "Cap_Archive"
Private Const C_TLB_SCREEN_ID As Long = 150
#If LIVE = 1 Then
    Private Const C_TLB_MAIN As Long = 2858
#Else
    Private Const C_TLB_MAIN As Long = 2928
#End If




Private Const LOCALE_USER_DEFAULT = &H400
Private Const LOCALE_SDECIMAL = &HE ' Decimal separator
Private Const LOCALE_STHOUSAND = &HF ' Thousand separator

Private Const CL_COLOR_ENABLED As Long = &H80000005
Private Const CL_COLOR_DISABLED As Long = &H8000000F
Private Const CL_COLOR_LOCKED As Long = &H80000018
Private Const C_ERRORRAISE As Long = 8000
Private Const FRM_SPACE_VER = 120
Private Const FRM_SPACE_HOR = 100

'**********************************************************************************************************************************

'**********************************************************************************************************************************
'**********************************************************************************************************************************
' FRAMEWORK VARIABLES
'**********************************************************************************************************************************
'**********************************************************************************************************************************


#If LIVE = 1 Then
    Dim mo_Db As Object
#Else
    Dim mo_Db As ARMSYSCOMLib.ArmDb
#End If

#If LIVE = 1 Then
    Dim mo_FSO As Object
#Else
    Dim mo_FSO As Scripting.FileSystemObject
#End If

Private ms_Language_Code                As String       'current user interface language
Private ml_U_code                       As Long         'U_Code (GEN_Systems_Users) of logged user
Private ms_LoginName                    As String       'contain loginname
Private ms_UserName                     As String       'contain name of logged user as defined in GEN_People
Private mb_InternalInit                 As Boolean      'framework is doing some own control manipulation, all events should handle
Private mb_Initialized                  As Boolean      'framework is initialised or not
Private ms_DecimalSeparator             As String       'locale decimal separator
Private ms_ThousandSeparator            As String       'locale thousand separator
Private ms_Title                        As String       'title of user control - can be assigned as Caption to the parent form or title for printing

'**********************************************************************************************************************************

'**********************************************************************************************************************************
'**********************************************************************************************************************************
' FRAMEWORK CUSTOM TYPES
'**********************************************************************************************************************************
'**********************************************************************************************************************************
Private Enum ArmErr
    DBCnxFailed = C_ERRORRAISE + 1             ' Unable to connect to the database
    CPTAlreadyInitialized = C_ERRORRAISE + 2   ' We try to initialize a component that is already initialized
    CPTNotInitialized = C_ERRORRAISE + 3       ' We try to use or free that is not initialized yet
    InvalidArgument = C_ERRORRAISE + 4
    PropertyNotSet = C_ERRORRAISE + 5
    SQLFailure = C_ERRORRAISE + 6               ' A SQL runtime error has occured : syntax wrong....
    SQLBadRowAffectedCount = C_ERRORRAISE + 7   ' A SQL request has not affected the expected rowcount (ex: one Update do nothing)
    SQLBadRowExpectedCount = C_ERRORRAISE + 8   ' A SQL request does not return the expected rowcount : select an item return nothing...
    DrivingError = C_ERRORRAISE + 9
    CompFncFailed = C_ERRORRAISE + 10           ' when component function fail
    GridLoadFailed = C_ERRORRAISE + 11          ' load function failed ... bad sql
    InvalidValue = C_ERRORRAISE + 12            ' load function failed ... bad sql
    ErrMsg_M130 = C_ERRORRAISE + 130            'You cannot email this SPA because the status is not APPROVED
    ErrMsg_M150 = C_ERRORRAISE + 150            'This email address does not appear to be the correct format (User@domain)
    ErrMsg_M730 = C_ERRORRAISE + 730            'The length of address cannot be more than 80 characters
    ErrMsg_M310 = C_ERRORRAISE + 310            'You are at the first Item in the list
    ErrMsg_M320 = C_ERRORRAISE + 320            'You are at the last item in the list

End Enum

Private Enum ArmCusErr
    DuplicityDetected = C_ERRORRAISE + 2301                ' detected row with same unique id
    WarMsgSelectRow = 2304
End Enum

'**********************************************************************************************************************************
'**********************************************************************************************************************************
' FRAMEWORK EVENTS
'**********************************************************************************************************************************
'**********************************************************************************************************************************

Public Event quit()


'**********************************************************************************************************************************
'**********************************************************************************************************************************
' FRAMEWORK INTERFACE AND PROPERTIES
' please DO NOT change anything in this part of code
'**********************************************************************************************************************************
'**********************************************************************************************************************************
Public Property Let Visible(ByVal aVisible As Boolean)
    UserControl.Extender.Visible = aVisible
End Property
Public Property Get Visible() As Boolean
    Visible = UserControl.Extender.Visible
End Property
Public Property Let Top(ByVal aTop As Single)
    UserControl.Extender.Top = aTop
End Property
Public Property Get Top() As Single
    Top = UserControl.Extender.Top
End Property
Public Property Let Height(ByVal aHeight As Single)
    UserControl.Extender.Height = aHeight
End Property
Public Property Get Height() As Single
    Height = UserControl.Extender.Height
End Property
Public Property Let Left(ByVal aLeft As Single)
    UserControl.Extender.Left = aLeft
End Property
Public Property Get Left() As Single
    Left = UserControl.Extender.Left
End Property
Public Property Let Width(ByVal aWidth As Single)
    UserControl.Extender.Width = aWidth
End Property
Public Property Get Width() As Single
    Width = UserControl.Extender.Width
End Property
Public Sub Move(ByVal aLeft As Single, ByVal aTop As Single, ByVal aWidth As Single, ByVal aHeight As Single)
    Call UserControl.Extender.Move(aLeft, aTop, aWidth, aHeight)
End Sub
Public Property Get Initialized() As Boolean
    Initialized = mb_Initialized
End Property
Public Property Get Title() As String
    Title = ms_Title
End Property
Public Property Let U_Code(ByVal al_U_code As Long)
On Error GoTo ErrHandler
    
    If Initialized Then Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    
    ml_U_code = al_U_code
    Exit Property
ErrHandler:
    Call ErrorHandler("U_Code(Let)")
End Property

Public Property Let LoginName(ByVal as_LoginName As String)
On Error GoTo ErrHandler
    
    If Initialized Then Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    
    ms_LoginName = as_LoginName
    Exit Property
ErrHandler:
    Call ErrorHandler("LoginName(Let)")
End Property

Public Property Let Language_Code(as_Language_Code As String)
On Error GoTo ErrHandler
    
    If Initialized Then Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    If Len(as_Language_Code) <> 1 Then Call Err.Raise(ArmErr.InvalidArgument, "", "Language_code must contains only 1 char")
    
    ms_Language_Code = as_Language_Code
    Exit Property
ErrHandler:
    Call ErrorHandler("Language(Let)")
End Property

Public Property Set DB(ByRef ao_DB As ArmDb)
On Error GoTo ErrHandler
    
    If Initialized Then Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    If ao_DB Is Nothing Then Call Err.Raise(ArmErr.InvalidArgument)
    
    Set mo_Db = ao_DB
    Exit Property
ErrHandler:
    Call ErrorHandler("Db(Set)")
End Property

'**********************************************************************************************************************************
'**********************************************************************************************************************************
' FRAMEWORK METHODS
' please DO NOT change anything in this part of code
'**********************************************************************************************************************************
'**********************************************************************************************************************************

Public Function Load_A_Com() As Boolean

Dim ll_Index As Long
Dim lo_Control As Object

On Error GoTo ErrHandler
    
    Load_A_Com = False
    
    If Initialized Then Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    If mo_Db Is Nothing Then Call Err.Raise(ArmErr.PropertyNotSet, "", "mo_Db")
    If Len(ms_Language_Code) < 1 Then Call Err.Raise(ArmErr.PropertyNotSet, "", "ms_Language_Code")
    
    mb_InternalInit = False
    ms_DecimalSeparator = Format(0, ".")
    Dim sBuffer As String
    Dim nBufferLen As Long
    nBufferLen = 255
    sBuffer = String$(nBufferLen, vbNullChar)
    nBufferLen = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_STHOUSAND, sBuffer, nBufferLen)
    If nBufferLen > 0 Then
        ms_ThousandSeparator = Left$(sBuffer, nBufferLen - 1)
    End If
    
    For Each lo_Control In UserControl.Controls
        Select Case UCase(TypeName(lo_Control))
        Case "ARMCOMBOBOX"
            Set lo_Control.ArmDb = mo_Db
            Call lo_Control.Load_A_Com
        Case "ARMPICKER"
            Set lo_Control.ArmDb = mo_Db
            Call lo_Control.Load_A_Com
        Case "TOOLBARCONTROL"
            lo_Control.Language = ms_Language_Code
            lo_Control.HideTips = True
            lo_Control.Load_A_Com
        Case "ARMGRID"
            Set lo_Control.ArmDb = mo_Db
            Call lo_Control.Load_A_Com
        Case "ARMTREEVIEW"
            Set lo_Control.ArmDb = mo_Db
            lo_Control.Language = ms_Language_Code
            Call lo_Control.Load_A_Com
        Case "ARMCHECKVIEW"
            Set lo_Control.ArmDb = mo_Db
            Call lo_Control.Load_A_Com
        Case "A_CALOCX"
            lo_Control.Language = ms_Language_Code
            Call lo_Control.reinit_cal
        End Select
    Next
    
    Set mo_FSO = CreateObject("Scripting.FileSystemObject")
    
    Call InitMainFrame
    If Init_control Then
        Load_A_Com = True
        mb_Initialized = True
    Else
        mb_Initialized = True
    End If
    
    Exit Function
ErrHandler:
    Call ErrorMessage("Load_A_COM")
End Function

Public Function Unload_A_Com() As Boolean
    
On Error GoTo ErrHandler
    
    Dim lo_Control As Object
    Dim ll_Index As Long
    
    For Each lo_Control In UserControl.Controls
        Select Case UCase(TypeName(lo_Control))
        Case "ARMCOMBOBOX", "TOOLBARCONTROL", "ARMGRID", "ARMTREEVIEW", "ARMCHECKVIEW", "ARMPICKER", "SRM_TASK"
            Call lo_Control.Unload_A_Com
        End Select
    Next
        
'    Debug.Assert (mo_Db.CursorCount = 0)
    
    Set mo_Db = Nothing
    Set mo_FSO = Nothing
    mb_Initialized = False
    Unload_A_Com = True
    Exit Function
ErrHandler:
    Unload_A_Com = False
    Call ErrorMessage("Unload_A_Com")
End Function

Public Sub Resize()
On Error GoTo ErrHandler

    If Not Resize_Custom Then
        Call ResizeMain
    End If
    Exit Sub
ErrHandler:
    Call ErrorMessage("Resize")
End Sub

Private Function Resize_Custom() As Boolean
On Error GoTo ErrHandler

    Resize_Custom = False
    Exit Function
ErrHandler:
    Call ErrorHandler("Resize_Custom")
End Function

Private Sub ResizeMain()
On Error GoTo ErrHandler


    If Width < 0 Or Height < 0 Then Exit Sub
    
    Call frm_Main.Move(FRM_SPACE_HOR, FRM_SPACE_VER, Width - 2 * FRM_SPACE_HOR, Height - 2 * FRM_SPACE_VER)
    Call tlb_main.Move(FRM_SPACE_HOR, 100 + FRM_SPACE_VER, frm_Main.Width - 2 * FRM_SPACE_HOR, tlb_main.Height)
    Call tb_navig.Move(FRM_SPACE_HOR, tlb_main.Top + tlb_main.Height + FRM_SPACE_VER, frm_Main.Width - 2 * FRM_SPACE_HOR, tb_navig.Height)
    Call frm_project.Move(tb_navig.Left, tb_navig.Top + tb_navig.Height + FRM_SPACE_VER, tlb_main.Width, frm_Main.Height - (tb_navig.Top + tb_navig.Height + 2 * FRM_SPACE_VER))
    Call grd_projects.Move(FRM_SPACE_HOR, 100 + FRM_SPACE_VER, frm_project.Width - 2 * FRM_SPACE_HOR, frm_project.Height - 2 * FRM_SPACE_VER - 100)
    
    Call Frm_Customer.Move(tb_navig.Left, tb_navig.Top + tb_navig.Height + FRM_SPACE_VER, tb_navig.Width, frm_Main.Height - (tb_navig.Top + tb_navig.Height + 2 * FRM_SPACE_VER))
    Call grd_customers.Move(FRM_SPACE_HOR, 100 + FRM_SPACE_VER, frm_project.Width - 2 * FRM_SPACE_HOR, frm_project.Height - 2 * FRM_SPACE_VER - 100)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("ResizeMain")
End Sub

Private Function Init_control() As Boolean
Const CL_REQUEST_TB As String = "EXEC A_ToolbarDef_sel NULL, NULL, $screenID$, NULL"
Dim ll_Index As Long

On Error GoTo ErrHandler

    Init_control = False
    mb_InternalInit = True
    Call Load_ConfigInfo
    
    ' init controls
    Call ChangeCharset(UserControl.Controls, GetCodePageFromLanguage(mo_Db, ms_Language_Code))
    Call LoadLabels(mo_Db, frm_Main, SCREEN_NAME, ms_Language_Code)
    
    ms_UserName = LoadUserInfo(mo_Db, ml_U_code)
    
    'SPA module = 2422
    Dim ll_Cursor As Long
    ll_Cursor = OpenSQLSafe(mo_Db, Replace(CL_REQUEST_TB, "$screenID$", C_TLB_SCREEN_ID))
    
    If mo_Db.Find(ll_Cursor, "id", C_TLB_MAIN) < 0 Then
        Call Err.Raise(CompFncFailed, "mo_Db.Find", "Toolbar definition is missing." & "(" & C_TLB_MAIN & ")")
    End If
    Dim ls_tlbInfo As String
    ls_tlbInfo = mo_Db.GetFields(ll_Cursor, "info")
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    Call tlb_main.SetToolbarInfoStringParameters(ls_tlbInfo, Left(ls_tlbInfo, 3))
    Call tlb_main.DisplayFace(0)
    


    frm_project.Visible = True
    Frm_Customer.Visible = False
    frm_Main.Visible = True
    
    grd_projects.Requests = "EXEC CapArchive_Project_lst '" & ms_LoginName & "', '" & ms_Language_Code & "'"
    Call grd_projects.Execute
    grd_customers.Requests = "EXEC CapArchive_Customer_lst '" & ms_LoginName & "', '" & ms_Language_Code & "'"
    
    mb_InternalInit = False
    
'    If Not InitUserRights(ml_U_code) Then
'        Exit Function
'    End If
    
    Init_control = True
    Exit Function
ErrHandler:
    mb_InternalInit = False
    Call ErrorMessage("Init_control")
End Function

Private Function LoadUserInfo(ByRef ao_Armdb As Object, ByVal al_U_code As Long) As String
On Error GoTo ErrHandler
Const C_REQ As String = _
    "SELECT GPL.P_Name + ' '+ GPL.P_First_Name as User_Name " & _
    "FROM GEN_Systems_Users GSU " & _
    "INNER JOIN GEN_People GPL ON (GSU.P_Code=GPL.P_Code) " & _
    "WHERE GSU.U_Code=$U_Code$"

Dim ls_Req As String
Dim ll_Cursor As Long
    
    ls_Req = ReplacePlaceHolder(C_REQ, "$U_Code$", al_U_code)
    ll_Cursor = OpenSQLSafe(ao_Armdb, ls_Req, 1)
    LoadUserInfo = ao_Armdb.GetFields(ll_Cursor, "User_Name")
    Call ao_Armdb.Close(ll_Cursor)
    Exit Function
    
ErrHandler:
    If ll_Cursor <> 0 Then Call ao_Armdb.Close(ll_Cursor)
    Call ErrorHandler("LoadUserInfo()")
End Function

Private Sub Load_ConfigInfo()
On Error GoTo ErrHandler

    grd_projects.FreeSelect = False
    grd_projects.AllowSort = True
    grd_projects.Title = "#Projects"
    grd_projects.AllowExcelExport = True
    grd_projects.ExportTitles = True
    grd_projects.ExportOnlyVisibleColumns = False
    
    
    grd_customers.FreeSelect = False
    grd_customers.AllowSort = True
    grd_customers.Title = "#Customers"
    grd_customers.AllowExcelExport = True
    grd_customers.ExportTitles = True
    grd_customers.ExportOnlyVisibleColumns = False


    Dim la_Columns() As String
    ReDim la_Columns(14) As String
    la_Columns(0) = "sp_capkey" & CH_LDELIMIT & "0" & CH_LDELIMIT & "1" & CH_LDELIMIT & "sp_capkey" & CH_LDELIMIT & "sp_capkey"
    la_Columns(1) = "language_code" & CH_LDELIMIT & "0" & CH_LDELIMIT & "2" & CH_LDELIMIT & "language_code" & CH_LDELIMIT & "language_code"
    la_Columns(2) = "sp_desc" & CH_LDELIMIT & "2000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "sp_desc" & CH_LDELIMIT & "sp_desc"
    la_Columns(3) = "sp_zip" & CH_LDELIMIT & "800" & CH_LDELIMIT & "0" & CH_LDELIMIT & "sp_zip" & CH_LDELIMIT & "sp_zip"
    la_Columns(4) = "sp_town" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "sp_town" & CH_LDELIMIT & "sp_town"
    la_Columns(5) = "sp_size" & CH_LDELIMIT & "800" & CH_LDELIMIT & "0" & CH_LDELIMIT & "sp_size" & CH_LDELIMIT & "sp_size"
    la_Columns(6) = "clgSpecified" & CH_LDELIMIT & "1300" & CH_LDELIMIT & "0" & CH_LDELIMIT & "clgSpecified" & CH_LDELIMIT & "Ceilings specified"
    la_Columns(7) = "ss_desc" & CH_LDELIMIT & "1300" & CH_LDELIMIT & "0" & CH_LDELIMIT & "ss_desc" & CH_LDELIMIT & "ss_desc"
    la_Columns(8) = "pp_desc" & CH_LDELIMIT & "1300" & CH_LDELIMIT & "0" & CH_LDELIMIT & "pp_desc" & CH_LDELIMIT & "pp_desc"
    la_Columns(9) = "cust_rep" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "cust_rep" & CH_LDELIMIT & "cust_rep"
    la_Columns(10) = "spec_rep" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "spec_rep" & CH_LDELIMIT & "spec_rep"
    la_Columns(11) = "SP_dateFollowUp" & CH_LDELIMIT & "1300" & CH_LDELIMIT & "0" & CH_LDELIMIT & "SP_dateFollowUp" & CH_LDELIMIT & "SP_dateFollowUp"
    la_Columns(12) = "Z_Creation" & CH_LDELIMIT & "1300" & CH_LDELIMIT & "0" & CH_LDELIMIT & "Z_Creation" & CH_LDELIMIT & "Z_Creation"
    la_Columns(13) = "ARCHIVED" & CH_LDELIMIT & "800" & CH_LDELIMIT & "0" & CH_LDELIMIT & "Archive" & CH_LDELIMIT & "#Archived"
    la_Columns(14) = "NB_CUSTS" & CH_LDELIMIT & "1300" & CH_LDELIMIT & "0" & CH_LDELIMIT & "nb_cust" & CH_LDELIMIT & "#Number of cust."
    grd_projects.SetColumns la_Columns


    ReDim la_Columns(13)
    la_Columns(0) = "ccu_capkey" & CH_LDELIMIT & "0" & CH_LDELIMIT & "1" & CH_LDELIMIT & "ccu_capkey" & CH_LDELIMIT & "ccu_capkey"
    la_Columns(1) = "language_code" & CH_LDELIMIT & "0" & CH_LDELIMIT & "2" & CH_LDELIMIT & "language_code" & CH_LDELIMIT & "language_code"
    la_Columns(2) = "ccu_desc" & CH_LDELIMIT & "2500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "ccu_desc" & CH_LDELIMIT & "ccu_desc"
    la_Columns(3) = "zip" & CH_LDELIMIT & "800" & CH_LDELIMIT & "0" & CH_LDELIMIT & "zip" & CH_LDELIMIT & "zip"
    la_Columns(4) = "ccu_town" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "ccu_town" & CH_LDELIMIT & "ccu_town"
    la_Columns(5) = "ccu_tel" & CH_LDELIMIT & "1200" & CH_LDELIMIT & "0" & CH_LDELIMIT & "ccu_tel" & CH_LDELIMIT & "ccu_tel"
    la_Columns(6) = "cct_desc" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "cct_desc" & CH_LDELIMIT & "cct_desc"
    la_Columns(7) = "sr_name" & CH_LDELIMIT & "1300" & CH_LDELIMIT & "0" & CH_LDELIMIT & "sr_name" & CH_LDELIMIT & "sr_name"
    la_Columns(8) = "cp_desc" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "cp_desc" & CH_LDELIMIT & "cp_desc"
    la_Columns(9) = "LOY_desc" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "LOY_desc" & CH_LDELIMIT & "LOY_desc"
    la_Columns(10) = "ARCHIVED" & CH_LDELIMIT & "800" & CH_LDELIMIT & "0" & CH_LDELIMIT & "Archive" & CH_LDELIMIT & "#Archived"
    la_Columns(11) = "NB_PROJECTS" & CH_LDELIMIT & "1000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "nb_prj" & CH_LDELIMIT & "#Nb. of prj."
    la_Columns(12) = "ACT_LASTUPD" & CH_LDELIMIT & "1100" & CH_LDELIMIT & "0" & CH_LDELIMIT & "ACT_dueDate" & CH_LDELIMIT & "#Last act date"
    la_Columns(13) = "NB_ACTIONS" & CH_LDELIMIT & "1000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "nb_act" & CH_LDELIMIT & "#Nb. of act."
    
    grd_customers.SetColumns la_Columns

    Exit Sub
ErrHandler:
    Call ErrorMessage("Load_ConfigInfo")
End Sub

Private Sub InitMainFrame()
On Error GoTo ErrHandler

    Call ResizeMain
    
    Exit Sub
ErrHandler:
    Call ErrorMessage("InitMainFrame")
End Sub

Private Sub InitFrameControls(ByRef av_InitControls As Variant)
On Error GoTo ErrHandler

Dim lo_Control As Control
Dim ll_Index As Long
Dim ls_Request As String

    If Not IsArray(av_InitControls) Then Exit Sub
    mb_InternalInit = True
    For ll_Index = 0 To UBound(av_InitControls)
        Set lo_Control = av_InitControls(ll_Index)(0)
        
        lo_Control.Tag = av_InitControls(ll_Index)(1)
        lo_Control.Visible = av_InitControls(ll_Index)(2)
        Select Case UCase(TypeName(lo_Control))
            Case "ARMCOMBOBOX"
                If UBound(av_InitControls(ll_Index)) >= 3 Then
                    ls_Request = av_InitControls(ll_Index)(3)
                    ls_Request = ReplaceCommonPlaceholders(ls_Request)
                    lo_Control.Request = ls_Request
                End If
            Case "TEXTBOX", "ARMPICKER"
                If UBound(av_InitControls(ll_Index)) >= 4 Then
                    lo_Control.MaxLength = av_InitControls(ll_Index)(4)
                End If
            Case "A_CALOCX"
            Case "LABEL", "CHECKBOX"
                lo_Control.Caption = "#" & lo_Control.Tag
        End Select
    Next
    mb_InternalInit = False
    Exit Sub
ErrHandler:
    mb_InternalInit = False
    Call ErrorHandler("InitFrameControls")
End Sub


Private Function ReplaceCommonPlaceholders(ByVal as_Request As String) As String
On Error GoTo ErrHandler

    as_Request = ReplacePlaceHolder(as_Request, "$language_code$", SQLStr(ms_Language_Code))
    as_Request = ReplacePlaceHolder(as_Request, "$Z_Creator$", SqlInt(ml_U_code))
    as_Request = ReplacePlaceHolder(as_Request, "$U_Code$", SqlInt(ml_U_code))
    as_Request = ReplacePlaceHolder(as_Request, "$LOGIN$", SQLStr(ms_LoginName))
    as_Request = ReplacePlaceHolder(as_Request, "$Z_Last_Upd_User$", SqlInt(ml_U_code))
    ReplaceCommonPlaceholders = as_Request
    Exit Function
ErrHandler:
    Call ErrorHandler("ReplaceCommonPlaceholders")
End Function


Private Function SqlInt(ByVal av_Data As Variant) As String
On Error GoTo ErrHandler

    SqlInt = "NULL"
    If IsNull(av_Data) Then av_Data = ""
    If Trim(CStr(av_Data)) <> "" Then
        SqlInt = CStr(av_Data)
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler("SqlInt")
End Function

Private Function SqlDbl(ByVal av_Data As Variant) As String
On Error GoTo ErrHandler

    SqlDbl = "NULL"
    If IsNull(av_Data) Then av_Data = ""
    If Trim(CStr(av_Data)) <> "" Then
        SqlDbl = Str(av_Data)
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler("SqlDbl")
End Function

Private Function SqlDate(ByVal av_Data As Variant) As String
On Error GoTo ErrHandler

    SqlDate = "NULL"
    If IsNull(av_Data) Then av_Data = ""
    If (Trim(CStr(av_Data)) <> "") And (CStr(av_Data) <> "0") Then
        SqlDate = "'" & Format(av_Data, "yyyy-mm-dd") & "'"
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler("SqlDate")
End Function


Private Function SQLStr(ByVal as_Data As String) As String
On Error GoTo ErrHandler

    SQLStr = "'" & Replace(as_Data, "'", "''") & "'"
    Exit Function
ErrHandler:
    Call ErrorHandler("SqlStr")
End Function







' ************************************************************************************
' FRAMEWORK DB-ACCESS FUNCTIONS
' please do not change this code
' ************************************************************************************

' Return the result of a SQL request
' Convert SQL runtime errors and process errors to VB Error
#If LIVE = 1 Then
Private Function OpenSQLSafe(ByVal ao_DB As Object, ByVal as_Request As String, Optional ByVal al_RowExpectedCount = -1) As Long
#Else
Private Function OpenSQLSafe(ByVal ao_DB As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional ByVal al_RowExpectedCount = -1) As Long
#End If

On Error GoTo ErrHandler

    Dim lc_Data As Long
    lc_Data = ao_DB.OpenSQL(as_Request)
    
    If lc_Data = 0 Then
        Err.Raise ArmErr.SQLFailure, "SQL : " & as_Request, Join(ao_DB.SQLErrorCodes, SEP2) & SEP1 & Join(ao_DB.SQLErrorMessages, SEP2)
    End If
    
    If al_RowExpectedCount <> -1 Then
        ' Then check the rowcount
        If ao_DB.RowCount(lc_Data) <> al_RowExpectedCount Then
            Err.Raise ArmErr.SQLBadRowExpectedCount, "SQL : " & as_Request, al_RowExpectedCount & "<>" & ao_DB.RowCount(lc_Data)
        End If
    End If

    OpenSQLSafe = lc_Data

    Exit Function

ErrHandler:

    Call ErrorHandler("OpenSQLSafe")

End Function


' Execute a SQL request returning no data
' Convert SQL runtime errors and process errors to VB Error
' Params:
' ao_Db (Object)
' as_Request (String)
' al_RowAffectedCount (String)
#If LIVE = 1 Then
Private Sub ExecuteSQLSafe(ByVal ao_DB As Object, ByVal as_Request As String, Optional ByVal al_RowAffectedCount = -1, Optional ab_DuplicityCheck As Boolean = False)
#Else
Private Sub ExecuteSQLSafe(ByVal ao_DB As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional ByVal al_RowAffectedCount = -1, Optional ab_DuplicityCheck As Boolean = False)
#End If
On Error GoTo ErrHandler

    ' First execute the request
    If Not ao_DB.ExecuteSQL(as_Request) Then
        Err.Raise ArmErr.SQLFailure, "SQL : " & as_Request, Join(ao_DB.SQLErrorCodes, SEP2) & SEP1 & Join(ao_DB.SQLErrorMessages, SEP2)
    End If

    If al_RowAffectedCount <> -1 Then
        ' Then check the rowcount
        If ao_DB.SQLRowsAffected <> al_RowAffectedCount Then
            
            If ab_DuplicityCheck Then
                Err.Raise ArmCusErr.DuplicityDetected, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_DB.SQLRowsAffected
            Else
                Err.Raise ArmErr.SQLBadRowAffectedCount, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_DB.SQLRowsAffected
            End If
        End If
    End If

    Exit Sub

ErrHandler:
    Call ErrorHandler("ExecuteSQLSafe")
End Sub

Private Function GetDbError(ByVal lo_Db As ARMSYSCOMLib.ArmDb) As String
On Error GoTo ErrHandler
    
    If IsArray(lo_Db.SQLErrorMessages) Then
        Debug.Assert (IsArray(mo_Db.SQLErrorCodes))
        ' Display errors msgBox
        GetDbError = Join(lo_Db.SQLErrorCodes, ",") & vbCrLf & Join(lo_Db.SQLErrorMessages, vbCrLf)
    Else
        ' ExecuteSQL failed but no error message?
        GetDbError = "Unknown error"
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler("GetDbError()")
End Function
' Standard error handler
Private Sub ErrorHandler(ByVal as_Fct As String)
  
    Call Err.Raise(Err.Number, as_Fct & SEP1 & Err.Source, Err.Description)
End Sub

' display standard error message
Private Sub ErrorMessage(ByVal as_Fct As String)
    Dim ls_ErrSource As String
    Dim ls_ErrDescription As String
    ls_ErrSource = as_Fct & SEP1 & Err.Source
    ls_ErrDescription = Err.Description
    
    Call LogMessage(SCREEN_NAME & " exception raised. Err.Number:" & Err.Number & ", Err.Source:" & ls_ErrSource & ", Err.Description " & ls_ErrDescription & ".", "E", False)
    Call MsgBox("Error occured, please contact IT. Application will now shutdown." & vbCrLf & ls_ErrSource & vbCrLf & "Description: " & ls_ErrDescription, , App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
    End
End Sub

' logs message to database
Private Sub LogMessage(ByVal as_logMsg As String, Optional ByVal as_logType As String = "E", Optional ab_ExitOnException As Boolean = False)
    Dim ll_errNumber As Long
    Dim ls_ErrDescription As String, ls_ErrSource As String
    
    ll_errNumber = Err.Number
    ls_ErrDescription = Err.Description
    ls_ErrSource = Err.Source

On Error GoTo ErrHandler

Const LOG_REQUEST As String = "EXEC A_log_ins $UCODE$,$LOGTYPE$,$MSG$,$APP$"
    Dim ls_Req As String
    Dim ll_Cursor As Long
    Dim ls_Source As String, ls_Msg As String
    
    ls_Source = SCREEN_NAME & " " & App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
    ls_Msg = as_logMsg & SEP1 & ll_errNumber & " : " & ls_ErrDescription & " - " & ls_ErrSource
    
    ls_Req = ReplacePlaceHolder(LOG_REQUEST, "$UCODE$", CStr(ml_U_code))
    ls_Req = ReplacePlaceHolder(ls_Req, "$LOGTYPE$", SQLStr(as_logType))
    ls_Req = ReplacePlaceHolder(ls_Req, "$MSG$", Left(Trim(SQLStr(ls_Msg)), 4000))
    ls_Req = ReplacePlaceHolder(ls_Req, "$APP$", Left(Trim(SQLStr(ls_Source)), 50))
    
    Call ExecuteSQLSafe(mo_Db, ls_Req)
    
    Err.Number = ll_errNumber
    Err.Description = ls_ErrDescription
    Err.Source = ls_ErrSource
    Exit Sub
    
ErrHandler:
    If ab_ExitOnException Then
        Call MsgBox("A fatal error occured. Unable to log error into database, the application will be close. Please report the following message to your IT support: " & vbCrLf & _
            "Number:" & Err.Number & vbCrLf & "Description:" & Err.Description, , App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
        End
    End If
    Err.Number = ll_errNumber
    Err.Description = ls_ErrDescription
    Err.Source = ls_ErrSource
End Sub


' procedure save/restore err object
Private Sub UpdateError(Optional ab_saveError As Boolean = False)
Static ls_ErrDesc As String
Static ls_ErrSource As String
Static ll_errnum As Long
    
    If ab_saveError Then
        ls_ErrDesc = Err.Description
        ls_ErrSource = Err.Source
        ll_errnum = Err.Number
    Else
        Err.Description = ls_ErrDesc
        Err.Source = ls_ErrSource
        Err.Number = ll_errnum
    End If
End Sub

Private Sub LockScreen(ByVal ab_lock As Boolean)

    Dim ll_errNumber As Long, ls_ErrSrc As String, ls_ErrDesc As String
    ll_errNumber = Err.Number
    ls_ErrSrc = Err.Source
    ls_ErrDesc = Err.Description

On Error GoTo ErrHandler
    Static ll_Count As Long
    Static ll_Mousepointer As Long
    Static lb_Locked As Boolean
      
      
    ll_Count = ll_Count + IIf(ab_lock, 1, -1)
    Debug.Assert (ll_Count >= 0)
    
    ' First lock
    If Not lb_Locked And ab_lock Then
        ll_Mousepointer = Screen.MousePointer
        Screen.MousePointer = vbHourglass
        LockWindowUpdate UserControl.hwnd
        lb_Locked = True
    End If
    
    ' Unlock
    If ll_Count = 0 Then
        DoEvents ' Flush events
        LockWindowUpdate 0
        UserControl.Refresh ' Repaint immediately
        Screen.MousePointer = ll_Mousepointer
        lb_Locked = False
    End If
    
    Err.Number = ll_errNumber
    Err.Source = ls_ErrSrc
    Err.Description = ls_ErrDesc
    Exit Sub
ErrHandler:
    Call ErrorHandler("LockScreen")
End Sub


Private Function CustomReplacePlaceholder(ByRef as_Request As String, ByVal as_PlaceHolder As String, ByVal as_DefaultValue As String) As Boolean
On Error GoTo ErrHandler

    CustomReplacePlaceholder = False
    Exit Function
ErrHandler:
    Call ErrorHandler("CustomReplacePlaceholder")
End Function

Private Function ReplacePlaceHolder(ByVal as_Request As String, ByVal as_PlaceHolder As String, ByVal as_DefaultValue As String) As String
On Error GoTo ErrHandler
    
    If Not CustomReplacePlaceholder(as_Request, as_PlaceHolder, as_DefaultValue) Then
        as_Request = Replace(as_Request, as_PlaceHolder, as_DefaultValue, , , vbTextCompare)
    End If
    ReplacePlaceHolder = as_Request
    Exit Function
ErrHandler:
    Call ErrorHandler("ReplacePlaceholder")
End Function

Private Function HasContainer(ByVal lo_Control As Control, ByRef lo_Container As Object) As Boolean
    Dim ll_Index As Long
    Dim lo_Object As Object

    On Error GoTo CleanUp   'not all controls support Container property
    HasContainer = False
    While Not (lo_Control Is Nothing)
        If lo_Control.Container Is lo_Container Then
            HasContainer = True
            Exit Function
        End If
        Set lo_Control = lo_Control.Container
    Wend

CleanUp:

End Function









' ************************************************************************************
' *************************** INTERNATIONAL FUNCTIONS ********************************
' ************************************************************************************

Private Function GetCodePageFromLanguage(ByRef ao_Armdb As Object, ByVal as_Language As String) As Long
On Error GoTo ErrHandler
Const C_REQ As String = "SELECT Code_Page FROM Language WHERE Language_Code = '$Language_Code$'"
    Dim ls_Req As String
    Dim ll_Cursor As Long
    Dim ll_codePage As Long
    
    ls_Req = ReplacePlaceHolder(C_REQ, "$Language_Code$", as_Language)

    ll_Cursor = OpenSQLSafe(ao_Armdb, ls_Req)
    Debug.Assert (ll_Cursor <> 0)
    
    ll_codePage = CLng(ao_Armdb.GetFields(ll_Cursor, "Code_Page"))
    Call ao_Armdb.Close(ll_Cursor)
    GetCodePageFromLanguage = ll_codePage
    Exit Function
    
ErrHandler:
    If ll_Cursor <> 0 Then Call ao_Armdb.Close(ll_Cursor)
    Call ErrorHandler("GetCodePageFromLanguage()")
End Function

'convert code page into charset integer
Private Function GetCharSetFromCodePage(ByVal al_CodePage As Long) As Long

On Error GoTo ErrHandler

    Select Case CStr(al_CodePage)
        Case 932 ' Japanese
            GetCharSetFromCodePage = 128
        Case 936 ' Simplified Chinese
            GetCharSetFromCodePage = 134
        Case 949 ' Korean
            GetCharSetFromCodePage = 129
        Case 950 ' Traditional Chinese
            GetCharSetFromCodePage = 136
        Case 1250 ' Eastern Europe
            GetCharSetFromCodePage = 238
        Case 1251 ' Russian
            GetCharSetFromCodePage = 204
        Case 1252 ' Western European Languages
            GetCharSetFromCodePage = 0
        Case 1253 ' Greek
            GetCharSetFromCodePage = 161
        Case 1254 ' Turkish
            GetCharSetFromCodePage = 162
        Case 1255 ' Hebrew
            GetCharSetFromCodePage = 177
        Case 1256 ' Arabic
            GetCharSetFromCodePage = 178
        Case 1257 ' Baltic
            GetCharSetFromCodePage = 186
        Case Else
            GetCharSetFromCodePage = 0
    End Select
    
    Exit Function
    
ErrHandler:
    Call ErrorHandler("GetCharSetFromCodePage()")
End Function

Private Sub ChangeCharset(ByRef ao_Container As Object, Optional ByVal aCodePage As Long)

On Error GoTo ErrHandler
   
    Dim lc_Control As Control
    Dim ll_Charset As Long
    
    On Error Resume Next
    ll_Charset = GetCharSetFromCodePage(aCodePage)
    
    For Each lc_Control In ao_Container
        Select Case UCase(TypeName(lc_Control))
        Case "TABSTRIP", "TEXTBOX", "LABEL", "FRAME", "COMMANDBUTTON", _
              "LISTVIEW", "CHECKBOX", "OPTIONBUTTON", _
              "ARMCHECKVIEW", "ARMTREEVIEW", "ARMGRID", "ARMCOMBOBOX", "ARMCHECKVIEW0", "ARMPICKER"
            lc_Control.Font.Name = "Arial"
            lc_Control.Font.Charset = ll_Charset
        Case "A_SEEK", "A_SRCHTXT"
            lc_Control.Charset = ll_Charset
        End Select
    Next
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("ChangeCharset")
End Sub

' Load the labels of a containers
Private Sub LoadLabels(ByRef ao_Armdb As ArmDb, ByRef ao_Container As Object, ByVal as_ScreenName As String, ByVal as_Language As String)
Dim lo_Control As Control   ' A control of the container
Dim li_Idx As Integer, li_Count As Integer
Dim li_Label As Integer      ' A label idx
Dim ls_Request As String
Dim lc_Labels As Long
Dim lsa_ControlTag() As String
    
    On Error GoTo Trace_Err

    ls_Request = "exec screen_csts '" & as_ScreenName & "','" & as_Language & "'"
    lc_Labels = OpenSQLSafe(ao_Armdb, ls_Request)
    
    On Error GoTo WithoutTag
    If ao_Container.Tag <> "" Then
        li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", ao_Container.Tag, , 1)
        If li_Label >= 0 Then
            ao_Container.Caption = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
        End If
    End If
WithoutTag:
    
    On Error GoTo Trace_Err
    
    ' Iterate the container for loading the label of each element which has defined a tag
    For Each lo_Control In UserControl.Controls
        If HasContainer(lo_Control, ao_Container) Then
            Select Case UCase(TypeName(lo_Control))
                Case UCase("TabStrip") ' Component is a tabstrip, we load the caption of each tab defined
                    Dim lo_Tbs
                    Set lo_Tbs = lo_Control ' Cast for use of intellisense
                    li_Count = lo_Tbs.Tabs.Count
                    For li_Idx = 1 To li_Count
                        If lo_Tbs.Tabs(li_Idx).Tag <> "" Then
                            li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lo_Tbs.Tabs(li_Idx).Tag, , 1)
                            If li_Label >= 0 Then
                                lo_Tbs.Tabs(li_Idx).Caption = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                            End If
                        End If
                    Next
                    Set lo_Tbs = Nothing
                
                Case UCase("ListView") ' Component is a listview, we load the caption of each columns
                    Dim lo_ListView As ListView
                    Set lo_ListView = lo_Control
                    li_Count = lo_ListView.ColumnHeaders.Count
                    For li_Idx = 1 To li_Count
                        If lo_ListView.ColumnHeaders(li_Idx).Tag <> "" Then
                            li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lo_ListView.ColumnHeaders(li_Idx).Tag, , 1)
                            If li_Label >= 0 Then
                                lo_ListView.ColumnHeaders(li_Idx).Text = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                            End If
                        End If
                    Next
                    Set lo_ListView = Nothing
            
                Case UCase("TextBox")  ' Component is a textbox
                    Dim lo_TextBox As TextBox
                    Set lo_TextBox = lo_Control
                    If lo_TextBox.Tag <> "" Then
                        lsa_ControlTag = Split(lo_Control.Tag, SEP)
                        li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lsa_ControlTag(0), , 1)
                        If li_Label >= 0 Then
                            lo_TextBox.Text = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                        End If
                    End If
                    Set lo_TextBox = Nothing
                
                Case UCase("Label"), UCase("Frame"), UCase("CommandButton"), UCase("CheckBox"), UCase("OptionButton")
                    If lo_Control.Tag <> "" Then
                        lsa_ControlTag = Split(lo_Control.Tag, SEP)
                        li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lsa_ControlTag(0), , 1)
                        If li_Label >= 0 Then
                            lo_Control.Caption = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                        End If
                    End If
                Case UCase("ArmGrid")
                    li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lo_Control.Tag, , 1)
                    If li_Label >= 0 Then
                      Call lo_Control.LoadConstants(ptStatic, ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT"), ctColumns)
                    End If
                    li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lo_Control.Tag & "_Title", , 1)
                    If li_Label >= 0 Then
                      lo_Control.Title = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                    End If
                Case UCase("Menu")
                    If lo_Control.Name <> "" Then
                        li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lo_Control.Name, , 1)
                        If li_Label >= 0 Then
                            lo_Control.Caption = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                        End If
                    End If
            End Select
        End If
    Next
    
    Call ao_Armdb.Close(lc_Labels)
        
Trace_End:
    Exit Sub
    
Trace_Err:
    Call ao_Armdb.Close(lc_Labels)
End Sub

Function MsgText(ByVal aID As Long, ByVal aLang As String, ByVal aDefault As String, Optional ByVal aInfo As Variant) As String
On Error GoTo ErrHandler

Const DB_REQ As String = "SELECT message_text FROM error_message WHERE msgid = $id$ AND Language_code = '$lang$'"

    MsgText = ""
    
    Dim lRequest As String
    lRequest = ReplacePlaceHolder(DB_REQ, "$id$", aID)
    lRequest = ReplacePlaceHolder(lRequest, "$lang$", aLang)
    Dim lData As Long
    
    lData = OpenSQLSafe(mo_Db, lRequest)
    
    Dim lBuffer As String
    lBuffer = mo_Db.GetFields(lData, "message_text")
    mo_Db.Close (lData)
    If lBuffer = "" Then lBuffer = aDefault
    
    Dim li_Idx As Integer
    If Not IsMissing(aInfo) Then
        For li_Idx = 0 To UBound(aInfo)
            lBuffer = Replace(lBuffer, aInfo(li_Idx, 0), aInfo(li_Idx, 1), , , vbTextCompare)
        Next li_Idx
    End If
    
    
    MsgText = lBuffer
    Exit Function
ErrHandler:
    mo_Db.Close (lData)
    Call MsgBox("Connection failure accessing message information.", , App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
    MsgText = aDefault
End Function



Private Sub grd_customers_DblClick()
Const CREQ As String = "INSERT INTO Cap_Archive_Customer (CCU_CapKey, Archive, Z_creation, Z_creator ) VALUES ($CCU_CAPKEY$, $ARCHIVE$, GETDATE(), $LOGIN$)"
    If grd_customers.SelectedCount = 0 Then Exit Sub

    Dim ll_Idx As Long
    For ll_Idx = 0 To grd_customers.SelectedCount - 1
        ' insert Archive into Archive table
        Dim ls_Req As String
        ls_Req = ReplaceCommonPlaceholders(CREQ)
        ls_Req = ReplacePlaceHolder(ls_Req, "$CCU_CAPKEY$", SQLStr(grd_customers.SelectedKey(ll_Idx)(0)))
        ls_Req = ReplacePlaceHolder(ls_Req, "$ARCHIVE$", SQLStr(IIf(grd_customers.SelectedLine(ll_Idx, "ARCHIVED") = "Y", "N", "Y")))
        Call ExecuteSQLSafe(mo_Db, ls_Req, 1)
        
        ' UPDATE GRID
        grd_customers.SelectedLine(ll_Idx, "ARCHIVED") = IIf(grd_customers.SelectedLine(ll_Idx, "ARCHIVED") = "Y", "N", "Y")
    Next
End Sub

Private Sub grd_projects_DblClick()
Const CREQ As String = "INSERT INTO Cap_Archive_Project (SP_CapKey, Archive, Z_creation, Z_creator ) VALUES ($SP_CAPKEY$, $ARCHIVE$, GETDATE(), $LOGIN$)"
    If grd_projects.SelectedCount = 0 Then Exit Sub
    
    Dim ll_Idx As Long
    For ll_Idx = 0 To grd_projects.SelectedCount - 1
        ' insert Archive into Archive table
        Dim ls_Req As String
        ls_Req = ReplaceCommonPlaceholders(CREQ)
        ls_Req = ReplacePlaceHolder(ls_Req, "$SP_CAPKEY$", SQLStr(grd_projects.SelectedKey(ll_Idx)(0)))
        ls_Req = ReplacePlaceHolder(ls_Req, "$ARCHIVE$", SQLStr(IIf(grd_projects.SelectedLine(ll_Idx, "ARCHIVED") = "Y", "N", "Y")))
        Call ExecuteSQLSafe(mo_Db, ls_Req, 1)
        
        ' UPDATE GRID
        grd_projects.SelectedLine(ll_Idx, "ARCHIVED") = IIf(grd_projects.SelectedLine(ll_Idx, "ARCHIVED") = "Y", "N", "Y")
    Next
    
End Sub

Private Sub tb_navig_Click()
    frm_project.Visible = False
    Frm_Customer.Visible = False
    Select Case tb_navig.SelectedItem.Tag
        Case "PROJECTS"
            If grd_projects.Rows = 0 Then Call grd_projects.Execute
            frm_project.Visible = True
        Case "CUSTOMERS"
            If grd_customers.Rows = 0 Then Call grd_customers.Execute
            Frm_Customer.Visible = True
    End Select
    
    
End Sub

Private Sub tlb_Main_action(ByVal as_Role As String, as_Language As String)
    Select Case as_Role
    Case "h"
        Select Case tb_navig.SelectedItem.Tag
            Case "PROJECTS"
                Call grd_projects_DblClick
            Case "CUSTOMERS"
                Call grd_customers_DblClick
        End Select
    Case "F"
        Select Case tb_navig.SelectedItem.Tag
            Case "PROJECTS"
                Call grd_projects.Refresh
            Case "CUSTOMERS"
                Call grd_customers.Refresh
        End Select
    Case "T"              ' QUIT
        RaiseEvent quit
    End Select

End Sub
