VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "mscomctl.OCX"
Begin VB.UserControl Capcon 
   ClientHeight    =   10500
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   13905
   ScaleHeight     =   10500
   ScaleWidth      =   13905
   ToolboxBitmap   =   "Capcon.ctx":0000
   Begin VB.Frame fraItem 
      Height          =   10170
      Left            =   1800
      TabIndex        =   17
      Top             =   -360
      Width           =   10875
      Begin VB.Frame fraItemBottom 
         Height          =   2415
         Left            =   120
         TabIndex        =   28
         Top             =   4905
         Width           =   7995
         Begin VB.CheckBox chk_Unsubscribed 
            Caption         =   "#Unsubscribed from Email campaigns"
            Height          =   255
            Left            =   120
            TabIndex        =   50
            Tag             =   "chk_Unsubscribed"
            Top             =   2040
            Width           =   4935
         End
         Begin Project1.ArmCheckView0 ckvMailingList 
            Height          =   1235
            Left            =   4320
            TabIndex        =   16
            Tag             =   "ckvMailingList"
            Top             =   375
            Width           =   3480
            _ExtentX        =   6138
            _ExtentY        =   2170
         End
         Begin VB.TextBox txt_officePhone 
            Height          =   330
            Left            =   1200
            MaxLength       =   80
            TabIndex        =   11
            Tag             =   "txt_officePhone"
            Top             =   180
            Width           =   2985
         End
         Begin VB.TextBox txt_cellPhone 
            Height          =   330
            Left            =   1200
            MaxLength       =   80
            TabIndex        =   12
            Tag             =   "txt_cellPhone"
            Top             =   540
            Width           =   2985
         End
         Begin VB.TextBox txt_homePhone 
            Height          =   330
            Left            =   1200
            MaxLength       =   80
            TabIndex        =   13
            Tag             =   "txt_homePhone"
            Top             =   900
            Width           =   2985
         End
         Begin VB.TextBox txt_fax 
            Height          =   330
            Left            =   1200
            MaxLength       =   80
            TabIndex        =   14
            Tag             =   "txt_fax"
            Top             =   1260
            Width           =   2985
         End
         Begin VB.TextBox txt_email 
            Height          =   330
            Left            =   1200
            MaxLength       =   80
            TabIndex        =   15
            Tag             =   "txt_email"
            Top             =   1620
            Width           =   6585
         End
         Begin VB.Label lbl_officePhone 
            Caption         =   "#Office phone"
            Height          =   255
            Left            =   120
            TabIndex        =   34
            Tag             =   "lbl_officePhone"
            Top             =   240
            Width           =   1095
         End
         Begin VB.Label lbl_cellPhone 
            Caption         =   "#Cell phone"
            Height          =   195
            Left            =   120
            TabIndex        =   33
            Tag             =   "lbl_cellPhone"
            Top             =   600
            Width           =   1155
         End
         Begin VB.Label lbl_email 
            Caption         =   "#E-mail"
            Height          =   195
            Left            =   120
            TabIndex        =   32
            Tag             =   "lbl_email"
            Top             =   1665
            Width           =   1215
         End
         Begin VB.Label lbl_fax 
            Caption         =   "#Fax"
            Height          =   255
            Left            =   120
            TabIndex        =   31
            Tag             =   "lbl_fax"
            Top             =   1320
            Width           =   1455
         End
         Begin VB.Label lbl_homePhone 
            Caption         =   "#Home phone"
            Height          =   195
            Left            =   120
            TabIndex        =   30
            Tag             =   "lbl_homePhone"
            Top             =   960
            Width           =   1035
         End
         Begin VB.Label lbl_mailingList 
            Caption         =   "#Mailing list"
            Height          =   315
            Left            =   4335
            TabIndex        =   29
            Tag             =   "lbl_mailingList"
            Top             =   165
            Width           =   3480
         End
      End
      Begin VB.Frame fraItemTop 
         Height          =   3915
         Left            =   120
         TabIndex        =   19
         Top             =   960
         Width           =   7995
         Begin VB.TextBox txt_DropDate 
            Alignment       =   2  'Center
            Enabled         =   0   'False
            Height          =   330
            Left            =   2100
            Locked          =   -1  'True
            TabIndex        =   48
            Top             =   3120
            Width           =   1400
         End
         Begin VB.CheckBox chk_DropFlag 
            Alignment       =   1  'Right Justify
            Caption         =   "#Drop flag"
            Enabled         =   0   'False
            Height          =   255
            Left            =   120
            TabIndex        =   47
            Tag             =   "DropFlag"
            Top             =   3225
            Width           =   1935
         End
         Begin VB.CheckBox chk_UpdateTV 
            Caption         =   "Search item in the list after update"
            Height          =   375
            Left            =   11040
            TabIndex        =   43
            Tag             =   "chk_UpdateTV"
            Top             =   240
            Value           =   1  'Checked
            Width           =   3135
         End
         Begin VB.TextBox txt_CntCode 
            Height          =   330
            Left            =   2100
            Locked          =   -1  'True
            TabIndex        =   5
            Tag             =   "txt_CntCode"
            Top             =   180
            Width           =   5775
         End
         Begin Project1.ArmCombobox cbo_job 
            Height          =   345
            Left            =   2100
            TabIndex        =   10
            Tag             =   "cbo_job"
            Top             =   1995
            Width           =   2890
            _ExtentX        =   5106
            _ExtentY        =   609
         End
         Begin Project1.ArmCombobox cbo_title 
            Height          =   345
            Left            =   2100
            TabIndex        =   7
            Tag             =   "cbo_title"
            Top             =   915
            Width           =   2890
            _ExtentX        =   5106
            _ExtentY        =   609
         End
         Begin VB.TextBox txt_ccu_code 
            Height          =   330
            Left            =   1650
            TabIndex        =   36
            Tag             =   "txt_ccu_code"
            Top             =   540
            Visible         =   0   'False
            Width           =   330
         End
         Begin VB.PictureBox Picture1 
            Height          =   0
            Left            =   0
            ScaleHeight     =   0
            ScaleWidth      =   0
            TabIndex        =   20
            Top             =   0
            Width           =   0
         End
         Begin VB.TextBox txt_lastname 
            Height          =   330
            Left            =   2100
            MaxLength       =   80
            TabIndex        =   9
            Tag             =   "txt_lastname"
            Top             =   1620
            Width           =   5775
         End
         Begin VB.TextBox txt_firstname 
            Height          =   330
            Left            =   2100
            MaxLength       =   80
            TabIndex        =   8
            Tag             =   "txt_firstname"
            Top             =   1260
            Width           =   5775
         End
         Begin VB.TextBox txt_desc 
            Enabled         =   0   'False
            Height          =   330
            Left            =   2100
            TabIndex        =   6
            Tag             =   "txt_desc"
            Top             =   540
            Width           =   5775
         End
         Begin Project1.A_calocx calBirthday 
            Height          =   375
            Left            =   2100
            TabIndex        =   44
            Tag             =   "txt_spare1"
            Top             =   2400
            Width           =   1815
            _ExtentX        =   3201
            _ExtentY        =   661
         End
         Begin Project1.ArmCheckView acvHobbies 
            Height          =   1575
            Left            =   5040
            TabIndex        =   45
            Tag             =   "txt_spare2"
            Top             =   2280
            Width           =   2775
            _ExtentX        =   4895
            _ExtentY        =   2778
         End
         Begin VB.Label lbl_cntCode 
            Caption         =   "#Contact Code"
            Height          =   255
            Left            =   120
            TabIndex        =   40
            Tag             =   "lbl_CntCode"
            Top             =   240
            Width           =   1920
         End
         Begin VB.Label lbl_CCU 
            BackColor       =   &H80000000&
            Caption         =   "#Customer name"
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   195
            Left            =   120
            TabIndex        =   27
            Tag             =   "lbl_CCU"
            Top             =   600
            Width           =   1920
         End
         Begin VB.Label lbl_title 
            Caption         =   "#Title"
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   120
            TabIndex        =   26
            Tag             =   "lbl_title"
            Top             =   960
            Width           =   1920
         End
         Begin VB.Label lbl_Job 
            Caption         =   "#Job"
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   120
            TabIndex        =   25
            Tag             =   "lbl_job"
            Top             =   2040
            Width           =   1920
         End
         Begin VB.Label lbl_firstName 
            Caption         =   "#First name"
            Height          =   255
            Left            =   120
            TabIndex        =   24
            Tag             =   "lbl_firstName"
            Top             =   1320
            Width           =   1920
         End
         Begin VB.Label lbl_LastName 
            Caption         =   "#Last name"
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   120
            TabIndex        =   23
            Tag             =   "lbl_lastName"
            Top             =   1680
            Width           =   1920
         End
         Begin VB.Label lbl_spare1 
            Caption         =   "#Birthday"
            Height          =   195
            Index           =   0
            Left            =   120
            TabIndex        =   22
            Tag             =   "lbl_spare1"
            Top             =   2520
            Width           =   1920
         End
         Begin VB.Label lbl_spare2 
            Caption         =   "#Hobbies"
            Height          =   195
            Left            =   5040
            TabIndex        =   21
            Tag             =   "lbl_spare2"
            Top             =   2040
            Width           =   2145
         End
      End
      Begin Project1.ToolBr pbitem 
         Height          =   735
         Left            =   2520
         TabIndex        =   18
         Top             =   180
         Width           =   2355
         _ExtentX        =   4154
         _ExtentY        =   1296
      End
      Begin MSComctlLib.TabStrip tbsEmbedded 
         Height          =   375
         Left            =   120
         TabIndex        =   35
         Top             =   9360
         Width           =   1695
         _ExtentX        =   2990
         _ExtentY        =   661
         Placement       =   1
         _Version        =   393216
         BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
            NumTabs         =   1
            BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
               ImageVarType    =   2
            EndProperty
         EndProperty
      End
   End
   Begin VB.Frame fraFilters 
      Height          =   8415
      Left            =   120
      TabIndex        =   37
      Top             =   240
      Width           =   4335
      Begin VB.PictureBox reload_treeview 
         Appearance      =   0  'Flat
         BackColor       =   &H80000000&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   540
         Left            =   0
         ScaleHeight     =   405
         ScaleMode       =   0  'User
         ScaleWidth      =   570
         TabIndex        =   49
         Top             =   1200
         Width           =   570
      End
      Begin VB.PictureBox pctTvReset 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   240
         Left            =   0
         Picture         =   "Capcon.ctx":0312
         ScaleHeight     =   16
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   16
         TabIndex        =   42
         Top             =   100
         Width           =   240
      End
      Begin Project1.ArmCombobox cbo_view 
         Height          =   345
         Left            =   720
         TabIndex        =   1
         Top             =   600
         Width           =   3495
         _ExtentX        =   6165
         _ExtentY        =   609
      End
      Begin Project1.ArmTreeView tvitems 
         Height          =   3915
         Left            =   0
         TabIndex        =   2
         Top             =   1200
         Width           =   2805
         _ExtentX        =   4948
         _ExtentY        =   6906
      End
      Begin MSComctlLib.TabStrip tbsArchive 
         Height          =   375
         Left            =   480
         TabIndex        =   46
         Top             =   120
         Width           =   3615
         _ExtentX        =   6376
         _ExtentY        =   661
         MultiRow        =   -1  'True
         Style           =   1
         Placement       =   1
         _Version        =   393216
         BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
            NumTabs         =   3
            BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
               Caption         =   "#All"
               Key             =   "K"
               Object.Tag             =   "tbsArchivedAll"
               ImageVarType    =   2
            EndProperty
            BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
               Caption         =   "#Non archived"
               Key             =   "K0"
               Object.Tag             =   "tbsArchivedNA"
               ImageVarType    =   2
            EndProperty
            BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
               Caption         =   "#Archived"
               Key             =   "K1"
               Object.Tag             =   "tbsArchivedA"
               ImageVarType    =   2
            EndProperty
         EndProperty
      End
      Begin VB.Label lbl_view 
         Caption         =   "#View"
         Height          =   195
         Left            =   0
         TabIndex        =   38
         Tag             =   "lbl_view"
         Top             =   600
         Width           =   615
      End
   End
   Begin VB.Frame fraList 
      Height          =   4935
      Left            =   4380
      TabIndex        =   0
      Top             =   120
      Width           =   9015
      Begin Project1.ArmGrid grdlst 
         Height          =   2895
         Left            =   480
         TabIndex        =   39
         Top             =   1680
         Width           =   4575
         _ExtentX        =   8070
         _ExtentY        =   5106
      End
      Begin VB.PictureBox fill_all_record 
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   600
         Left            =   0
         ScaleHeight     =   600
         ScaleWidth      =   600
         TabIndex        =   4
         Top             =   0
         Width           =   600
      End
      Begin Project1.ToolBr pblst 
         Height          =   1095
         Left            =   540
         TabIndex        =   3
         Top             =   360
         Width           =   3375
         _ExtentX        =   5953
         _ExtentY        =   1931
      End
      Begin VB.Label lbl_ListFilter 
         Alignment       =   2  'Center
         BackColor       =   &H0000FFFF&
         Caption         =   "#All "
         Height          =   375
         Left            =   360
         TabIndex        =   41
         Top             =   1200
         Width           =   4935
      End
   End
End
Attribute VB_Name = "Capcon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

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


'******** Curseur de connexion
Private mo_ArmDb As Object
Private mb_Created As Boolean
Private mb_use_framework_connection As Boolean
Private ms_ConnectString As String
Private ms_UID As String


'******** Propriétés de Cap_Project


'******** AFFICHAGE ****************************************************************
Private mt_CstValues As Type_CstValues  ' Structure which contains constants value
Private mi_DisplayMode As Variant       ' Current display mode
Private mi_OldDisplayMode As Variant    ' Old display mode, need for know parameters
Private mi_EmbeddedIn As Integer        ' Indicates the tag  of the component which embed this component
Private mi_EmbedTag As Integer          ' Indicates the tag of the last component embedded
Private mi_CptTag As Integer            ' Tag of the component type
Private mb_Root As Boolean              ' Indicates if the component is the focus of the user

'******** Clé en cours (enreg. en cours de visu ou modif ou delete
Private m_CurrentKey1 As String
Private m_CurrentKey2 As String
Private m_CurrentKey3 As String

Private m_Language As String

'******** iConccurency of current Record
Private p_iCon As Integer

'******** Type de l'objet (1=Normal, liste longue; 2=Liste courte; 3=détail)
Private mi_TypeList As Integer
Private mi_TypeParam As Integer

Private m_Project As String 'For the property .Project, display in ShortList
Private m_Customer As String 'For the property .Customer, display in ShortList
Private m_Memo As String 'For the property .Memo, display in ShortList
Private m_Action As String 'For the property .Action, display in ShortList
Private m_Product As String 'For the property .Product, display in ShortList
Private mb_EmbeddedIsDropped As Boolean '298.2

'Ask the application to change the size of component
Public Event SwitchToView(ByVal li_View As Integer)

'Ask the application to simulate encapsulation of a component by resizing it and push it to front
Public Event Catch(ByVal li_TagEmbedded As Integer, ByVal ls_Param As String)
'Ask the application to release the encapsulation : hide the component embedded
Public Event Release()
Public Event quit()
Public Event HideGrid(AParentID As Integer)

Public Event Updated() ' Indicates if user update date when it's embedded
Public Event UnlockNavigation()


Private p_DefaultValues(MAX_VALUE) As DefaultValue
Private p_DefaultValuesCount As Integer
Private p_DefaultValuesLoaded As Boolean

Public mb_CycleReset As Boolean

Private ms_View_Key As String

Private m_CCU_Town As String
Private m_CCU_CTY_Code As String
Private m_CCU_CTY_Desc As String
Private m_CCU_CT_Code As String
Private m_CCU_CT_Desc As String
Private m_CCU_CCT_Code As String
Private m_CCU_CCT_Desc As String
Private m_Z_Creator As String

Private Enum ArmErr
    DBCnxFailed = vbObjectError + 1             ' Unable to connect to the database
    CPTAlreadyInitialized = vbObjectError + 2   ' We try to initialize a component that is already initialized
    CPTNotInitialized = vbObjectError + 3       ' We try to use or free that is not initialized yet
    InvalidArgument = vbObjectError + 4
    PropertyNotSet = vbObjectError + 5
    SQLFailure = vbObjectError + 6               ' A SQL runtime error has occured : syntax wrong....
    SQLBadRowAffectedCount = vbObjectError + 7   ' A SQL request has not affected the expected rowcount (ex: one Update do nothing)
    SQLBadRowExpectedCount = vbObjectError + 8   ' A SQL request does not return the expected rowcount : select an item return nothing...
    DrivingError = vbObjectError + 9
    CompFncFailed = vbObjectError + 10           ' when component function fail
    GridLoadFailed = vbObjectError + 11          ' load function failed ... bad sql
End Enum



Public Property Set ArmDb(ByRef ao_local_connection As Object)
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:ArmDb_Set"
    #End If
    CapMouseOff
    
    If Not (ao_local_connection Is Nothing) Then
        Set mo_ArmDb = ao_local_connection
        mb_use_framework_connection = True
        
        
            Set grdlst.ArmDb = mo_ArmDb
        
        Set pblst.ArmDb = mo_ArmDb
        Set pbitem.ArmDb = mo_ArmDb
        Set tvitems.ArmDb = mo_ArmDb
        Set ckvMailingList.ArmDb = mo_ArmDb
        Set cbo_view.ArmDb = mo_ArmDb
        Set cbo_title.ArmDb = mo_ArmDb
        Set cbo_job.ArmDb = mo_ArmDb
        Set acvHobbies.ArmDb = mo_ArmDb
    End If
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:ArmDb_Set"
    #End If
    CapMouseOn
End Property

Property Let ConnectString(as_ConnectString As String)

    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:ConnectString_Let", "as_ConnectString=" & as_ConnectString
    #End If
    CapMouseOff
    
    ms_UID = ConnectionStringValidation(as_ConnectString)
    If ms_UID = "" Then GoTo Trace_End
    
    ms_ConnectString = as_ConnectString
    
    'Affectation aux objets
    grdlst.ConnectString = ms_ConnectString
    pblst.ConnectString = ms_ConnectString
    pbitem.ConnectString = ms_ConnectString
    tvitems.ConnectString = ms_ConnectString
    ckvMailingList.ConnectString = ms_ConnectString
    cbo_view.ConnectString = ms_ConnectString
    cbo_title.ConnectString = ms_ConnectString
    cbo_job.ConnectString = ms_ConnectString
    acvHobbies.ConnectString = ms_ConnectString

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:ConnectString_Let"
    #End If
    CapMouseOn
