VERSION 5.00
Begin VB.UserControl SOM_ExchRate 
   ClientHeight    =   10005
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   15090
   LockControls    =   -1  'True
   ScaleHeight     =   10005
   ScaleWidth      =   15090
   Begin VB.Frame Fra_Item 
      Height          =   9255
      Left            =   0
      TabIndex        =   2
      Top             =   720
      Visible         =   0   'False
      Width           =   15015
      Begin VB.CheckBox chk_delete 
         Caption         =   "#Deleted"
         Height          =   315
         Left            =   2190
         TabIndex        =   9
         Top             =   1680
         Width           =   2235
      End
      Begin VB.TextBox txt_exchrate 
         Height          =   285
         Left            =   2190
         MaxLength       =   12
         TabIndex        =   5
         Tag             =   "EXCH_rateŽŠNumŽŠ4"
         Text            =   "EXCH_rateŽŠNumŽŠ4"
         Top             =   1230
         Width           =   1395
      End
      Begin VB.TextBox txt_curr_desc 
         Height          =   285
         Left            =   2190
         MaxLength       =   50
         TabIndex        =   4
         Tag             =   "CURR_descŽŠText"
         Text            =   "CURR_descŽŠText"
         Top             =   810
         Width           =   6135
      End
      Begin VB.TextBox txt_curr_code 
         Height          =   285
         Left            =   2190
         MaxLength       =   5
         TabIndex        =   3
         Tag             =   "CURR_codeŽŠText"
         Text            =   "CURR_codeŽŠText"
         Top             =   390
         Width           =   1695
      End
      Begin VB.Label lbl_label 
         Alignment       =   1  'Right Justify
         Caption         =   "#Currency description"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   225
         Index           =   1
         Left            =   90
         TabIndex        =   8
         Tag             =   "lbl_CurrDesc"
         Top             =   870
         Width           =   2055
      End
      Begin VB.Label lbl_label 
         Alignment       =   1  'Right Justify
         Caption         =   "#Currency code"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   225
         Index           =   0
         Left            =   90
         TabIndex        =   7
         Tag             =   "lbl_CurrCode"
         Top             =   420
         Width           =   2055
      End
      Begin VB.Label lbl_label 
         Alignment       =   1  'Right Justify
         Caption         =   "#Exchange rate"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   225
         Index           =   2
         Left            =   90
         TabIndex        =   6
         Tag             =   "lbl_ExchRate"
         Top             =   1290
         Width           =   2055
      End
   End
   Begin Project1.ArmGrid grd_main 
      Height          =   9225
      Left            =   60
      TabIndex        =   0
      Tag             =   "grd_selection"
      Top             =   720
      Visible         =   0   'False
      Width           =   14955
      _ExtentX        =   26379
      _ExtentY        =   15055
   End
   Begin Project1.ToolbarControl tbl_main 
      Height          =   690
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Visible         =   0   'False
      Width           =   6555
      _ExtentX        =   11562
      _ExtentY        =   1217
   End
End
Attribute VB_Name = "SOM_ExchRate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Event OnExit()

Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwnd As Long) As Long

Private Const SCREEN_NAME As String = "SOM_EXCHRATE"

Private me_Mode As eMode
Private me_OldMode As eMode


Private Const SEP As String = "ŽŠ"
Private Const SEP1 As String = "Ž"
Private Const SEP2 As String = "Š"

'TODO put the correct number for error
Const C_ERRORRAISE As Long = 7000


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

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

Private Const LOCALE_USER_DEFAULT = &H400
Private ms_DecimalSeparator  As String
Private ms_ThousandSeparator As String
Private Declare Function GetLocaleInfo Lib "Kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare Function GetSystemDefaultLCID Lib "Kernel32" () As Long

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




#If LIVE Then
    Private mo_Db                   As Object
#Else
    Private mo_Db                   As ArmDb
#End If

Private mb_Initialized              As Boolean
Private ms_LoginName                As String
Private ms_FullUserName             As String
Private ms_Language_Code           As String
Private ml_UCode                    As Long


Private Type TConfigRecord
    RequestView As String
    RequestAdd As String
    RequestUpd As String
    RequestDel As String
    RequestGrd As String
    ListFieldsToDisable             As Variant
    ListFieldsMandatory             As Variant
    ListFieldsDefaultValue          As Variant
End Type

Private mt_ClassInfoLst() As TConfigRecord

Private mb_IsFullAccess As Boolean

Private mb_IsVisible As Boolean

Private ml_Cursor As Long

Private ml_LocalID As Long


Private mb_Internal As Boolean

Private Declare Function GetComputerName Lib "Kernel32" _
        Alias "GetComputerNameA" (ByVal lpBuffer As String, _
        nSize As Long) As Long

Private Function ComputerName() As String
  Dim lsBuffer As String
  Dim llReturn As Long
  Dim lsName As String
 
  lsName = ""
  lsBuffer = Space$(255)
  llReturn = GetComputerName(lsBuffer, 255)
  
  If llReturn Then
        lsName = Left$(lsBuffer, InStr(lsBuffer, Chr(0)) - 1)
  End If
  
  ComputerName = lsName
  
End Function

#If LIVE Then
Public Property Set Db(ByRef aDb As Object)
#Else
Public Property Set Db(ByRef aDb As ArmDb)
#End If
    Set mo_Db = aDb
End Property

Public Property Get Initialized() As Boolean
    Initialized = mb_Initialized
End Property

Public Property Let LoginName(ByVal aLoginName As String)
    ms_LoginName = aLoginName
End Property

Public Property Let FullUserName(ByVal aFullUserName As String)
    ms_FullUserName = aFullUserName
End Property

Public Property Let Ucode(ByVal aUcode As Long)
    ml_UCode = aUcode
End Property


Public Property Let Language_Code(ByVal aLanguage_Code As String)
    ms_Language_Code = aLanguage_Code
End Property

Public Property Let A_Visible(ByVal aVisible As Boolean)
    UserControl.Extender.Visible = aVisible
    mb_IsVisible = aVisible
End Property

Public Property Get IsVisible() As Boolean
    IsVisible = mb_IsVisible
End Property

Public Property Get A_Visible() As Boolean
    A_Visible = UserControl.Extender.Visible
End Property

Public Sub Move(ByVal aLeft As Single, ByVal aTop As Single, ByVal aWidth As Single, ByVal aHeight As Single)
    Call UserControl.Extender.Move(aLeft, aTop, aWidth, aHeight)
End Sub


Public Property Let Visible(ByVal aVisible As Boolean)
    UserControl.Extender.Visible = aVisible
End Property
Public Property Get Visible() As Boolean
    Visible = UserControl.Extender.Visible
End Property



Private Function HaveRight() As Boolean

On Error GoTo ErrHandler
    Dim mb_Ok As Boolean
    
    mb_Ok = False
    Dim lc_Data As Long
    lc_Data = OpenSQLSafe(mo_Db, "SELECT CFG_Value FROM A_Config WHERE CFG_Key = 'SOM_ExchRate_Rights'")
       
    Dim lv_ArrUpd As Variant
    lv_ArrUpd = Split(mo_Db.GetFields(lc_Data, 0) & SEP, SEP, , vbTextCompare)
    mo_Db.Close (lc_Data)
    Dim ll_Idx As Long, ll_count As Long
    ll_count = UBound(lv_ArrUpd)
    For ll_Idx = 0 To ll_count
        If lv_ArrUpd(ll_Idx) = ml_UCode Then
            mb_Ok = True
            Exit For
        End If
    Next
    HaveRight = mb_Ok

    Exit Function

ErrHandler:
    mo_Db.Close (lc_Data)
    Call ErrorHandler("HaveRight")

