VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.1#0"; "mscomctl.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "ComDlg32.OCX"
Begin VB.UserControl CapFile 
   ClientHeight    =   11835
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   14865
   ScaleHeight     =   11835
   ScaleWidth      =   14865
   Begin VB.Frame fraItem 
      Height          =   10710
      Left            =   -180
      TabIndex        =   3
      Tag             =   "fraItem"
      Top             =   765
      Width           =   13770
      Begin VB.Frame fraItemTop 
         Height          =   8250
         Left            =   405
         TabIndex        =   16
         Tag             =   "fraItemTop"
         Top             =   1005
         Width           =   14790
         Begin VB.TextBox txt_FIL_Name 
            Height          =   375
            Left            =   1080
            TabIndex        =   26
            Tag             =   "FIL_Name"
            Top             =   255
            Width           =   5250
         End
         Begin VB.TextBox txt_FileName 
            Height          =   375
            Left            =   8085
            TabIndex        =   25
            Tag             =   "FIL_FileName"
            Top             =   255
            Width           =   4635
         End
         Begin VB.TextBox txt_FileNamePath 
            Enabled         =   0   'False
            Height          =   375
            Left            =   1080
            TabIndex        =   24
            Top             =   1065
            Width           =   11100
         End
         Begin VB.CommandButton cmd_BrowseFile 
            Caption         =   "..."
            Height          =   375
            Left            =   12225
            TabIndex        =   23
            Top             =   1035
            Width           =   480
         End
         Begin VB.TextBox txt_FIL_Ext 
            Height          =   375
            Left            =   1080
            TabIndex        =   22
            Tag             =   "FIL_Ext"
            Top             =   660
            Width           =   1215
         End
         Begin VB.CommandButton cmd_Save_As 
            Caption         =   "#Save As ..."
            Height          =   375
            Left            =   1095
            TabIndex        =   21
            Tag             =   "lbl_SaveAs"
            Top             =   1515
            Width           =   1815
         End
         Begin VB.TextBox txt_FIL_Path 
            Height          =   375
            Left            =   1095
            TabIndex        =   20
            Tag             =   "FIL_Path"
            Top             =   2040
            Visible         =   0   'False
            Width           =   5415
         End
         Begin VB.TextBox txt_FIL_ID 
            Height          =   360
            Left            =   945
            TabIndex        =   17
            Tag             =   "FIL_Id"
            Top             =   4260
            Visible         =   0   'False
            Width           =   1830
         End
         Begin MSComDlg.CommonDialog dlg_Common 
            Left            =   135
            Top             =   7470
            _ExtentX        =   847
            _ExtentY        =   847
            _Version        =   393216
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Name"
            Height          =   255
            Index           =   0
            Left            =   135
            TabIndex        =   29
            Tag             =   "lbl_FIL_Name"
            Top             =   315
            Width           =   735
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Ext"
            Height          =   255
            Index           =   1
            Left            =   150
            TabIndex        =   28
            Tag             =   "lbl_FIL_Ext"
            Top             =   720
            Width           =   735
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#File Name"
            Height          =   255
            Index           =   2
            Left            =   6555
            TabIndex        =   27
            Tag             =   "lbl_FIL_FileName"
            Top             =   315
            Width           =   1095
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Id"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   238
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Index           =   22
            Left            =   390
            TabIndex        =   18
            Tag             =   "lbl_COF_ID"
            Top             =   4290
            Visible         =   0   'False
            Width           =   510
         End
      End
      Begin VB.Frame fraItemBottom 
         Height          =   585
         Left            =   1440
         TabIndex        =   5
         Tag             =   "fraItemBottom"
         Top             =   9720
         Width           =   13950
         Begin VB.TextBox txt_updatedBy 
            Enabled         =   0   'False
            Height          =   330
            Left            =   8595
            TabIndex        =   11
            TabStop         =   0   'False
            Top             =   165
            Width           =   1875
         End
         Begin VB.TextBox txt_createdBy 
            Enabled         =   0   'False
            Height          =   330
            Left            =   3375
            TabIndex        =   10
            TabStop         =   0   'False
            Tag             =   "txt_createdBy"
            Top             =   150
            Width           =   1875
         End
         Begin VB.TextBox txt_dateEntered 
            Alignment       =   2  'Center
            Enabled         =   0   'False
            Height          =   330
            Left            =   1275
            TabIndex        =   9
            TabStop         =   0   'False
            Tag             =   "txt_dateEntered"
            Top             =   165
            Width           =   1100
         End
         Begin VB.TextBox txt_dateUpdated 
            Alignment       =   2  'Center
            Enabled         =   0   'False
            Height          =   330
            Left            =   6495
            TabIndex        =   8
            TabStop         =   0   'False
            Tag             =   "txt_lastUpdated"
            Top             =   165
            Width           =   1100
         End
         Begin VB.CheckBox chk_DropFlag 
            Alignment       =   1  'Right Justify
            Caption         =   "#Drop flag"
            Enabled         =   0   'False
            Height          =   255
            Left            =   10590
            TabIndex        =   7
            Tag             =   "chk_DropFlag"
            Top             =   240
            Width           =   1845
         End
         Begin VB.TextBox txt_DropDate 
            Alignment       =   2  'Center
            Enabled         =   0   'False
            Height          =   330
            Left            =   12480
            Locked          =   -1  'True
            TabIndex        =   6
            Top             =   150
            Width           =   1400
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#By"
            Enabled         =   0   'False
            Height          =   255
            Index           =   13
            Left            =   7635
            TabIndex        =   15
            Tag             =   "lbl_updatedBy"
            Top             =   210
            Width           =   900
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#By"
            Enabled         =   0   'False
            Height          =   255
            Index           =   12
            Left            =   2400
            TabIndex        =   14
            Tag             =   "lbl_createdBy"
            Top             =   210
            Width           =   900
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Last Updated"
            Enabled         =   0   'False
            Height          =   255
            Index           =   11
            Left            =   5295
            TabIndex        =   13
            Tag             =   "lbl_lastUpdated"
            Top             =   210
            Width           =   1140
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Date Entered"
            Enabled         =   0   'False
            Height          =   255
            Index           =   10
            Left            =   75
            TabIndex        =   12
            Tag             =   "lbl_dateEntered"
            Top             =   210
            Width           =   1140
         End
      End
      Begin Project1.ToolbarControl tlb_Item 
         Height          =   690
         Left            =   90
         TabIndex        =   4
         Tag             =   "3005"
         Top             =   195
         Width           =   16215
         _ExtentX        =   28601
         _ExtentY        =   1217
      End
      Begin MSComctlLib.TabStrip tbsEmbedded 
         Height          =   375
         Left            =   120
         TabIndex        =   19
         Tag             =   "tbsEmbedded"
         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 fraList 
      Height          =   4935
      Left            =   5460
      TabIndex        =   0
      Tag             =   "fraList"
      Top             =   2610
      Width           =   9015
      Begin Project1.ToolbarControl tlb_Main 
         Height          =   690
         Left            =   75
         TabIndex        =   1
         Tag             =   "3004"
         Top             =   120
         Width           =   8685
         _ExtentX        =   15319
         _ExtentY        =   1217
      End
      Begin Project1.ArmGrid grdlst 
         Height          =   2775
         Left            =   240
         TabIndex        =   2
         Tag             =   "grdlst"
         Top             =   1200
         Width           =   5175
         _ExtentX        =   9128
         _ExtentY        =   4895
      End
   End
End
Attribute VB_Name = "CapFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' **************************************************************************************************
' **************************************** USER DEFINED ERRORS *************************************
' **************************************************************************************************
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
    QuietException = vbObjectError + 12          ' do not display error message
    SQLTableReferenceConstraint = vbObjectError + 13 ' A SQL request cannot be executed : Table reference constraint
    DuplicityDetected = vbObjectError + 2301     ' detected row with same unique id
End Enum

Private Const LOCALE_SDECIMAL = &HE ' Decimal separator
Private Const LOCALE_STHOUSAND = &HF ' Thousand separator
Private Const LOCALE_USER_DEFAULT = &H400
Private Const SCREEN_NAME As String = "CapFile"

Private Const CL_COLOR_ENABLED  As Long = &H80000005
Private Const CL_COLOR_DISABLED As Long = &H8000000F
Private Const CL_COLOR_Expired  As Long = 10066414          ' # EE9999
Private Const CL_COLOR_Requested    As Long = 10066414      ' # EE9999
Private Const CL_COLOR_Delivered    As Long = 10088089      ' # 99EE99
'******** Curseur de connexion

#If ENV = LIVE Then
Private mo_Sys As Object
Private mo_Db As Object
Private mo_FSO As Object
#Else
Private mo_Sys As ARMSYSCOMLib.ArmSYS
Private mo_Db As ARMSYSCOMLib.ArmDb
Private mo_FSO As Scripting.FileSystemObject
#End If


Private mo_Tools As DPC_Tools

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

Private mb_Created As Boolean
Dim mb_use_framework_connection As Boolean
Private ms_ConnectString As String
Private ms_UID As String
Private ml_U_Code As Long
Private ms_LoginName As String
Private ml_iConcurrency As Long
Private mb_FileChanged As Boolean  'indicate if image picture was changed
Private ms_FilePath                      As String       'used to save images from database

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 ms_Language_Code As String

'******** iConccurency of current Record
Private p_iCon As Integer
Private prj_iConc As Long                       ' iConc of project - valid after ViewInitFields and AddInitFields
Private m_projectStatus As Variant

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

Private m_Project As String 'For the property .Project, display in ShortList
Private m_Contact As String 'For the property .Contact, display in ShortList
Private m_Customer As String 'For the property .Customer, 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

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

Private mb_InternalInit As Boolean
Private mb_TemplateDownloaded As Boolean
Private mb_grd_ProductsLoaded As Boolean
Private ms_DecimalSeparator As String
Private ms_ThousandSeparator As String
Private mc_ScreenLabels As Long
Private mc_Toolbars As Long
Private mo_WshNetwork As Object
Private ms_ComputerName As String
Private ms_Caption As String
Private mb_Initialized As Boolean

Private Const VALUE_FORMAT As String = "###0.00"
Private Const MONEY_FORMAT As String = "###0.00"

Public Property Set ArmDb(ByRef ao_Db As Object)
On Error GoTo ErrorHandler

  Set mo_Db = ao_Db
  Exit Property
ErrorHandler:
  Call ErrorHandler("ArmDb.Set")
End Property