End Property

Property Let Language(as_Language As String)
    
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:Language_Let", "as_Language=" & as_Language
    #End If
    CapMouseOff
    
    m_Language = as_Language
    
    ckvMailingList.Language = m_Language
    'grdlst.Language = m_Language
    tvitems.Language = m_Language
    pbitem.Language = m_Language
    pblst.Language = m_Language
    calBirthday.Language = m_Language

    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:Language_Let"
    #End If
    CapMouseOn
End Property

Private Sub CboView_Resize(ALabel As Label, ACboView As Object, AFrame As Frame)
Dim LMargin As Integer

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:CboView_Resize"
    #End If
    
    LMargin = 100
    
    ALabel.AutoSize = True
    ALabel.Left = LMargin
    ACboView.Left = ALabel.Left + ALabel.Width + LMargin
    ACboView.Width = AFrame.Width - ACboView.Left - LMargin
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:CboView_Resize"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:CboView_Resize"
    CapMouseOn
End Sub


Private Sub DrawMainGrid()
Dim la_Columns(7) As String

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:DrawMainGrid"
    #End If
    
    mi_TypeList = 1

    pblst.ClearAllIcons
    pblst.TableName = mt_CstValues.SecurityContact
    pblst.PictureDisplayed = "P_Refresh=7 P_View=-4 P_Excel=-5 P_Quit=-1"

    grdlst.ResetGrid
    grdlst.Title = "Contact"
    grdlst.MultiSelect = True
    
    la_Columns(0) = "cnt_code" & CH_LDELIMIT & "0" & CH_LDELIMIT & "1" & CH_LDELIMIT & "cnt_code" & CH_LDELIMIT & "cnt_code"
    la_Columns(1) = "ccu_capkey" & CH_LDELIMIT & "0" & CH_LDELIMIT & "2" & CH_LDELIMIT & "ccu_capkey" & CH_LDELIMIT & "ccu_capkey"
    la_Columns(2) = "language_code" & CH_LDELIMIT & "0" & CH_LDELIMIT & "3" & CH_LDELIMIT & "language_code" & CH_LDELIMIT & "language_code"
    la_Columns(3) = "name" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "name" & CH_LDELIMIT & "name"
    la_Columns(4) = "tit_desc" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "tit_desc" & CH_LDELIMIT & "tit_desc"
    la_Columns(5) = "ccu_desc" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "ccu_desc" & CH_LDELIMIT & "ccu_desc"
    la_Columns(6) = "job_desc" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "job_desc" & CH_LDELIMIT & "job_desc"
    la_Columns(7) = "CNT_TelOffice" & CH_LDELIMIT & "2000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "CNT_TelOffice" & CH_LDELIMIT & "CNT_TelOffice"

    
    grdlst.SetColumns la_Columns
    grdlst.LoadConstants ptSQL, "EXEC screen_csts_lst2 'cap_contact_longlist', 'grid', '" & m_Language & "'", ctColumns

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:DrawMainGrid"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:DrawMainGrid"
    CapMouseOn
End Sub

Private Sub InitParentKey()
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:InitParentKey"
    #End If
    
    m_Project = ""
    m_Customer = ""
    m_Memo = ""
    m_Product = ""
    m_Action = ""

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:InitParentKey"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:InitParentKey"
    CapMouseOn
End Sub

Private Sub InitMailingList()
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:InitMailingList"
    #End If
    
    ckvMailingList.Visible = False
    ckvMailingList.Clear
      
    Select Case mi_DisplayMode
    
        Case mt_CstValues.DisplayMode_Add
            ckvMailingList.EditRequest = "exec Cap_ContactMailingList_lst2 " & "'" & ms_UID & "', '" & m_Language & "'" & ", $0$, ''"
            ckvMailingList.MasterID = ""
            ckvMailingList.Mode = ListLoadMode.ModeEdit
            
        Case mt_CstValues.DisplayMode_Update
            ckvMailingList.EditRequest = "exec Cap_ContactMailingList_lst2 " & "'" & ms_UID & "', '" & m_Language & "'" & ", $0$, '" & Trim$(txt_ccu_code.Text) & "'"
            ckvMailingList.MasterID = m_CurrentKey1
            ckvMailingList.Mode = ListLoadMode.ModeEdit
        
        Case mt_CstValues.DisplayMode_Delete, mt_CstValues.DisplayMode_View
            ckvMailingList.ViewRequest = "exec Cap_ContactMailingList_lst $0$, '" & Trim$(txt_ccu_code.Text) & "', '" & m_Language & "'"
            ckvMailingList.MasterID = m_CurrentKey1
            ckvMailingList.Mode = ListLoadMode.ModeView
        
    End Select
       
    ckvMailingList.LoadList
    ckvMailingList.Visible = True

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:InitMailingList"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:InitMailingList"
    CapMouseOn
End Sub



Private Function SaveMailingList(ms_ContactCode As String) As Boolean
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:SaveMailingList", "ms_ContactCode=" & ms_ContactCode
    #End If
    
    SaveMailingList = False
    
    ckvMailingList.CheckRequest = "exec Cap_ContactMailingList_ins $0$, '" & Trim$(txt_ccu_code.Text) & "', $1$ , '','',null, null,null,null,null"
    ckvMailingList.UnCheckRequest = "exec Cap_ContactMailingList_del $0$ , '" & Trim$(txt_ccu_code.Text) & "', $1$ "
    ckvMailingList.MasterID = ms_ContactCode

    SaveMailingList = ckvMailingList.SaveList

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:SaveMailingList", "Result=" & SaveMailingList
    #End If
    CapMouseOn
    Exit Function
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:SaveMailingList"
    CapMouseOn
End Function

Function RecordAdd() As Boolean
Dim ls_Request As String
Dim ls_ContactCode As String
Dim lb_Result As Boolean
Dim ls_Result As String
Dim ll_Count As Long

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:RecordAdd"
    #End If
    
    RecordAdd = False
    
    If Not cbo_title.SelectedItem Is Nothing Then
        ls_Request = "Exec Cap_Title_chk " & GetCodeFromCombo(cbo_title) & ",'" & m_CCU_CT_Code & "'"
        lb_Result = ASC_RecordExec(mo_ArmDb, ls_Request, ls_Result, False)
        If lb_Result Then
            If Mid(ls_Result, 1, 1) = "~" Then
                Call ASC_SendMessage(mo_ArmDb, m_Language, 926, "#This data is not authorized for this country", lbl_title.Caption & " : " & cbo_title.SelectedItem.DisplayText)
                cbo_title.SetFocus
                GoTo Trace_End
            End If
        End If
    End If
    
    If Not cbo_job.SelectedItem Is Nothing Then
        ls_Request = "Exec Cap_Job_chk " & GetCodeFromCombo(cbo_job) & ",'" & m_CCU_CT_Code & "'"
        lb_Result = ASC_RecordExec(mo_ArmDb, ls_Request, ls_Result, False)
        If lb_Result Then
            If Mid(ls_Result, 1, 1) = "~" Then
                Call ASC_SendMessage(mo_ArmDb, m_Language, 926, "#This data is not authorized for this country", lbl_Job.Caption & " : " & cbo_job.SelectedItem.DisplayText)
                cbo_job.SetFocus
                GoTo Trace_End
            End If
        End If
    End If
    
    If ckvMailingList.CheckedCount > 0 Then
        For ll_Count = 1 To ckvMailingList.Count
            If ckvMailingList.ListItems(ll_Count).Checked = True Then
                ls_Request = "Exec Cap_MailingList_chk " & ckvMailingList.ListItems(ll_Count).Tag.Id & ",'" & m_CCU_CT_Code & "'"
                lb_Result = ASC_RecordExec(mo_ArmDb, ls_Request, ls_Result, False)
                If lb_Result Then
                    If Mid(ls_Result, 1, 1) = "~" Then
                        Call ASC_SendMessage(mo_ArmDb, m_Language, 926, "#This data is not authorized for this country", lbl_mailingList.Caption & " : " & ckvMailingList.ListItems(ll_Count).Text)
                        ckvMailingList.ListItems(ll_Count).Selected = True
                        ckvMailingList.SelectedItem.EnsureVisible
                        ckvMailingList.SelectedItem.Ghosted = True
                        ckvMailingList.SetFocus
                        GoTo Trace_End
                    End If
                End If
            End If
        Next
    End If
    
    ErrorOFF
    
    ls_ContactCode = mo_ArmDb.SQLNextID("Cap_Contact")
    If ls_ContactCode = "" Then Call Err.Raise(SQLFailure, "", "SQL Error: mo_ArmDb.SQLNextID(""Cap_Contact"") return nothing.")

    ls_Request = "Exec Cap_Contact_ins "
    ls_Request = ls_Request & "  " & CorrectString(mo_ArmDb, m_Language, txt_ccu_code, True) '@CCU_CapKey char (16),
    ls_Request = ls_Request & ", " & CorrectString(mo_ArmDb, m_Language, txt_firstname, False) '@CNT_firstname varchar (80),
    ls_Request = ls_Request & ", " & CorrectCodeInt(mo_ArmDb, m_Language, cbo_title, True) '@TIT_code int ,
    ls_Request = ls_Request & ", " & CorrectCodeInt(mo_ArmDb, m_Language, cbo_job, True) '@JOB_code int ,
    ls_Request = ls_Request & ", " & CorrectString(mo_ArmDb, m_Language, txt_officePhone) '@CNT_telOffice varchar (80),
    ls_Request = ls_Request & ", " & CorrectString(mo_ArmDb, m_Language, txt_cellPhone) '@CNT_telCell varchar (80),
    ls_Request = ls_Request & ", " & CorrectString(mo_ArmDb, m_Language, txt_homePhone) '@CNT_telHome varchar (80),
    ls_Request = ls_Request & ", " & CorrectString(mo_ArmDb, m_Language, txt_fax) '@CNT_fax varchar (80),
    ls_Request = ls_Request & ", " & CorrectEMail(mo_ArmDb, m_Language, txt_email) '@CNT_email varchar (80),
    ls_Request = ls_Request & ", " & CorrectString(mo_ArmDb, m_Language, txt_lastname, True) '@CNT_lastname varchar (80),
    ls_Request = ls_Request & ", " & "''" '@Internet CHAR(1),
    ls_Request = ls_Request & ", " & "''" '@Drop CHAR(1),
    ls_Request = ls_Request & ", " & "NULL" '@Drop_date DATETIME,
    
    ls_Request = ls_Request & ", " & CorrectDate2(mo_ArmDb, m_Language, calBirthday, False) '@SP_Spare1    DATETIME,
    ls_Request = ls_Request & ", " & "'" & GetHobbies & "'"
    
    ls_Request = ls_Request & ", 0"  ' @spare3_real REAL, ' TASK 298.2
    'BEGIN T299.WP6
    ls_Request = ls_Request & ", 0"  ' @spare4_real REAL,
    ls_Request = ls_Request & ", " & CorrectBool(chk_Unsubscribed)  '@CNT_Unsub char(1)
    'END T299.WP6
    ls_Request = ls_Request & ", '" & ls_ContactCode & "'"
    
    'Execution
    If ErrorFound Then GoTo Trace_End
    
    If Not ASC_ConnectToDB(mo_ArmDb, ms_ConnectString, mb_Created) Then GoTo Trace_End
    
    Dim lb_Transaction As Boolean
    ASC_BeginTransaction mo_ArmDb
    lb_Transaction = True
    
    lb_Result = ASC_RecordExec(mo_ArmDb, ls_Request, ls_ContactCode)
    If lb_Result Then lb_Result = SaveMailingList(ls_ContactCode)
       
    If lb_Result = False Then
        ASC_RollBackTransaction mo_ArmDb
        lb_Transaction = False
        Call ASC_SendMessage(mo_ArmDb, m_Language, 891, "#An error occured during this manipulation, please contact your IT support")
        GoTo Trace_End
    End If
    
    ASC_CommitTransaction mo_ArmDb
    lb_Transaction = False
    m_CurrentKey1 = ls_ContactCode
    m_CurrentKey2 = txt_ccu_code
    RecordAdd = True
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:RecordAdd", "Result=" & RecordAdd
    #End If
    CapMouseOn
    Exit Function
    
Trace_Err:
    If lb_Transaction Then
        ASC_RollBackTransaction mo_ArmDb
    End If
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:RecordAdd"
    CapMouseOn
End Function

Function RecordUpdate(ACode1 As String, ACode2 As String) As Boolean
Dim ls_Request As String
Dim ls_Result As String
Dim lb_Result As Boolean
Dim ll_Count As Long

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:RecordUpdate", "ACode1=" & ACode1, "ACode2=" & ACode2
    #End If
    
    RecordUpdate = False

    If Not (Trim$(ACode1) <> "" And Trim$(ACode2) <> "") Then
        Call ASC_SendMessage(mo_ArmDb, m_Language, 891, "#An error occured during this manipulation, please contact your IT support")
        GoTo Trace_End
    End If

    If Not cbo_title.SelectedItem Is Nothing Then
        ls_Request = "Exec Cap_Title_chk " & GetCodeFromCombo(cbo_title) & ",'" & m_CCU_CT_Code & "'"
        lb_Result = ASC_RecordExec(mo_ArmDb, ls_Request, ls_Result, False)
        If lb_Result Then
            If Mid(ls_Result, 1, 1) = "~" Then
                Call ASC_SendMessage(mo_ArmDb, m_Language, 891, "#An error occured during this manipulation, please contact your IT support")
                cbo_title.SetFocus
                GoTo Trace_End
            End If
        End If
    End If
    
    If Not cbo_job.SelectedItem Is Nothing Then
        ls_Request = "Exec Cap_Job_chk " & GetCodeFromCombo(cbo_job) & ",'" & m_CCU_CT_Code & "'"
        lb_Result = ASC_RecordExec(mo_ArmDb, ls_Request, ls_Result, False)
        If lb_Result Then
            If Mid(ls_Result, 1, 1) = "~" Then
                Call ASC_SendMessage(mo_ArmDb, m_Language, 891, "#An error occured during this manipulation, please contact your IT support")
                cbo_job.SetFocus
                GoTo Trace_End
            End If
        End If
    End If
    
    For ll_Count = 1 To ckvMailingList.Count
        If ckvMailingList.ListItems(ll_Count).Checked = True Then
            ls_Request = "Exec Cap_MailingList_chk " & ckvMailingList.ListItems(ll_Count).Tag.Id & ",'" & m_CCU_CT_Code & "'"
            lb_Result = ASC_RecordExec(mo_ArmDb, ls_Request, ls_Result, False)
            If lb_Result Then
                If Mid(ls_Result, 1, 1) = "~" Then
                    Call ASC_SendMessage(mo_ArmDb, m_Language, 891, "#An error occured during this manipulation, please contact your IT support")
                    ckvMailingList.ListItems(ll_Count).Selected = True
                    ckvMailingList.SelectedItem.EnsureVisible
                    ckvMailingList.SelectedItem.Ghosted = True
                    ckvMailingList.SetFocus
                    GoTo Trace_End
                End If
            End If
        End If
    Next

    ErrorOFF

    ls_Request = "Exec Cap_Contact_upd "
    ls_Request = ls_Request & "  " & "'" & ACode1 & "'" '@CNT_code char(16) ,
    ls_Request = ls_Request & ", " & "'" & ACode2 & "'" '@CCU_CapKey char (16),
    ls_Request = ls_Request & ", " & p_iCon '@iConcurrency   SMALLINT
    ls_Request = ls_Request & ", " & CorrectString(mo_ArmDb, m_Language, txt_firstname, False) '@CNT_firstname varchar (80),
    ls_Request = ls_Request & ", " & CorrectCodeInt(mo_ArmDb, m_Language, cbo_title, True) '@TIT_code int ,
    ls_Request = ls_Request & ", " & CorrectCodeInt(mo_ArmDb, m_Language, cbo_job, True) '@JOB_code int ,
    ls_Request = ls_Request & ", " & CorrectString(mo_ArmDb, m_Language, txt_officePhone) '@CNT_telOffice varchar (80),
    ls_Request = ls_Request & ", " & CorrectString(mo_ArmDb, m_Language, txt_cellPhone) '@CNT_telCell varchar (80),
    ls_Request = ls_Request & ", " & CorrectString(mo_ArmDb, m_Language, txt_homePhone) '@CNT_telHome varchar (80),
    ls_Request = ls_Request & ", " & CorrectString(mo_ArmDb, m_Language, txt_fax) '@CNT_fax varchar (80),
    ls_Request = ls_Request & ", " & CorrectEMail(mo_ArmDb, m_Language, txt_email) '@CNT_email varchar (80),
    ls_Request = ls_Request & ", " & CorrectString(mo_ArmDb, m_Language, txt_lastname, True) '@CNT_lastname varchar (80),
    ls_Request = ls_Request & ", " & "''" '@Internet CHAR(1),
    ls_Request = ls_Request & ", " & "''" '@Drop CHAR(1),
    ls_Request = ls_Request & ", " & "NULL" '@Drop_date DATETIME,
    
    
    ls_Request = ls_Request & ", " & CorrectDate2(mo_ArmDb, m_Language, calBirthday, False) '@SP_Spare1    DATETIME,
    ls_Request = ls_Request & ", " & "'" & GetHobbies & "'"
    
      
    ls_Request = ls_Request & ", 0" '@spare3_real REAL, ' TASK 298.2
    