End Function
Private Sub Load_ClassInfo()
On Error GoTo ErrHandler

    ReDim mt_ClassInfoLst(0)

        With mt_ClassInfoLst(0)
            .RequestView = "exec SOM_Currencies_Exchanges_Sel '$Language_code$','$CURR_code$'"

            .RequestAdd = "exec SOM_Currencies_Exchanges_Ins '$CURR_code$', '$CURR_desc$', $EXCH_rate$, $Z_Creator$"

            .RequestUpd = "exec SOM_Currencies_Exchanges_Desc_Upd '$CURR_code$', '$Language_code$', $iConcurrency$, '$CURR_desc$', $Z_Creator$" & SEP & _
                            "exec SOM_Currencies_Exchanges_EXCH_Upd '$CURR_code$', $iConcurrency$, '$EXCH_rate$', $Z_Creator$" & SEP & _
                            "exec SOM_Quote_EXCH_Upd '$CURR_code$', '$EXCH_rate$',$Z_last_upd_user$" & SEP & _
                            "exec SOM_Quote_EXCH_Upd2 '$CURR_code$', '$EXCH_rate$',$Z_last_upd_user$"

            .RequestDel = "exec SOM_Currencies_Exchanges_Del '$CURR_code$',$iConcurrency$, $Z_Creator$"
            
            .RequestGrd = "exec SOM_Currencies_Exchanges_Lst '$Language_code$'"
            
            
            ReDim .ListFieldsMandatory(2, 1)
            Set .ListFieldsMandatory(0, 0) = txt_CURR_Code
             .ListFieldsMandatory(0, 1) = 0
            Set .ListFieldsMandatory(1, 0) = txt_curr_desc
             .ListFieldsMandatory(1, 1) = 1
            Set .ListFieldsMandatory(2, 0) = txt_exchrate
             .ListFieldsMandatory(2, 1) = 2
             
            ReDim .ListFieldsToDisable(1)
            Set .ListFieldsToDisable(0) = txt_CURR_Code
            Set .ListFieldsToDisable(1) = chk_delete
             
        End With
    Exit Sub

ErrHandler:
    Call ErrorHandler("Load_ClassInfo")

End Sub
Private Function ReplaceHolders(ByRef aControls As Variant, ByRef aContainer As Object, ByVal as_Request As String) As String

On Error GoTo ErrHandler

    Dim lIdx As Long, lCount As Long
    Dim lControl As Control
    Dim lv_number As Variant
    Dim lValues As Variant


    lCount = aControls.Count - 1

    For lIdx = 0 To lCount
        Set lControl = aControls.Item(lIdx)
        If HasContainer(lControl, aContainer) Then
            Select Case UCase(TypeName(lControl))
                Case "TEXTBOX"
                    lValues = Split(lControl.Tag, SEP)
                    If UBound(lValues) > 0 Then
                        Select Case lValues(1)
                        Case "Text"
                            If lValues(0) = "CURR_code" Then
                                as_Request = Replace(as_Request, "$" & lValues(0) & "$", Replace(UCase(Trim(lControl.Text)), "'", "''"), , , vbTextCompare)
                            Else
                                as_Request = Replace(as_Request, "$" & lValues(0) & "$", Replace(Trim(lControl.Text), "'", "''"), , , vbTextCompare)
                            End If
                            
                        Case "Num"
                            lv_number = Replace(Trim(IIf(lControl.Text = "", 0, lControl.Text)), ms_ThousandSeparator, "", , , vbTextCompare)
                            lv_number = Replace(lv_number, ms_DecimalSeparator, ".", , , vbTextCompare)
                            as_Request = Replace(as_Request, "$" & lValues(0) & "$", lv_number, , , vbTextCompare)
                        End Select
                    End If
                    
                Case "ARMCOMBOBOX"
                    lValues = Split(lControl.Tag, SEP)
                    If Not lControl.SelectedItem Is Nothing Then
                        as_Request = Replace(as_Request, "$" & lValues(0) & "$", IIf(lControl.SelectedItem.Key = "", "NULL", lControl.SelectedItem.Key), , , vbTextCompare)
                    Else
                        as_Request = Replace(as_Request, "$" & lValues(0) & "$", "NULL", , , vbTextCompare)
                    End If

                Case "OPTIONBUTTON" ', "ARMTREEVIEW", "LISTBOX", "PICTUREBOX" '"A_CALOCX",
                    If lControl.value = True Then
                        lValues = Split(lControl.Tag, SEP)
                        as_Request = Replace(as_Request, "$" & lValues(0) & "$", lValues(2), , , vbTextCompare)
                    End If
                    
                Case "CHECKBOX"
                        lValues = Split(lControl.Tag, SEP)
                  If lControl.value = vbChecked Then
                    as_Request = Replace(as_Request, "$" & lValues(0) & "$", "X", , , vbTextCompare)
                  Else
                    as_Request = Replace(as_Request, "$" & lValues(0) & "$", "", , , vbTextCompare)
                  End If
                  
                Case "A_CALOCX"
                    as_Request = Replace(as_Request, "$" & lControl.Tag & "$", lControl.date_sql, , , vbTextCompare)
            End Select
        End If
        Set lControl = Nothing
    Next

    as_Request = Replace(as_Request, "$Language_code$", ms_Language_Code, , , vbTextCompare)
    as_Request = Replace(as_Request, "$Z_Creator$", ml_UCode, , , vbTextCompare)
    as_Request = Replace(as_Request, "$Z_last_upd_user$", ml_UCode, , , vbTextCompare)
    as_Request = Replace(as_Request, "'NULL'", "NULL", , , vbTextCompare)

    ReplaceHolders = as_Request
    Exit Function

ErrHandler:
    Set lControl = Nothing
    Call ErrorHandler("ReplaceHolders")

End Function

Private Sub EnableFrame(ByRef aControls As Variant, ByRef aContainer As Object, ByVal aEnabled As Boolean)
On Error GoTo ErrHandler
    Dim lIdx As Long, lCount As Long
    Dim lControl As Control
    
    lCount = aControls.Count - 1
    
    For lIdx = 0 To lCount
        Set lControl = aControls.Item(lIdx)
        If HasContainer(lControl, aContainer) Then
            Select Case UCase(TypeName(lControl))
                Case "TOOLBARCONTROL"
                    lControl.Visible = aEnabled
                
                Case "FRAME", "LABEL", "MSFLEXGRID"
                    ' Do nothing !
                
                Case "TEXTBOX"
                        lControl.Locked = Not aEnabled
                        lControl.BackColor = IIf(aEnabled, CL_COLOR_ENABLED, CL_COLOR_DISABLED)
                
                Case "ARMGRID", "ARMCHECKVIEW"
                    
                Case "DIRLISTBOX", "DRIVELISTBOX", "FILELISTBOX"
                    lControl.Enabled = aEnabled
                    lControl.BackColor = IIf(aEnabled, CL_COLOR_ENABLED, CL_COLOR_DISABLED)

                Case "ARMCOMBOBOX", "A_CALOCX", "OPTIONBUTTON", "ARMTREEVIEW", "LISTBOX", "PICTUREBOX", "TABSTRIP", "CHECKBOX"
                    lControl.Enabled = aEnabled
                
                Case "COMMANDBUTTON"
                
                
                Case "SOM_LINK", "SOM_QUOTE"
                
                Case Else
                    lControl.Enabled = aEnabled
                    Debug.Print "EnableFrame " & UCase(TypeName(lControl))
            End Select
        End If
        Set lControl = Nothing
    Next
    Exit Sub
ErrHandler:
    If Not lControl Is Nothing Then Set lControl = Nothing
    Call ErrorHandler("EnableFrame")

End Sub

Private Function Item_CheckMandatory(ByVal al_Index As Long) As Boolean

On Error GoTo ErrHandler
    Dim lIdx As Long, lCount As Long
    Dim lValues As Variant
    Dim ls_TempTag As String
    Dim ls_Str As String
    Dim lControl As Control

    Dim lv_MsgReplaceInfo(0, 1) As String

    'lecture du tableau des valeurs par defaut en prmeier car + petit
    lCount = UBound(mt_ClassInfoLst(al_Index).ListFieldsMandatory)
    For lIdx = 0 To lCount

        Set lControl = mt_ClassInfoLst(al_Index).ListFieldsMandatory(lIdx, 0)

        Select Case UCase(TypeName(lControl))
            Case "TEXTBOX"
                If Trim(lControl.Text) = "" Then
                    lv_MsgReplaceInfo(0, 0) = "$LabelCaption$"
                    lv_MsgReplaceInfo(0, 1) = lbl_Label(mt_ClassInfoLst(al_Index).ListFieldsMandatory(lIdx, 1)).Caption
                    Call MsgBox(MsgText(2120, ms_Language_Code, "The field " & lv_MsgReplaceInfo(0, 1) & " is mandatory.", lv_MsgReplaceInfo), vbInformation)
                    lControl.SetFocus

                    Exit Function
                End If

            Case "ARMCOMBOBOX"
                If lControl.SelectedItem Is Nothing Then
                    lv_MsgReplaceInfo(0, 0) = "$LabelCaption$"
                    lv_MsgReplaceInfo(0, 1) = lbl_Label(mt_ClassInfoLst(al_Index).ListFieldsMandatory(lIdx, 1)).Caption
                    Call MsgBox(MsgText(2120, ms_Language_Code, "The field " & lv_MsgReplaceInfo(0, 1) & " is mandatory.", lv_MsgReplaceInfo), vbInformation)
                    lControl.SetFocus

                    Exit Function
                End If

            Case "A_CALOCX"
                If lControl.date_courte = "" Then
                    lv_MsgReplaceInfo(0, 0) = "$LabelCaption$"
                    lv_MsgReplaceInfo(0, 1) = lbl_Label(mt_ClassInfoLst(al_Index).ListFieldsMandatory(lIdx, 1)).Caption
                    Call MsgBox(MsgText(2120, ms_Language_Code, "The field " & lv_MsgReplaceInfo(0, 1) & " is mandatory.", lv_MsgReplaceInfo), vbInformation)
                    lControl.SetFocus

                    Exit Function
               End If

            Case "OPTIONBUTTON", "CHECKBOX", "ARMGRID", "LABEL", "FRAME", "DIRLISTBOX", "FILELISTBOX", "DRIVELISTBOX", "TOOLBARCONTROL"
                'Nothing to do
            Case Else
                Debug.Print "Item_CheckMandatory " & UCase(TypeName(mt_ClassInfoLst(al_Index).ListFieldsMandatory(lIdx, 0)))
        End Select
        Set lControl = Nothing

    Next


    Item_CheckMandatory = True
    Exit Function