Public Property Get ArmDb() As Object
On Error GoTo ErrorHandler

  Set ArmDb = mo_Db
  Exit Property
ErrorHandler:
  Call ErrorHandler("ArmDb.Get")
End Property

Public Property Set Tools(ByRef ao_Tools As Object)
On Error GoTo ErrorHandler

  Set mo_Tools = ao_Tools
  Exit Property
ErrorHandler:
  Call ErrorHandler("Tools.Set")
End Property

Public Property Let Language(as_Language As String)
On Error GoTo ErrHandler
  
  ms_Language_Code = as_Language
  Exit Property
ErrHandler:
  Call ErrorHandler("Language.Let")
End Property

Public Property Get Language() As String
On Error GoTo ErrHandler
  
  Language = ms_Language_Code
  Exit Property
ErrHandler:
  Call ErrorHandler("Language.Get")
End Property

Public Property Let U_Code(ByVal al_U_Code As Long)
On Error GoTo ErrorHandler

  ml_U_Code = al_U_Code
  Exit Property
ErrorHandler:
  Call ErrorHandler("U_Code.Let")
End Property

Public Property Let LoginName(ByVal as_Value As String)
On Error GoTo ErrorHandler

  ms_LoginName = as_Value
  Exit Property
ErrorHandler:
  Call ErrorHandler("LoginName.Let")
End Property

Public Property Let Caption(ByVal as_Value As String)
On Error GoTo ErrHandler
    
  ms_Caption = as_Value
  Exit Property
ErrHandler:
  Call ErrorHandler("Caption.Let")
End Property

Public Property Get Caption() As String
On Error GoTo ErrHandler
    
  Caption = ms_Caption
  Exit Property
ErrHandler:
  Call ErrorHandler("Caption.Get")
End Property

Public Property Let Name(ByVal as_Value As String)
On Error GoTo ErrHandler
    
  UserControl.Extender.Name = as_Value
  Exit Property
ErrHandler:
  Call ErrorHandler("Name.Let")
End Property

Public Property Get Name() As String
On Error GoTo ErrHandler
    
  Name = UserControl.Extender.Name
  Exit Property
ErrHandler:
  Call ErrorHandler("Name.Get")
End Property

Public Property Let Tag(ByVal as_Value As String)
On Error GoTo ErrHandler
    
  UserControl.Tag = as_Value
  Exit Property
ErrHandler:
  Call ErrorHandler("Tag.Let")
End Property

Public Property Get Tag() As String
On Error GoTo ErrHandler
    
  Tag = UserControl.Tag
  Exit Property
ErrHandler:
  Call ErrorHandler("Tag.Get")
End Property

Public Property Let Visible(ByVal aVisible As Boolean)
On Error GoTo ErrHandler
    
  UserControl.Extender.Visible = aVisible
  Exit Property
ErrHandler:
  Call ErrorHandler("Visible.Let")
End Property

Public Property Get Visible() As Boolean
On Error GoTo ErrHandler
    
  Visible = UserControl.Extender.Visible
  Exit Property
ErrHandler:
  Call ErrorHandler("Visible.Get")
End Property

Public Property Let Top(ByVal aTop As Single)
On Error GoTo ErrHandler
    
  UserControl.Extender.Top = aTop
  Exit Property
ErrHandler:
  Call ErrorHandler("Top.Let")
End Property

Public Property Get Top() As Single
On Error GoTo ErrHandler
    
  Top = UserControl.Extender.Top
  Exit Property
ErrHandler:
  Call ErrorHandler("Top.Get")
End Property

Public Property Let Height(ByVal aHeight As Single)
On Error GoTo ErrHandler
    
  UserControl.Extender.Height = aHeight
  Exit Property
ErrHandler:
  Call ErrorHandler("Height.Let")
End Property

Public Property Get Height() As Single
On Error GoTo ErrHandler
    
  Height = UserControl.Extender.Height
  Exit Property
ErrHandler:
  Call ErrorHandler("Height.Get")
End Property

Public Property Let Left(ByVal aLeft As Single)
On Error GoTo ErrHandler
    
  UserControl.Extender.Left = aLeft
  Exit Property
ErrHandler:
  Call ErrorHandler("Left.Let")
End Property

Public Property Get Left() As Single
On Error GoTo ErrHandler
    
  Left = UserControl.Extender.Left
  Exit Property
ErrHandler:
  Call ErrorHandler("Left.Get")
End Property

Public Property Let Width(ByVal aWidth As Single)
On Error GoTo ErrHandler
    
  UserControl.Extender.Width = aWidth
  Exit Property
ErrHandler:
  Call ErrorHandler(".Let")
End Property

Public Property Get Width() As Single
On Error GoTo ErrHandler
    
  Width = UserControl.Extender.Width
  Exit Property
ErrHandler:
  Call ErrorHandler("Width.Get")
End Property

Public Sub Move(ByVal aLeft As Single, ByVal aTop As Single, ByVal aWidth As Single, ByVal aHeight As Single)
On Error GoTo ErrHandler
  
  Call UserControl.Extender.Move(aLeft, aTop, aWidth, aHeight)
  Exit Sub
ErrHandler:
  Call ErrorHandler("Move")
End Sub

Public Property Let Enabled(ByVal ab_Value As Boolean)
On Error GoTo ErrHandler

  UserControl.Enabled = ab_Value
  Exit Property
ErrHandler:
  Call ErrorHandler("Enabled.Let")
End Property

Public Property Get Enabled() As Boolean
 On Error GoTo ErrHandler

   Enabled = UserControl.Enabled
  Exit Property
ErrHandler:
  Call ErrorHandler("Enabled.Get")
End Property

Public Sub Zorder()
On Error GoTo ErrHandler

    Call UserControl.Extender.Zorder
  Exit Sub
ErrHandler:
  Call ErrorHandler("Zorder")
End Sub

Public Sub Refresh()
On Error GoTo ErrHandler

    Call UserControl.Refresh
  Exit Sub
ErrHandler:
  Call ErrorHandler("Refresh")
End Sub

Public Property Get hwnd() As Long
On Error GoTo ErrHandler
  
  hwnd = UserControl.hwnd
  Exit Property
ErrHandler:
  Call ErrorHandler("hwnd.Get")
End Property

Public Property Get Initialized() As Boolean
On Error GoTo ErrHandler
    
  Initialized = mb_Initialized
  Exit Property
ErrHandler:
  Call ErrorHandler("Initialized.Get")
End Property

Public Property Let ConnectString(ByVal as_Value As String)
On Error GoTo ErrHandler
    
  ms_ConnectString = as_Value
  Exit Property
ErrHandler:
  Call ErrorHandler("ConnectString.Let")
End Property

' Initialization of the component
Public Sub Load_A_COM(ab_root As Boolean)
On Error GoTo ErrHandler
    
  VerifyInitialization mo_Db, ms_ConnectString, ms_Language_Code, Me
  
  If mo_Db Is Nothing Then
      Call Err.Raise(ArmErr.PropertyNotSet)
  End If
  
  If mo_Tools Is Nothing Then
      Call Err.Raise(ArmErr.PropertyNotSet)
  End If
  
  'Set mo_Tools = New DPC_Tools
  'Set mo_Tools.ArmDb = mo_Db
  'Call mo_Tools.Load_A_COM
  mb_FileChanged = False
  ms_FilePath = prg.AppCache_Dir & DPC_FILE_CACHE
  mb_FileChanged = False
  
  Call mo_Tools.Load_A_ComControls(UserControl.Controls, mo_Db, ms_Language_Code)
  ms_ThousandSeparator = mo_Tools.GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_STHOUSAND)
  ms_DecimalSeparator = Format(0, ".")
  
  Set mo_FSO = CreateObject("Scripting.FileSystemObject")
#If ENV = LIVE Then
  Set mo_Sys = CreateObject("ArmSYSCOM.ArmSys")
#Else
  Set mo_Sys = New ARMSYSCOMLib.ArmSYS
#End If
  
  Set mo_WshNetwork = CreateObject("WScript.Network")
  ms_ComputerName = mo_WshNetwork.ComputerName
  
  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
  mb_InternalInit = False

  grdlst.MultiSelect = False
  Dim la_Columns(7) As String        ' mmmm 3. Add town
  la_Columns(0) = "FIL_Id" & CH_LDELIMIT & "0" & CH_LDELIMIT & "1" & CH_LDELIMIT & "FIL_Id" & CH_LDELIMIT & "#Id"
  la_Columns(1) = "FIL_Name" & CH_LDELIMIT & "4000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "FIL_Name" & CH_LDELIMIT & "#Name"
  la_Columns(2) = "FIL_FileName" & CH_LDELIMIT & "4000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "FIL_FileName" & CH_LDELIMIT & "#Filename"
  la_Columns(3) = "FIL_Ext" & CH_LDELIMIT & "4000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "FIL_Ext" & CH_LDELIMIT & "#Extension"
  la_Columns(4) = "Z_CreatorDesc" & CH_LDELIMIT & "1000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "Z_CreatorDesc" & CH_LDELIMIT & "#User create"
  la_Columns(5) = "Z_Creation" & CH_LDELIMIT & "1000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "Z_Creation" & CH_LDELIMIT & "#Create date"
  la_Columns(6) = "Z_Last_Upd_UserDesc" & CH_LDELIMIT & "1000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "Z_Last_Upd_UserDesc" & CH_LDELIMIT & "#User update"
  la_Columns(7) = "Z_Last_Upd" & CH_LDELIMIT & "1000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "Z_Last_Upd" & CH_LDELIMIT & "#Update date"
  grdlst.SetColumns la_Columns

  Call mo_Tools.LoadToolbars(mo_Db, UserControl.Controls, SCREEN_NAME)
  'Screen csts
  mc_ScreenLabels = mo_Tools.LoadLabels(mo_Db, UserControl.Controls, Me, SCREEN_NAME, ms_Language_Code)
  Call mo_Tools.ChangeCharset(UserControl.Controls, gl_CodePage)
  Exit Sub
ErrHandler:
  Call ErrorHandler("Load_A_Com")
End Sub

' Release the memory used
Public Sub Unload_A_COM()
On Error GoTo ErrHandler
    
  Call mo_Tools.Unload_A_ComControls(UserControl.Controls)
  'Call mo_Tools.Unload_A_COM
  Call mo_Db.Close(mc_ScreenLabels)
  Set mo_Sys = Nothing
  Set mo_FSO = Nothing
  Set mo_Db = Nothing
  Set mo_Tools = Nothing
  
  Exit Sub