'BEGIN T299.WP6
    ls_Request = ls_Request & ", 0" '@spare4_real REAL,
    ls_Request = ls_Request & ", " & CorrectBool(chk_Unsubscribed) '@CNT_Unsub char(1)
    'END T299.WP6
    
    'Execution
    If ErrorFound Then GoTo Trace_End
    
    If Not ASC_ConnectToDB(mo_ArmDb, ms_ConnectString, mb_Created) Then GoTo Trace_End
    
    ASC_BeginTransaction mo_ArmDb
    
    lb_Result = ASC_RecordExec(mo_ArmDb, ls_Request, ls_Result)
    If lb_Result Then lb_Result = SaveMailingList(ACode1)
    
    If lb_Result = False Then
        ASC_RollBackTransaction mo_ArmDb
        If ls_Result = "-1" Then
            Call ASC_SendMessage(mo_ArmDb, m_Language, 916, "#This data has been updated by another user. Data will be reloaded. Please check the data and try again.")
            ViewInitFields
        Else
            Call ASC_SendMessage(mo_ArmDb, m_Language, 891, "#An error occured during this manipulation, please contact your IT support")
        End If
        GoTo Trace_End
    End If
    
    ASC_CommitTransaction mo_ArmDb
    RecordUpdate = True
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:RecordUpdate", "Result=" & RecordUpdate
    #End If
    CapMouseOn
    Exit Function
    
Trace_Err:
    ASC_RollBackTransaction mo_ArmDb
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:RecordUpdate"
    CapMouseOn
End Function


' TASK 298.2
Function RecordDelete(ACode1 As String, ACode2 As String) As Boolean
Dim ll_Cursor As Long
Dim lb_Result As Boolean
Dim ls_Result As String
    Dim lb_IsPrimary As Boolean

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:RecordDelete", "ACode1=" & ACode1, "ACode2=" & ACode2
    #End If
    
    RecordDelete = False
    
    If Not (Trim$(ACode1) <> "" And Trim$(ACode2) <> "") Then
        Call ASC_SendMessage(mo_ArmDb, m_Language, 891, "#An error occured during this manipulation, please contact your IT support")
        GoTo Trace_End
    End If

    ErrorOFF

    If Not ASC_ConnectToDB(mo_ArmDb, ms_ConnectString, mb_Created) Then GoTo Trace_End


    Dim ls_ResultCode As String
    
    If ASC_RecordExec(mo_ArmDb, "exec SPA_Prj_Cust_Cnt_chk NULL, NULL, '" & ACode1 & "'", ls_ResultCode) Then
        Call ASC_SendMessage(mo_ArmDb, m_Language, 8719, "#You cannot delete this contact, because one or more SPA exists for this contact")
        GoTo Trace_End
    End If
    
    ' Step 1 - Check if the contact is the primary of its customer
    Dim ls_Request_Check As String
    ls_Request_Check = "exec Claim_Customer_PrimaryContactGet '" & ACode2 & "'"
    ll_Cursor = mo_ArmDb.OpenSQL(ls_Request_Check)
    If (ll_Cursor = 0 Or mo_ArmDb.RowCount(ll_Cursor) = 0) Then
        Call ASC_SendMessage(mo_ArmDb, m_Language, 891, "#An error occured during this manipulation, please contact your IT support")
        GoTo Trace_End
    End If
    ' And select the appropriate confirmation message
    Dim ll_ConfirmMsgID As Long, ls_ConfirmMsgDesc As String
    If mo_ArmDb.GetFields(ll_Cursor, "CCU_PrimCnt") = ACode1 Then
        lb_IsPrimary = True
        ll_ConfirmMsgID = 2501
        ls_ConfirmMsgDesc = "#This contact is currently selected as the ''Primary Contact'' for this Customer. If you proceed this customer will no longer have a primary contact assigned to it. You are sure you want to delete this contact ?"
    Else
        lb_IsPrimary = False
        ll_ConfirmMsgID = 2500
        ls_ConfirmMsgDesc = "#Do you really want to delete this contact?"
    End If
    mo_ArmDb.Close (ll_Cursor)
    If DeleteConfirmation(mo_ArmDb, m_Language, ll_ConfirmMsgID, ls_ConfirmMsgDesc) = False Then GoTo Trace_End
    
    'Execution
    If ErrorFound Then GoTo Trace_End
    
    
    ' Step 2 - Prepare transaction
        ' Drop the contact
    Dim ls_Request_DropContact As String
    ls_Request_DropContact = "Exec Cap_Contact_del '" & ACode1 & "', " & p_iCon
        ' Clear the primary contact
    Dim ls_Request_ClearPrim As String
    ls_Request_ClearPrim = "Exec Claim_Customer_PrimaryContactClear '" & ACode2 & "', '" & ACode1 & "'"
        ' Update the customer (used if the primary contact has not been cleared)
    Dim ls_Request_LastUpdateCustomer As String
    ls_Request_LastUpdateCustomer = "Exec Claim_Customer_LastUpd '" & ACode2 & "'"
    
            ' Update project
    Dim ls_Request_UpdateProjects As String
    ls_Request_UpdateProjects = "Exec Cap_Contact_Sales_Project_LastUpd '" & ACode1 & "'"
    
    ' Step 3 - Execute the transaction
    Dim lb_InTransaction As Boolean, lb_ContactDropped As Boolean
    
    lb_ContactDropped = False
    ASC_BeginTransaction mo_ArmDb
    
    lb_InTransaction = True
    
    Call ExecuteSQLSafe(mo_ArmDb, ls_Request_DropContact, 1)
    lb_ContactDropped = True
    
    ' Clear the primary contact only if it's still the primary contact
    If lb_IsPrimary Then
        If ExecuteSQLSafe(mo_ArmDb, ls_Request_ClearPrim) = 0 Then ' Someone already change it...
            ' Changing a contact MUST update the customer
            Call ExecuteSQLSafe(mo_ArmDb, ls_Request_LastUpdateCustomer, 1)
        End If
    Else
        ' Changing a contact MUST update the customer
        Call ExecuteSQLSafe(mo_ArmDb, ls_Request_LastUpdateCustomer, 1)
    End If
    
    ' If the contact was not linked to any projects, nothing has to be done
    Call ExecuteSQLSafe(mo_ArmDb, ls_Request_UpdateProjects)
    
    ASC_CommitTransaction mo_ArmDb
    lb_InTransaction = False
    RecordDelete = True
    
Trace_End:
    mo_ArmDb.Close ll_Cursor
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:RecordDelete", "Result=" & RecordDelete
    #End If
    CapMouseOn
    Exit Function
    
Trace_Err:
    Dim ll_Err As Long
    Dim ls_Err As String
    ll_Err = Err.Number
    ls_Err = Err.Description
    
    mo_ArmDb.Close ll_Cursor
    If lb_InTransaction Then ASC_RollBackTransaction mo_ArmDb
    
    
    ' Display error message
    If (ll_Err = ArmErr.SQLBadRowAffectedCount) And (Not lb_ContactDropped) And (lb_InTransaction) Then
        ' We are in the transaction
        ' The contact has not been dropped yet
        ' We executed a request that don't affect the good count of rows
        ' It's a concurrency issue on the contact !
        Call ASC_SendMessage(mo_ArmDb, m_Language, 916, "#This data has been updated by another user. Data will be reloaded. Please check the data and try again.")
        ' We reload the contact to display the change done by the other user
        ViewInitFields
    Else
        ' Display generic message
        Call ASC_SendMessage(mo_ArmDb, m_Language, 891, "#An error occured during this manipulation, please contact your IT support")
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceError ll_Err, ls_Err, "capcon:RecordDelete"
    End If
    CapMouseOn
End Function

Private Function WithParent() As Boolean
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:WithParent"
    #End If
    
    If m_Project = "" And m_Customer = "" And m_Memo = "" And m_Product = "" And m_Action = "" Then
        WithParent = False
    Else
        WithParent = True
    End If

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:WithParent", "Result=" & WithParent
    #End If
    CapMouseOn
    Exit Function
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:WithParent"
    CapMouseOn
End Function

Private Sub LongListDisplay()
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:LongListDisplay"
    #End If
    
    RaiseEvent SwitchToView(mt_CstValues.View_Full)
    
    'If the component was on short list, it does appear now in long list
    InitControl 1
    InitParentKey
        
    Call LongList_Resize
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:LongListDisplay"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:LongListDisplay"
    CapMouseOn
End Sub

Private Sub LongList_Resize()
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:LongList_Resize"
    #End If
    
    With UserControl
    
        .fraFilters.Width = mt_CstValues.View_Frame_Width
        .fraFilters.Left = mt_CstValues.Frm_Spacing
        .fraFilters.Top = mt_CstValues.Frm_Spacing
        .fraFilters.Height = .Height - .fraFilters.Top - (2 * mt_CstValues.Frm_Spacing)
        
        .fraList.Left = .fraFilters.Left + fraFilters.Width + mt_CstValues.Frm_Spacing
        .fraList.Top = mt_CstValues.Frm_Spacing
        .fraList.Width = .Width - .fraList.Left - mt_CstValues.Frm_Spacing
        .fraList.Height = .Height - .fraList.Top - (2 * mt_CstValues.Frm_Spacing)
        
        .tvitems.Left = mt_CstValues.Frm_Spacing
        .tvitems.Width = .fraFilters.Width - (2 * mt_CstValues.Frm_Spacing)
        
        '.tbsFilters.Left = mt_CstValues.Frm_Spacing
        '.tbsFilters.Top = .fraFilters.Height - .tbsFilters.Height - mt_CstValues.Frm_Spacing
        '.tbsFilters.Width = .tvitems.Width
        
        .tvitems.Height = .fraFilters.Height - .tvitems.Top - mt_CstValues.Frm_Spacing
        
        .pblst.Height = mt_CstValues.View_ToolBar_Height
        .pblst.Top = mt_CstValues.Frm_Spacing * 4
        .pblst.Left = mt_CstValues.Frm_Spacing
        .pblst.Width = .fraList.Width - .pblst.Left - (2 * mt_CstValues.Frm_Spacing)
        .pblst.Refresh
        .fill_all_record.Left = mt_CstValues.Frm_Spacing + 5000
        .fill_all_record.Top = (mt_CstValues.Frm_Spacing * 4) + 60
        .fill_all_record.Zorder 0
        .fill_all_record.Picture = LoadResPicture(116, vbResIcon)
        .fill_all_record.Visible = 0
       
        lbl_ListFilter.Top = mt_CstValues.Frm_Spacing + .pblst.Top + .pblst.Height + 50
        lbl_ListFilter.Left = mt_CstValues.Frm_Spacing
        lbl_ListFilter.Width = .fraList.Width - .pblst.Left - (2 * mt_CstValues.Frm_Spacing)
              
        .grdlst.Top = mt_CstValues.Frm_Spacing + .pblst.Top + .pblst.Height + 500
        .grdlst.Left = mt_CstValues.Frm_Spacing
        .grdlst.Width = .fraList.Width - .grdlst.Left - mt_CstValues.Frm_Spacing
        .grdlst.Height = .fraList.Height - .grdlst.Top - mt_CstValues.Frm_Spacing
          
        .fraFilters.Visible = True
        .fraFilters.Enabled = True
        .fraList.Visible = True
        .lbl_ListFilter.Visible = True
        
        CboView_Resize lbl_view, cbo_view, fraFilters
        
        
    End With
    
    Call ControlsEnable(UserControl.Controls, UserControl.fraFilters, True)
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:LongList_Resize"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:LongList_Resize"
    CapMouseOn
End Sub

Private Sub Add_Resize()

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:Add_Resize"
    #End If
    
    With UserControl
        
        .fraFilters.Width = mt_CstValues.View_Frame_Width
        .fraFilters.Left = mt_CstValues.Frm_Spacing
        .fraFilters.Top = mt_CstValues.Frm_Spacing
        .fraFilters.Height = .Height - .fraFilters.Top - (2 * mt_CstValues.Frm_Spacing)
        '.fraFilters.Left = 0
        '.fraFilters.Width = 0
        
        .tvitems.Left = mt_CstValues.Frm_Spacing
        .tvitems.Width = .fraFilters.Width - (2 * mt_CstValues.Frm_Spacing)
                
        '.tbsFilters.Left = mt_CstValues.Frm_Spacing
        '.tbsFilters.Top = .fraFilters.Height - .tbsFilters.Height - mt_CstValues.Frm_Spacing
        '.tbsFilters.Width = .tvitems.Width
        
        .tvitems.Height = .fraFilters.Height - .tvitems.Top - mt_CstValues.Frm_Spacing
        
        .fraItem.Left = mt_CstValues.Frm_Spacing
        .fraItem.Top = mt_CstValues.Frm_Spacing
        .fraItem.Width = .Width - .fraItem.Left - (2 * mt_CstValues.Frm_Spacing)
        .fraItem.Height = .Height - .fraItem.Top - (2 * mt_CstValues.Frm_Spacing)
        
        .pbitem.Height = mt_CstValues.View_ToolBar_Height
        .pbitem.Top = mt_CstValues.Frm_Spacing * 4
        .pbitem.Left = mt_CstValues.Frm_Spacing
        .pbitem.Width = .fraItem.Width - .pbitem.Left - (2 * mt_CstValues.Frm_Spacing)
        .pbitem.Refresh
        
        .tbsEmbedded.Visible = False
        
        .fraItemTop.Width = .fraItem.Width - .fraItemTop.Left - mt_CstValues.Frm_Spacing
        .fraItemTop.Left = mt_CstValues.Frm_Spacing
        .fraItemTop.Top = mt_CstValues.Frm_Spacing + .pbitem.Top + .pbitem.Height
        
        .tbsEmbedded.Top = .fraItem.Height - .tbsEmbedded.Height - mt_CstValues.Frm_Spacing
        .tbsEmbedded.Left = mt_CstValues.Frm_Spacing
        .tbsEmbedded.Width = .fraItem.Width - .tbsEmbedded.Left - mt_CstValues.Frm_Spacing
        
        .fraItemBottom.Width = .fraItem.Width - .tbsEmbedded.Left - mt_CstValues.Frm_Spacing
        .fraItemBottom.Height = mt_CstValues.Cpt_View_Emb_Height
        .fraItemBottom.Top = .tbsEmbedded.Top - .fraItemBottom.Height
        .fraItemBottom.Left = mt_CstValues.Frm_Spacing
        
        .fraFilters.Visible = True
        .fraFilters.Enabled = False
        
        .fraItem.Visible = True
        .fraItemTop.BorderStyle = 0
        .fraItemBottom.Visible = True
        .fraItemBottom.BorderStyle = 0
        
    End With

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:Add_Resize"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:Add_Resize"
    CapMouseOn
End Sub

Private Sub Update_Resize()
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:Update_Resize"
    #End If
    
    With UserControl
    
        .fraFilters.Width = mt_CstValues.View_Frame_Width
        .fraFilters.Left = mt_CstValues.Frm_Spacing
        .fraFilters.Top = mt_CstValues.Frm_Spacing
        .fraFilters.Height = .Height - .fraFilters.Top - (2 * mt_CstValues.Frm_Spacing)
        '.fraFilters.Left = 0
        '.fraFilters.Width = 0
        
        .tvitems.Left = mt_CstValues.Frm_Spacing
        .tvitems.Width = .fraFilters.Width - (2 * mt_CstValues.Frm_Spacing)
                
        '.tbsFilters.Left = mt_CstValues.Frm_Spacing
        '.tbsFilters.Top = .fraFilters.Height - .tbsFilters.Height - mt_CstValues.Frm_Spacing
        '.tbsFilters.Width = .tvitems.Width
        
        .tvitems.Height = .fraFilters.Height - .tvitems.Top - mt_CstValues.Frm_Spacing
        
        .fraItem.Left = mt_CstValues.Frm_Spacing
        .fraItem.Top = mt_CstValues.Frm_Spacing
        .fraItem.Width = .Width - .fraItem.Left - (2 * mt_CstValues.Frm_Spacing)
        .fraItem.Height = .Height - .fraItem.Top - (2 * mt_CstValues.Frm_Spacing)
        
        .pbitem.Height = mt_CstValues.View_ToolBar_Height
        .pbitem.Top = mt_CstValues.Frm_Spacing * 4
        .pbitem.Left = mt_CstValues.Frm_Spacing
        .pbitem.Width = .fraItem.Width - .pbitem.Left - (2 * mt_CstValues.Frm_Spacing)
        .pbitem.Refresh
        
        .fraItemTop.Width = .fraItem.Width - .fraItemTop.Left - mt_CstValues.Frm_Spacing
        .fraItemTop.Left = mt_CstValues.Frm_Spacing
        .fraItemTop.Top = mt_CstValues.Frm_Spacing + .pbitem.Top + .pbitem.Height
        
        .tbsEmbedded.Top = .fraItem.Height - .tbsEmbedded.Height - mt_CstValues.Frm_Spacing
        .tbsEmbedded.Left = mt_CstValues.Frm_Spacing
        .tbsEmbedded.Width = .fraItem.Width - .tbsEmbedded.Left - mt_CstValues.Frm_Spacing
        
        .fraItemBottom.Width = .fraItem.Width - .tbsEmbedded.Left - mt_CstValues.Frm_Spacing
        .fraItemBottom.Height = mt_CstValues.Cpt_View_Emb_Height
        .fraItemBottom.Top = .tbsEmbedded.Top - .fraItemBottom.Height
        .fraItemBottom.Left = mt_CstValues.Frm_Spacing
        
        .tbsEmbedded.Visible = False
        
        .fraFilters.Visible = True
        .fraFilters.Enabled = False
        
        .fraItem.Visible = True
        .fraItemTop.BorderStyle = 0
        .fraItemBottom.Visible = True
        .fraItemBottom.BorderStyle = 0
    
    End With

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:Update_Resize"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:Update_Resize"
    CapMouseOn
End Sub


Property Get FraFilterLeft() As Long
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:FraFilterLeft"
    #End If
    
    FraFilterLeft = UserControl.fraFilters.Left + UserControl.fraFilters.Width
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:FraFilterLeft"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:FraFilterLeft"
    CapMouseOn
End Property
Property Get UserControlWidth() As Long
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:UserControlWidth"
    #End If
    
    UserControlWidth = UserControl.Width
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:UserControlWidth"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:UserControlWidth"
    CapMouseOn
End Property