ErrHandler:
    Call ErrorHandler("Item_CheckMandatory")

End Function
Private Sub SetMode(ByVal aMode As eMode)
    me_OldMode = me_Mode
    me_Mode = aMode
End Sub
Private Sub Item_AddInit()
On Error GoTo ErrHandler
    
    Call SetMode(eMode.emAdd)
    
    'visuel
    Call ClearForm(UserControl.Controls, fra_item)

    Call EnableFrame(UserControl.Controls, fra_item, True)
    
    'Call DisableFrameParts(0)
    Call HandleToolbar(tbl_main, 1, mb_IsFullAccess)
    
    chk_delete.Visible = False
    
    fra_item.Visible = True
   
   Exit Sub
    
ErrHandler:
    Call ErrorHandler("Item_AddInit")
End Sub


Private Function Item_Add() As Boolean
On Error GoTo ErrHandler
    
    Dim ls_SrzFields As String
    
    
    If Not Item_CheckMandatory(0) Then Exit Function

    If Not Item_Check Then Exit Function

    If Not Item_AddDB(0) Then Exit Function  'GoTo BackToGrid

    ls_SrzFields = Build_SrzString(UserControl.Controls, fra_item)
    
    Call AddLineToGrid(grd_Main, ls_SrzFields)

    Call Item_Exit

    Item_Add = True

    Exit Function

ErrHandler:
    Call ErrorHandler("Item_Add")

End Function

Private Function Build_SrzString(ByRef aControls As Variant, ByRef aContainer As Object) As String
On Error GoTo ErrHandler
    Dim ls_SrzString As String
    Dim lo_Control As CheckBox
    Dim lIdx As Long, lCount As Long
    
    Dim lValues As Variant
    Dim ls_TempTag As String
    Dim ls_Str As String
    Dim lControl As Control
   
    
        lCount = aControls.Count - 1
        ls_SrzString = ""
    
        For lIdx = 0 To lCount
            Set lControl = aControls.Item(lIdx)
            If HasContainer(lControl, aContainer) Then
                
                ls_TempTag = lControl.Tag & SEP
                lValues = Split(ls_TempTag, SEP)
                
                Select Case UCase(TypeName(lControl))
                    Case "TEXTBOX"
                            Select Case lValues(1)
                                Case "Text"
                                    ls_SrzString = ls_SrzString & lValues(0) & SEP1 & lControl.Text & SEP
                                Case "Num"
                                    ls_Str = Replace(lControl.Text, ms_ThousandSeparator, "")
                                    ls_Str = Replace(ls_Str, ms_DecimalSeparator, ".")
                                    ls_SrzString = ls_SrzString & lValues(0) & SEP1 & ls_Str & SEP
                           End Select
                    
                    Case "ARMCOMBOBOX"
        
                        ls_SrzString = ls_SrzString & lValues(0) & SEP1 & lControl.SelectedItem.Key & SEP
                        ls_SrzString = ls_SrzString & lValues(1) & SEP1 & lControl.SelectedItem.GetData(1) & SEP
                        
                    Case "OPTIONBUTTON"
                        
                    Case "CHECKBOX"
                        
                    Case "A_CALOCX"
                        ls_SrzString = ls_SrzString & lValues(0) & SEP1 & lControl.date_courte & SEP
                        
                        
                    Case "LABEL", "FRAME", "DIRLISTBOX", "FILELISTBOX", "DRIVELISTBOX", "TOOLBARCONTROL"
                        'Do Nothing
                    
                    Case "ARMGRID"
                    
                    Case Else
                        Debug.Print "Build_SrzString  -> " & UCase(TypeName(lControl))
                End Select
            End If
            Set lControl = Nothing
        Next

    ls_SrzString = Trim(ls_SrzString)
    Build_SrzString = ls_SrzString
    
    Exit Function
    
ErrHandler:
    If Not lControl Is Nothing Then Set lControl = Nothing
    Call ErrorHandler("Build_SrzString")
End Function

Private Function Item_AddDB(ByVal al_InfoArrayIndex As Long) As Boolean

On Error GoTo ErrHandler

    Dim ls_ADD_Request As String

    ls_ADD_Request = ReplaceHolders(UserControl.Controls, Me, mt_ClassInfoLst(0).RequestAdd)

    ExecuteSQLSafe mo_Db, ls_ADD_Request
    
    If mo_Db.SQLRowsAffected = 0 Then
        Err.Raise ArmErr.SQLBadRowAffectedCount, "SQL : 0 rows affected."
    End If
    
    
    Item_AddDB = True

    Exit Function

ErrHandler:
    Call ErrorHandler("Item_AddDB")

End Function
Private Function Item_UpdateDB(ByVal al_InfoArrayIndex As Long) As Boolean
On Error GoTo ErrHandler
    Dim lv_Request As Variant
    Dim lb_TranOpened As Boolean
    Dim ls_req As String

'open the transaction
    ls_req = Replace(mt_ClassInfoLst(0).RequestUpd, "$Language_code$", tbl_main.Language)
    ls_req = Replace(mt_ClassInfoLst(0).RequestUpd, "$iConcurrency$", mo_Db.GetFields(ml_Cursor, "iConcurrency"))
    
    lv_Request = Split(ReplaceHolders(UserControl.Controls, Me, ls_req), SEP)
    
    
    If Not BeginTran("UpdEXCHDB") Then
        Err.Raise C_ERRORRAISE + 3, SCREEN_NAME, "Transaction Failure." & vbCrLf & "Enable to Start the transaction." & vbCrLf & Join(mo_Db.SQLErrorMessages, vbCrLf)
    End If
    
    lb_TranOpened = True

    If Trim(mo_Db.GetFields(ml_Cursor, "CURR_desc")) <> Trim(txt_curr_desc.Text) Then
        ls_req = lv_Request(0)
        ExecuteSQLSafe mo_Db, ls_req, 1
    End If
    
    
    If Replace(mo_Db.GetFields(ml_Cursor, "EXCH_rate"), ms_DecimalSeparator, ".") <> Replace(txt_exchrate.Text, ms_DecimalSeparator, ".") Then
        ls_req = lv_Request(1)
        ExecuteSQLSafe mo_Db, ls_req
        
        If mo_Db.SQLRowsAffected = 0 Then
            Err.Raise ArmErr.SQLBadRowAffectedCount, "SQL : 0 rows affected."
        End If
        
        ls_req = lv_Request(2)
        ExecuteSQLSafe mo_Db, ls_req
        
        ls_req = lv_Request(3)
        ExecuteSQLSafe mo_Db, ls_req
        
    End If
    
'close the transaction
    If Not CommitTran("UpdEXCHDB") Then
        Err.Raise C_ERRORRAISE + 4, SCREEN_NAME, "Transaction Failure." & vbCrLf & "Enable to commit the transaction." & vbCrLf & Join(mo_Db.SQLErrorMessages, vbCrLf)
    End If
    lb_TranOpened = False

    Item_UpdateDB = True

    Exit Function
    
ErrHandler:
    Item_UpdateDB = False
    If lb_TranOpened Then
         Call RollbackTran("UpdEXCHDB")
    End If
    
    Call ErrorHandler("Item_UpdateDB")

End Function
Private Function BeginTran(as_Tran As String) As Boolean

On Error GoTo ErrHandler
    BeginTran = False
    ExecuteSQLSafe mo_Db, "BEGIN TRANSACTION " & as_Tran

    BeginTran = True
    Exit Function
    