ErrHandler:
  Call ErrorHandler("Unload_A_Com")
End Sub

Public Sub GoToTab1()
On Error GoTo ErrHandler
    
    If UserControl.tbsEmbedded.Tabs.Count > 0 Then
        UserControl.tbsEmbedded.Tabs(1).Selected = True
    End If
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("GoToTab1")
End Sub

Private Sub Add_Resize()
On Error GoTo ErrHandler
    
    With UserControl
        
        .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 - (2 * mt_CstValues.Frm_Spacing)
        
        .tlb_Item.Height = mt_CstValues.View_ToolBar_Height
        .tlb_Item.Top = mt_CstValues.Frm_Spacing * 4
        .tlb_Item.Left = mt_CstValues.Frm_Spacing
        .tlb_Item.Width = .fraItem.Width - .tlb_Item.Left - (2 * mt_CstValues.Frm_Spacing)
        
        .tbsEmbedded.Visible = False
        
        .fraItemTop.Left = mt_CstValues.Frm_Spacing
        .fraItemTop.Top = mt_CstValues.Frm_Spacing + .tlb_Item.Top + .tlb_Item.Height
        .fraItemTop.Width = .fraItem.Width - .fraItemTop.Left - mt_CstValues.Frm_Spacing
        
        .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 = .fraItem.Height - .fraItemBottom.Height - mt_CstValues.Frm_Spacing
        .fraItemBottom.Left = mt_CstValues.Frm_Spacing
        
        .fraItem.Visible = True
        .fraItemTop.BorderStyle = 0
        .fraItemBottom.Visible = True
        .fraItemBottom.BorderStyle = 0
        
    End With

    Exit Sub
ErrHandler:
    Call ErrorHandler("Add_Resize")
End Sub

Private Sub AddDisplay()
On Error GoTo ErrHandler
    
    RaiseEvent SwitchToView(mt_CstValues.View_Full)
    
    'If the component was on short list, it does appear now in long list
    'InitControl 4
    
    BlankFields
    Call tlb_Item.DisplayFace("1")
    Add_Enablecontrols
    Add_Resize
    AddInitFields
    Exit Sub
ErrHandler:
    Call ErrorHandler("AddDisplay")
End Sub

Private Sub Delete_Resize()
On Error GoTo ErrHandler
    With UserControl
        
        .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)
        
        .tlb_Item.Height = mt_CstValues.View_ToolBar_Height
        .tlb_Item.Top = mt_CstValues.Frm_Spacing * 4
        .tlb_Item.Left = mt_CstValues.Frm_Spacing
        .tlb_Item.Width = .fraItem.Width - .tlb_Item.Left - (2 * mt_CstValues.Frm_Spacing)
        
        .tbsEmbedded.Visible = False
        
        .fraItemTop.Top = mt_CstValues.Frm_Spacing + .tlb_Item.Top + .tlb_Item.Height
        .fraItemTop.Left = mt_CstValues.Frm_Spacing
        .fraItemTop.Width = .fraItem.Width - .fraItemTop.Left - mt_CstValues.Frm_Spacing
        
        .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 = .fraItem.Height - .fraItemBottom.Height - mt_CstValues.Frm_Spacing
        .fraItemBottom.Left = mt_CstValues.Frm_Spacing
        
        .fraItem.Visible = True
        .fraItemTop.Visible = True
        .fraItemBottom.Visible = True
        .fraItemTop.BorderStyle = 0
        .fraItemBottom.BorderStyle = 0
    End With
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("Delete_Resize")
End Sub

Private Sub DeleteDisplay()
On Error GoTo ErrHandler
    
    RaiseEvent SwitchToView(mt_CstValues.View_Full)
    
    'If the component was on short list, it does appear now in long list
    'InitControl 4
    
    BlankFields
    Call tlb_Item.DisplayFace("3")
    Delete_EnableControls
    Delete_Resize
    ViewInitFields
    Exit Sub
ErrHandler:
    Call ErrorHandler("DeleteDisplay")
End Sub

Private Sub Delete_EnableControls()
On Error GoTo ErrHandler
    
    ControlsEnable UserControl.Controls, fraItemTop, False
    ControlsEnable UserControl.Controls, fraItemBottom, False
    Exit Sub
ErrHandler:
    Call ErrorHandler("Delete_EnableControls")
End Sub

Private Sub Update_Resize()
On Error GoTo ErrHandler
    
    With UserControl
    
        .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)
        
        .tlb_Item.Height = mt_CstValues.View_ToolBar_Height
        .tlb_Item.Top = mt_CstValues.Frm_Spacing * 4
        .tlb_Item.Left = mt_CstValues.Frm_Spacing
        .tlb_Item.Width = .fraItem.Width - .tlb_Item.Left - (2 * mt_CstValues.Frm_Spacing)
        
        .fraItemTop.Left = mt_CstValues.Frm_Spacing
        .fraItemTop.Top = mt_CstValues.Frm_Spacing + .tlb_Item.Top + .tlb_Item.Height
        .fraItemTop.Width = .fraItem.Width - .fraItemTop.Left - mt_CstValues.Frm_Spacing
        
        .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 = .fraItem.Height - .fraItemBottom.Height - mt_CstValues.Frm_Spacing
        .fraItemBottom.Left = mt_CstValues.Frm_Spacing
        
        .tbsEmbedded.Visible = False
        
        .fraItem.Visible = True
        .fraItemTop.BorderStyle = 0
        .fraItemBottom.Visible = True
        .fraItemBottom.BorderStyle = 0
    End With
    Exit Sub
ErrHandler:
    Call ErrorHandler("Update_Resize")
End Sub

Private Sub UpdateDisplay()
On Error GoTo ErrHandler
    
    RaiseEvent SwitchToView(mt_CstValues.View_Full)
    
    'If the component was on short list, it does appear now in long list
    'InitControl 4
    
    Call tlb_Item.DisplayFace("2")
    If mi_OldDisplayMode <> mt_CstValues.DisplayMode_View Then BlankFields
    If mi_OldDisplayMode <> mt_CstValues.DisplayMode_View Then
        UpdateInitFields
    End If
    Update_EnableControls
    Update_Resize
    Exit Sub
ErrHandler:
    Call ErrorHandler("UpdateDisplay")
End Sub

Function RecordAdd() As Boolean
On Error GoTo ErrHandler
Dim ls_req As String

    RecordAdd = False
    If txt_FileNamePath.Text = "" Then
        Call mo_Tools.ShowMsg(mo_Db, ms_Language_Code, 9738, "#Please select file")
        Exit Function
    End If
    
    m_CurrentKey1 = mo_Tools.GetNextID(mo_Db, "DPC_File")
    txt_FIL_ID.Text = m_CurrentKey1
    Call InsertFile(txt_FileNamePath, m_CurrentKey1)
    
    
    ls_req = "exec DPC_FileInfo_ins $FIL_Id$,$FIL_Name$,$FIL_FileName$,$FIL_Ext$,$FIL_Path$,$Z_creator$"

    ls_req = mo_Tools.ReplaceRequestByFrameData(ls_req, Controls, fraItemTop)
    ls_req = Replace(ls_req, "$Language_Code$", mo_Tools.SqlStr(ms_Language_Code), , , vbTextCompare)
    ls_req = Replace(ls_req, "$Z_creator$", ml_U_Code)
    
    Call mo_Tools.ExecuteSQLSafe(mo_Db, ls_req)
    
    ls_req = ""
    Select Case mi_EmbeddedIn
    Case mt_CstValues.Tag_Project
      ls_req = "exec Cap_FileProject_ins $FIL_Id$,$SP_CapKey$,$U_Code$"
    Case mt_CstValues.Tag_Customer
      ls_req = "exec Cap_FileCustomer_ins $FIL_Id$,$CCU_CapKey$,$U_Code$"
    Case mt_CstValues.Tag_Contact
      ls_req = "exec Cap_FileContact_ins $FIL_Id$,$CNT_Code$,$CCU_CapKey$,$U_Code$"
    Case mt_CstValues.Tag_Action
      ls_req = "exec Cap_FileAction_ins $FIL_Id$,$AC_Code$,$U_Code$"
    Case Else
      Err.Raise ArmErr.CompFncFailed, "RecordAdd", "#Unknown embeeded component " & mi_EmbeddedIn
    End Select
    
    ls_req = ReplaceDataPlaceholders(ls_req)
    ls_req = ReplaceCommonPlaceholders(ls_req)
    Call mo_Tools.ExecuteSQLSafe(mo_Db, ls_req)
        
    RaiseEvent Updated
    RecordAdd = True
    Exit Function
ErrHandler:
    Call ErrorHandler("RecordAdd")
End Function

Function RecordUpdate(ACode As String) As Boolean
On Error GoTo ErrHandler
Dim ls_req As String
Dim ls_FIL_Id As String

    RecordUpdate = False
    If txt_FileNamePath.Text = "" Then
        Call mo_Tools.ShowMsg(mo_Db, ms_Language_Code, 9738, "#Please select file")
        Exit Function
    End If
    
    If mb_FileChanged = True Then
        
        'ls_FIL_Id = mo_Tools.GetNextID(mo_Db, "DPC_File")
        'txt_FIL_ID.Text = ls_FIL_Id
        Call UpdateFile(txt_FileNamePath, m_CurrentKey1)
        
        ls_req = "exec DPC_FileInfo_upd $FIL_Id$,$FIL_Name$,$FIL_FileName$,$FIL_Ext$,$FIL_Path$,$Z_creator$, $iConcurrency$"
    
        ls_req = mo_Tools.ReplaceRequestByFrameData(ls_req, Controls, fraItemTop)
        ls_req = ReplaceCommonPlaceholders(ls_req)
        Call mo_Tools.ExecuteSQLSafe(mo_Db, ls_req)
    Else
        ls_req = "exec DPC_FileInfo_upd $FIL_Id$,$FIL_Name$,$FIL_FileName$,$FIL_Ext$,$FIL_Path$,$Z_last_upd_user$, $iConcurrency$"
        ls_req = mo_Tools.ReplaceRequestByFrameData(ls_req, Controls, fraItemTop)
        ls_req = ReplaceCommonPlaceholders(ls_req)
    
        Call mo_Tools.ExecuteSQLSafe(mo_Db, ls_req, 1)
    End If
    
    ls_req = ""
    Select Case mi_EmbeddedIn
    Case mt_CstValues.Tag_Project
      ls_req = "exec Cap_FileProject_upd $FIL_Id$, $SP_CapKey$, $Z_Last_Upd_User$, $iConcurrency$ "
    Case mt_CstValues.Tag_Customer
      ls_req = "exec Cap_FileCustomer_upd $FIL_Id$, $CCU_CapKey$, $Z_Last_Upd_User$, $iConcurrency$ "
    Case mt_CstValues.Tag_Contact
      ls_req = "exec Cap_FileContact_upd $FIL_Id$, $CNT_Code$, $CCU_CapKey$, $Z_Last_Upd_User$, $iConcurrency$ "
    Case mt_CstValues.Tag_Action
      ls_req = "exec Cap_FileAction_upd $FIL_Id$, $AC_Code$, $Z_Last_Upd_User$, $iConcurrency$ "
    Case Else
      Err.Raise ArmErr.CompFncFailed, "RecordUpdate", "#Unknown embeeded component " & mi_EmbeddedIn
    End Select
    
    ls_req = ReplaceDataPlaceholders(ls_req)
    ls_req = ReplaceCommonPlaceholders(ls_req)
    Call mo_Tools.ExecuteSQLSafe(mo_Db, ls_req, 1)
    
    'The data has been updated
    RaiseEvent Updated
    RecordUpdate = True
    Exit Function