Private Sub Delete_Resize()

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:Delete_Resize"
    #End If
    
    With UserControl
        
        .fraFilters.Width = mt_CstValues.View_Frame_Width
        .fraFilters.Left = mt_CstValues.Frm_Spacing
        .fraFilters.Top = mt_CstValues.Frm_Spacing
        .fraFilters.Height = .Height - .fraFilters.Top - (2 * mt_CstValues.Frm_Spacing)
        '.fraFilters.Left = 0
        '.fraFilters.Width = 0
        
        .tvitems.Left = mt_CstValues.Frm_Spacing
        .tvitems.Width = .fraFilters.Width - (2 * mt_CstValues.Frm_Spacing)
                
        '.tbsFilters.Left = mt_CstValues.Frm_Spacing
        '.tbsFilters.Top = .fraFilters.Height - .tbsFilters.Height - mt_CstValues.Frm_Spacing
        '.tbsFilters.Width = .tvitems.Width
        
        .tvitems.Height = .fraFilters.Height - .tvitems.Top - mt_CstValues.Frm_Spacing
        
        .fraItem.Left = mt_CstValues.Frm_Spacing
        .fraItem.Top = mt_CstValues.Frm_Spacing
        .fraItem.Width = .Width - .fraItem.Left - (2 * mt_CstValues.Frm_Spacing)
        .fraItem.Height = .Height - .fraItem.Top - (2 * mt_CstValues.Frm_Spacing)
        
        .pbitem.Height = mt_CstValues.View_ToolBar_Height
        .pbitem.Top = mt_CstValues.Frm_Spacing * 4
        .pbitem.Left = mt_CstValues.Frm_Spacing
        .pbitem.Width = .fraItem.Width - .pbitem.Left - (2 * mt_CstValues.Frm_Spacing)
        .pbitem.Refresh
        
        .tbsEmbedded.Visible = False
        
        .fraItemTop.Width = .fraItem.Width - .fraItemTop.Left - mt_CstValues.Frm_Spacing
        .fraItemTop.Left = mt_CstValues.Frm_Spacing
        .fraItemTop.Top = mt_CstValues.Frm_Spacing + .pbitem.Top + .pbitem.Height
        
        .tbsEmbedded.Top = .fraItem.Height - .tbsEmbedded.Height - mt_CstValues.Frm_Spacing
        .tbsEmbedded.Left = mt_CstValues.Frm_Spacing
        .tbsEmbedded.Width = .fraItem.Width - .tbsEmbedded.Left - mt_CstValues.Frm_Spacing
        
        .fraItemBottom.Width = .fraItem.Width - .tbsEmbedded.Left - mt_CstValues.Frm_Spacing
        .fraItemBottom.Height = mt_CstValues.Cpt_View_Emb_Height
        .fraItemBottom.Top = .tbsEmbedded.Top - .fraItemBottom.Height
        .fraItemBottom.Left = mt_CstValues.Frm_Spacing
        
        .fraFilters.Visible = True
        .fraFilters.Enabled = False
        
        .fraItem.Visible = True
        .fraItemTop.Visible = True
        .fraItemBottom.Visible = True
        .fraItemTop.BorderStyle = 0
        .fraItemBottom.BorderStyle = 0
        
    End With
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:Delete_Resize"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:Delete_Resize"
    CapMouseOn
End Sub


Public Sub GoToTab1()

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:GoToTab1"
    #End If
    
    
    If UserControl.tbsEmbedded.Tabs.Count > 0 Then
        UserControl.tbsEmbedded.Tabs(1).Selected = True
    End If
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:GoToTab1"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:GoToTab1"
    CapMouseOn
End Sub

Private Sub View_Resize()
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:View_Resize"
    #End If
    
    With UserControl
        
        If mi_EmbeddedIn = -1 And Not mb_Root Then
        
            .fraFilters.Width = mt_CstValues.View_Frame_Width
            .fraFilters.Left = mt_CstValues.Frm_Spacing
            .fraFilters.Top = mt_CstValues.Frm_Spacing
            .fraFilters.Height = .Height - .fraFilters.Top - (2 * mt_CstValues.Frm_Spacing)
            '.fraItem.Left = mt_CstValues.Frm_Spacing
            .fraItem.Left = .fraFilters.Left + fraFilters.Width + mt_CstValues.Frm_Spacing
            
            .fraFilters.Visible = True
            .fraFilters.Enabled = True
            
            .tbsEmbedded.Visible = True
            .tbsEmbedded.Zorder 0
            
        Else
            .fraItem.Left = mt_CstValues.Frm_Spacing
            
            .tbsEmbedded.Visible = True
            .tbsEmbedded.Zorder 0
            
        End If
        
        .fraItem.Top = mt_CstValues.Frm_Spacing
        .fraItem.Width = .Width - .fraItem.Left - (2 * mt_CstValues.Frm_Spacing)
        .fraItem.Height = .Height - .fraItem.Top - (2 * mt_CstValues.Frm_Spacing)
        
        .tvitems.Left = mt_CstValues.Frm_Spacing
        .tvitems.Width = .fraFilters.Width - (2 * mt_CstValues.Frm_Spacing)
                
        '.tbsFilters.Left = mt_CstValues.Frm_Spacing
        '.tbsFilters.Top = .fraFilters.Height - .tbsFilters.Height - mt_CstValues.Frm_Spacing
        '.tbsFilters.Width = .tvitems.Width
        
        .tvitems.Height = .fraFilters.Height - .tvitems.Top - mt_CstValues.Frm_Spacing
        
        .pbitem.Height = mt_CstValues.View_ToolBar_Height
        .pbitem.Top = mt_CstValues.Frm_Spacing * 4
        .pbitem.Left = mt_CstValues.Frm_Spacing
        .pbitem.Width = .fraItem.Width - .pbitem.Left - (2 * mt_CstValues.Frm_Spacing)
        .pbitem.Refresh
        
        .fraItemTop.Width = .fraItem.Width - .fraItemTop.Left - mt_CstValues.Frm_Spacing
        .fraItemTop.Left = mt_CstValues.Frm_Spacing
        .fraItemTop.Top = mt_CstValues.Frm_Spacing + .pbitem.Top + .pbitem.Height
        
        .tbsEmbedded.Top = .fraItem.Height - .tbsEmbedded.Height - mt_CstValues.Frm_Spacing
        .tbsEmbedded.Left = mt_CstValues.Frm_Spacing
        .tbsEmbedded.Width = .fraItem.Width - .tbsEmbedded.Left - mt_CstValues.Frm_Spacing
        
        .fraItemBottom.Width = .fraItem.Width - .tbsEmbedded.Left - mt_CstValues.Frm_Spacing
        .fraItemBottom.Height = mt_CstValues.Cpt_View_Emb_Height
        .fraItemBottom.Top = .tbsEmbedded.Top - .fraItemBottom.Height
        .fraItemBottom.Left = mt_CstValues.Frm_Spacing
        
        .fraItemBottom.Visible = True
        
        .fraItem.Visible = True
        .fraItemTop.BorderStyle = 0
        .fraItemBottom.BorderStyle = 0
        
    End With

    Call ControlsEnable(UserControl.Controls, UserControl.fraFilters, False)

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:View_Resize"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:View_Resize"
    CapMouseOn
End Sub

Private Sub ShortList_Resize()
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:ShortList_Resize"
    #End If
    
    With UserControl
    
        .fraList.Left = mt_CstValues.Frm_Spacing
        .fraList.Top = mt_CstValues.Frm_Spacing
        .fraList.Width = .Width - .fraList.Left - (2 * mt_CstValues.Frm_Spacing)
        .fraList.Height = .Height - .fraList.Top - (2 * mt_CstValues.Frm_Spacing)
   
        .pblst.Height = mt_CstValues.View_ToolBar_Height
        .pblst.Top = mt_CstValues.Frm_Spacing * 4
        .pblst.Left = mt_CstValues.Frm_Spacing
        .pblst.Width = .fraList.Width - .pblst.Left - (2 * mt_CstValues.Frm_Spacing)
        .pblst.Refresh
        
        .grdlst.Top = mt_CstValues.Frm_Spacing + .pblst.Top + .pblst.Height
        .grdlst.Left = mt_CstValues.Frm_Spacing
        .grdlst.Width = .fraList.Width - .grdlst.Left - mt_CstValues.Frm_Spacing
        .grdlst.Height = .fraList.Height - .pblst.Height - .pblst.Top - (2 * mt_CstValues.Frm_Spacing)
        
        .fraFilters.Visible = False
        .fraList.Visible = True
        .fill_all_record.Visible = 0
    End With
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:ShortList_Resize"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:ShortList_Resize"
    CapMouseOn
End Sub


Property Let project(AKey As String)
Dim TheKeys As Variant

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:Project_Let", "AKey=" & AKey
    #End If
    
    'AKey represents the concatenation of several keys separated by '@'
    If AKey = "" Then GoTo Trace_End

    ' First, we hide all elements
    DisplayMode_None
    
    If (Not mb_Root) And (mi_TypeList <> 1) Then
        mi_EmbedTag = -1
    End If
    
    InitControl 2
    
    mi_EmbeddedIn = mt_CstValues.Tag_Project
   
    TheKeys = Split(AKey, CH_LDELIMIT)
    m_Project = CStr(TheKeys(0))
    mb_EmbeddedIsDropped = False
    ListProjectOf CStr(TheKeys(0)), CStr(TheKeys(1))
    
    SwapToDisplayMode mt_CstValues.DisplayMode_List
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:Project_Let"
    #End If
    CapMouseOn
    Exit Property
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:Project_Let"
    CapMouseOn
End Property

Property Let Customer(AKey As String)
Dim TheKeys As Variant

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:Customer_Let", "AKey=" & AKey
    #End If
    
    'AKey represents the concatenation of several keys separated by '@'
    If AKey = "" Then GoTo Trace_End

    'First, we hide all elements
    DisplayMode_None
    
    If (Not mb_Root) And (mi_TypeList <> 1) Then
        mi_EmbedTag = -1
    End If
    
    InitControl 2
    
    mi_EmbeddedIn = mt_CstValues.Tag_Customer
   
    TheKeys = Split(AKey, CH_LDELIMIT)
    m_Customer = CStr(TheKeys(0))
    mb_EmbeddedIsDropped = (TheKeys(2) = "1") ' TASK 298.2
    ListCustomerOf CStr(TheKeys(0)), CStr(TheKeys(1))
    
    SwapToDisplayMode mt_CstValues.DisplayMode_List

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:Customer_Let"
    #End If
    CapMouseOn
    Exit Property
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:Customer_Let"
    CapMouseOn
End Property

Property Let memo(AMemoKey As String)
Dim TheKeys As Variant

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:Memo_Let", "AMemoKey=" & AMemoKey
    #End If
    
    'AKey represents the concatenation of several keys separated by '@'
    If AMemoKey = "" Then GoTo Trace_End

    ' First, we hide all elements
    DisplayMode_None
    
    If (Not mb_Root) And (mi_TypeList <> 1) Then
        mi_EmbedTag = -1
    End If
    
    InitControl 2
    
    mi_EmbeddedIn = mt_CstValues.Tag_Memo
   
    TheKeys = Split(AMemoKey, CH_LDELIMIT)
    m_Memo = CStr(TheKeys(0))
    
    SwapToDisplayMode mt_CstValues.DisplayMode_List

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:Memo_Let"
    #End If
    CapMouseOn
    Exit Property
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:Memo_Let"
    CapMouseOn
End Property

Property Let action(AActionKey As String)
Dim TheKeys As Variant

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:action_Let", "AActionKey=" & AActionKey
    #End If
    
    'AKey represents the concatenation of several keys separated by '@'
    If AActionKey = "" Then GoTo Trace_End

    ' First, we hide all elements
    DisplayMode_None
    
    If (Not mb_Root) And (mi_TypeList <> 1) Then
        mi_EmbedTag = -1
    End If
    
    InitControl 2
    
    mi_EmbeddedIn = mt_CstValues.Tag_Action
    TheKeys = Split(AActionKey, CH_LDELIMIT)
    m_Action = CStr(TheKeys(0))
    ListActionOf m_Action, CStr(TheKeys(1)), CStr(TheKeys(2))
    
    If grdlst.Rows <> 0 Then
        SwapToDisplayMode mt_CstValues.DisplayMode_List
        SelectFirst
    Else
        Call ASC_SendMessage(mo_ArmDb, m_Language, 941, "#This action is not linked to a contact")
        RaiseEvent HideGrid(mi_EmbeddedIn)
    End If

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:action_Let"
    #End If
    CapMouseOn
    Exit Property
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:action_Let"
    CapMouseOn
End Property

Private Sub SelectFirst()
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:SelectFirst"
    #End If
    
    grdlst.FirstLine
    'grdlst.SelectItem
    grdLst_ItemSelected
    'If grdlst.CurrentKey <> "" Then DisplayMode = mt_CstValues.DisplayMode_View
    
Trace_End:
   #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:SelectFirst"
    #End If
   CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:SelectFirst"
    CapMouseOn
End Sub

Property Let product(AProductKey As String)
Dim TheKeys As Variant

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:Product_Let", "AProductKey=" & AProductKey
    #End If
    
    'AKey represents the concatenation of several keys separated by '@'
    If AProductKey = "" Then GoTo Trace_End

    ' First, we hide all elements
    DisplayMode_None
    
    If (Not mb_Root) And (mi_TypeList <> 1) Then
        mi_EmbedTag = -1
    End If
    
    InitControl 2
    
    mi_EmbeddedIn = mt_CstValues.Tag_Product
   
    TheKeys = Split(AProductKey, CH_LDELIMIT)
    m_Product = CStr(TheKeys(0))
    mb_EmbeddedIsDropped = False
    
    SwapToDisplayMode mt_CstValues.DisplayMode_List

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:Product_Let"
    #End If
    CapMouseOn
    Exit Property
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:Product_Let"
    CapMouseOn
End Property

Property Let TypeList(AType As Integer)
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:TypeList_Let", "AType=" & AType
    #End If
    mi_TypeList = AType
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:TypeList_Let"
    #End If
End Property

Property Get TypeList() As Integer
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:TypeList_Get"
    #End If
    TypeList = mi_TypeList
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:TypeList_Get", "Result=" & TypeList
    #End If
End Property


Private Sub InitControl(Optional aMode As Integer = 0)
Dim ConnectData As Variant
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:InitControl", "AMode=" & aMode
    #End If
    
    If Not ASC_ConnectToDB(mo_ArmDb, ms_ConnectString, mb_Created) Then GoTo Trace_End
   
    Select Case aMode
        Case 0
    'If No mode then exit
            GoTo Trace_End
   
        Case 1
    'If already initialized then exit
        If mi_TypeList <> 1 Then
            mi_TypeList = 1
        Else
            pblst.PictureDisplayed = "P_Quit=-1"
            GoTo Trace_End
        End If
        Case 2
        If mi_TypeList <> 1 And mi_TypeList <> 2 Then
            mi_TypeList = 2
        End If
    End Select
   
    UserControl.ScaleMode = 1
    
   
    'Object unvisble
    ObjectVisible False
    
    Select Case aMode
        Case 1
    'Pour la liste longue uniquement
    
        DrawMainGrid
                
        Case 2
    'Pour la liste courte
    
        'Grille
        grdlst.ResetGrid
        
        'Pour liste longue : Initialisation toolbar
        pblst.ClearAllIcons
        pblst.TableName = mt_CstValues.SecurityContact_lst
        pblst.PictureDisplayed = "P_Refresh=7"
            
        Case 3
    'Pour détail
    
        pbitem.ClearAllIcons
'            If WithParent Then
'                pbItem.TableName = mt_CstValues.SecurityContact_lst
'            Else
'                pbItem.TableName = mt_CstValues.SecurityContact
'            End If
'            pbItem.PictureDisplayed = "P_Print=5 P_Quit=-1"
            pbitem.TableName = ""
            pbitem.PictureDisplayed = "P_Update=2 P_Delete=3 P_Previous=4 P_Next=5 P_Quit=-1"
    
        Case 4
    'Pour màj
      
        'Toolbar
        pbitem.ClearAllIcons
        If DisplayMode = mt_CstValues.DisplayMode_Delete Then
            pbitem.PictureDisplayed = "P_Valid=1 P_Quit=-1"
        Else
            pbitem.PictureDisplayed = "P_Valid=1 P_UnDo=2 P_Quit=-1"
        End If
    
    End Select
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:InitControl"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:InitControl"
    CapMouseOn
End Sub
Private Sub ObjectVisible(Optional aVisible As Boolean = True)

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:ObjectVisible", "AVisible=" & aVisible
    #End If
    
    UserControl.fraFilters.Visible = aVisible
    UserControl.fraItem.Visible = aVisible
    UserControl.fraList.Visible = aVisible

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:ObjectVisible"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:ObjectVisible"
    CapMouseOn
End Sub

Sub UpdateInitFields()

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:UpdateInitFields"
    #End If

    'idem
    ViewInitFields
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:UpdateInitFields"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:UpdateInitFields"
    CapMouseOn
End Sub
Sub View_EnableControls()

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:View_EnableControls"
    #End If

    ControlsEnable UserControl.Controls, fraItemTop, False
    ControlsEnable UserControl.Controls, fraItemBottom, False
    lbl_cntCode.Enabled = True
    txt_CntCode.Enabled = True
    ckvMailingList.Enabled = True
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:View_EnableControls"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:View_EnableControls"
    CapMouseOn
End Sub
Sub Add_Enablecontrols()

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:Add_Enablecontrols"
    #End If

    ControlsEnable UserControl.Controls, fraItemTop, True
    ControlsEnable UserControl.Controls, fraItemBottom, True
    
    lbl_CCU.Enabled = False
    txt_desc.Enabled = False
    chk_DropFlag.Enabled = False

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:Add_Enablecontrols"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:Add_Enablecontrols"
    CapMouseOn
End Sub

Sub Update_EnableControls()

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:Update_EnableControls"
    #End If

    ControlsEnable UserControl.Controls, fraItemTop, True
    ControlsEnable UserControl.Controls, fraItemBottom, True
    
    lbl_CCU.Enabled = False
    txt_desc.Enabled = False
    chk_DropFlag.Enabled = False
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:Update_EnableControls"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:Update_EnableControls"
    CapMouseOn
End Sub
Property Get CurrentKey(Optional APart As Integer = 0) As String

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:CurrentKey_Get", "APart=" & APart
    #End If

    If APart = 0 Then
        CurrentKey = m_CurrentKey1 & CH_LDELIMIT & m_CurrentKey2 & CH_LDELIMIT & m_CurrentKey3
    ElseIf APart = 1 Then
        CurrentKey = m_CurrentKey1
    ElseIf APart = 2 Then
        CurrentKey = m_CurrentKey2
    ElseIf APart = 3 Then
        CurrentKey = m_CurrentKey3
    Else
        CurrentKey = ""
    End If

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:CurrentKey_Get", "Result=" & CurrentKey
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:CurrentKey_Get"
    CapMouseOn