ErrHandler:
    mo_Db.Disconnect
    Set mo_Db = Nothing
    MsgBox "A Fatal error occured in " & SCREEN_NAME & ".BeginTran, your application will be close. Please contact your IT support"
    End
End Function
Private Function CommitTran(as_Tran As String) As Boolean

On Error GoTo ErrHandler
    CommitTran = False
    ExecuteSQLSafe mo_Db, "COMMIT TRANSACTION " & as_Tran

    CommitTran = True
    Exit Function
    
ErrHandler:
    mo_Db.Disconnect
    Set mo_Db = Nothing
    MsgBox "A Fatal error occured in " & SCREEN_NAME & ".CommitTran, your application will be close. Please contact your IT support"
    End

End Function

Private Function RollbackTran(as_Tran As String) As Boolean
    
    Dim ll_errNumber As Long, ls_ErrSrc As String, ls_ErrDesc As String
    ll_errNumber = Err.Number
    ls_ErrSrc = Err.Source
    ls_ErrDesc = Err.Description

On Error GoTo ErrHandler
    RollbackTran = False
    
    ExecuteSQLSafe mo_Db, "ROLLBACK TRANSACTION " & as_Tran


    Err.Number = ll_errNumber
    Err.Source = ls_ErrSrc
    Err.Description = ls_ErrDesc

    RollbackTran = True
    Exit Function
    
ErrHandler:
    mo_Db.Disconnect
    Set mo_Db = Nothing
    MsgBox "A Fatal error occured in " & SCREEN_NAME & ".RollbackTran, your application will be close. Please contact your IT support"
    End
End Function
Private Sub Item_Update()
On Error GoTo ErrHandler
    
    Dim ls_SrzFields As String
    
    If Not Item_CheckMandatory(0) Then Exit Sub
    
    If Not Item_Check() Then Exit Sub
    
    If Not Item_UpdateDB(0) Then Exit Sub
        
    ls_SrzFields = Build_SrzString(UserControl.Controls, fra_item)
        
    Call UpdateLineToGrid(grd_Main, "CURR_code", txt_CURR_Code.Text, ls_SrzFields, True)
    
    Call Item_Exit
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Update")
   
End Sub



Private Sub Item_UpdateInit()
On Error GoTo ErrHandler
    
    Dim ls_req As String

    Call SetMode(eMode.emUpdate)

    'visuel
    Call ClearForm(UserControl.Controls, fra_item)
    Call EnableFrame(UserControl.Controls, fra_item, True)
    
    Call DisableFrameParts(0)
    
        
    Call OpenCursor(mt_ClassInfoLst(0).RequestView)
    
    Call HandleToolbar(tbl_main, 2, mb_IsFullAccess)
    
    Call LoadDataToForm(ml_Cursor, UserControl.Controls, fra_item)
    
    If Not tbl_main.Language Like "E" Then
        txt_exchrate.Locked = True
        txt_exchrate.BackColor = CL_COLOR_DISABLED
    End If
    
    fra_item.Visible = True
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_UpdateInit")
End Sub
Private Sub OpenCursor(ByVal as_Request As String)
On Error GoTo ErrHandler
    Dim ls_SelectRequest As String
        
        
    ls_SelectRequest = Replace(as_Request, "$Language_code$", tbl_main.Language, , , vbTextCompare)
    ls_SelectRequest = Replace(ls_SelectRequest, "$CURR_code$", grd_Main.SelectedLine(0, "CURR_code"), , , vbTextCompare)
    
    If ml_Cursor > 0 Then
        mo_Db.Close (ml_Cursor)
        ml_Cursor = 0
    End If
    
    ml_Cursor = OpenSQLSafe(mo_Db, ls_SelectRequest, 1)
    
    Exit Sub

ErrHandler:
    mo_Db.Close (ml_Cursor)
    Call ErrorHandler("OpenCursor")

End Sub

Private Sub LoadDataToForm(ByVal ac_Cursor As Long, ByRef aControls As Variant, ByRef aContainer As Object)
On Error GoTo ErrHandler
   
    Dim lIdx As Long, lCount As Long
    Dim lControl As Control
    Dim lValues As Variant
    Dim ls_TempTag As String
    
        lCount = aControls.Count - 1
    
        For lIdx = 0 To lCount
            Set lControl = aControls.Item(lIdx)
            If HasContainer(lControl, aContainer) Then
                Select Case UCase(TypeName(lControl))
                    Case "TEXTBOX"
                            ls_TempTag = lControl.Tag & SEP
                            lValues = Split(ls_TempTag, SEP)
                            If mo_Db.GetFieldIndex(ac_Cursor, lValues(0)) >= 0 Then
                                Select Case lValues(1)
                                    Case "Text"
                                        lControl.Text = mo_Db.GetFields(ac_Cursor, lValues(0))
                                    Case "Num"
                                        If (me_Mode = eMode.emView Or me_Mode = eMode.emDelete) Then
                                            lControl.Text = FormatNumber(mo_Db.GetFields(ac_Cursor, lValues(0)), lValues(2))
                                        Else
                                            lControl.Text = Replace(mo_Db.GetFields(ac_Cursor, lValues(0)), ms_DecimalSeparator, ".", , , vbTextCompare)
                                        End If
                                End Select
                            End If
                    
                    Case "ARMCOMBOBOX"
                        mb_Internal = True
                        ls_TempTag = lControl.Tag & SEP
                        lValues = Split(ls_TempTag, SEP)
                        If mo_Db.GetFieldIndex(ac_Cursor, lValues(0)) >= 0 Then
                            If mo_Db.GetFields(ac_Cursor, lValues(0)) = 0 Or mo_Db.GetFields(ac_Cursor, lValues(0)) = "" Then
                                Set lControl.SelectedItem = Nothing
                            Else
                                If lControl.SearchItem(mo_Db.GetFields(ac_Cursor, lValues(0)), 0, 0, True) = False Then
                                    If lControl.AddItem(Array(mo_Db.GetFields(ac_Cursor, lValues(0)), mo_Db.GetFields(ac_Cursor, lValues(1))), True) Is Nothing Then
                                        Err.Raise 2222, "", ""
                                    End If
                                End If
                            End If
                        End If
                        mb_Internal = False
                        
                    Case "OPTIONBUTTON"
                        lValues = Split(lControl.Tag, SEP)
                        If mo_Db.GetFieldIndex(ac_Cursor, lValues(0)) >= 0 Then
                            If UCase(lValues(2)) Like UCase(mo_Db.GetFields(ac_Cursor, lValues(0))) Then
                                lControl.value = True
                            End If
                        End If
                        
                    Case "CHECKBOX"
                        If mo_Db.GetFieldIndex(ac_Cursor, lControl.Tag) >= 0 Then
                            If UCase(mo_Db.GetFields(ac_Cursor, lControl.Tag)) Like "X" Then
                                lControl.value = vbChecked
                            Else
                                lControl.value = vbUnchecked
                            End If
                        End If
                        
                    Case "A_CALOCX"
                        lControl.date_courte = mo_Db.GetFields(ac_Cursor, lControl.Tag)
                        
                    Case "LABEL", "FRAME", "DIRLISTBOX", "FILELISTBOX", "DRIVELISTBOX", "TOOLBARCONTROL"
                        'Do Nothing
                    
                    Case "ARMGRID"
                    
                    Case Else
                        Debug.Print "LoadDataToForm  -> " & UCase(TypeName(lControl))
                End Select
            End If
            Set lControl = Nothing
        Next

    Exit Sub

ErrHandler:
    If Not lControl Is Nothing Then Set lControl = Nothing
    Call ErrorHandler("LoadDataToForm")

End Sub
Private Sub DisableFrameParts(ByVal al_InfoArrayIndex As Long)
On Error GoTo ErrHandler
    Dim lIdx As Long, lCount As Long
    Dim lParams As Variant
    
    lCount = UBound(mt_ClassInfoLst(al_InfoArrayIndex).ListFieldsToDisable)
    
    For lIdx = 0 To lCount
            Select Case UCase(TypeName(mt_ClassInfoLst(al_InfoArrayIndex).ListFieldsToDisable(lIdx)))
                Case "FRAME", "LABEL", "MSFLEXGRID", "TOOLBARCONTROL"
                    ' Do nothing !
                
                Case "TEXTBOX"
                        mt_ClassInfoLst(al_InfoArrayIndex).ListFieldsToDisable(lIdx).Locked = True
                        mt_ClassInfoLst(al_InfoArrayIndex).ListFieldsToDisable(lIdx).BackColor = CL_COLOR_DISABLED
                        
                Case "ARMGRID", "ARMCHECKVIEW"
                                    
                Case "OPTIONBUTTON", "COMMANDBUTTON", "ARMCOMBOBOX", "A_CALOCX", "ARMTREEVIEW", "LISTBOX", "PICTUREBOX", "TABSTRIP", "CHECKBOX"
                    mt_ClassInfoLst(al_InfoArrayIndex).ListFieldsToDisable(lIdx).Enabled = False
                    
                Case Else
                    Debug.Print "DisableFrameParts " & UCase(TypeName(mt_ClassInfoLst(al_InfoArrayIndex).ListFieldsToDisable(lIdx)))
            End Select
    Next
    Exit Sub