ErrHandler:
    Call ErrorHandler("RecordUpdate")
End Function

Function RecordDelete(ACode As String) As Boolean
On Error GoTo ErrHandler

Dim ls_req As String

    ls_req = ""
    Select Case mi_EmbeddedIn
    Case mt_CstValues.Tag_Project
      ls_req = "exec Cap_FileProject_del $FIL_Id$, $SP_CapKey$, $Z_Last_Upd_User$, $iConcurrency$ "
    Case mt_CstValues.Tag_Customer
      ls_req = "exec Cap_FileCustomer_del $FIL_Id$, $CCU_CapKey$, $Z_Last_Upd_User$, $iConcurrency$ "
    Case mt_CstValues.Tag_Contact
      ls_req = "exec Cap_FileContact_del $FIL_Id$, $CNT_Code$, $CCU_CapKey$, $Z_Last_Upd_User$, $iConcurrency$ "
    Case mt_CstValues.Tag_Action
      ls_req = "exec Cap_FileAction_del $FIL_Id$, $AC_Code$, $Z_Last_Upd_User$, $iConcurrency$ "
    Case Else
      Err.Raise ArmErr.CompFncFailed, "RecordDelete", "#Unknown embeeded component " & mi_EmbeddedIn
    End Select
    
    ls_req = ReplaceDataPlaceholders(ls_req)
    ls_req = ReplaceCommonPlaceholders(ls_req)
    Call mo_Tools.ExecuteSQLSafe(mo_Db, ls_req, 1)
    
    'The data has been deleted
    RaiseEvent Updated
    RecordDelete = True
    Exit Function
ErrHandler:
    Call ErrorHandler("RecordDelete")
End Function

Private Sub ViewDisplay()
On Error GoTo ErrHandler
    
    If mi_EmbeddedIn = -1 Then
        RaiseEvent SwitchToView(mt_CstValues.View_Full)
    Else
        RaiseEvent SwitchToView(mt_CstValues.View_Full)
    End If
    
    'If the component was on short list, it doues appear now in long list
    'InitControl 3
    
    BlankFields
    Call tlb_Item.DisplayFace("0")
    View_EnableControls
    ViewLoad
    View_Resize
    ViewInitFields
    Exit Sub
ErrHandler:
    Call ErrorHandler("ViewDisplay")
End Sub

Private Sub View_Resize()
On Error GoTo ErrHandler
    
    With UserControl
        
        If mi_EmbeddedIn = -1 And Not mb_Root Then
        
            .fraItem.Left = mt_CstValues.Frm_Spacing
            
            .tbsEmbedded.Visible = False 'true
            .tbsEmbedded.Zorder 0
            
        Else
            .fraItem.Left = mt_CstValues.Frm_Spacing
            
            .tbsEmbedded.Visible = False '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)
        
        .tlb_Item.Height = mt_CstValues.View_ToolBar_Height
        .tlb_Item.Top = mt_CstValues.Frm_Spacing * 4
        .tlb_Item.Left = mt_CstValues.Frm_Spacing
        .tlb_Item.Width = .fraItem.Width - .tlb_Item.Left - (2 * mt_CstValues.Frm_Spacing)
        
        .fraItemTop.Top = mt_CstValues.Frm_Spacing + .tlb_Item.Top + .tlb_Item.Height
        .fraItemTop.Left = mt_CstValues.Frm_Spacing
        .fraItemTop.Width = .fraItem.Width - .fraItemTop.Left - mt_CstValues.Frm_Spacing
        
        .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 = .fraItem.Height - .fraItemBottom.Height - mt_CstValues.Frm_Spacing
        .fraItemBottom.Left = mt_CstValues.Frm_Spacing
        
        .fraItemBottom.Visible = True
        
        .fraItem.Visible = True
        .fraItemTop.BorderStyle = 0
        .fraItemBottom.BorderStyle = 0
    End With
    Exit Sub
ErrHandler:
    Call ErrorHandler("View_Resize")
End Sub

Public Property Get UserControlWidth() As Long
On Error GoTo ErrorHandler
    UserControlWidth = UserControl.Width
    Exit Property
ErrorHandler:
    Call ErrorMessage("UserControlWidth.Get")
End Property

Public Property Get CurrentKey(Optional APart As Integer = 0) As String
On Error GoTo ErrorHandler
    If APart = 0 Then
        CurrentKey = m_CurrentKey1 & CH_LDELIMIT & m_CurrentKey2
    ElseIf APart = 1 Then
        CurrentKey = m_CurrentKey1
    ElseIf APart = 2 Then
        CurrentKey = m_CurrentKey2
    Else
        CurrentKey = ""
    End If
    Exit Property
ErrorHandler:
    Call ErrorHandler("CurrentKey.Get")
End Property

Public Property Let CurrentKey(Optional APart As Integer = 0, AKeyValue As String)
On Error GoTo ErrorHandler
    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
    Else
        CurrentKey = ""
    End If
    Exit Property
ErrorHandler:
    Call ErrorHandler("CurrentKey.Let")
End Property

Public Property Let TypeList(AType As Integer)
On Error GoTo ErrorHandler
    
  mi_TypeList = AType

  Exit Property
ErrorHandler:
  Call ErrorHandler("TypeList.Let")
End Property

Property Get TypeList() As Integer
On Error GoTo ErrorHandler
    
  TypeList = mi_TypeList
  
  Exit Property
ErrorHandler:
  Call ErrorHandler("TypeList.Get")
End Property

Private Sub ShortList_Resize()
On Error GoTo ErrHandler
    
    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)
   
        .tlb_Main.Height = mt_CstValues.View_ToolBar_Height
        .tlb_Main.Top = mt_CstValues.Frm_Spacing * 4
        .tlb_Main.Left = mt_CstValues.Frm_Spacing
        .tlb_Main.Width = .fraList.Width - .tlb_Main.Left - (2 * mt_CstValues.Frm_Spacing)
        
        .grdlst.Top = mt_CstValues.Frm_Spacing + .tlb_Main.Top + .tlb_Main.Height
        .grdlst.Left = mt_CstValues.Frm_Spacing
        .grdlst.Width = .fraList.Width - .grdlst.Left - mt_CstValues.Frm_Spacing
        .grdlst.Height = .fraList.Height - .tlb_Main.Height - .tlb_Main.Top - (2 * mt_CstValues.Frm_Spacing)
        
        .fraList.Visible = True
        
    End With
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("ShortList_Resize")
End Sub

' Called when application must resize the current view
Public Sub Resize()
On Error GoTo ErrHandler
    
    Call DisplayMode_None
    
    Select Case DisplayMode
        Case mt_CstValues.DisplayMode_List
               Call ShortList_Resize
    End Select
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("Resize")
End Sub

Sub UnCatch()
    mi_EmbeddedIn = -1
End Sub

Public Property Let product(AProductKey As String)

    ' no product-offer navigation
End Property

Public Property Let action(AKey As String)
On Error GoTo ErrHandler
    Dim TheKeys     As Variant
    
    'AKey represents the concatenation of several keys separated by '@'
    If AKey = "" Then Call Err.Raise(InvalidArgument, "", "AKey is empty.")

    ' First, we hide all elements
    DisplayMode_None
    
    If (Not mb_Root) And (mi_TypeList <> 1) Then
        mi_EmbedTag = -1
    End If
    
    TheKeys = Split(AKey, CH_LDELIMIT)
    'Debug.Assert (UBound(TheKeys) = 3)
    m_Action = CStr(TheKeys(0))
    m_Customer = ""
    m_Contact = ""
    m_Project = ""
    m_projectStatus = "" 'CLng(TheKeys(2))
    
    mi_EmbeddedIn = mt_CstValues.Tag_Action

    mb_EmbeddedIsDropped = False
    
    ListActionOf CStr(TheKeys(0)), CStr(TheKeys(1))
    
    SwapToDisplayMode mt_CstValues.DisplayMode_List
    
    Exit Property
ErrHandler:
    Call ErrorHandler("Customer.Let")
End Property

Public Property Let contact(AKey As String)
On Error GoTo ErrHandler
    Dim TheKeys     As Variant
    
    'AKey represents the concatenation of several keys separated by '@'
    If AKey = "" Then Call Err.Raise(InvalidArgument, "", "AKey is empty.")

    ' First, we hide all elements
    DisplayMode_None
    
    If (Not mb_Root) And (mi_TypeList <> 1) Then
        mi_EmbedTag = -1
    End If
    
    TheKeys = Split(AKey, CH_LDELIMIT)
    'Debug.Assert (UBound(TheKeys) = 3)
    m_Action = ""
    m_Contact = CStr(TheKeys(0))
    m_Customer = CStr(TheKeys(1))
    m_Project = ""
    m_projectStatus = "" 'CLng(TheKeys(2))
    
    mi_EmbeddedIn = mt_CstValues.Tag_Contact

    mb_EmbeddedIsDropped = False
    
    ListContactOf CStr(TheKeys(0)), CStr(TheKeys(1)), CStr(TheKeys(2))
    
    SwapToDisplayMode mt_CstValues.DisplayMode_List
    
    Exit Property
ErrHandler:
    Call ErrorHandler("Customer.Let")
End Property
 