End Property

Property Let CurrentKey(Optional APart As Integer = 0, AKeyValue As String)

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:CurrentKey_Let", "APart=" & APart, "AKeyValue=" & AKeyValue
    #End If

    If APart = 0 Then
        m_CurrentKey1 = AKeyValue
        m_CurrentKey2 = ""
        m_CurrentKey3 = ""
    ElseIf APart = 1 Then
        m_CurrentKey1 = AKeyValue
    ElseIf APart = 2 Then
        m_CurrentKey2 = AKeyValue
    ElseIf APart = 3 Then
        m_CurrentKey3 = AKeyValue
    Else
        CurrentKey = ""
    End If

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:CurrentKey_Let"
    #End If
    CapMouseOn
    Exit Property
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:CurrentKey_Get"
    CapMouseOn
End Property

Sub UnCatch()
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:UnCatch"
    #End If
    mi_EmbeddedIn = -1
    Call grdlst.DeselectRow
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:UnCatch"
    #End If
End Sub

Private Sub calBirthday_changeposition(y As Integer)
    calBirthday.Zorder 0
    calBirthday.Top = calBirthday.Top + y
End Sub


Private Sub cbo_View_ComboItemSelected()
Dim ls_Key As String

    On Error GoTo Trace_Err
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:cbo_view_ComboItemSelected"
    #End If
    CapMouseOff
    
    If reload_treeview.Visible = True Then GoTo Trace_End

    ls_Key = ""
    If reload_treeview.Visible = False Then
        If grdlst.Row >= 0 Then
            ls_Key = grdlst.CurrentKey(0)
        End If
    ReinitTreeview GetCodeFromCombo(cbo_view)
    End If
    If ls_Key <> "" Then
        SearchTreeView ls_Key, False
    End If
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:cbo_view_ComboItemSelected"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:cbo_view_ComboItemSelected"
    CapMouseOn
End Sub



Private Sub fill_all_record_Click()
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:fill_all_record_Click"
    #End If

    If tvitems.Checkboxes = True Then
        grdlst.Requests = tvitems.CheckedNodesRequests
    Else
        grdlst.Requests = tvitems.SelectedNodeRequest
    End If
    If grdlst.Execute = False Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceSQLError grdlst.ArmDb, "CapCon:fill_all_record_Click", "Requests=", grdlst.Requests
    End If

    fill_all_record.Visible = False

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:fill_all_record_Click"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:fill_all_record_Click"
    CapMouseOn
End Sub

Private Sub grdLst_ItemSelected()
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:grdlst_ItemSelected"
    #End If
    
    Dim a As Double, b As Double
    a = timer
    
    CapMouseOff
    
    m_CurrentKey1 = grdlst.CurrentKey(0)
    m_CurrentKey2 = grdlst.CurrentKey(1)
    m_CurrentKey3 = grdlst.CurrentKey(2)
    If grdlst.Row >= 0 Then DisplayMode = mt_CstValues.DisplayMode_View
    
    
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:grdlst_ItemSelected"
    #End If
    CapMouseOn
    
    b = timer - a
    Call AddToTimeLog(6, b)
    
End Sub


Private Sub pbItem_action(ByVal as_ActionType As String)
Dim lb_Result As Boolean

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:pbItem_action", "as_ActionType=" & as_ActionType
    #End If

    Select Case UCase$(as_ActionType)
        Case UCase$("Add")
            DisplayMode = mt_CstValues.DisplayMode_Add
            
        Case UCase$("Update")
            If grdlst.Row >= 0 Then Item_UpdateInit
        
        Case UCase$("Delete")
            If grdlst.Row >= 0 Then Item_DeleteInit
        
        Case UCase$("Excel")

        Case UCase$("Quit")
        
            If mb_Root And mi_DisplayMode = mt_CstValues.DisplayMode_View Then
                ' We stay on the same...
                RaiseEvent UnlockNavigation
                GoTo Trace_End
            End If
        
            If mi_EmbedTag <> -1 And mi_EmbedTag <> mt_CstValues.Tag_Customer Then
                RaiseEvent Release
                mi_EmbedTag = -1
            End If
          
            If Not (m_Action = "") Then
                RaiseEvent HideGrid(mi_EmbeddedIn)
            Else
                DisplayMode = mt_CstValues.DisplayMode_List
            End If
            
        Case UCase$("Valid")
    
            Dim a As Double, b As Double
            a = timer
            Select Case DisplayMode
                Case mt_CstValues.DisplayMode_Add
                    lb_Result = RecordAdd
                Case mt_CstValues.DisplayMode_Update
                    lb_Result = RecordUpdate(m_CurrentKey1, m_CurrentKey2)
                Case mt_CstValues.DisplayMode_Delete
                    lb_Result = RecordDelete(m_CurrentKey1, m_CurrentKey2)
            End Select
            
            If lb_Result Then
                If WithParent Then
                    grdlst.Refresh
                    RaiseEvent Updated
                Else
                    Select Case DisplayMode
                        Case mt_CstValues.DisplayMode_Delete
                            ReinitTreeViewAfterDelete grdlst, tvitems
                        Case mt_CstValues.DisplayMode_Update
                            If chk_UpdateTV.Value Then
                                Call Item_LocalUpdate
                    Else
                                ReinitTreeViewAfterDelete grdlst, tvitems
                            End If
                        Case Else
                            Call Item_LocalUpdate
                    End Select
                End If
                DisplayMode = mt_CstValues.DisplayMode_List
                If Not (m_Action = "") Then RaiseEvent HideGrid(mi_EmbeddedIn)
                b = timer - a
                Call AddToTimeLog(mi_OldDisplayMode, b)
            End If
            
        Case UCase$("Undo")
            BlankFields
            'DisplayMode = mt_CstValues.DisplayMode_List
            If mi_DisplayMode = mt_CstValues.DisplayMode_Add Then
                AddInitFields
            Else
                ViewInitFields
            End If
        
        Case UCase$("Previous")
            If grdlst.Row = 0 Then
                Call ASC_SendMessage(mo_ArmDb, m_Language, 927, "#No more previous item.")
            Else
                grdlst.Row = grdlst.Row - 1
                m_CurrentKey1 = grdlst.CurrentKey(0)
                m_CurrentKey2 = grdlst.CurrentKey(1)
                BlankFields
                ViewInitFields
                CheckMemoContact
            End If
        
        Case UCase$("Next")
            If grdlst.Row = grdlst.Rows - 1 And grdlst.AllDataLoaded = True Then
                Call ASC_SendMessage(mo_ArmDb, m_Language, 928, "#No more next item.")
            Else
                grdlst.Row = grdlst.Row + 1
                m_CurrentKey1 = grdlst.CurrentKey(0)
                m_CurrentKey2 = grdlst.CurrentKey(1)
                BlankFields
                ViewInitFields
                CheckMemoContact
            End If
        
        Case Else
            Call ASC_SendMessage(mo_ArmDb, m_Language, 929, "#Invalid option :", as_ActionType)
    End Select

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:pbItem_action"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:pbItem_action"
    CapMouseOn
End Sub


Private Sub Item_UpdateInit()

    ' Get current key
    Dim ls_Key As String
    ls_Key = grdlst.CurrentKey(0)

    ' Retrieve the drop flag
    Dim ls_Request As String
    ls_Request = "SELECT DROP_Flag FROM Cap_Contact WHERE CNT_Code = '" & ls_Key & "'"
    
    Dim lc_Cursor As Long
    lc_Cursor = OpenSQLSafe(mo_ArmDb, ls_Request)
    Dim ls_DropFlag As String
    ls_DropFlag = mo_ArmDb.GetFields(lc_Cursor, "DROP_Flag")
    
    If (ls_DropFlag <> "X") Then
        ' Not drop, we can go to update screen
        DisplayMode = mt_CstValues.DisplayMode_Update
    Else
        ' Drop, just display a message
        Call ASC_SendMessage(mo_ArmDb, m_Language, 2511, "#You are unable to update a Deleted Contact")
    End If
    
End Sub


Private Sub Item_DeleteInit()

    ' Get current key
    Dim ls_Key As String
    ls_Key = grdlst.CurrentKey(0)

    ' Retrieve the drop flag
    Dim ls_Request As String
    ls_Request = "SELECT DROP_Flag FROM Cap_Contact WHERE CNT_Code = '" & ls_Key & "'"
    
    Dim lc_Cursor As Long
    lc_Cursor = OpenSQLSafe(mo_ArmDb, ls_Request)
    Dim ls_DropFlag As String
    ls_DropFlag = mo_ArmDb.GetFields(lc_Cursor, "DROP_Flag")
    
    If (ls_DropFlag <> "X") Then
        ' Not drop, we can go to delete screen
        DisplayMode = mt_CstValues.DisplayMode_Delete
    Else
        ' Drop, just display a message
        Call ASC_SendMessage(mo_ArmDb, m_Language, 2513, "#This contact is already deleted")
    End If
    
End Sub


Private Sub pbLst_Action(ByVal as_ActionType As String)

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:pbLst_Action", "as_ActionType=" & as_ActionType
    #End If

    Select Case UCase$(as_ActionType)
    
        Case UCase$("Add")
            If m_Project <> "" And mi_EmbeddedIn <> -1 Then
                'short list project
                ShowLink as_ActionType
            Else
                If mb_EmbeddedIsDropped Then
                    Call ASC_SendMessage(mo_ArmDb, m_Language, 2509, "#You are unable to create a Contact for a Deleted Customer")
                Else
                    DisplayMode = mt_CstValues.DisplayMode_Add
                End If
            End If
            
        Case UCase$("Update")
            If grdlst.Row >= 0 Then
                If m_Project <> "" And mi_EmbeddedIn <> -1 Then
                    'short list project
                    ShowLink as_ActionType
                Else
                    Item_UpdateInit
                End If
            End If
            
        Case UCase$("Delete")
            If grdlst.Row >= 0 Then
                If m_Project <> "" And mi_EmbeddedIn = -1 Then
                    'short list project
                    ShowLink as_ActionType
                Else
                    Item_DeleteInit
                End If
            End If
        
        Case UCase$("Refresh")
            If mi_EmbeddedIn <> -1 Then
                grdlst.Refresh
            Else
                grdlst.ClearGrid
                grdlst.Requests = ""
                tvitems.Refresh
            End If
            
        Case UCase$("View")
            OwlSearch
        
        Case UCase$("Print")
        
        Case UCase$("Excel")
           If grdlst.Rows <> 0 Then ExportExcel mo_ArmDb, mb_use_framework_connection, ms_ConnectString, m_Language, grdlst, DataTypeEnum.contact
            
        Case UCase$("Quit")
            RaiseEvent quit
        
        Case Else
            Call ASC_SendMessage(mo_ArmDb, m_Language, 929, "#Invalid option :", as_ActionType)
    
    End Select

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:pbLst_Action"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:pbLst_Action"
    CapMouseOn
End Sub



Private Sub pctTvReset_Click()
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:pctTvReset_Click"
    #End If
    cbo_view.SearchItem "X", "TV_Default", 0 ', "TV_Default"
    tbsArchive.Tabs(2).Selected = True

    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:pctTvReset_Click"
    #End If
    CapMouseOn
End Sub

Private Sub tbsArchive_Click()
    reload_treeview.Visible = True
    fill_all_record.Visible = False
    grdlst.ClearGrid
    grdlst.Requests = ""
    tvitems.Visible = False
    ' TASK 298.2
    lbl_ListFilter.Caption = GetCurrentFiltersDescription
End Sub

Private Sub tvItems_NodeClick(ByVal Node As MSComctlLib.INode)
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:tvItems_NodeClick"
    #End If

    If tvitems.Checkboxes = True Then
        fill_all_record.Visible = True
        GoTo Trace_End
    End If

    grdlst.ClearGrid
    grdlst.Requests = ""
    
    If tvitems.NodeInfo(Node).ml_Level = tvitems.Levels - 1 Then
        fill_all_record.Visible = 0
        grdlst.Requests = tvitems.SelectedNodeRequest
        If grdlst.Execute = False Then
            If Not go_Trace Is Nothing Then go_Trace.WriteTraceSQLError grdlst.ArmDb, "CapCon:tvItems_NodeClick", "Requests=", grdlst.Requests
        End If
    Else
        fill_all_record.Visible = -1
    End If

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:tvItems_NodeClick"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:tvItems_NodeClick"
    CapMouseOn
End Sub

' Initialization of the component
Public Sub Load_A_COM(ab_root As Boolean)
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:Load_A_Com", "ab_root = " & ab_root
    #End If

    VerifyInitialization mo_ArmDb, ms_ConnectString, m_Language, Me
    
    mi_EmbeddedIn = -1  '   Component is not embedded by someone
    mi_EmbedTag = -1    '   Component embed none component
    
    mb_Root = False     ' Component is not the default focus
    
    grdlst.Load_A_COM
    tvitems.Load_A_COM
    ckvMailingList.Load_A_COM
    pbitem.Load_A_COM
    pblst.Load_A_COM
    
    pbitem.DrivenByCapture = True
    pblst.DrivenByCapture = True
    
    cbo_view.Load_A_COM
    cbo_title.Load_A_COM
    cbo_job.Load_A_COM
    
    cbo_title.FirstBlankItem = False
    cbo_title.SearchPrefix = " "
    cbo_title.Request = "EXEC cap_title_cbo " & "'" & ms_UID & "', '" & m_Language & "'"
    cbo_job.FirstBlankItem = False
    cbo_job.SearchPrefix = " "
    cbo_job.Request = "cap_job_cbo " & "'" & ms_UID & "', '" & m_Language & "'"

    calBirthday.opening_toward_top = 1
    
    acvHobbies.Load_A_COM
    
    acvHobbies.Common_List_Load = True
    acvHobbies.Type_Of_Key = tkDependant
    acvHobbies.Calling_Key_Fields = "HB_Code"
    acvHobbies.Driven_By = "Contact"
    acvHobbies.Link_Key_Fields = "HB_Code"
    acvHobbies.ComboVisible = False
    
    acvHobbies.RoleCount = 2
    
    Dim lView As Variant, lEdit As Variant
    lView = Array("RVIEW", "VIEW", "", "", "Main view", "HB_Code®©HB_Desc", "HB_Desc", "2000", "HB_code", "exec Cap_Hobbies_lst '" & m_Language & "'", "", "", True, 2, False, True, 0, 0)
    lEdit = Array("REDIT", "EDIT", "", "", "Main view", "HB_Code®©HB_Desc", "HB_Desc", "2000", "HB_code", "exec Cap_Hobbies_lst '" & m_Language & "'", "", "", False, 2, False, True, 0, 0)
    
    If Not acvHobbies.SetRoleList(Array(lView, lEdit)) Then
        MsgBox "error here"
    End If
    acvHobbies.Synchronize_View = True
    acvHobbies.HideColumnHeaders = True
    acvHobbies.LoadList
    acvHobbies.Init
    acvHobbies.SetVisibleList ("RVIEW")

    tbsArchive.Tabs(2).Selected = True
    
    'acvHobbies.LoadConstants CVptStatic, "SR_Name" & CH_LDELIMIT & Lbl_SalesReps.Caption & CH_LDELIMIT & "RR_Desc" & CH_LDELIMIT & lbl_role.Caption, CVctColumns

    UserControl.ScaleMode = vbPixels
    
    'Screen csts
    LoadLabels mo_ArmDb, UserControl.Controls, "Cap_Contact_Detail", m_Language
    
    reload_treeview.Picture = LoadResPicture(116, vbResIcon)
    reload_treeview.Visible = False
    
    lbl_ListFilter.Caption = GetCurrentFiltersDescription
    
    If ab_root = True Then
        'Initialisation treeview et filtres
        cbo_view.Clear
        cbo_view.FirstBlankItem = False
        cbo_view.Request = "exec TreeView_View_t_lst 'Capture_Contact'," & "'" & m_Language & "'"
        cbo_view.Load
        cbo_view.SearchItem "X", "TV_Default", 0
    End If
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:Load_A_Com"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:Load_A_Com"
    CapMouseOn
End Sub

' Initialization for the framework
Public Sub FrameWorkInit(ByRef lt_CstValues As Type_CstValues, ByVal ls_InstanceName As String, Optional ATypeList As Integer = 0)
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:FrameWorkInit", "ls_InstanceName=" & ls_InstanceName, "ATypeList=" & ATypeList
    #End If

    'Restriction of initialsation
    mi_TypeParam = ATypeList
    
    Set mt_CstValues = lt_CstValues
    
    
    mi_CptTag = mt_CstValues.Tag_Contact
    
    ' Add the tabulation for the embedded controls
    With UserControl
        .tbsEmbedded.Tabs.Clear
        .tbsEmbedded.TabFixedWidth = 150
        Call .tbsEmbedded.Tabs.Add(.tbsEmbedded.Tabs.Count + 1, SetLstKey(mt_CstValues.Tag_Contact), "#Contact")
        Call .tbsEmbedded.Tabs.Add(.tbsEmbedded.Tabs.Count + 1, SetLstKey(mt_CstValues.Tag_Action), "#Action")
        Call .tbsEmbedded.Tabs.Add(.tbsEmbedded.Tabs.Count + 1, SetLstKey(mt_CstValues.Tag_Project), "#Project")
        Call .tbsEmbedded.Tabs.Add(.tbsEmbedded.Tabs.Count + 1, SetLstKey(mt_CstValues.Tag_Customer), "#Customer")
        Call .tbsEmbedded.Tabs.Add(.tbsEmbedded.Tabs.Count + 1, SetLstKey(mt_CstValues.Tag_Memo), "#Memo")
        Call .tbsEmbedded.Tabs.Add(.tbsEmbedded.Tabs.Count + 1, SetLstKey(mt_CstValues.Tag_File), "#File")
        
        tbsEmbedded.Tabs.Item(1).Tag = "tbs_Contact"
        tbsEmbedded.Tabs.Item(2).Tag = "tbs_Action"
        tbsEmbedded.Tabs.Item(3).Tag = "tbs_Project"
        tbsEmbedded.Tabs.Item(4).Tag = "tbs_Customer"
        tbsEmbedded.Tabs.Item(5).Tag = "tbs_Memo"
        tbsEmbedded.Tabs.Item(6).Tag = "tbs_File"
    End With

    
    mi_DisplayMode = mt_CstValues.DisplayMode_None
    mi_OldDisplayMode = mi_DisplayMode
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:FrameWorkInit"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:FrameWorkInit"
    CapMouseOn