ErrHandler:
    Call ErrorHandler("DisableFrameParts")
End Sub

Private Function CheckNumericField(ByVal ao_value As TextBox, ByVal ai_NbDecimal As Integer, ByVal av_Min As Variant, ByVal av_Max As Variant) As Long
On Error GoTo ErrHandler
    Dim ls_Value As Variant
    
    ls_Value = Replace(ao_value.Text, ".", ms_DecimalSeparator, , , vbTextCompare)
        
    
    On Error Resume Next
    Dim ld_Number As Double
    Dim ll_errnum As Long
    ld_Number = CDbl(ls_Value)
    ll_errnum = Err.Number
    Err.Clear
    On Error GoTo ErrHandler
    If ll_errnum <> 0 Then
        CheckNumericField = 2131
        GoTo BackToControl
    End If
    
    If InStr(1, ls_Value, "e", vbTextCompare) Or InStr(1, ls_Value, ms_ThousandSeparator, vbTextCompare) Then
        CheckNumericField = 2131
        GoTo BackToControl
    End If
    
    If Not (ld_Number > av_Min) Then
        CheckNumericField = 7100
        GoTo BackToControl
    End If
    
    If Not (ld_Number >= av_Min And ld_Number <= av_Max) Then
        CheckNumericField = 2132
        GoTo BackToControl
    End If
    
    
    If InStr(1, ls_Value, ms_DecimalSeparator) Then
        If Len(Mid(ls_Value, InStr(1, ls_Value, ms_DecimalSeparator) + 1)) > ai_NbDecimal Then
            CheckNumericField = 7103
            GoTo BackToControl
        End If
        
    End If
    
    
    ao_value.Text = ls_Value
    CheckNumericField = 0
    
    Exit Function

BackToControl:
    ao_value.SelStart = 0
    ao_value.SelLength = Len(ao_value.Text)
    If ao_value.Visible Then ao_value.SetFocus
    
    Exit Function

ErrHandler:
    Call ErrorHandler("CheckNumericField")
   
End Function

Private Function Item_Check() As Boolean
On Error GoTo ErrHandler
    Dim lv_MsgReplaceInfo() As String
    Dim ll_IsNum As Long 'if 0 then ok
    
    'select case to manage the different records
            ll_IsNum = 0

            ll_IsNum = CheckNumericField(txt_exchrate, 7, 0, 99999999)
            If ll_IsNum <> 0 Then
                ReDim lv_MsgReplaceInfo(2, 1)
                lv_MsgReplaceInfo(0, 0) = "$LabelCaption$"
                lv_MsgReplaceInfo(0, 1) = lbl_Label(2).Caption
                lv_MsgReplaceInfo(1, 0) = "$Min$"
                lv_MsgReplaceInfo(1, 1) = 0
                lv_MsgReplaceInfo(2, 0) = "$Max$"
                lv_MsgReplaceInfo(2, 1) = FormatNumber(9999999, 0)
                GoTo errMessage
            End If

errMessage:
    Select Case ll_IsNum
        Case 2131
            Call MsgBox(MsgText(ll_IsNum, ms_Language_Code, "#The field " & lv_MsgReplaceInfo(0, 1) & " must be numeric.", lv_MsgReplaceInfo), vbInformation)
            Exit Function
        Case 2134
            Call MsgBox(MsgText(ll_IsNum, ms_Language_Code, "#The field " & lv_MsgReplaceInfo(0, 1) & " does not accept decimal number.", lv_MsgReplaceInfo), vbInformation)
            Exit Function
        Case 2132
            Call MsgBox(MsgText(ll_IsNum, ms_Language_Code, "#The field " & lv_MsgReplaceInfo(0, 1) & " must be a number between " & lv_MsgReplaceInfo(1, 1) & " and " & lv_MsgReplaceInfo(2, 1) & ".", lv_MsgReplaceInfo), vbInformation)
            Exit Function
        Case 7100
            Call MsgBox(MsgText(ll_IsNum, ms_Language_Code, "#The field " & lv_MsgReplaceInfo(0, 1) & " grater than " & lv_MsgReplaceInfo(1, 1) & ".", lv_MsgReplaceInfo), vbInformation)
            Exit Function
        Case 7103
            ReDim lv_MsgReplaceInfo(2, 1)
            lv_MsgReplaceInfo(0, 0) = "$LabelCaption$"
            lv_MsgReplaceInfo(0, 1) = lbl_Label(2).Caption
            lv_MsgReplaceInfo(1, 0) = "$Decimal$"
            lv_MsgReplaceInfo(1, 1) = 7
        
            Call MsgBox(MsgText(ll_IsNum, ms_Language_Code, "#The field " & lv_MsgReplaceInfo(0, 1) & "  can not have more than " & lv_MsgReplaceInfo(1, 1) & " digits after the decimal.", lv_MsgReplaceInfo), vbInformation)
            Exit Function
    End Select

    Item_Check = True
    Exit Function
    
ErrHandler:
    Call ErrorHandler("Item_Check")


End Function


Private Sub Item_DeleteInit()
On Error GoTo ErrHandler

    Call SetMode(eMode.emDelete)

    'visuel
    Call ClearForm(UserControl.Controls, fra_item)
    Call EnableFrame(UserControl.Controls, fra_item, False)
    
    Call OpenCursor(mt_ClassInfoLst(0).RequestView)
    
    Call HandleToolbar(tbl_main, 3, mb_IsFullAccess)
    
    Call LoadDataToForm(ml_Cursor, UserControl.Controls, fra_item)
    
    
    fra_item.Visible = True

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


Private Sub Item_Delete()
On Error GoTo ErrHandler


    If Not Item_DeleteDB() Then Exit Sub

    grd_Main.SelectedLine(0, "drop_flag") = "X"
    grd_Main.SelectedLine(0, "drop_date") = Format(Now, "dd\/mm\/yyyy")

    Call Item_Exit

    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Delete")
End Sub
Private Function Item_DeleteDB() As Boolean
On Error GoTo ErrHandler

    Dim ls_DEL_Request As String

    ls_DEL_Request = Replace(mt_ClassInfoLst(0).RequestDel, "$CURR_code$", grd_Main.SelectedLine(0, "CURR_code"))
    ls_DEL_Request = Replace(ls_DEL_Request, "$iConcurrency$", mo_Db.GetFields(ml_Cursor, "iConcurrency"))
    ls_DEL_Request = Replace(ls_DEL_Request, "$Z_Creator$", ml_UCode)
    
    ExecuteSQLSafe mo_Db, ls_DEL_Request

    If mo_Db.SQLRowsAffected = 0 Then
        Err.Raise ArmErr.SQLBadRowAffectedCount, "SQL : 0 rows affected."
    End If


    Item_DeleteDB = True

    Exit Function

ErrHandler:

    Call ErrorHandler("Item_DeleteDB")
End Function

Private Sub Item_Exit()
On Error GoTo ErrHandler

    If ml_Cursor > 0 Then
        mo_Db.Close (ml_Cursor)
        ml_Cursor = 0
    End If
    
    fra_item.Visible = False
    Call HandleToolbar(tbl_main, 0, True)

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



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

Private Sub ClearForm(ByRef aControls As Variant, ByRef aContainer As Object)
On Error GoTo ErrHandler


    Dim lIdx As Long, lCount As Long, lControl As Object
    lCount = aControls.Count - 1
    For lIdx = 0 To lCount
        Set lControl = aControls.Item(lIdx)

        If HasContainer(lControl, aContainer) Then
            Select Case UCase(TypeName(lControl))
                Case "TEXTBOX"
                    lControl.Text = ""

                Case "ARMCOMBOBOX"
                    'Set lControl.SelectedItem = Nothing
                    lControl.Clear
                    DoEvents

                Case "A_CALOCX"
                    lControl.reinit_cal

                Case "CHECKBOX"
                    lControl.value = vbUnchecked

                Case "ARMCHECKVIEW"
                    'lControl.Reset

                Case "FRAME", "LABEL", "TOOLBARCONTROL", "PICTUREBOX", "COMMANDBUTTON"

                Case "ARMGRID"
                    lControl.ClearGrid
                    lControl.Requests = ""

                Case "LISTBOX"
                    lControl.ListIndex = -1

                Case "OPTIONBUTTON"
                    Dim lValues As Variant
                    lValues = Split(lControl.Tag, SEP)
                    lControl.value = lValues(1)

                Case "TABSTRIP", "DRIVELISTBOX", "DIRLISTBOX", "FILELISTBOX"

                Case Else
                    Debug.Print "ClearForm " & UCase(TypeName(lControl))
            End Select
        End If

        Set lControl = Nothing
    Next

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