Public Property Let Customer(AKey As String)
On Error GoTo ErrHandler
    Dim TheKeys     As Variant
    
    'AKey represents the concatenation of several keys separated by '@'
    If AKey = "" Then Call Err.Raise(InvalidArgument, "", "AKey is empty.")

    ' First, we hide all elements
    DisplayMode_None
    
    If (Not mb_Root) And (mi_TypeList <> 1) Then
        mi_EmbedTag = -1
    End If
    
    TheKeys = Split(AKey, CH_LDELIMIT)
    'Debug.Assert (UBound(TheKeys) = 3)
    m_Action = ""
    m_Customer = CStr(TheKeys(0))
    m_Contact = ""
    m_Project = ""
    m_projectStatus = "" 'CLng(TheKeys(2))
    
    mi_EmbeddedIn = mt_CstValues.Tag_Customer

    mb_EmbeddedIsDropped = False
    
    ListCustomerOf CStr(TheKeys(0)), CStr(TheKeys(1))
    
    SwapToDisplayMode mt_CstValues.DisplayMode_List
    
    Exit Property
ErrHandler:
    Call ErrorHandler("Customer.Let")
End Property

Public Property Let project(AKey As String)
On Error GoTo ErrHandler
    Dim TheKeys     As Variant
    
    'AKey represents the concatenation of several keys separated by '@'
    If AKey = "" Then Call Err.Raise(InvalidArgument, "", "AKey is empty.")

    ' First, we hide all elements
    DisplayMode_None
    
    If (Not mb_Root) And (mi_TypeList <> 1) Then
        mi_EmbedTag = -1
    End If
    
    TheKeys = Split(AKey, CH_LDELIMIT)
    'Debug.Assert (UBound(TheKeys) = 3)
    m_Action = ""
    m_Customer = ""
    m_Contact = ""
    m_Project = CStr(TheKeys(0))
    m_projectStatus = "" 'CLng(TheKeys(2))

    'InitControl 2
    
    mi_EmbeddedIn = mt_CstValues.Tag_Project

    mb_EmbeddedIsDropped = False
    
    ListProjectOf CStr(TheKeys(0)), CStr(TheKeys(1))
    
    SwapToDisplayMode mt_CstValues.DisplayMode_List
    
    Exit Property
ErrHandler:
    Call ErrorHandler("project.Let")
End Property

Private Sub cmd_BrowseFile_Click()
On Error GoTo ErrHandler
    