End Sub


' Release the memory used
Public Sub Unload_A_COM()
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:Unload_A_COM"
    #End If

    grdlst.Unload_A_COM
    pblst.Unload_A_COM
    pbitem.Unload_A_COM
    tvitems.Unload_A_COM
    ckvMailingList.Unload_A_COM
    cbo_view.Unload_A_COM
    cbo_title.Unload_A_COM
    cbo_job.Unload_A_COM
    acvHobbies.Unload_A_COM

    ASC_DisconnectFromDB mo_ArmDb, ms_UID, mb_Created
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:Unload_A_COM"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:Unload_A_COM"
    CapMouseOn
End Sub

' Properties for let application access to critical data
Public Property Get CptTag()
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:CptTag_Get"
    #End If
    CptTag = mi_CptTag
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:CptTag_Get", "Result=" & CptTag
    #End If
End Property

' Give the tag of the component which embed this instance
Public Property Get EmbeddedIn() As Integer
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:EmbeddedIn_Get"
    #End If
    EmbeddedIn = mi_EmbeddedIn
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:EmbeddedIn_Get", "Result=" & EmbeddedIn
    #End If
End Property

' Give the tag of the component embed by this
Public Property Get EmbedTag() As Integer
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:EmbedTag_Get"
    #End If
    EmbedTag = mi_EmbedTag
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:EmbedTag_Get", "Result=" & EmbedTag
    #End If
End Property

' Get the root state
Public Property Get Root() As Boolean
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:Root_Get"
    #End If
    Root = mb_Root
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:Root_Get", "Result=" & Root
    #End If
End Property

Public Property Let Root(ByVal ab_root As Boolean)
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:Root_Let", "ab_Root=" & ab_root
    #End If
    mb_Root = ab_root
    If mb_Root = True Then
        mi_EmbeddedIn = -1
    End If
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:Root_Let"
    #End If
End Property

' Give the actual display mode
Public Property Get DisplayMode() As Integer
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:DisplayMode_Get"
    #End If
    DisplayMode = mi_DisplayMode
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:DisplayMode_Get", "Result=" & Root
    #End If
End Property

' Change the actual display mode
Public Property Let DisplayMode(ByVal li_DisplayMode As Integer)
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:DisplayMode_Let", "li_DisplayMode=" & li_DisplayMode
    #End If
    CapMouseOff
    SwapToDisplayMode li_DisplayMode
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:DisplayMode_Let"
    #End If
    CapMouseOn
End Property


Public Function cas_all(ByVal parm As String)
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:cas_all", "parm=" & parm
    #End If

    Select Case UCase(parm)
        Case "'ALL'", "''", Len(parm) = 0, "'A'":            cas_all = "Null"
        Case "'N'":  cas_all = "''"
        Case Else: cas_all = parm
    End Select

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:cas_all", "Result=" & cas_all
    #End If
    CapMouseOn
    Exit Function
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:cas_all"
    CapMouseOn
End Function

' Change the display mode
Private Sub SwapToDisplayMode(li_DisplayMode As Integer, Optional ls_Params As String = "")
 
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:SwapToDisplayMode", "li_DisplayMode=" & li_DisplayMode, "ls_Params=" & ls_Params
    #End If

    mi_OldDisplayMode = mi_DisplayMode
   
    'When a component is root, it can't select the list mode
    ' Perhaps a correction
    'If (Not mi_TypeList = 1) And mb_Root And (mi_EmbedTag <> mi_EmbeddedIn) And (li_DisplayMode = mt_CstValues.DisplayMode_List) Then
     If mb_Root And (li_DisplayMode = mt_CstValues.DisplayMode_List) And (EmbeddedIn = -1) Then
        li_DisplayMode = mt_CstValues.DisplayMode_View
    End If

    mi_DisplayMode = li_DisplayMode
   
    'We should hide all graphics frames before resize and move it
    DisplayMode_None
    
    Select Case mi_DisplayMode
        Case mt_CstValues.DisplayMode_List
            'The list mode is different if the component is embedded
            Select Case mi_EmbeddedIn
                Case -1
                    LongListDisplay
                Case Else
                    ShortListDisplay ls_Params
            End Select

        Case mt_CstValues.DisplayMode_View
                ViewDisplay
            
        Case mt_CstValues.DisplayMode_Update
                UpdateDisplay
            
        Case mt_CstValues.DisplayMode_Add
                AddDisplay
            
        Case mt_CstValues.DisplayMode_Delete
                DeleteDisplay
    End Select
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:SwapToDisplayMode"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:SwapToDisplayMode"
    CapMouseOn
End Sub

' Hide all graphics elements
Private Sub DisplayMode_None()
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:DisplayMode_None"
    #End If

    With UserControl
        .fraFilters.Visible = False
        .fraItem.Visible = False
        .fraList.Visible = False
        .lbl_ListFilter.Visible = False
    End With
    DoEvents
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:DisplayMode_None"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:DisplayMode_None"
    CapMouseOn
End Sub

Private Sub AddDisplay()
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:AddDisplay"
    #End If

    RaiseEvent SwitchToView(mt_CstValues.View_Full)
    
    'If the component was on short list, it does appear now in long list
    InitControl 4
        
    BlankFields
    Add_Enablecontrols
    AddInitFields
    Add_Resize
    
    cbo_title.SetFocus
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:AddDisplay"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:AddDisplay"
    CapMouseOn
End Sub

Private Sub UpdateDisplay()
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:UpdateDisplay"
    #End If

    RaiseEvent SwitchToView(mt_CstValues.View_Full)
    
    
    'If the component was on short list, it does appear now in long list
    InitControl 4
    
    If mi_OldDisplayMode <> mt_CstValues.DisplayMode_View Then BlankFields
    Update_EnableControls
    If mi_OldDisplayMode <> mt_CstValues.DisplayMode_View Then
        UpdateInitFields
    Else
        InitMailingList
    End If
    Call acvHobbies.SetVisibleList("REDIT")
    
    Update_Resize
    
    cbo_title.SetFocus
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:UpdateDisplay"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:UpdateDisplay"
    CapMouseOn
End Sub

Private Sub DeleteDisplay()
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:DeleteDisplay"
    #End If

    RaiseEvent SwitchToView(mt_CstValues.View_Full)
    
    'If the component was on short list, it does appear now in long list
    InitControl 4
    
    BlankFields
    Delete_EnableControls
    ViewInitFields
    Delete_Resize
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:DeleteDisplay"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:DeleteDisplay"
    CapMouseOn
End Sub

Private Sub Delete_EnableControls()
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:Delete_EnableControls"
    #End If

    ControlsEnable UserControl.Controls, fraItemTop, False
    ControlsEnable UserControl.Controls, fraItemBottom, False
    lbl_cntCode.Enabled = True
    txt_CntCode.Enabled = True
    ckvMailingList.Enabled = True
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:Delete_EnableControls"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:Delete_EnableControls"
    CapMouseOn
End Sub

Private Sub ViewDisplay()
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:ViewDisplay"
    #End If

    If mi_EmbeddedIn = -1 Then
        RaiseEvent SwitchToView(mt_CstValues.View_Full)
    Else
        RaiseEvent SwitchToView(mt_CstValues.View_Medium)
    End If
    
    If mb_CycleReset Then
        mb_CycleReset = False
        GoTo Trace_End
    End If
    
    'If the component was on short list, it doues appear now in long list
    InitControl 3
    
    If IsArray(grdlst.CurrentKey) Then
        BlankFields
        View_EnableControls
        ViewLoad
        ViewInitFields
        View_Resize
        ms_View_Key = txt_CntCode.Text
        CheckMemoContact
    Else
        View_EnableControls
        View_Resize
        
        DrawMainGrid
        Call SearchTreeView(ms_View_Key, False)
        If ms_View_Key <> txt_CntCode.Text Then
            ViewLoad
            ViewInitFields
            CheckMemoContact
        End If
        
    End If


Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:ViewDisplay"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:ViewDisplay"
    CapMouseOn
End Sub

Private Sub ViewLoad()
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:ViewLoad"
    #End If

    If (mb_Root And mi_OldDisplayMode <> mt_CstValues.DisplayMode_List) Or mi_EmbedTag = -1 Then
        With UserControl
                .tbsEmbedded.Tabs.Item(1).Selected = True
        End With
    End If
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:ViewLoad"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:ViewLoad"
    CapMouseOn
End Sub


Private Sub ShortListDisplay(ByVal ls_Params As String)
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:ShortListDisplay", "ls_Params=" & ls_Params
    #End If

    RaiseEvent SwitchToView(mt_CstValues.View_Embedded)
   
    ShortList_Resize
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:ShortListDisplay"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:ShortListDisplay"
    CapMouseOn
End Sub

' Embed a component
Private Sub tbsEmbedded_Click()
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:tbsEmbedded_Click"
    #End If
    ' TASK 298.2
    Dim ls_CntKey As String
    
    With UserControl
        Dim li_Key As Integer
        li_Key = GetLstKey(.tbsEmbedded.SelectedItem.Key)
        
        If (li_Key = mi_EmbedTag) Or (mi_EmbedTag = -1 And .tbsEmbedded.SelectedItem.Index = 1) Then GoTo Trace_End
        
        If mi_EmbedTag <> -1 Then
            RaiseEvent Release
            mi_EmbedTag = -1
        End If
        
        If .tbsEmbedded.SelectedItem.Index = 1 Then
            If mi_EmbeddedIn <> -1 Then
                 RaiseEvent SwitchToView(mt_CstValues.View_Medium)
            End If
            .fraItemBottom.Visible = True
        Else
            .fraItemBottom.Visible = False
            If mi_EmbeddedIn <> -1 Then
                If (li_Key = mt_CstValues.Tag_Memo) Or (li_Key = mt_CstValues.Tag_File) Then
                     RaiseEvent SwitchToView(mt_CstValues.View_Medium)
                Else
                    RaiseEvent SwitchToView(mt_CstValues.View_Full)
                End If
            End If
            mi_EmbedTag = li_Key
            ls_CntKey = m_CurrentKey1 & CH_LDELIMIT & m_CurrentKey2 & CH_LDELIMIT & m_CurrentKey3 & CH_LDELIMIT & chk_DropFlag.Value
            RaiseEvent Catch(mi_EmbedTag, ls_CntKey)
        End If
    End With

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:tbsEmbedded_Click"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:tbsEmbedded_Click"
    CapMouseOn
End Sub


' Called when application must resize the current view
Public Sub Resize()
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:Resize"
    #End If

    Call DisplayMode_None
    
    Select Case DisplayMode
        Case mt_CstValues.DisplayMode_List
            If mi_EmbeddedIn = -1 Then
                Call LongList_Resize
            Else
               Call ShortList_Resize
            End If
        Case mt_CstValues.DisplayMode_View
            If mi_EmbeddedIn = -1 Then
                Call LongList_Resize
             End If
            Call View_Resize
        Case mt_CstValues.DisplayMode_Update
            Call Update_Resize
        Case mt_CstValues.DisplayMode_Add
            Call Add_Resize
        Case mt_CstValues.DisplayMode_Delete
            Call Delete_Resize
    End Select
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:Resize"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:Resize"
    CapMouseOn
End Sub
Private Sub AddInitFields()
Dim TheRequest As String
Dim ll_Cursor As Long

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:AddInitFields"
    #End If

    InitMailingList
    DisplayDefaultValues

    'Try connection, 'use_framework_connection' is inside 'ASC_ConnectToDB' !
    If Not ASC_ConnectToDB(mo_ArmDb, ms_ConnectString, mb_Created) Then GoTo Trace_End
    
    TheRequest = "exec claim_customer_t_sel4 '" & m_Customer & "','" & m_Language & "'"
    ll_Cursor = mo_ArmDb.OpenSQL(TheRequest, -1, 0)
    If ll_Cursor = 0 Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceSQLError mo_ArmDb, "CapCon:AddInitFields", "Request=" & TheRequest
        GoTo Trace_End
    End If
    txt_ccu_code.Text = m_Customer
    
    m_CCU_CT_Code = mo_ArmDb.GetFields(ll_Cursor, "CT_Code")
    Call acvHobbies.SetVisibleList("REDIT")
Trace_End:
    mo_ArmDb.Close ll_Cursor
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:AddInitFields"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    mo_ArmDb.Close ll_Cursor
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:AddInitFields"
    CapMouseOn
End Sub
Private Sub BlankFields()
Dim TheRequest As String

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:BlankFields"
    #End If

    cbo_title.Clear
    cbo_job.Clear
    
    txt_CntCode.Text = ""
    txt_desc.Text = ""
    txt_firstname.Text = ""
    txt_lastname.Text = ""
    txt_officePhone.Text = ""
    txt_cellPhone.Text = ""
    txt_homePhone.Text = ""
    txt_fax.Text = ""
    txt_email.Text = ""
        
    'TODO
    'txt_spare2.Text = ""
    
    ' 298.2
    chk_DropFlag.Value = 0
    txt_DropDate.Text = ""
      'BEGIN T299.WP6
    chk_Unsubscribed.Value = vbUnchecked
    'END T299.WP6
    
    calBirthday.reinit_cal
    acvHobbies.Init
    acvHobbies.SetVisibleList "RVIEW"
    
    
    Dim lIdx As Long, lCount As Long
    
    If mi_DisplayMode = mt_CstValues.DisplayMode_View Then
        GoToTab1
    End If

    'clear highlight
    Call UpdateTabInfo(tbsEmbedded, SetLstKey(mt_CstValues.Tag_Memo), False, 0)
    'tbsEmbedded.Tabs(SetLstKey(mt_CstValues.Tag_Memo)).HighLighted = False

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:BlankFields"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:BlankFields"
    CapMouseOn
End Sub

Public Sub DisplayDefaultValues()
Dim i As Integer
Dim TheControl As Control
Dim TheControlName As String

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:DisplayDefaultValues"
    #End If

    If p_DefaultValuesLoaded = False Then
        p_DefaultValuesCount = GetScreenDefaultValues(mo_ArmDb, ms_UID, m_Language, "Cap_Contact_Detail", p_DefaultValues)
        p_DefaultValuesLoaded = True
            End If
    DisplayScreenDefaultValues UserControl.Controls, p_DefaultValues, p_DefaultValuesCount

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:DisplayDefaultValues"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:DisplayDefaultValues"
    CapMouseOn
End Sub

Private Sub ViewInitFields()
Dim TheRequest As String
Dim Thekey1 As String
Dim Thekey2 As String
Dim Thekey3 As String
Dim ll_Cursor As Long

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:ViewInitFields"
    #End If

    'On construit la requête
    Thekey1 = grdlst.CurrentKey(0)
    Thekey2 = grdlst.CurrentKey(1)
    Thekey3 = grdlst.CurrentKey(2)
    
    m_CurrentKey1 = Thekey1
    m_CurrentKey2 = Thekey2
    m_CurrentKey3 = Thekey3
    
    'Si pas de clé en cours, ie pas de ligne en grille sélectionnée alors bye
    If Thekey1 = "" Or Thekey2 = "" Or Thekey3 = "" Then GoTo Trace_End
    
    'Affectation aux clés membres
    CurrentKey(1) = Thekey1
    CurrentKey(2) = Thekey2
    CurrentKey(3) = Thekey3
    
    'Try connection, 'use_framework_connection' is inside 'ASC_ConnectToDB' !
    If Not ASC_ConnectToDB(mo_ArmDb, ms_ConnectString, mb_Created) Then GoTo Trace_End
    
    TheRequest = "exec cap_contact_t_sel '" & Thekey1 & "','" & Thekey2 & "', '" & m_Language & "'"
    ll_Cursor = mo_ArmDb.OpenSQL(TheRequest, -1, 0)
    If ll_Cursor = 0 Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceSQLError mo_ArmDb, "CapCon:ViewInitFields", "Request=" & TheRequest
        GoTo Trace_End
    End If
    p_iCon = mo_ArmDb.GetFields(ll_Cursor, "iConcurrency")
  
    cbo_title.AddItem Array(CStr(mo_ArmDb.GetFields(ll_Cursor, "tit_code")), CStr(mo_ArmDb.GetFields(ll_Cursor, "tit_desc"))), True
    cbo_job.AddItem Array(CStr(mo_ArmDb.GetFields(ll_Cursor, "job_code")), CStr(mo_ArmDb.GetFields(ll_Cursor, "job_desc"))), True
  
    txt_CntCode.Text = mo_ArmDb.GetFields(ll_Cursor, "cnt_code")
    txt_ccu_code.Text = mo_ArmDb.GetFields(ll_Cursor, "ccu_capkey")
    
    chk_DropFlag.Value = IIf(mo_ArmDb.GetFields(ll_Cursor, "drop_flag") = "X", 1, 0)
    txt_DropDate.Text = Cap_FormatDate(mo_ArmDb.GetFields(ll_Cursor, "drop_date"))
    
    
    txt_desc.Text = mo_ArmDb.GetFields(ll_Cursor, "ccu_desc")
    txt_firstname.Text = mo_ArmDb.GetFields(ll_Cursor, "cnt_firstname")
    txt_lastname.Text = mo_ArmDb.GetFields(ll_Cursor, "cnt_lastname")
    txt_officePhone.Text = mo_ArmDb.GetFields(ll_Cursor, "cnt_teloffice")
    txt_cellPhone.Text = mo_ArmDb.GetFields(ll_Cursor, "cnt_telcell")
    txt_homePhone.Text = mo_ArmDb.GetFields(ll_Cursor, "cnt_telhome")
    txt_fax.Text = mo_ArmDb.GetFields(ll_Cursor, "cnt_fax")
    txt_email.Text = mo_ArmDb.GetFields(ll_Cursor, "cnt_email")
    
    calBirthday.date_courte = mo_ArmDb.GetFields(ll_Cursor, "spare1_varchar")
    acvHobbies.SetVisibleList ("RVIEW")
    Call SetHobbies(mo_ArmDb.GetFields(ll_Cursor, "spare2_varchar"))
    
    
    ' TASK 298.2
    
    chk_Unsubscribed.Value = IIf(mo_ArmDb.GetFields(ll_Cursor, "CNT_Unsub") = "X", vbChecked, vbUnchecked)
    'END T299.WP6
    
    m_CCU_CT_Code = mo_ArmDb.GetFields(ll_Cursor, "CT_Code")
    m_CCU_CT_Desc = mo_ArmDb.GetFields(ll_Cursor, "CT_desc")
    m_CCU_CTY_Code = mo_ArmDb.GetFields(ll_Cursor, "CTY_Code")
    m_CCU_CTY_Desc = mo_ArmDb.GetFields(ll_Cursor, "CTY_desc")
    m_CCU_Town = mo_ArmDb.GetFields(ll_Cursor, "CCU_town")
    m_CCU_CCT_Code = mo_ArmDb.GetFields(ll_Cursor, "CCT_Code")
    m_CCU_CCT_Desc = mo_ArmDb.GetFields(ll_Cursor, "CCT_desc")
    m_Z_Creator = mo_ArmDb.GetFields(ll_Cursor, "Z_Creator")
    
    InitMailingList
    