Public Function Load_A_COM() As Boolean

On Error GoTo ErrHandler

    If mb_Initialized Then Exit Function

    Call LockScreen(True)

    If Not HaveRight() Then
        Call MsgBox(MsgText(7101, ms_Language_Code, "#Permission denied."), vbInformation)
        LockScreen (False)
        Exit Function
    End If

'to handle Decimal with the local settings
    Dim sBuffer As String
    Dim nBufferLen As Long
    Dim LCID As Long

    LCID = GetSystemDefaultLCID

    ms_DecimalSeparator = Format(0, ".")

    nBufferLen = 255
    sBuffer = String$(nBufferLen, vbNullChar)
    nBufferLen = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_STHOUSAND, sBuffer, nBufferLen)
    If nBufferLen > 0 Then
        ms_ThousandSeparator = Left$(sBuffer, nBufferLen - 1)
    End If

    mb_IsFullAccess = SOM_lib.IsFullAccess
    ml_LocalID = GetLCIDFromCodePage(Get_Code_Page)
    
    
    mb_IsFullAccess = True

    Call Components_Settings

    Call Load_ClassInfo
    
    Call InitComponents


    Call LoadAllLabels

    Call LockScreen(False)

    mb_Initialized = True

    Call LogMessage("ComputerName: '" & ComputerName & "' | LoginName: '" & ms_LoginName & "' | ThousandSeparator: '" & ms_ThousandSeparator & "' | DecimalSeparator: '" & ms_DecimalSeparator & "' | Date: '" & Now & "'", "I")
    
    Load_A_COM = True

    Exit Function

ErrHandler:
    Call LockScreen(False)
    Call ErrorHandler("Load_A_Com")
End Function

Private Sub Components_Settings()
On Error GoTo ErrHandler

    Call Component_SetUp(tbl_main, "", 8)
    Call Component_SetUp(grd_Main, "grd_main", 7)

    Call Component_SetUp(lbl_Label(2), "lbl_ExchRate", 6)
    Call Component_SetUp(lbl_Label(1), "lbl_CurrDesc", 5)
    Call Component_SetUp(lbl_Label(0), "lbl_CurrCode", 4)
    Call Component_SetUp(chk_delete, "Drop_flag", 3)
    Call Component_SetUp(txt_exchrate, "EXCH_rate" & SEP & "Num" & SEP & "4", 2)
    Call Component_SetUp(txt_curr_desc, "CURR_desc" & SEP & "Text", 1)
    Call Component_SetUp(txt_CURR_Code, "CURR_code" & SEP & "Text", 0)

    Exit Sub

ErrHandler:
    Call ErrorHandler("Components_Settings")
End Sub


Private Sub Component_SetUp(ByVal ao_cpt As Object, ByVal as_Tag As String, Optional ai_TabIndex As Integer)

On Error GoTo ErrHandler

    ao_cpt.Tag = as_Tag
    ao_cpt.TabIndex = ai_TabIndex

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


Private Sub HandleToolbar(ByVal atlb_Toolbar As Object, ByVal as_face As String, ByVal ab_ButtonsVisible As Boolean)
On Error GoTo ErrHandler

    atlb_Toolbar.Visible = False
    atlb_Toolbar.DisplayFace (as_face)
    If Not ab_ButtonsVisible Then
        atlb_Toolbar.Redraw = False

        'here we can hidde buttons
        'atlb_Toolbar.ButtonVisible("C") = False
        atlb_Toolbar.Redraw = True
    End If
    atlb_Toolbar.Visible = True

    Exit Sub

ErrHandler:
    Call ErrorHandler("HandleToolbar")

End Sub

Private Sub InitComponents()

On Error GoTo ErrHandler

    Dim ll_Charset As Long


    Const CL_REQUEST_TB As String = "SELECT Toolbar_Info FROM Toolbars_Users WHERE User_Code=$user_id$"

    Dim ls_Toolbar_Info As String
    Dim lCursTB As Long

    lCursTB = OpenSQLSafe(mo_Db, Replace(CL_REQUEST_TB, "$user_id$", 0))

    ls_Toolbar_Info = mo_Db.GetFields(lCursTB, "toolbar_info")
    Call mo_Db.Close(lCursTB)
    
    Call tbl_main.Load_A_COM
    tbl_main.Language = "E" 'ms_Language_Code

    Call tbl_main.SetToolbarInfoStringParameters(ls_Toolbar_Info, "059")
    Call HandleToolbar(tbl_main, "0", mb_IsFullAccess)

    ll_Charset = GetCharSetFromCodePage(Get_Code_Page)

    Dim lo_Control As Control

    For Each lo_Control In UserControl.Controls
        Select Case UCase(TypeName(lo_Control))
            Case "ARMGRID"
                Set lo_Control.ArmDb = mo_Db
                lo_Control.Font.Name = "Arial"
                lo_Control.Font.Charset = ll_Charset
                lo_Control.LocalID = ml_LocalID
                lo_Control.codepage = Get_Code_Page
                lo_Control.Load_A_COM

            Case "ARMCOMBOBOX"
                Set lo_Control.ArmDb = mo_Db
                lo_Control.Font.Name = "Arial"
                lo_Control.Font.Charset = ll_Charset
                lo_Control.Load_A_COM

            Case "CHECKBOX", "LABEL", "COMMANDBUTTON", "FRAME", "TEXTBOX"
                lo_Control.Font.Name = "Arial"
                lo_Control.Font.Charset = ll_Charset

        End Select
    Next

    grd_Main.AllowExcelExport = False
    grd_Main.AllowPrint = False
    grd_Main.MultiSelect = False
    grd_Main.Title = ""

    ReDim lColumns(4)
    lColumns(0) = Join(Array("CURR_code", 1500, 0, "CURR_code", "#Currency Code"), SEP)
    lColumns(1) = Join(Array("CURR_desc", 5000, 0, "CURR_desc", "#Currency Description"), SEP)
    lColumns(2) = Join(Array("EXCH_rate", 1500, 0, "EXCH_rate", "#Exchange Rate", "Float", "0.0000000"), SEP)
    lColumns(3) = Join(Array("Drop_flag", 1000, 0, "Drop_flag", "#Deleted"), SEP)
    lColumns(4) = Join(Array("Drop_date", 1500, 0, "Drop_date", "#Deleted Date"), SEP)

    If Not grd_Main.SetColumns(lColumns) Then
        Debug.Print "grd_main.SetColumns error"
        Call Unload_A_COM
        End
    End If

    grd_Main.Requests = Replace(mt_ClassInfoLst(0).RequestGrd, "$Language_code$", ms_Language_Code, , , vbTextCompare)

    grd_Main.Execute
    grd_Main.Visible = True
    
    fra_item.Visible = False
    
    Exit Sub

ErrHandler:
    mo_Db.Close (lCursTB)
    Call ErrorHandler("InitComponents")
End Sub

Private Function Get_Code_Page() As Long
On Error GoTo ErrHandler

    Const Request As String = "SELECT Code_Page FROM Language WHERE Language_code = '$Language_code$'"

    Static lb_HasRun As Boolean
    Static ls_code_page As Long



    Dim ls_req As String
    Dim ll_curs As Long
    If Not lb_HasRun Then
        ls_req = Replace(Request, "$Language_code$", ms_Language_Code, , , vbTextCompare)

        ll_curs = OpenSQLSafe(mo_Db, ls_req)

        If mo_Db.RowCount(ll_curs) = 0 Then
             Err.Raise C_ERRORRAISE + 503, "Get_Code_Page", "#Enable to get the code page for the language " & ms_Language_Code & " - " & Join(mo_Db.SQLErrorMessages, vbCrLf)
        End If

        ls_code_page = mo_Db.GetFields(ll_curs, "Code_Page")

        mo_Db.Close (ll_curs)
    End If

    Get_Code_Page = ls_code_page


    Exit Function

ErrHandler:
    mo_Db.Close (ll_curs)
    Call ErrorHandler("Get_Code_Page")