Dim ls_Filename As String
    
    dlg_Common.Filter = "All files (*.*)|*.*"
    dlg_Common.CancelError = False
    Call dlg_Common.ShowOpen
    ls_Filename = dlg_Common.FileName
    If ls_Filename <> "" Then
        txt_FileNamePath.Text = ls_Filename
        txt_FileName.Text = right(ls_Filename, Len(ls_Filename) - InStrRev(ls_Filename, "\", -1, vbTextCompare))
        If InStrRev(txt_FileName.Text, ".", -1, vbTextCompare) > 0 Then
            txt_FIL_Name.Text = Left(txt_FileName.Text, InStrRev(txt_FileName.Text, ".", -1, vbTextCompare) - 1)
            txt_FIL_Ext.Text = right(txt_FileName.Text, Len(txt_FileName.Text) - InStrRev(txt_FileName.Text, ".", -1, vbTextCompare))
        Else
            txt_FIL_Name.Text = txt_FileName.Text
            txt_FIL_Ext.Text = ""
        End If
        txt_FIL_Path.Text = Left(ls_Filename, InStrRev(ls_Filename, "\", -1, vbTextCompare))
        mb_FileChanged = True
    End If
    Exit Sub
ErrHandler:
    Call ErrorMessage("cmd_BrowseFile_Click")
End Sub

Private Sub cmd_Save_As_Click()
On Error GoTo ErrHandler
    
Dim ls_Filename As String
    
    dlg_Common.Filter = "All files (*.*)|*.*"
    dlg_Common.CancelError = True
    dlg_Common.FileName = txt_FileName.Text
    dlg_Common.ShowSave
    
    If dlg_Common.FileName <> "" Then
        ls_Filename = dlg_Common.FileName
        If mo_FSO.FileExists(ls_Filename) Then
            If MsgBox(mo_Tools.MsgText(mo_Db, ms_Language_Code, -666, "#A file with this name already exists. Do you want to overwrite it?"), vbOKCancel) = vbCancel Then
                Exit Sub
            End If
        End If
        If Not mo_Db.BlobToFileSQL("SELECT FIL_File FROM DPC_File WHERE FIL_Id=" & txt_FIL_ID.Text, ls_Filename, True, False) Then
          Call MsgBox(mo_Tools.MsgText(mo_Db, ms_Language_Code, -666, "#Cannot download the file from db - FIL_Id:" & txt_FIL_ID.Text))
          Exit Sub
        End If
    
    End If
    Exit Sub
ErrHandler:
    If Err.Number = cdlCancel Then  ' this line is not executed on cancel
        Exit Sub
    End If
    Call ErrorMessage("cmd_Save_As_Click")
End Sub

Private Sub grdLst_ItemSelected()
On Error GoTo ErrHandler
    
    Call mo_Tools.LockScreen(Me, True)
    If (grdlst.SelectedCount = 1) Then
      m_CurrentKey1 = grdlst.CurrentKey(0)
    '  DisplayMode = mt_CstValues.DisplayMode_View
      Call Launch_File(m_CurrentKey1, grdlst.SelectedLine(0, "FIL_FileName"))
    End If

    Call mo_Tools.LockScreen(Me, False)
    Exit Sub
ErrHandler:
    Call ErrorMessage("grdLst_ItemSelected")
End Sub

' Get the root state
Public Property Get Root() As Boolean
On Error GoTo ErrorHandler
    
    Root = mb_Root

    Exit Property
ErrorHandler:
    Call ErrorHandler("Root.Get")
End Property

Public Property Let Root(ByVal ab_root As Boolean)
On Error GoTo ErrorHandler
    
    mb_Root = ab_root
    If mb_Root = True Then
        mi_EmbeddedIn = -1
    End If

    Exit Property
ErrorHandler:
    Call ErrorHandler("Root.Let")
End Property


Private Sub tlb_Item_action(ByVal as_Role As String, as_Language As String)
On Error GoTo ErrHandler
    Dim lb_Result   As Boolean
    Dim ls_auxStr   As String
    Dim ls_serialStr As String

    Call mo_Tools.LockScreen(Me, True)
    
    Select Case as_Role
        Case "A"
            CurrentKey = ""
            DisplayMode = mt_CstValues.DisplayMode_Add
        
        Case "B"
            If m_CurrentKey1 <> "" Then
                DisplayMode = mt_CstValues.DisplayMode_Update
            End If
        
        Case "C"
            If m_CurrentKey1 <> "" Then
                DisplayMode = mt_CstValues.DisplayMode_Delete
            End If
        
        Case "T"
            If mi_EmbedTag <> -1 Then
                RaiseEvent Release
                mi_EmbedTag = -1
            End If
            
            DisplayMode = mt_CstValues.DisplayMode_List
            
        Case "H"
        
            lb_Result = False
            Select Case DisplayMode
                Case mt_CstValues.DisplayMode_Add
                    lb_Result = RecordAdd
                Case mt_CstValues.DisplayMode_Update
                    lb_Result = RecordUpdate(m_CurrentKey1)
                Case mt_CstValues.DisplayMode_Delete
                    lb_Result = RecordDelete(m_CurrentKey1)
            End Select
            If lb_Result Then
                Call RefreshGridSafe(grdlst)
                If DisplayMode = mt_CstValues.DisplayMode_Add Then
                    Call grdlst.SearchKey(True, m_CurrentKey1)
                End If
                DisplayMode = mt_CstValues.DisplayMode_List
            End If
            
        Case "I"
            BlankFields
            'DisplayMode = mt_CstValues.DisplayMode_List
            If mi_DisplayMode = mt_CstValues.DisplayMode_Add Then
                AddInitFields
            Else
                ViewInitFields
            End If
            
        Case "J"
            If grdlst.Row = 0 Then
                Call ASC_SendMessage(mo_Db, ms_Language_Code, 927, "#No more previous item.")
            Else
                grdlst.Row = grdlst.Row - 1
                m_CurrentKey1 = grdlst.CurrentKey(0)
                BlankFields
                ViewInitFields
            End If
        
        Case "K"
            If grdlst.Row = grdlst.Rows - 1 And grdlst.AllDataLoaded = True Then
                Call ASC_SendMessage(mo_Db, ms_Language_Code, 928, "#No more next item.")
            Else
                grdlst.Row = grdlst.Row + 1
                m_CurrentKey1 = grdlst.CurrentKey(0)
                BlankFields
                ViewInitFields
            End If
        Case Else
          Err.Raise ArmErr.InvalidArgument, "as_Role", "Invalid role: " & as_Role
    
    End Select

    Call mo_Tools.LockScreen(Me, False)
    Exit Sub
ErrHandler:
    Select Case Err.Number
    Case ArmErr.SQLBadRowExpectedCount
        Call ASC_SendMessage(mo_Db, ms_Language_Code, 2138, "#The record you try to open has been deleted by an other user. Please refresh the grid.", , vbInformation)
        Call mo_Tools.LockScreen(Me, False)
        Exit Sub
    Case ArmErr.SQLBadRowAffectedCount
        Call ASC_SendMessage(mo_Db, ms_Language_Code, 916, "#This data has been updated by another user. Data will be reloaded. Please check the data and try again.", , vbInformation)
        ViewInitFields
        Call mo_Tools.LockScreen(Me, False)
        Exit Sub
    End Select

    Call ErrorMessage("tlb_Item_action")
    Call mo_Tools.LockScreen(Me, False)
End Sub

Private Sub tlb_Main_action(ByVal as_Role As String, as_Language As String)
On Error GoTo ErrHandler

Dim ls_serialStr As String

  Call mo_Tools.LockScreen(Me, True)
  
  ' TASK 298.2
  Select Case as_Role
  
  Case "A"
      CurrentKey = ""
      DisplayMode = mt_CstValues.DisplayMode_Add
      
  Case "B"
      If (grdlst.SelectedCount = 1) Then
          If grdlst.CurrentKey(0) <> "" Then
              CurrentKey = grdlst.CurrentKey(0)
              DisplayMode = mt_CstValues.DisplayMode_Update
          End If
      End If
      
  Case "C"
      If (grdlst.SelectedCount = 1) Then
          If grdlst.CurrentKey(0) <> "" Then
              m_CurrentKey1 = grdlst.CurrentKey(0)
              DisplayMode = mt_CstValues.DisplayMode_Delete
          End If
      End If
  
  Case "F"
      grdlst.Refresh
      
  Case "T"
      Call mo_Tools.LockScreen(Me, False)
      RaiseEvent quit
      Exit Sub
  Case Else
    Err.Raise ArmErr.InvalidArgument, "as_Role", "Invalid role: " & as_Role
  
  End Select
  
  Call mo_Tools.LockScreen(Me, False)
  Exit Sub
    
ErrHandler:
  Call ErrorMessage("tlb_Main_Action")
End Sub

Sub View_EnableControls()
On Error GoTo ErrHandler
    
    ControlsEnable UserControl.Controls, fraItemTop, False
    ControlsEnable UserControl.Controls, fraItemBottom, False
    
    Call mo_Tools.EnableControl(cmd_Save_As, True)

'    txt_FIL_Name.Locked = True
'    txt_FIL_Name.BackColor = CL_COLOR_DISABLED
'    txt_FIL_Name.Enabled = True
'
'    txt_FileName.Locked = True
'    txt_FileName.BackColor = CL_COLOR_DISABLED
'    txt_FileName.Enabled = True
'
'    txt_FIL_Ext.Locked = True
'    txt_FIL_Ext.BackColor = CL_COLOR_DISABLED
'    txt_FIL_Ext.Enabled = True
'
'    txt_FIL_Id.Locked = True
'    txt_FIL_Id.BackColor = CL_COLOR_DISABLED
'    txt_FIL_Id.Enabled = True
'
'    txt_dateEntered.Locked = True
'    txt_dateEntered.BackColor = CL_COLOR_DISABLED
'    txt_dateEntered.Enabled = True
'
'    txt_dateUpdated.Locked = True
'    txt_dateUpdated.BackColor = CL_COLOR_DISABLED
'    txt_dateUpdated.Enabled = True
'
'    txt_createdBy.Locked = True
'    txt_createdBy.BackColor = CL_COLOR_DISABLED
'    txt_createdBy.Enabled = True
'
'    txt_updatedBy.Locked = True
'    txt_updatedBy.BackColor = CL_COLOR_DISABLED
'    txt_updatedBy.Enabled = True
'
'    txt_DropDate.Locked = True
'    txt_DropDate.BackColor = CL_COLOR_DISABLED
'    txt_DropDate.Enabled = True
    Exit Sub
ErrHandler:
    Call ErrorHandler("View_EnableControls")
End Sub

Sub Add_Enablecontrols()
On Error GoTo ErrHandler
    
  ControlsEnable UserControl.Controls, fraItemTop, True
  ControlsEnable UserControl.Controls, fraItemBottom, True
  
  Call mo_Tools.EnableControl(txt_FIL_ID, False)
  Call mo_Tools.EnableControl(txt_FileName, False)
  Call mo_Tools.EnableControl(txt_FIL_Ext, False)
  Call mo_Tools.EnableControl(txt_FIL_Path, False)

  Call mo_Tools.EnableControl(txt_dateEntered, False)
  Call mo_Tools.EnableControl(txt_dateUpdated, False)
  Call mo_Tools.EnableControl(txt_createdBy, False)
  Call mo_Tools.EnableControl(txt_updatedBy, False)
  Call mo_Tools.EnableControl(txt_DropDate, False)
  Call mo_Tools.EnableControl(chk_DropFlag, False)
  Call mo_Tools.EnableControl(cmd_Save_As, False)
    
'    txt_dateEntered.Locked = True
'    txt_dateEntered.BackColor = CL_COLOR_DISABLED
'    txt_dateUpdated.Locked = True
'    txt_dateUpdated.BackColor = CL_COLOR_DISABLED
'    txt_createdBy.Locked = True
'    txt_createdBy.BackColor = CL_COLOR_DISABLED
'    txt_updatedBy.Locked = True
'    txt_updatedBy.BackColor = CL_COLOR_DISABLED
'    txt_DropDate.Locked = True
'    txt_DropDate.BackColor = CL_COLOR_DISABLED
'    chk_DropFlag.Enabled = False
    Exit Sub
ErrHandler:
    Call ErrorHandler("Add_Enablecontrols")
End Sub

Sub Update_EnableControls()
On Error GoTo ErrHandler
    
  ControlsEnable UserControl.Controls, fraItemTop, True
  ControlsEnable UserControl.Controls, fraItemBottom, True
  
  Call mo_Tools.EnableControl(txt_FIL_ID, False)
  Call mo_Tools.EnableControl(txt_FileNamePath, False)
  Call mo_Tools.EnableControl(txt_FIL_Ext, False)
  Call mo_Tools.EnableControl(txt_FIL_Path, False)
  Call mo_Tools.EnableControl(txt_FileName, False)

  Call mo_Tools.EnableControl(txt_dateEntered, False)
  Call mo_Tools.EnableControl(txt_dateUpdated, False)
  Call mo_Tools.EnableControl(txt_createdBy, False)
  Call mo_Tools.EnableControl(txt_updatedBy, False)
  Call mo_Tools.EnableControl(txt_DropDate, False)
  Call mo_Tools.EnableControl(chk_DropFlag, False)
  
'  txt_dateEntered.Locked = True
'  txt_dateEntered.BackColor = CL_COLOR_DISABLED
'  txt_dateUpdated.Locked = True
'  txt_dateUpdated.BackColor = CL_COLOR_DISABLED
'  txt_createdBy.Locked = True
'  txt_createdBy.BackColor = CL_COLOR_DISABLED
'  txt_updatedBy.Locked = True
'  txt_updatedBy.BackColor = CL_COLOR_DISABLED
'  txt_DropDate.Locked = True
'  txt_DropDate.BackColor = CL_COLOR_DISABLED
'  chk_DropFlag.Enabled = False
  Exit Sub
ErrHandler:
  Call ErrorHandler("Update_EnableControls")
End Sub

Sub UpdateInitFields()
On Error GoTo ErrHandler
    
  'idem
  ViewInitFields
  
  Exit Sub
ErrHandler:
  Call ErrorHandler("UpdateInitFields")
End Sub

Private Sub InitControl(Optional aMode As Integer = 0)
On Error GoTo ErrHandler
    Dim ConnectData As Variant
    
    If Not ASC_ConnectToDB(mo_Db, ms_ConnectString, mb_Created) Then Exit Sub
    
    Select Case aMode
        Case 0
    'If No mode then exit
            Exit Sub
   
        Case 1
    'If already initialized then exit
        If mi_TypeList <> 1 Then
            mi_TypeList = 1
        Else
            'tlb_Main.PictureDisplayed = "P_Quit=-1"
            Exit Sub
        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 2
        'Pour la liste courte
        
        'Grille
'        grdlst.ResetGrid
        
        'Pour liste longue : Initialisation toolbar
'        tlb_Main.ClearAllIcons
'        tlb_Main.TableName = "Cap_SubProject"
'        tlb_Main.PictureDisplayed = "P_Refresh=6"
        
        Case 3
    
'            tlb_Item.ClearAllIcons
'            tlb_Item.TableName = ""
'            tlb_Item.PictureDisplayed = "P_Update=2 P_Previous=4 P_Next=5 P_Quit=-1"
    
        Case 4
    
        'Toolbar
'        tlb_Item.ClearAllIcons
'        tlb_Item.PictureDisplayed = "P_Valid=1 P_UnDo=2 P_Quit=-1"
    End Select
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("InitControl")
End Sub
Private Sub ObjectVisible(Optional aVisible As Boolean = True)
On Error GoTo ErrHandler
    
  UserControl.fraItem.Visible = aVisible
  UserControl.fraList.Visible = aVisible

  Exit Sub
ErrHandler:
  Call ErrorHandler("ObjectVisible")
End Sub

Public Sub FrameWorkInit(ByRef lt_CstValues As Type_CstValues, ByVal ls_InstanceName As String, Optional ATypeList As Integer = 0)
On Error GoTo ErrHandler
    
  'Restriction of initialsation
  mi_TypeParam = ATypeList
      
  Set mt_CstValues = lt_CstValues
  
  
  mi_CptTag = mt_CstValues.Tag_File
  
  ' Add the tabulation for the embedded controls
  With UserControl
    .ScaleMode = 1
    .tbsEmbedded.Tabs.Clear
    .tbsEmbedded.TabFixedWidth = 150
    Dim lt_Tab As Object
    Set lt_Tab = .tbsEmbedded.Tabs.Add(.tbsEmbedded.Tabs.Count + 1, "Project", "#Project")
    lt_Tab.Tag = mt_CstValues.Tag_Project
    Set lt_Tab = Nothing
    Set lt_Tab = .tbsEmbedded.Tabs.Add(.tbsEmbedded.Tabs.Count + 1, "Action", "#Action")
    lt_Tab.Tag = mt_CstValues.Tag_Action
    Set lt_Tab = Nothing
    Set lt_Tab = .tbsEmbedded.Tabs.Add(.tbsEmbedded.Tabs.Count + 1, "Customer", "#Customer")
    lt_Tab.Tag = mt_CstValues.Tag_Customer
    Set lt_Tab = Nothing
    Set lt_Tab = .tbsEmbedded.Tabs.Add(.tbsEmbedded.Tabs.Count + 1, "Contact", "#Contact")
    lt_Tab.Tag = mt_CstValues.Tag_Contact
    Set lt_Tab = Nothing
    Set lt_Tab = .tbsEmbedded.Tabs.Add(.tbsEmbedded.Tabs.Count + 1, "Product", "#Product")
    lt_Tab.Tag = mt_CstValues.Tag_Product
    Set lt_Tab = Nothing
    Set lt_Tab = .tbsEmbedded.Tabs.Add(.tbsEmbedded.Tabs.Count + 1, "Memo", "#Memo")
    lt_Tab.Tag = mt_CstValues.Tag_Memo
    Set lt_Tab = Nothing
  End With
  
  mi_DisplayMode = mt_CstValues.DisplayMode_None
  mi_OldDisplayMode = mi_DisplayMode
  
  Exit Sub
ErrHandler:
  Call ErrorHandler("FrameWorkInit")
End Sub

' Properties for let application access to critical data
Public Property Get CptTag()
    
    CptTag = mi_CptTag
End Property

' Give the tag of the component which embed this instance
Public Property Get EmbeddedIn() As Integer
    
    EmbeddedIn = mi_EmbeddedIn
End Property

' Give the tag of the component embed by this
Public Property Get EmbedTag() As Integer
    
    EmbedTag = mi_EmbedTag
End Property

' Give the actual display mode
Public Property Get DisplayMode() As Integer
    
    DisplayMode = mi_DisplayMode
End Property

' Change the actual display mode
Public Property Let DisplayMode(ByVal li_DisplayMode As Integer)
    
    SwapToDisplayMode li_DisplayMode
End Property

' when a component embed this instance
Public Sub CatchBy(ByVal li_TagCaller, ByVal ls_Params As String)
On Error GoTo ErrHandler
    
    mi_EmbeddedIn = li_TagCaller
    mb_Root = False
    mi_EmbedTag = -1
    
    If mi_EmbeddedIn <> -1 Then
        ' When a component is embedded, it always appears in short list
        SwapToDisplayMode mt_CstValues.DisplayMode_List, ls_Params
    End If
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("CatchBy")
End Sub

Private Function WithParent() As Boolean
On Error GoTo ErrHandler
    
    If m_Project = "" And m_Customer = "" And m_Contact = "" And m_Product = "" And m_Action = "" Then
        WithParent = False
    Else
        WithParent = True
    End If

    Exit Function
ErrHandler:
    Call ErrorHandler("WithParent")
End Function

' Change the display mode
Private Sub SwapToDisplayMode(li_DisplayMode As Integer, Optional ls_Params As String = "")
On Error GoTo ErrHandler
    mb_InternalInit = True
    
    mi_OldDisplayMode = mi_DisplayMode
   
    'When a component is root, it can't select the list mode
    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 component is embedded
            ShortListDisplay ls_Params
        
        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
    
    mb_InternalInit = False
    Exit Sub
    
ErrHandler:
    mb_InternalInit = False
    Call ErrorHandler("SwapToDisplayMode")
End Sub

' Hide all graphics elements
Private Sub DisplayMode_None()
On Error GoTo ErrHandler
    
   With UserControl
        .fraItem.Visible = False
        .fraList.Visible = False
    End With
    Exit Sub
ErrHandler:
    Call ErrorHandler("DisplayMode_None")
End Sub

Private Sub ViewLoad()
End Sub

Private Sub ShortListDisplay(ByVal ls_Params As String)
On Error GoTo ErrHandler
    
    RaiseEvent SwitchToView(mt_CstValues.View_Embedded)
   
    ShortList_Resize
        
    Exit Sub
ErrHandler:
    Call ErrorHandler("ShortListDisplay")
End Sub


' Embed a component
Private Sub tbsEmbedded_Click()
On Error GoTo ErrHandler
    
    If mi_EmbedTag = UserControl.tbsEmbedded.SelectedItem.Tag Then Exit Sub
    
    Call mo_Tools.LockScreen(Me, True)
    With UserControl
        
        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 .tbsEmbedded.SelectedItem.Tag = mt_CstValues.Tag_Memo Then
                     RaiseEvent SwitchToView(mt_CstValues.View_Medium)
                Else
                    RaiseEvent SwitchToView(mt_CstValues.View_Full)
                End If
            End If
            mi_EmbedTag = .tbsEmbedded.SelectedItem.Tag
            RaiseEvent Catch(mi_EmbedTag, m_CurrentKey1 & CH_LDELIMIT & m_CurrentKey2)
        End If
    End With

    Call mo_Tools.LockScreen(Me, False)
    Exit Sub
ErrHandler:
    Call ErrorMessage("tbsEmbedded_Click")
End Sub


Private Sub AddInitFields()
On Error GoTo ErrHandler

Dim ls_Request As String
Dim ll_Cursor As Long

  'Try connection, 'use_framework_connection' is inside 'ASC_ConnectToDB' !
  txt_FIL_ID.Text = grdlst.Rows + 1
  txt_FIL_Name.Text = ""
  txt_FileName.Text = ""
  
  ls_Request = "SELECT SP_Desc FROM sales_project WHERE SP_Capkey=$SP_Capkey$"
  ls_Request = Replace(ls_Request, "$SP_Capkey$", mo_Tools.SqlStr(m_Project), , , vbTextCompare)
  ls_Request = ReplaceCommonPlaceholders(ls_Request)
  ll_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_Request)
  'txt_SP_Desc.Text = mo_Db.GetFields(ll_Cursor, "SP_Desc")
  Call mo_Db.Close(ll_Cursor)
  
  txt_createdBy.Text = ms_UID
  txt_updatedBy.Text = ms_UID
  txt_dateEntered.Text = Format(Date, "dd\/mm\/yyyy")
  txt_dateUpdated.Text = Format(Date, "dd\/mm\/yyyy")
  
  
  chk_DropFlag.Visible = False
  txt_DropDate.Visible = False
  
  DisplayDefaultValues
  
  Exit Sub
  
ErrHandler:
  Call mo_Db.Close(ll_Cursor)
  Call ErrorHandler("AddInitFields")
End Sub

Private Sub BlankFields()
On Error GoTo ErrHandler
    Dim ls_req As String
          
    txt_FIL_Name.Text = ""
    txt_FileName.Text = ""
    txt_FIL_Ext.Text = ""
    txt_FIL_Path.Text = ""
    txt_FileNamePath.Text = ""
    chk_DropFlag.Value = 0
    txt_DropDate.Text = ""
    
    mb_grd_ProductsLoaded = False
    Exit Sub
ErrHandler:
    Call ErrorHandler("BlankFields")
End Sub

Private Sub DisplayDefaultValues()
On Error GoTo ErrHandler
    Dim i As Integer
    Dim TheControl As Control
    Dim TheControlName As String
    
    If p_DefaultValuesLoaded = False Then
        p_DefaultValuesCount = GetScreenDefaultValues(mo_Db, ms_UID, ms_Language_Code, "Cap_Offer_Detail", p_DefaultValues)
        p_DefaultValuesLoaded = True
    End If
    DisplayScreenDefaultValues UserControl.Controls, p_DefaultValues, p_DefaultValuesCount

    Exit Sub
ErrHandler:
    Call ErrorHandler("DisplayDefaultValues")
End Sub

Private Sub ViewInitFields()
On Error GoTo ErrHandler
    Dim ls_Request As String
    Dim ll_Cursor As Long

    If m_CurrentKey1 = "" Then Exit Sub
    
    ls_Request = ""
    Select Case mi_EmbeddedIn
    Case mt_CstValues.Tag_Project
      ls_Request = "exec Cap_FileProject_sel $FIL_Id$, $SP_Capkey$, $Language_Code$"
    Case mt_CstValues.Tag_Customer
      ls_Request = "exec Cap_FileCustomer_sel $FIL_Id$, $CCU_Capkey$, $Language_Code$"
    Case mt_CstValues.Tag_Contact
      ls_Request = "exec Cap_FileContact_sel $FIL_Id$, $CNT_Code$, $CCU_Capkey$, $Language_Code$"
    Case mt_CstValues.Tag_Action
      ls_Request = "exec Cap_FileAction_sel $FIL_Id$, $AC_Code$, $Language_Code$"
    Case Else
      Err.Raise ArmErr.CompFncFailed, "ViewInitFields", "#Unknown embeeded component " & mi_EmbeddedIn
    End Select
    
    ls_Request = ReplaceDataPlaceholders(ls_Request)
    ls_Request = ReplaceCommonPlaceholders(ls_Request)
    
    ll_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_Request, 1)
    txt_FIL_ID.Text = mo_Db.GetFields(ll_Cursor, "FIL_ID")
    txt_FIL_Name.Text = mo_Db.GetFields(ll_Cursor, "FIL_Name")
    txt_FileName.Text = mo_Db.GetFields(ll_Cursor, "FIL_FileName")
    txt_FIL_Ext.Text = mo_Db.GetFields(ll_Cursor, "FIL_Ext")
    txt_FIL_Path.Text = mo_Db.GetFields(ll_Cursor, "FIL_Path")
    txt_FileNamePath.Text = ms_FilePath & txt_FileName.Text
    'If txt_FIL_Ext.Text <> "" Then
    '    txt_FileNamePath.Text = txt_FileNamePath.Text & "." & txt_FIL_Ext.Text
    'End If
    
    ml_iConcurrency = mo_Db.GetFields(ll_Cursor, "iConcurrency")
    
    txt_dateEntered.Text = Format(mo_Db.GetFields(ll_Cursor, "Z_Creation"), "dd\/mm\/yyyy")
    txt_dateUpdated.Text = Format(mo_Db.GetFields(ll_Cursor, "Z_Last_Upd"), "dd\/mm\/yyyy")
    txt_createdBy.Text = mo_Db.GetFields(ll_Cursor, "Z_CreatorDesc")
    txt_updatedBy.Text = mo_Db.GetFields(ll_Cursor, "Z_Last_Upd_UserDesc")
    
    Call mo_Db.Close(ll_Cursor)
    
    mb_FileChanged = False
     
    chk_DropFlag.Value = IIf(False, 1, 0)
    txt_DropDate.Text = ""

    chk_DropFlag.Visible = chk_DropFlag.Value
    txt_DropDate.Visible = chk_DropFlag.Value
    Exit Sub
    
ErrHandler:
    Call mo_Db.Close(ll_Cursor)
    Call ErrorHandler("ViewInitFields")
End Sub

Private Sub ListProjectOf(ByVal AProjectKey1 As String, ByVal AProjectKey2 As String)
On Error GoTo ErrHandler
  Dim ls_req As String
  
    If Not (AProjectKey1 <> "" And AProjectKey2 <> "") Then Exit Sub
    ls_req = "Cap_FileProject_lst $SP_Capkey$, $Language_Code$"
    ls_req = Replace(ls_req, "$SP_Capkey$", mo_Tools.SqlStr(AProjectKey1), , , vbTextCompare)
    ls_req = ReplaceCommonPlaceholders(ls_req)
    Call grdlst.Load(ls_req, True)
    Exit Sub
ErrHandler:
    Call ErrorHandler("ListProjectOf")
End Sub

Private Sub ListCustomerOf(ACustomerkey1 As String, ACustomerkey2 As String)
On Error GoTo ErrHandler
  Dim ls_req As String
  
    If Not (ACustomerkey1 <> "" And ACustomerkey2 <> "") Then Exit Sub
    ls_req = "Cap_FileCustomer_lst $CCU_Capkey$, $Language_Code$"
    ls_req = Replace(ls_req, "$CCU_Capkey$", mo_Tools.SqlStr(ACustomerkey1), , , vbTextCompare)
    ls_req = ReplaceCommonPlaceholders(ls_req)
    Call grdlst.Load(ls_req, True)
    Exit Sub
ErrHandler:
    Call ErrorHandler("ListCustomerOf")
End Sub

Private Sub ListContactOf(AContactKey1 As String, AContactKey2 As String, AContactKey3 As String)
On Error GoTo ErrHandler
  Dim ls_req As String
  
    If Not (AContactKey1 <> "" And AContactKey2 <> "") Then Exit Sub
    ls_req = "Cap_FileContact_lst $CNT_Code$, $CCU_Capkey$, $Language_Code$"
    ls_req = Replace(ls_req, "$CNT_Code$", mo_Tools.SqlStr(AContactKey1), , , vbTextCompare)
    ls_req = Replace(ls_req, "$CCU_Capkey$", mo_Tools.SqlStr(AContactKey2), , , vbTextCompare)
    ls_req = ReplaceCommonPlaceholders(ls_req)
    Call grdlst.Load(ls_req, True)
    Exit Sub
ErrHandler:
    Call ErrorHandler("ListCustomerOf")
End Sub

Private Sub ListActionOf(AActionKey1 As String, AActionKey2 As String)
On Error GoTo ErrHandler
  Dim ls_req As String
  
    If Not (AActionKey1 <> "" And AActionKey2 <> "") Then Exit Sub
    ls_req = "Cap_FileAction_lst $AC_Code$, $Language_Code$"
    ls_req = Replace(ls_req, "$AC_Code$", mo_Tools.SqlStr(AActionKey1), , , vbTextCompare)
    ls_req = ReplaceCommonPlaceholders(ls_req)
    Call grdlst.Load(ls_req, True)
    Exit Sub
ErrHandler:
    Call ErrorHandler("ListActionOf")
End Sub

' This function is called by the application when the component embedded is updated
Public Sub Embedded_Updated()
' DO NOTHING
End Sub

Private Sub RefreshGridSafe(ByRef ao_grd As ArmGrid)
On Error GoTo ErrHandler
    Dim lv_Key As Variant
    If ao_grd.SelectedCount > 0 Then
        lv_Key = ao_grd.SelectedKey(0)
    Else
        lv_Key = Empty
    End If
    Call ao_grd.Refresh
    If Not IsEmpty(lv_Key) Then
        Call ao_grd.SearchKey(True, lv_Key)
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("RefreshGridSafe")
End Sub

Private Function DeleteFile(ByVal al_FIL_Id As Long) As Boolean
Dim ls_FilName As String

  DeleteFile = False
  If al_FIL_Id = 0 Then Exit Function
  ls_FilName = ms_FilePath & "FIL" & al_FIL_Id
  If mo_FSO.FileExists(ls_FilName) Then
        Call mo_FSO.DeleteFile(ls_FilName)
  End If
  DeleteFile = True
End Function

Private Sub InsertFile(ByVal as_fileName As String, ByVal as_FIL_Id As String)
On Error GoTo ErrHandler

Dim ll_Index As Long
Dim ls_Request As String
Dim ls_Filename As String

    ls_Request = "INSERT INTO DPC_File (FIL_Id,FIL_File) VALUES ($FIL_Id$,?)"
    ls_Request = mo_Tools.ReplacePlaceHolder(ls_Request, "$FIL_Id$", as_FIL_Id)
        
    If Not mo_Db.FileToBlobSQL(ls_Request, as_fileName, 9) Then
        Err.Raise ArmErr.SQLFailure, "FileToBlobSQL", mo_Db.LastErrorMessage & " Error writing blob: " & ls_Request & " File: " & ls_Filename
    End If

    Exit Sub
ErrHandler:
    Call ErrorHandler("InsertFile as_FileName=" & as_fileName)
End Sub

Private Sub UpdateFile(ByVal as_fileName As String, ByVal as_FIL_Id As String)
On Error GoTo ErrHandler

Dim ll_Index As Long
Dim ls_Request As String
Dim ls_Filename As String

    ls_Request = "UPDATE DPC_File SET FIL_File=? WHERE  FIL_Id=$FIL_Id$"
    ls_Request = mo_Tools.ReplacePlaceHolder(ls_Request, "$FIL_Id$", as_FIL_Id)
        
    If Not mo_Db.FileToBlobSQL(ls_Request, as_fileName, 9) Then
        Err.Raise ArmErr.SQLFailure, "FileToBlobSQL", mo_Db.LastErrorMessage & " Error writing blob: " & ls_Request & " File: " & ls_Filename
    End If

    Exit Sub
ErrHandler:
    Call ErrorHandler("UpdateFile as_FileName=" & as_fileName)
End Sub

Private Function ShowFile(ByVal al_FilId As Long, ByVal as_fileName As String) As Boolean
On Error GoTo ErrHandler

Dim ls_Request As String
Dim ll_Cursor As Long

    If al_FilId > 0 Then
        ls_Request = "exec DPC_FileInfo_sel " & al_FilId
        ls_Request = Replace(ls_Request, "$Language_Code$", mo_Tools.SqlStr(ms_Language_Code), , , vbTextCompare)
        ll_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_Request)
        
        If Not mo_Db.EOF(ll_Cursor) Then
            txt_FIL_Name.Text = mo_Db.GetFields(ll_Cursor, "FIL_Name")
            txt_FIL_Ext.Text = mo_Db.GetFields(ll_Cursor, "FIL_Ext")
            txt_FIL_ID.Text = al_FilId
            txt_FileName.Text = mo_Db.GetFields(ll_Cursor, "FIL_FileName")
            txt_FileNamePath.Text = ms_FilePath & "FIL" & al_FilId
            txt_FIL_Path.Text = mo_Db.GetFields(ll_Cursor, "FIL_Path")
            
            If txt_FIL_Ext.Text <> "" Then
                txt_FileNamePath.Text = txt_FileNamePath.Text & "." & txt_FIL_Ext.Text
            End If
            
            ml_iConcurrency = mo_Db.GetFields(ll_Cursor, "iConcurrency")
        Else
            Err.Raise ArmErr.CompFncFailed, "ShowFile", "#File does not exists in DPC_File table with FIL_Id=" & al_FilId
        End If
            
        Call mo_Db.Close(ll_Cursor)

    End If
    
    ShowFile = True
    
    Exit Function
ErrHandler:
        
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
    End If

    ShowFile = False
    Call ErrorHandler("ShowFile")
End Function

Private Sub Launch_File(ByVal al_FIL_Id As Long, ByVal as_fileName As String)
Dim ls_TempPath As String
Dim lo_shell As Object

On Error GoTo ErrHandler
  If as_fileName = "" Then Exit Sub
  
  ls_TempPath = ms_FilePath & as_fileName
  If Not mo_FSO.FolderExists(ms_FilePath) Then
    Call mo_FSO.CreateFolder(ms_FilePath)
  End If
  
  If Not mo_Db.BlobToFileSQL("SELECT FIL_File FROM DPC_File WHERE FIL_Id=" & al_FIL_Id, ls_TempPath, True, False) Then
    Call MsgBox(mo_Tools.MsgText(mo_Db, ms_Language_Code, 9843, "#Cannot download the file from db - FIL_Id: $FIL_Id$ Filename: $FileName$", Array("$FIL_Id$", al_FIL_Id, "$FileName$", as_fileName)))
    Exit Sub
  End If
  
  Set lo_shell = CreateObject("Shell.Application")
  Call lo_shell.ShellExecute(ls_TempPath, "", "", "open", 1)
  Set lo_shell = Nothing
  Exit Sub
ErrHandler:
  Set lo_shell = Nothing
  Call ErrorHandler("Launch_File:" & al_FIL_Id & " FileName: " & ls_TempPath)
End Sub

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

  as_Request = Replace(as_Request, "$FIL_Id$", mo_Tools.SqlStr(m_CurrentKey1), , , vbTextCompare)
  as_Request = Replace(as_Request, "$SP_Capkey$", mo_Tools.SqlStr(m_Project), , , vbTextCompare)
  as_Request = Replace(as_Request, "$CCU_Capkey$", mo_Tools.SqlStr(m_Customer), , , vbTextCompare)
  as_Request = Replace(as_Request, "$CNT_Code$", mo_Tools.SqlStr(m_Contact), , , vbTextCompare)
  as_Request = Replace(as_Request, "$AC_Code$", mo_Tools.SqlStr(m_Action), , , vbTextCompare)
  ReplaceDataPlaceholders = as_Request
  Exit Function
ErrHandler:
  Call ErrorHandler("ReplaceDataPlaceholders")
End Function

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

  as_Request = Replace(as_Request, "$Z_Creator$", mo_Tools.SqlInt(ml_U_Code), , , vbTextCompare)
  as_Request = Replace(as_Request, "$U_Code$", mo_Tools.SqlInt(ml_U_Code), , , vbTextCompare)
  as_Request = Replace(as_Request, "$Z_Last_Upd_User$", mo_Tools.SqlInt(ml_U_Code), , , vbTextCompare)
  as_Request = Replace(as_Request, "$Language_Code$", mo_Tools.SqlStr(ms_Language_Code), , , vbTextCompare)
  as_Request = Replace(as_Request, "$iConcurrency$", mo_Tools.SqlInt(ml_iConcurrency), , , vbTextCompare)
  ReplaceCommonPlaceholders = as_Request
  Exit Function
ErrHandler:
  Call ErrorHandler("ReplaceCommonPlaceholders")
End Function

' display standard error message
Public Sub ErrorMessage(ByVal as_Fct As String)
  Dim ls_ErrSource As String
  Dim ls_errDescription As String
  Dim ls_Message As String
  
  ls_ErrSource = as_Fct & SEP1 & Err.Source
  ls_errDescription = Err.Description
  ls_Message = SCREEN_NAME & " exception. Nr:" & Err.Number & ",Desc: " & ls_errDescription & ",Src:" & ls_ErrSource & "@"
  Call mo_Tools.LogMessage(mo_Db, ml_U_Code, SCREEN_NAME, ls_Message, "E")
  Call MsgBox("Error occured, please contact IT. Application will now shutdown." & vbCrLf & ls_ErrSource & vbCrLf & "Description: " & ls_errDescription, vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
  End
End Sub

' Standard error handler
Private Sub ErrorHandler(ByVal as_Fct As String)
  
  Call Err.Raise(Err.Number, UserControl.Name & "." & as_Fct & SEP1 & Err.Source, Err.Description)
End Sub