Trace_End:
    mo_ArmDb.Close ll_Cursor
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:ViewInitFields"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    mo_ArmDb.Close ll_Cursor
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:ViewInitFields"
    CapMouseOn
End Sub
Private Sub ReinitTreeview(as_View As String)
Dim TheRequest As String
Dim li_rowCount As Integer
Dim li_CurrentRow As Integer
Dim li_level As Integer
Dim ls_nodesRequest() As String
Dim ls_gridRequest() As String
Dim ls_countRequest() As String
Dim ls_findRequest() As String
Dim li_images() As Integer
Dim li_selectedImages() As Integer
Dim ll_Cursor As Long

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:ReinitTreeview", "as_View=" & as_View
    #End If

    'Try connection, 'use_framework_connection' is inside 'ASC_ConnectToDB' !
    If Not ASC_ConnectToDB(mo_ArmDb, ms_ConnectString, mb_Created) Then GoTo Trace_End
    
    tvitems.Visible = False
    
    TheRequest = "EXEC Treeview_Parameters_lst 'Contact', '" & as_View & "'"
    ll_Cursor = mo_ArmDb.OpenSQL(TheRequest, -1)
    If ll_Cursor = 0 Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceSQLError mo_ArmDb, "CapCon:ReinitTreeview", "Request=" & TheRequest
        GoTo Trace_End
    End If
    li_rowCount = mo_ArmDb.RowCount(ll_Cursor)
    
    If li_rowCount = 0 Then
        'zzMsgBox "error in Treeview_Parameters_lst : no rows returned"
        tvitems.Visible = True
        GoTo Trace_End
    End If
    
    ReDim ls_nodesRequest(0 To li_rowCount)
    ReDim ls_gridRequest(0 To li_rowCount)
    ReDim ls_countRequest(0 To li_rowCount)
    ReDim ls_findRequest(0 To li_rowCount)
    ReDim li_images(0 To li_rowCount)
    ReDim li_selectedImages(0 To li_rowCount)
    
    While Not mo_ArmDb.EOF(ll_Cursor)
        li_level = mo_ArmDb.GetFields(ll_Cursor, "TV_Level")
        ls_nodesRequest(li_level) = ParamReqReplace(mo_ArmDb.GetFields(ll_Cursor, "TV_NodeRequest"))
        ls_gridRequest(li_level) = ParamReqReplace(mo_ArmDb.GetFields(ll_Cursor, "TV_GridRequest"))
        ls_countRequest(li_level) = ParamReqReplace(mo_ArmDb.GetFields(ll_Cursor, "TV_CountRequest"))
        ls_findRequest(li_level) = ParamReqReplace(mo_ArmDb.GetFields(ll_Cursor, "TV_FindRequest"))
        li_images(li_level) = mo_ArmDb.GetFields(ll_Cursor, "TV_Images")
        li_selectedImages(li_level) = mo_ArmDb.GetFields(ll_Cursor, "TV_SelectedImages")
        
        mo_ArmDb.Next ll_Cursor
    Wend

    tvitems.Levels = li_rowCount                 'set number of levels
    tvitems.StartDemandLevel = 1                 'set level on which we load childs on demand
    tvitems.UseImages = True                     'show icons in treeview
    tvitems.Images = li_images                   'set normal icons
    tvitems.SelectedImages = li_selectedImages   'set selected icons
    tvitems.NodeRequests = ls_nodesRequest
    tvitems.GridRequests = ls_gridRequest
    tvitems.FindRequests = ls_findRequest
    tvitems.CountRequests = ls_countRequest
    grdlst.ClearGrid
    grdlst.Requests = ""
    tvitems.LoadTree LoadTypeChildsDemand
    fill_all_record.Visible = 0
    tvitems.Visible = True

      lbl_ListFilter.Caption = GetCurrentFiltersDescription

Trace_End:
    mo_ArmDb.Close ll_Cursor
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:ReinitTreeview"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    mo_ArmDb.Close ll_Cursor
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:ReinitTreeview"
    CapMouseOn
End Sub
Private Sub ListCustomerOf(ACustomerkey1 As String, ACustomerkey2 As String)
Dim la_Columns(8) As String

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:ListCustomerOf", "ACustomerkey1=" & ACustomerkey1, "ACustomerkey2=" & ACustomerkey2
    #End If

    If Not (ACustomerkey1 <> "" And ACustomerkey2 <> "") Then GoTo Trace_End

    grdlst.ResetGrid
    grdlst.MultiSelect = False

    la_Columns(0) = "cnt_code" & CH_LDELIMIT & "0" & CH_LDELIMIT & "1" & CH_LDELIMIT & "cnt_code" & CH_LDELIMIT & "cnt_code"
    la_Columns(1) = "ccu_capkey" & CH_LDELIMIT & "0" & CH_LDELIMIT & "2" & CH_LDELIMIT & "ccu_capkey" & CH_LDELIMIT & "ccu_capkey"
    la_Columns(2) = "language_code" & CH_LDELIMIT & "0" & CH_LDELIMIT & "3" & CH_LDELIMIT & "language_code" & CH_LDELIMIT & "language_code"
    la_Columns(3) = "name" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "CNT_lastname" & CH_LDELIMIT & "name"
    la_Columns(4) = "tit_desc" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "tit_desc" & CH_LDELIMIT & "tit_desc"
    la_Columns(5) = "job_desc" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "job_desc" & CH_LDELIMIT & "job_desc"
    la_Columns(6) = "CNT_telOffice" & CH_LDELIMIT & "2000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "CNT_telOffice" & CH_LDELIMIT & "cnt_tel_office"
    la_Columns(7) = "CNT_telCell" & CH_LDELIMIT & "2000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "CNT_telCell" & CH_LDELIMIT & "CNT_telCell"
    la_Columns(8) = "Drop" & CH_LDELIMIT & "1000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "Drop_Flag" & CH_LDELIMIT & "#DELETE"
    
    grdlst.SetColumns la_Columns
    grdlst.LoadConstants ptSQL, "EXEC screen_csts_lst2 'cap_ContactOfCustomer_Short', 'grid', '" & m_Language & "'", ctColumns

    grdlst.Requests = "exec Cap_Contact_t_lst2 '" & ACustomerkey1 & "', '" & m_Language & "'"
    If grdlst.Execute = False Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceSQLError grdlst.ArmDb, "CapCon:ListCustomerOf", "Requests=", grdlst.Requests
    End If

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:ListCustomerOf"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:ListCustomerOf"
    CapMouseOn
End Sub

Private Sub ListActionOf(AActionKey1 As String, AActionKey2 As String, AActionKey3 As String)
Dim la_Columns(7) As String

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:ListActionOf", "AActionKey1=" & AActionKey1, "AActionKey2=" & AActionKey2, "AActionKey3=" & AActionKey3
    #End If


    If Not (AActionKey1 <> "" And AActionKey2 <> "" And AActionKey3 <> "") Then GoTo Trace_End

    grdlst.ResetGrid
    grdlst.MultiSelect = False
       
    la_Columns(0) = "cnt_code" & CH_LDELIMIT & "0" & CH_LDELIMIT & "1" & CH_LDELIMIT & "cnt_code" & CH_LDELIMIT & "cnt_code"
    la_Columns(1) = "ccu_capkey" & CH_LDELIMIT & "0" & CH_LDELIMIT & "2" & CH_LDELIMIT & "ccu_capkey" & CH_LDELIMIT & "ccu_capkey"
    la_Columns(2) = "language_code" & CH_LDELIMIT & "0" & CH_LDELIMIT & "3" & CH_LDELIMIT & "language_code" & CH_LDELIMIT & "language_code"
    'Normalement la procédure stockée ne renvoit qu'une seule ligne au plus et que la clé !
    'On définit ces colonnes seulement si la procédure n'envoit pas de résultat pour que l'utilisateur ait des colonnes visibles
    la_Columns(3) = "SP_zip" & CH_LDELIMIT & "1500" & 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 & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "SP_size" & CH_LDELIMIT & "SP_size"
    la_Columns(6) = "SS_desc" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "SS_desc" & CH_LDELIMIT & "SS_desc"
    la_Columns(7) = "CPR_desc" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "CPR_desc" & CH_LDELIMIT & "CPR_desc"

    
    grdlst.SetColumns la_Columns
    
'    grdlst.ColMapString = "FIELD=00 COL=0 WIDTH=0 KEY1=YES"               '
'    grdlst.ColMapString = "FIELD=01 COL=1 WIDTH=0 KEY2=YES"               '
'    grdlst.ColMapString = "FIELD=02 COL=2 WIDTH=0 KEY3=YES"               '
'    grdlst.ColMapString = "FIELD=03 COL=3 WIDTH=1500"                     'SP_zip
'    grdlst.ColMapString = "FIELD=04 COL=4 WIDTH=1500"                     'SP_town
'    grdlst.ColMapString = "FIELD=05 COL=5 WIDTH=1500"                     'SP_size
'    grdlst.ColMapString = "FIELD=06 COL=6 WIDTH=1500"                     'SS_desc
'    grdlst.ColMapString = "FIELD=07 COL=7 WIDTH=1500"                     'CPR_desc

    grdlst.Requests = "exec Cap_ContactAction_t_lst '" & AActionKey1 & "','" & AActionKey2 & "','" & m_Language & "'"
    If grdlst.Execute = False Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceSQLError grdlst.ArmDb, "CapCon:ListActionOf", "Requests=", grdlst.Requests
    End If

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:ListActionOf"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:ListActionOf"
    CapMouseOn
End Sub

Private Sub ListProjectOf(AProjectKey1 As String, AProjectKey2 As String)
Dim la_Columns(10) As String

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:ListProjectOf", "AProjectKey1=" & AProjectKey1, "AProjectKey2=" & AProjectKey2
    #End If


    If Not (AProjectKey1 <> "" And AProjectKey2 <> "") Then GoTo Trace_End

    grdlst.ResetGrid
    grdlst.MultiSelect = False
        
    la_Columns(0) = "CNT_code" & CH_LDELIMIT & "0" & CH_LDELIMIT & "1" & CH_LDELIMIT & "CNT_code" & CH_LDELIMIT & "CNT_code"
    la_Columns(1) = "CCU_CapKey" & CH_LDELIMIT & "0" & CH_LDELIMIT & "2" & CH_LDELIMIT & "CCU_CapKey" & CH_LDELIMIT & "CCU_CapKey"
    la_Columns(2) = "language_code" & CH_LDELIMIT & "0" & CH_LDELIMIT & "3" & CH_LDELIMIT & "language_code" & CH_LDELIMIT & "language_code"
    la_Columns(3) = "CCU_desc" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "CCU_desc" & CH_LDELIMIT & "CCU_desc"
    la_Columns(4) = "CCT_desc" & CH_LDELIMIT & "1000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "CCT_desc" & CH_LDELIMIT & "CCT_desc"
    la_Columns(5) = "CCU_Zip + CCU_Zip2" & CH_LDELIMIT & "1000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "CCU_Zip + CCU_Zip2" & CH_LDELIMIT & "CCU_Zip + CCU_Zip2"
    la_Columns(6) = "CCU_town" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "CCU_town" & CH_LDELIMIT & "CCU_town"
    la_Columns(7) = "CCU_tel" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "CCU_tel" & CH_LDELIMIT & "CCU_tel"
    la_Columns(8) = "TIT_desc" & CH_LDELIMIT & "1000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "TIT_desc" & CH_LDELIMIT & "TIT_desc"
    la_Columns(9) = "CNT_lastname" & CH_LDELIMIT & "1000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "CNT_lastname" & CH_LDELIMIT & "CNT_lastname"
    la_Columns(10) = "CNT_telOffice" & CH_LDELIMIT & "1000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "CNT_telOffice" & CH_LDELIMIT & "CNT_telOffice"

    grdlst.SetColumns la_Columns
    grdlst.LoadConstants ptSQL, "EXEC screen_csts_lst2 'cap_ContactOfProject_Short', 'grid', '" & m_Language & "'", ctColumns
    
    grdlst.Requests = "exec Cap_projectcontact_t_lst2 '" & AProjectKey1 & "', '" & m_Language & "'"
    If grdlst.Execute = False Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceSQLError grdlst.ArmDb, "CapCon:ListProjectOf", "Requests=", grdlst.Requests
    End If

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:ListProjectOf"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:ListProjectOf"
    CapMouseOn
End Sub

Private Function ParamReqReplace(as_Request As String) As String
Dim ls_Request As String
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:ParamReqReplace", "as_request=" & as_Request
    #End If

    ls_Request = Replace(as_Request, "$lang$", "'" & m_Language & "'", , , vbTextCompare)
    ls_Request = Replace(ls_Request, "$SA$", "''", , , vbTextCompare)
    ls_Request = Replace(ls_Request, "$uid$", "'" & ms_UID & "'", , , vbTextCompare)
    
    
    ' BEGIN TASK 298.2
    Dim ls_Value As String
    Select Case tbsArchive.SelectedItem.Key
        Case "K"
            ls_Value = "null"
        Case "K0"
            ls_Value = "''"
        Case "K1"
            ls_Value = "'X'"
    End Select
    ls_Request = Replace(ls_Request, "$dropflag$", ls_Value, , , vbTextCompare)
    ParamReqReplace = ls_Request
    ' END TASK 298.2
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:ParamReqReplace", "Result=" & ParamReqReplace
    #End If
    CapMouseOn
    Exit Function
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:ParamReqReplace"
    CapMouseOn
End Function

Private Function WhichOptIsTrue(ByRef ao_opt As Object, ai_maxIndex As Integer) As Integer
Dim i As Integer
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:WhichOptIsTrue", "ai_maxIndex=" & ai_maxIndex
    #End If

    For i = 0 To ai_maxIndex
        If ao_opt(i).Value = True Then
            WhichOptIsTrue = i
            GoTo Trace_End
        End If
    Next i
    WhichOptIsTrue = 0

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:WhichOptIsTrue", "Result=" & WhichOptIsTrue
    #End If
    CapMouseOn
    Exit Function
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:WhichOptIsTrue"
    CapMouseOn
End Function


Private Sub ShowLink(as_ActionType As String)
Dim lo_LinkForm As LinkForm

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:ShowLink", "as_ActionType=" & as_ActionType
    #End If

    Set lo_LinkForm = New LinkForm
    Load lo_LinkForm
    
    lo_LinkForm.ConnectString = ms_ConnectString
    If mb_use_framework_connection = True Then
        Set lo_LinkForm.ArmDb = mo_ArmDb
    End If
        
    lo_LinkForm.Language = m_Language
    lo_LinkForm.ConnectString = ms_ConnectString
    If mb_use_framework_connection = True Then Set lo_LinkForm.ArmDb = mo_ArmDb
    'lo_linkForm.ScreenName = "PROJECTLINK"
    lo_LinkForm.project = m_Project

    If as_ActionType <> "Add" Then
        lo_LinkForm.Customer = m_CurrentKey2
    End If
    lo_LinkForm.SQLActionType = as_ActionType
    CapMouseOn True
    lo_LinkForm.show 1
    CapMouseOff True
    
    Unload lo_LinkForm
    Set lo_LinkForm = Nothing
    grdlst.Refresh
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:ShowLink"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:ShowLink"
    If Not lo_LinkForm Is Nothing Then
        Unload lo_LinkForm
        Set lo_LinkForm = Nothing
    End If
    
    CapMouseOn
End Sub

Private Sub OwlSearch()
Dim ls_CCUCapKey As String
Dim lo_SearchForm As SeekForm

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:OwlSearch"
    #End If

    ls_CCUCapKey = ""
    
    If GetCodeFromCombo(cbo_view) = "" Then
        Call ASC_SendMessage(mo_ArmDb, m_Language, 266, "#Missing Data in compulsory field")
        cbo_view.SetFocus
        GoTo Trace_End
    End If
        
    Set lo_SearchForm = New SeekForm
    Load lo_SearchForm
    If mb_use_framework_connection = True Then Set lo_SearchForm.ArmDb = mo_ArmDb
    lo_SearchForm.ConnectString = ms_ConnectString
    lo_SearchForm.Language = m_Language
    lo_SearchForm.ComponentType = "CONTACT"
    
    lo_SearchForm.TreeView_DateType = "0"
    lo_SearchForm.TreeViewFiltersDesc = GetCurrentFiltersDescription()
    lo_SearchForm.TreeViewFilters = GetCurrentFilters()

    
    lo_SearchForm.Load_A_COM
    CapMouseOn True
    lo_SearchForm.show 1
    CapMouseOff True
    
    If lo_SearchForm.SelectedData = True Then
        ls_CCUCapKey = lo_SearchForm.SelectedItemCode
    End If
    
    lo_SearchForm.Unload_A_COM
    Unload lo_SearchForm
    Set lo_SearchForm = Nothing
    
    If ls_CCUCapKey <> "" Then
        SearchTreeView ls_CCUCapKey
    End If
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:OwlSearch"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:OwlSearch"
    If Not lo_SearchForm Is Nothing Then
        lo_SearchForm.Unload_A_COM
        Unload lo_SearchForm
        Set lo_SearchForm = Nothing
    End If
    CapMouseOn
End Sub

Public Function GetItemSelectedKey() As String
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capprj:GetItemSelectedKey"
    #End If
    GetItemSelectedKey = m_CurrentKey1
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capprj:GetItemSelectedKey"
    #End If
End Function