End Function

Private Sub LockScreen(ByVal ab_lock As Boolean)

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

On Error GoTo ErrHandler
    Static ll_count As Long
    Static ll_Mousepointer As Long
    Static lb_Locked As Boolean


    ll_count = ll_count + IIf(ab_lock, 1, -1)
    Debug.Assert (ll_count >= 0)

    ' First lock
    If Not lb_Locked And ab_lock Then
        ll_Mousepointer = Screen.MousePointer
        Screen.MousePointer = vbHourglass
        LockWindowUpdate UserControl.hwnd
        lb_Locked = True
    End If

    ' Unlock
    If ll_count = 0 Then
        DoEvents ' Flush events
        LockWindowUpdate 0
        UserControl.Refresh ' Repaint immediately
        Screen.MousePointer = ll_Mousepointer
        lb_Locked = False
    End If

    Err.Number = ll_errNumber
    Err.Source = ls_ErrSrc
    Err.Description = ls_ErrDesc

    Exit Sub

ErrHandler:
    Call ErrorHandler("LockScreen")
End Sub

Public Function Unload_A_COM() As Boolean

On Error GoTo ErrHandler

    If Not mb_Initialized Then Exit Function

    Dim lo_Control As Control

    For Each lo_Control In UserControl.Controls
        Select Case UCase(TypeName(lo_Control))
            Case "TOOLBARCONTROL", "ARMCOMBOBOX", "ARMGRID"
                lo_Control.Unload_A_COM
        End Select
    Next


    Set mo_Db = Nothing

    mb_Initialized = False

    Unload_A_COM = True

    Exit Function

ErrHandler:
    Call ErrorHandler("Unload_A_Com")
End Function

Private Sub ErrorHandler(ByVal as_Fct As String)
    Err.Raise Err.Number, UserControl.Name & "." & UserControl.Ambient.DisplayName & "::" & as_Fct & SEP1 & Err.Source, Err.Description
End Sub

Function MsgText(ByVal aID As Long, ByVal aLang As String, ByVal aDefault As String, Optional ByVal aInfo As Variant) As String

On Error GoTo ErrHandler

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

    MsgText = ""

    Dim lRequest As String
    lRequest = Replace(DB_REQ, "$id$", aID)
    lRequest = Replace(lRequest, "$lang$", aLang)
    Dim lData As Long

    lData = OpenSQLSafe(mo_Db, lRequest)

    Dim lBuffer As String
    lBuffer = mo_Db.GetFields(lData, "message_text")
    mo_Db.Close (lData)
    If lBuffer = "" Then lBuffer = aDefault

    Dim li_Idx As Integer
    If Not IsMissing(aInfo) Then
        For li_Idx = 0 To UBound(aInfo)
            lBuffer = Replace(lBuffer, aInfo(li_Idx, 0), aInfo(li_Idx, 1), , , vbTextCompare)
        Next li_Idx
    End If


    MsgText = lBuffer
    Exit Function
ErrHandler:
    mo_Db.Close (lData)
    Call ErrorHandler("MsgText")

End Function
' 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
'    Debug.Print 1 / 0
    If al_RowExpectedCount <> -1 Then
        ' Then check the rowcount
        If ao_Db.RowCount(lc_Data) <> al_RowExpectedCount Then
            Err.Raise ArmErr.SQLBadRowExpectedCount, "SQL : " & as_Request, al_RowExpectedCount & "<>" & ao_Db.RowCount(lc_Data)
        End If
    End If

    OpenSQLSafe = lc_Data

    Exit Function

ErrHandler:

    Call ErrorHandler("OpenSQLSafe")

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

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

    If al_RowAffectedCount <> -1 Then
        ' Then check the rowcount
        If ao_Db.SQLRowsAffected <> al_RowAffectedCount Then

            If ab_DuplicityCheck Then
                Err.Raise ArmCusErr.DuplicityDetected, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_Db.SQLRowsAffected
            Else
                Err.Raise ArmErr.SQLBadRowAffectedCount, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_Db.SQLRowsAffected
            End If
        End If
    End If

    Exit Sub

ErrHandler:
    Call ErrorHandler("ExecuteSQLSafe")
End Sub
' logs message to database
Private Sub LogMessage(ByVal as_logMsg As String, Optional ByVal as_logType As String = "I", Optional ab_throwException As Boolean = True)
On Error GoTo ErrHandler
Const InsertReq As String = "EXEC A_log_ins $UCODE$, '$LOGTYPE$', '$MSG$', '$APP$'"
    Dim ls_req As String
    Dim ll_cursor As Long

    ls_req = Replace(InsertReq, "$UCODE$", CStr(ml_UCode))
    ls_req = Replace(ls_req, "$APP$", Left(Trim(SQLStr(SCREEN_NAME & " " & App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)), 50))
    ls_req = Replace(ls_req, "$MSG$", right(Trim(SQLStr(as_logMsg)), 4000))
    ls_req = Replace(ls_req, "$LOGTYPE$", SQLStr(as_logType), 1)

    Call ExecuteSQLSafe(mo_Db, ls_req)

    Exit Sub
ErrHandler:
    If ab_throwException Then Call ErrorHandler(Extender.Name & ".LogMessage - " & Err.Number & ": " & Err.Description)
End Sub

Private Function SQLStr(ByVal as_str As String) As String
    SQLStr = Replace(as_str, "'", "''")
End Function

Private Sub LoadAllLabels()

On Error GoTo ErrHandler

    Call LoadLabels(UserControl.Controls, Me, SCREEN_NAME, ms_Language_Code)
    Exit Sub

ErrHandler:
    Call ErrorHandler("LoadAllLabels")

End Sub

Public Sub LoadLabels(ByRef aControls As Variant, ByRef av_Container As Object, ByVal as_ScreenName As String, ByVal as_Language As String)

On Error GoTo ErrHandler
    Dim lIdx As Long, lCount As Long, lLabels As Long, lb_Apply As Boolean, lv_Iter As Object, ls_Buffer As String
    Dim lControl As Control, ll_Idx2 As Long, ll_Count2 As Long, ll_IdxGrd As Long

    'lLabels = mo_Db.OpenSQL("exec Screen_Csts '" & as_ScreenName & "','" & as_Language & "'")
    lLabels = OpenSQLSafe(mo_Db, "exec Screen_Csts '" & as_ScreenName & "','" & as_Language & "'")
    lCount = aControls.Count - 1

    For lIdx = 0 To lCount
        Set lControl = aControls.Item(lIdx)

        If Not av_Container Is Nothing Then
            lb_Apply = HasContainer(lControl, av_Container)
        Else
            lb_Apply = True
        End If
        If lb_Apply Then
            Select Case UCase(TypeName(lControl))
                Case "LABEL", "FRAME", "COMMANDBUTTON"
                    If lControl.Tag <> "" Then
                        If mo_Db.Find(lLabels, "FIELD_NAME", lControl.Tag, , 1) >= 0 Then
                            lControl.Caption = mo_Db.GetFields(lLabels, "LOCAL_TEXT")
                        End If
                    End If
                Case "CHECKBOX"
                    If lControl.Tag <> "" Then
                        ls_Buffer = Split(lControl.Tag, SEP, , vbTextCompare)(0)
                        If mo_Db.Find(lLabels, "FIELD_NAME", ls_Buffer, , 1) >= 0 Then
                            lControl.Caption = mo_Db.GetFields(lLabels, "LOCAL_TEXT")
                        End If
                    End If
                Case "TEXTBOX"
                    If lControl.Tag <> "" Then
                        If mo_Db.Find(lLabels, "FIELD_NAME", lControl.Tag, , 1) >= 0 Then
                            lControl.Text = mo_Db.GetFields(lLabels, "LOCAL_TEXT")
                        End If
                    End If
                Case "TABSTRIP"
                    If lControl.Tag <> "" Then
                        For Each lv_Iter In lControl.Tabs
                            If mo_Db.Find(lLabels, "FIELD_NAME", lControl.Tag & "_" & lv_Iter.Tag, , 1) >= 0 Then
                                lv_Iter.Caption = mo_Db.GetFields(lLabels, "LOCAL_TEXT")
                            End If
                        Next
                    End If

                Case "OPTIONBUTTON"
                    If lControl.Tag <> "" Then
                        ls_Buffer = Split(lControl.Tag, SEP, , vbTextCompare)(0)
                        On Error Resume Next
                        ls_Buffer = ls_Buffer & lControl.Index
                        On Error GoTo 0
                        If mo_Db.Find(lLabels, "FIELD_NAME", ls_Buffer, , 1) >= 0 Then
                            lControl.Caption = mo_Db.GetFields(lLabels, "LOCAL_TEXT")
                        End If
                    End If

                Case "ARMGRID"
                    If lControl.Tag <> "" Then
                        If mo_Db.Find(lLabels, "FIELD_NAME", lControl.Tag, , 1) >= 0 Then
                            Dim ls_Text As String
                            Dim ls_Title As String
                            ls_Text = mo_Db.GetFields(lLabels, "LOCAL_TEXT")
                            If ls_Text <> "" And InStr(1, ls_Text, SEP) <> 0 Then

                                ls_Title = Mid(ls_Text, 1, InStr(1, ls_Text, SEP) - 1)

                                lControl.Title = ls_Title

                                ls_Text = Mid(ls_Text, InStr(1, ls_Text, SEP) + 2)
                                Call lControl.LoadConstants(ptStatic, ls_Text, ctColumns)
                            End If
                        End If
                    End If

                Case "FRAME", "MSFLEXGRID", "TOOLBARCONTROL", "COMMANDBUTTON", "ARMCHECKVIEW", "ARMCOMBOBOX", "A_CALOCX", "ARMTREEVIEW", "LISTBOX", "PICTUREBOX"
                   ' NOTHING

            End Select
        End If
        Set lControl = Nothing
    Next