Public Property Let contact(ByVal as_CNTCode As String)
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:contact"
    #End If
    
    DisplayMode = mt_CstValues.DisplayMode_List
    mb_EmbeddedIsDropped = False
    SearchTreeView as_CNTCode, True
    
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:contact"
    #End If
End Property

Private Sub SearchTreeView(ByVal as_CNTCode As String, Optional ByVal ab_ViewItem As Boolean = True, Optional ByVal ab_DontReinitialize As Boolean = False)
Dim ls_Request As String
Dim ls_RepositionInfo As String
Dim ls_RepositionCode As String
Dim lv_Key As Variant
Dim ll_Cursor As Long

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:SearchTreeView", "as_CNTCode=" & as_CNTCode
    #End If
    
    If as_CNTCode = "" Then GoTo Trace_End
    
    If reload_treeview.Visible Then Call reload_treeview_Click ' TASK 298.2
    
    'Try connexion
    If Not ASC_ConnectToDB(mo_ArmDb, ms_ConnectString, mb_Created) Then GoTo Trace_End

    ls_Request = "exec Cap_Contact_t_sel2 '" & as_CNTCode & "','" & m_Language & "'"
    ll_Cursor = mo_ArmDb.OpenSQL(ls_Request, -1, 0)
    If ll_Cursor = 0 Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceSQLError mo_ArmDb, "CapCon:SearchTreeView", "Request=" & ls_Request
        GoTo Trace_End
    End If

    ls_RepositionInfo = mo_ArmDb.GetFields(ll_Cursor, "CNT_code") & mo_ArmDb.GetFields(ll_Cursor, "CCU_CapKey") & "E"
    lv_Key = Split(mo_ArmDb.GetFields(ll_Cursor, "CNT_code") & CH_LDELIMIT & mo_ArmDb.GetFields(ll_Cursor, "CCU_CapKey") & CH_LDELIMIT & "E", CH_LDELIMIT)
    Select Case GetCodeFromCombo(cbo_view)
    Case "Va"
        ls_RepositionInfo = ls_RepositionInfo & CH_LDELIMIT & mo_ArmDb.GetFields(ll_Cursor, "CT_desc")
        ls_RepositionInfo = ls_RepositionInfo & CH_LDELIMIT & mo_ArmDb.GetFields(ll_Cursor, "ML_desc")
    Case "Vb"
        ls_RepositionInfo = ls_RepositionInfo & CH_LDELIMIT & mo_ArmDb.GetFields(ll_Cursor, "CT_desc")
        ls_RepositionInfo = ls_RepositionInfo & CH_LDELIMIT & mo_ArmDb.GetFields(ll_Cursor, "CTY_desc")
        ls_RepositionInfo = ls_RepositionInfo & CH_LDELIMIT & mo_ArmDb.GetFields(ll_Cursor, "CCU_Town")
        ls_RepositionInfo = ls_RepositionInfo & CH_LDELIMIT & mo_ArmDb.GetFields(ll_Cursor, "JOB_desc")
    Case "Vc"
        ls_RepositionInfo = ls_RepositionInfo & CH_LDELIMIT & mo_ArmDb.GetFields(ll_Cursor, "CT_desc")
        ls_RepositionInfo = ls_RepositionInfo & CH_LDELIMIT & mo_ArmDb.GetFields(ll_Cursor, "JOB_desc")
    Case "Vd"
        ls_RepositionInfo = ls_RepositionInfo & CH_LDELIMIT & mo_ArmDb.GetFields(ll_Cursor, "CT_desc")
        ls_RepositionInfo = ls_RepositionInfo & CH_LDELIMIT & mo_ArmDb.GetFields(ll_Cursor, "CCT_desc")
    Case "Ve"
        ls_RepositionInfo = ls_RepositionInfo & CH_LDELIMIT & mo_ArmDb.GetFields(ll_Cursor, "CT_desc")
        ls_RepositionInfo = ls_RepositionInfo & CH_LDELIMIT & mo_ArmDb.GetFields(ll_Cursor, "Z_Creator")
    End Select
    
    ls_RepositionCode = RepositionAfterSeek(ls_RepositionInfo, tvitems)
    If ls_RepositionCode <> "" Then
        If grdlst.SearchKey(True, lv_Key) Then
            If ab_ViewItem Then
                grdLst_ItemSelected
            End If
        Else
            If ab_DontReinitialize = True Then
                Call ASC_SendMessage(mo_ArmDb, m_Language, 202, "#The record you are saving can not be displayed within the current tree view (Record out with your selected tree view criteria)")
            Else
                pctTvReset_Click
                SearchTreeView as_CNTCode, ab_ViewItem, True
            End If
        End If
    Else
        If ab_DontReinitialize = True Then
            Call ASC_SendMessage(mo_ArmDb, m_Language, 202, "#The record you are saving can not be displayed within the current tree view (Record out with your selected tree view criteria)")
        Else
            pctTvReset_Click
            SearchTreeView as_CNTCode, ab_ViewItem, True
        End If
    End If

Trace_End:
    mo_ArmDb.Close ll_Cursor
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:SearchTreeView"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    mo_ArmDb.Close ll_Cursor
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:SearchTreeView"
    CapMouseOn
End Sub


Private Function GetCurrentFiltersDescription() As String
    
    GetCurrentFiltersDescription = tbsArchive.SelectedItem.Caption
    
End Function


' TASK 298.2
Private Function GetCurrentFilters() As String
    
    Dim ls_Filters As String
    Select Case tbsArchive.SelectedItem.Key
        Case "K"
            ls_Filters = "NULL"
        Case "K0"
            ls_Filters = "''"
        Case "K1"
            ls_Filters = "'X'"
    End Select
    GetCurrentFilters = ls_Filters

End Function


Private Function CheckMemoContact() As Boolean
Dim ls_Request As String
Dim ll_Cursor As Long
Dim ll_Count As Long

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:CheckMemoContact"
    #End If
    
    CheckMemoContact = False
    
    If Not ASC_ConnectToDB(mo_ArmDb, ms_ConnectString, mb_Created) Then GoTo Trace_End
    
    ls_Request = "Select count(*) FROM Cap_MemoContact MC Where MC.CNT_Code = '" & m_CurrentKey1 & "' "
    ll_Cursor = mo_ArmDb.OpenSQL(ls_Request)
    If ll_Cursor = 0 Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceSQLError mo_ArmDb, "capcon:CheckMemoContact", "Request=" & ls_Request
        GoTo Trace_End
    End If
    
    ll_Count = mo_ArmDb.GetFields(ll_Cursor, 0)
    Call UpdateTabInfo(tbsEmbedded, SetLstKey(mt_CstValues.Tag_Memo), ll_Count > 0, ll_Count)
    
    CheckMemoContact = True
    
Trace_End:
    mo_ArmDb.Close ll_Cursor
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:CheckMemoContact"
    #End If
    CapMouseOn
    Exit Function
    
Trace_Err:
    mo_ArmDb.Close ll_Cursor
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:CheckMemoContact"
    CapMouseOn
End Function

Private Sub UpdateTabInfo(ao_TabStrip As MSComctlLib.TabStrip, av_TabKey As Variant, ab_HighLight As Boolean, Optional al_RecordCount As Long = -1)
Dim ls_Caption As String
Dim ll_Index As Long
Dim lo_Tab As MSComctlLib.Tab
Dim lv_TabHighlight As Variant
    
    On Error GoTo Trace_Err
    
    
    Set lo_Tab = ao_TabStrip.Tabs(av_TabKey)
        
    If al_RecordCount >= 0 Then
      'first I must store highlight for all tabs, because it will be destroyed
      'by setting caption for tab (seems to be VB issue)
      ReDim lv_TabHighlight(ao_TabStrip.Tabs.Count - 1)
      For ll_Index = 1 To ao_TabStrip.Tabs.Count
        lv_TabHighlight(ll_Index - 1) = ao_TabStrip.Tabs(ll_Index).HighLighted
      Next
      
      ls_Caption = lo_Tab.Caption
      ll_Index = InStr(1, ls_Caption, " [")
      If ll_Index > 0 Then ls_Caption = Left(ls_Caption, ll_Index - 1)
      ls_Caption = ls_Caption & " [" & al_RecordCount & "]"
      
      lo_Tab.Caption = ls_Caption
      DoEvents
      For ll_Index = 1 To ao_TabStrip.Tabs.Count
        ao_TabStrip.Tabs(ll_Index).HighLighted = lv_TabHighlight(ll_Index - 1)
      Next
      DoEvents
    End If
    DoEvents
    lo_Tab.HighLighted = ab_HighLight
    DoEvents
    Exit Sub
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:UpdateTab"
End Sub

' This function is called by the application when the component embedded is updated
Public Sub Embedded_Updated(ByVal ab_FromEmbedded As Boolean)
    
    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "Capcnt:Embedded_Updated"
    #End If

    If Not ab_FromEmbedded Then
        ' TO DO
    Else
        Select Case mi_EmbedTag
        Case mt_CstValues.Tag_Memo
            CheckMemoContact
        End Select
    End If
    
Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "Capcnt:Embedded_Updated"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "Capcnt:Embedded_Updated"
    CapMouseOn
    
End Sub


' Return true if have created the node
Private Function FindInTreeView(ByVal aTV As ArmTreeView, ByVal aPath As String) As Boolean

    On Error GoTo onError:
    Dim lValues As Variant
    lValues = Split(aPath, SEP & SEP)

    Dim lIdx As Long, lCount As Long, lFoundedCount As Long
    lCount = UBound(lValues)
    Dim lData As Variant, lKey As String, lValue As String
    
    lData = Split(lValues(0), SEP)
    lKey = lData(0)
    lValue = lData(1)
    
    
    If Not aTV.Find(lKey, 0, , 0) Then
        aTV.AddNode(, lKey, lValue, 1, 2).Selected = True
        FindInTreeView = True
    End If
    
    lFoundedCount = 1
    Call aTV.ExpandNode(aTV.SelectedItem)

    For lIdx = 1 To lCount
        lData = Split(lValues(lIdx), SEP)
        lKey = lData(0)
        lValue = lData(1)
        If Not aTV.Find(lKey, 0, aTV.SelectedItem, lIdx) Then
            aTV.AddNode(aTV.SelectedItem, lKey, lValue, 1, 2).Selected = True
            Call tvItems_NodeClick(aTV.SelectedItem)
            FindInTreeView = True
            
        End If
        Call aTV.ExpandNode(aTV.SelectedItem)
        lFoundedCount = lFoundedCount + 1
    Next

    Exit Function
onError:
    'debug.print "Error in findintreeview"
End Function


Private Function GetCurrentPath(ByRef aControls As Variant, ByRef aContainer As Object, ByVal aPattern As String) As String

    Dim lPattern() As String
    lPattern = Split(aPattern, SEP)

    Dim lPath() As String
    lPath = lPattern

    Dim lIdxPattern As Long, lCountPattern As Long, lIdxPath As Long
    Dim lIdx As Long, lCount As Long, lIdxLbl As Long
    Dim lControl As Control, li As Long, lc As Long

    lCountPattern = UBound(lPattern)
    lCount = aControls.Count - 1
    For lIdx = 0 To lCount
        Set lControl = aControls.Item(lIdx)
        If HasContainer(lControl, aContainer) Then
            If lControl.Tag <> "" Then
            lIdxPath = -1
            For lIdxPattern = 0 To lCountPattern
                If StrComp(lControl.Tag, lPattern(lIdxPattern), vbTextCompare) = 0 Then
                    Select Case UCase(TypeName(lControl))
                        Case "TEXTBOX"
                            lPath(lIdxPattern) = lControl.Text & SEP & lControl.Text
                        Case "ARMCOMBOBOX"
                            lPath(lIdxPattern) = lControl.SelectedItem.Key & SEP & lControl.SelectedItem.DisplayText
                        Case "ARMCHECKVIEW0"
                            lc = lControl.ListItems.Count - 1
                            For li = 0 To lc
                                If lControl.ItemInfo(li).Checked = True Then
                                    lPath(lIdxPattern) = lControl.ItemInfo(li).Id & SEP & lControl.ItemInfo(li).Caption
                                    Exit For
                                End If
                            Next
                        Case "ARMCHECKVIEW"
                                If lControl.RoleList(lControl.GetVisibleList).CheckedCount Then
                                    lPath(lIdxPattern) = Trim(lControl.RoleList(lControl.GetVisibleList).CheckedKeys(0)(0))
                                Else
                                    lPath(lIdxPattern) = ""
                                End If
                        Case Else
                            'debug.print "GetCurrentPath" & UCase(TypeName(lControl))
                    End Select
                Exit For
                End If
            Next
            End If
        End If
        Set lControl = Nothing
    Next

    Dim lBuffer As String
    lBuffer = Join(lPath, SEP & SEP)
    
    ' PUT HERE THE EXCEPTION
    lBuffer = Replace(lBuffer, "cbo_country", m_CCU_CT_Code & SEP & m_CCU_CT_Desc, , , vbTextCompare)
    lBuffer = Replace(lBuffer, "txt_town", m_CCU_Town & SEP & m_CCU_Town, , , vbTextCompare)
    lBuffer = Replace(lBuffer, "cbo_county", m_CCU_CTY_Code & SEP & m_CCU_CTY_Desc, , , vbTextCompare)
    lBuffer = Replace(lBuffer, "cbo_customertype", m_CCU_CCT_Code & SEP & m_CCU_CCT_Desc, , , vbTextCompare)
    lBuffer = Replace(lBuffer, "Z_Creator", m_Z_Creator & SEP & m_Z_Creator, , , vbTextCompare)
        
    GetCurrentPath = lBuffer

End Function

Private Function HasContainer(ByRef aControl As Control, ByRef aContainer As Object) As Boolean
    
    HasContainer = False
    Dim lControl As Control
    
    Set lControl = aControl
    While Not (lControl Is Nothing)
        On Error GoTo NotFound
        If lControl.Container Is aContainer Then
            Set lControl = Nothing
            HasContainer = True
            Exit Function
        End If
        Set lControl = lControl.Container
    Wend

NotFound:
    Set lControl = Nothing
    HasContainer = False
End Function


Public Function Item_Filtered() As Boolean
    
    
    ' BEGIN TASK 298.2
    Select Case tbsArchive.SelectedItem.Key
        Case "K"
            ' NO Filters
        Case "K0"
            ' Only non archived,
            Item_Filtered = (chk_DropFlag.Value = 1)
            Exit Function
        Case "K1"
            ' Only archived
            Item_Filtered = (chk_DropFlag.Value <> 1)
            Exit Function
    End Select
    'END TASK 298.2
    
    Item_Filtered = False
End Function

Public Sub Item_LocalUpdate()
    
    If Item_Filtered Then
        Call AddToTimeLog(mi_OldDisplayMode, 99)
        If ASC_SendMessage(mo_ArmDb, m_Language, 1006, "#The item you have added/updated couldn't be displayed with the current criteria set. Would you like to reset the filters to their original values ?", "", vbQuestion Or vbYesNo, "") = vbYes Then
            pctTvReset_Click
        Else
            Exit Sub
        End If
    
    End If
    
    Dim lPath As String
    lPath = GetCurrentPath(UserControl.Controls, fraItem, cbo_view.SelectedItem.GetData(2))
    tvitems.Visible = False
    Call FindInTreeView(tvitems, lPath)
    tvitems.Visible = True
    Call grdlst.SearchKey(True, Array(m_CurrentKey1, m_CurrentKey2, m_CurrentKey3))
            
End Sub


Public Sub AddToTimeLog(ByVal aFct As Long, ByVal aTime As Double)

    Static lComputer As String
    
    If lComputer = "" Then
        Dim loNetObject
        Set loNetObject = CreateObject("WScript.Network")
        lComputer = loNetObject.ComputerName
        Set loNetObject = Nothing
    End If
    
    Call mo_ArmDb.ExecuteSQL("insert into Log_Esther values ('N" & aFct & "', GetDate(), '" & lComputer & "', " & Replace(CStr(aTime), ",", ".") & ")")

End Sub


Public Sub SetHobbies(ByVal aSrz As String)

    If aSrz = "" Then Exit Sub

    Dim lIdx As Long, lCount As Long
    Dim lArr As Variant
    lArr = Split(aSrz, SEP)
    
    lCount = UBound(lArr)
    For lIdx = 0 To lCount
        Call acvHobbies.SetItemState("REDIT", lArr(lIdx), True)
        
    Next
    

End Sub


Public Function GetHobbies() As String

    Dim lIdx As Long, lCount As Long
    Dim lStr As String
    lCount = acvHobbies.RoleList("REDIT").CheckedCount - 1
    For lIdx = 0 To lCount
            lStr = IIf(lStr = "", "", lStr & SEP) & acvHobbies.RoleList("REDIT").CheckedKeys(lIdx)(0)
    Next
    GetHobbies = lStr

End Function



Private Sub reload_treeview_Click()

    On Error GoTo Trace_Err
    CapMouseOff
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc True, "capcon:reload_treeview_Click"
    #End If
    
    ReinitTreeview GetCodeFromCombo(cbo_view)
    tvitems.Visible = True
    reload_treeview.Visible = False

    lbl_ListFilter.Caption = GetCurrentFiltersDescription

Trace_End:
    #If CapDebug Then
        If Not go_Trace Is Nothing Then go_Trace.WriteTraceProc False, "capcon:reload_treeview_Click"
    #End If
    CapMouseOn
    Exit Sub
    
Trace_Err:
    If Not go_Trace Is Nothing Then go_Trace.WriteTraceError Err.Number, Err.Description, "capcon:reload_treeview_Click"
    CapMouseOn
End Sub




' 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 Function ExecuteSQLSafe(ByVal ao_Db As Object, ByVal as_Request As String, Optional ByVal al_RowAffectedCount = -1) As Long
#Else
Private Function ExecuteSQLSafe(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional ByVal al_RowAffectedCount = -1) As Long
#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
            Err.Raise ArmErr.SQLBadRowAffectedCount, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_Db.SQLRowsAffected
        End If
    End If

    ExecuteSQLSafe = ao_Db.SQLRowsAffected
    Exit Function

ErrHandler:
    Call ErrorHandler("ExecuteSQLSafe")
End Function


' Standard error handler
Private Sub ErrorHandler(ByVal as_Fct As String)
    Err.Raise Err.Number, as_Fct & SEP1 & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Sub