CleanUp:
    mo_Db.Close (lLabels)
    Exit Sub

ErrHandler:
    mo_Db.Close (lLabels)
    If Not lControl Is Nothing Then Set lControl = Nothing
    Call ErrorHandler("LoadLabels")

End Sub

Private Sub UpdateLineToGrid(ByVal ao_grid As ArmGrid, as_keyField As String, ByVal as_key As String, ByVal as_SrzFields As String, ByVal ab_OneRowToUpdate As Boolean)
On Error GoTo ErrHandler
    
    Dim lv_SrzFields As Variant
    Dim lv_Values
    Dim ll_count As Long
    Dim ll_Nb As Long, ll_Nb2 As Long, ll_Idx As Long
    
    Dim ls_ColNames As String
    
    ll_Nb = ao_grid.Rows - 1
    For ll_count = 0 To ll_Nb
        
        'si cust_id = alkey mettre ŕ jour la ligne de la grille
        If ao_grid.Data(ll_count, as_keyField) = as_key Then
            lv_SrzFields = Split(as_SrzFields, SEP)
            ll_Nb2 = UBound(lv_SrzFields) - 1
            
            'build the list of columns of the grid
            ls_ColNames = SEP2
            Dim i As Long
            For i = 0 To ao_grid.Cols - 1
                ls_ColNames = ls_ColNames & UCase(ao_grid.Columns(i).FieldName) & SEP2
            Next i
            
            For ll_Idx = 0 To ll_Nb2
                lv_Values = Split(lv_SrzFields(ll_Idx), SEP1)
                 If InStr(1, UCase(ls_ColNames), SEP2 & UCase(lv_Values(0)) & SEP2) Then
                    If lv_Values(0) = "EXCH_rate" Then
                        ao_grid.Data(ll_count, lv_Values(0)) = Val(lv_Values(1))
                    Else
                        ao_grid.Data(ll_count, lv_Values(0)) = lv_Values(1)
                    End If
                End If
            Next

            'there is only on link per proj/cust
            If ab_OneRowToUpdate Then Exit For
        
        End If
    Next
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("UpdateLineToGrid")
End Sub

Private Sub AddLineToGrid(ByVal ao_grid As ArmGrid, ByVal as_SrzFields As String)
On Error GoTo ErrHandler
    
    Dim lv_SrzFields As Variant
    Dim lv_Values
    Dim ll_count As Long
    Dim ll_Nb As Long
    
    Dim ls_ColNames As String
    
    ao_grid.AddLine
    
    ls_ColNames = SEP2
    Dim i As Long
    For i = 0 To ao_grid.Cols - 1
        ls_ColNames = ls_ColNames & ao_grid.Columns(i).FieldName & SEP2
    Next i
    
    lv_SrzFields = Split(as_SrzFields, SEP)
    ll_Nb = UBound(lv_SrzFields) - 1

    For ll_count = 0 To ll_Nb
        lv_Values = Split(lv_SrzFields(ll_count), SEP1)
         If InStr(1, UCase(ls_ColNames), SEP2 & UCase(lv_Values(0)) & SEP2) Then
            
            Select Case lv_Values(0)
                Case "CURR_code"
                    ao_grid.SelectedLine(0, lv_Values(0)) = UCase(lv_Values(1))
                
                Case "EXCH_rate"
                    ao_grid.SelectedLine(0, lv_Values(0)) = Val(lv_Values(1))
                
                Case Else
                    ao_grid.SelectedLine(0, lv_Values(0)) = lv_Values(1)
                    
            End Select
            
            Debug.Print lv_SrzFields(ll_count)
         End If
    Next ll_count
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("AddLineToGrid")
End Sub



Private Sub grd_Main_SelChange()
    'read the status of the project in grid
    If grd_Main.SelectedLine(0, "drop_flag") <> "X" Then
        tbl_main.ButtonEnabled("B") = True
        If tbl_main.Language = "E" Then tbl_main.ButtonEnabled("C") = True
    Else
        tbl_main.ButtonEnabled("B") = False
        tbl_main.ButtonEnabled("C") = False
    End If
    Exit Sub
ErrHandler:

    Select Case Err.Number
    Case 3008
        MsgBox MsgText(2138, ms_Language_Code, "#The record you try to open has been deleted by an other user. Please refresh the grid."), vbInformation

    Case Else
        Call LogMessage("grd_main_SelChange: " & Err.Number & ": " & Err.Source & ": " & Err.Description, "E", False)
        Call MsgBox("Error during the process, Contact immediatly your IT support.", vbCritical)
        End
    End Select

End Sub

Private Sub tbl_main_action(ByVal as_Role As String, as_Language As String)

On Error GoTo ErrHandler
    Static DoCheck As Boolean
    
    If DoCheck = True Then Exit Sub
    DoCheck = True

    Call LockScreen(True)
    
    tbl_main.Enabled = False

    Select Case as_Role
        Case "A"
            Call Item_AddInit
        
        Case "H"
            Call Item_Add
        
        Case "B"
            If grd_Main.SelectedCount > 0 Then
                Call Item_UpdateInit
            End If
            
        Case "U"
            Call Item_Update

        Case "C"
            If grd_Main.SelectedCount > 0 And grd_Main.SelectedLine(0, "drop_flag") <> "X" Then
                Call Item_DeleteInit
            End If
        
        Case "D"
            Call Item_Delete
            
        Case "F"
            tbl_main.ButtonEnabled("B") = True
            If tbl_main.Language = "E" Then tbl_main.ButtonEnabled("C") = True
            grd_Main.Refresh
            DoEvents
            
        Case "Q"
            grd_Main.Requests = Replace(mt_ClassInfoLst(0).RequestGrd, "$Language_code$", tbl_main.Language, , , vbTextCompare)
            grd_Main.Execute
            
        Case "T"
            Call Item_Exit
            
        Case "X"
            RaiseEvent OnExit
            
    End Select
    
    tbl_main.Enabled = True
    
    Call LockScreen(False)
    
    DoCheck = False
    
    Exit Sub
ErrHandler:
    DoCheck = False
    Call LockScreen(False)
    tbl_main.Enabled = True

    Select Case Err.Number

    Case 7007
        MsgBox MsgText(3054, ms_Language_Code, "#Enable to update the data."), vbInformation
        Call LogMessage("tbl_main_action: " & Err.Number & ": " & Err.Source & ": " & Err.Description, "E", False)
        Call Item_Exit
        
    Case 7008
        MsgBox MsgText(2138, ms_Language_Code, "#The record you try to open has been deleted by an other user. Please refresh the grid."), vbInformation
        Call Item_Exit
        
    Case 7006
        Select Case me_Mode
        Case eMode.emAdd
            MsgBox MsgText(59, ms_Language_Code, "#This data already exists."), vbInformation
        Case eMode.emUpdate
            MsgBox MsgText(7102, ms_Language_Code, "#This exchange rate value cannot be used, as it would create quote values that are to big to store in the database."), vbInformation
        Case Else
            MsgBox MsgText(2135, ms_Language_Code, "#Unable to update the record."), vbInformation
        End Select
        
    Case Else
        Call LogMessage("tbl_main_action: " & Err.Number & ": " & Err.Source & ": " & Err.Description, "E", False)
        Call MsgBox("Error during the process, Contact immediatly your IT support.", vbCritical)
        End
    End Select

End Sub


