VERSION 5.00
Begin VB.UserControl Saved_Select 
   ClientHeight    =   10005
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   15090
   LockControls    =   -1  'True
   ScaleHeight     =   10005
   ScaleWidth      =   15090
   Begin VB.TextBox txt_ucode 
      ForeColor       =   &H000000FF&
      Height          =   315
      Left            =   8400
      TabIndex        =   7
      Tag             =   "U_codeŽŠText"
      Text            =   "U_codeŽŠText"
      Top             =   0
      Width           =   1545
   End
   Begin VB.TextBox txt_Sel_Value 
      ForeColor       =   &H000000FF&
      Height          =   315
      Left            =   6810
      TabIndex        =   6
      Tag             =   "Sel_ValueŽŠText"
      Text            =   "Sel_ValueŽŠText"
      Top             =   660
      Width           =   6975
   End
   Begin VB.TextBox txt_Sel_Type 
      ForeColor       =   &H000000FF&
      Height          =   315
      Left            =   6810
      TabIndex        =   5
      Tag             =   "Sel_TypeŽŠText"
      Text            =   "Sel_TypeŽŠText"
      Top             =   330
      Width           =   6975
   End
   Begin VB.TextBox txt_key 
      ForeColor       =   &H000000FF&
      Height          =   315
      Left            =   6810
      TabIndex        =   4
      Tag             =   "Sel_IDŽŠText"
      Text            =   "Sel_IDŽŠText"
      Top             =   0
      Width           =   1545
   End
   Begin VB.TextBox txt_select 
      Height          =   285
      Left            =   1920
      MaxLength       =   150
      TabIndex        =   0
      Tag             =   "Sel_DescŽŠText"
      Text            =   "Sel_DescŽŠText"
      Top             =   990
      Width           =   13095
   End
   Begin Project1.ArmGrid grd_selection 
      Height          =   8535
      Left            =   60
      TabIndex        =   1
      Tag             =   "grd_selection"
      Top             =   1410
      Width           =   14955
      _ExtentX        =   26379
      _ExtentY        =   15055
   End
   Begin Project1.ToolbarControl tbl_main 
      Height          =   690
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   6555
      _ExtentX        =   11562
      _ExtentY        =   1217
   End
   Begin VB.Label lbl_label 
      Alignment       =   1  'Right Justify
      Caption         =   "#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           =   0
      Left            =   60
      TabIndex        =   3
      Tag             =   "lbl_ProjectName"
      Top             =   1020
      Width           =   1815
   End
End
Attribute VB_Name = "Saved_Select"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Event OnExit()

'as_SrzFields: 1st element must be string must be the description
Public Event OnItemAdd(ByVal ae_CptType As eComponent, ByVal al_Key As Long, ByVal as_SrzFields As String)

Public Event OnItemDelete(ByVal ae_CptType As eComponent, ByVal al_Key As Long)

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

Private Const SCREEN_NAME As String = "MY_SELECT"

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


Const CL_COLOR_ENABLED As Long = &H80000005
Const CL_COLOR_DISABLED As Long = &H8000000F
Const CL_COLOR_LOCKED As Long = &H80000018

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


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




#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
    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_LocalID As Long


#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 Sub Run(ByVal al_Ucode As Long, ByVal al_SelType As Long, ByVal as_SrzFields As String)
On Error GoTo ErrHandler
    Debug.Assert (mb_Initialized = True)
    
    
    Call Item_ViewInit(al_Ucode, al_SelType, as_SrzFields)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("Run")
End Sub
Private Sub Load_ClassInfo()
On Error GoTo ErrHandler

    ReDim mt_ClassInfoLst(0)
    
        With mt_ClassInfoLst(0)
            .RequestView = "exec Saved_Selections_Lst $U_code$,$Sel_Type$"
            
            .RequestAdd = "exec Saved_Selections_Ins $Sel_ID$,$U_code$,$Sel_Type$,'$Sel_Desc$','$Sel_Value$'"
            
            .RequestUpd = ""
                                                        
            .RequestDel = "exec Saved_Selections_Del $Sel_ID$"
            
            ReDim .ListFieldsMandatory(0, 1)
            Set .ListFieldsMandatory(0, 0) = txt_select
             .ListFieldsMandatory(0, 1) = 0
        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
                        as_Request = Replace(as_Request, "$" & lValues(0) & "$", Replace(Trim(lControl.Text), "'", "''"), , , vbTextCompare)
                    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 Item_ViewInit(ByVal al_Ucode As Long, ByVal al_SelType As Long, ByVal as_SrzFields As String)
On Error GoTo ErrHandler
    
    Dim ls_req As String
     
    'visuel
    Call ClearForm(UserControl.Controls, Me)
    
    txt_ucode.Text = al_Ucode
    txt_Sel_Type.Text = al_SelType
    txt_Sel_Value.Text = as_SrzFields
    
    ls_req = ReplaceHolders(UserControl.Controls, Me, mt_ClassInfoLst(0).RequestView)
    
    Call grd_selection.Load(ls_req, False, , , True)
                    
    Exit Sub
    
ErrHandler:
    Call ErrorHandler("Item_ViewInit")
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 Function Item_Add() As Boolean
On Error GoTo ErrHandler
    
    If Not Item_CheckMandatory(0) Then Exit Function
        
    If Not Item_AddDB(0) Then Exit Function  'GoTo BackToGrid
        
    RaiseEvent OnItemAdd(eSavedSel, CLng(txt_key.Text), txt_select.Text & SEP & txt_Sel_Value.Text)
    
    Call Item_Exit
    
    Item_Add = True
    
    Exit Function

ErrHandler:
    Call ErrorHandler("Item_Add")

End Function
Private Function Item_AddDB(ByVal al_InfoArrayIndex As Long) As Boolean

On Error GoTo ErrHandler

    Dim ls_ADD_Request As String
    
    Dim ll_NextID As Long
    ll_NextID = mo_Db.SQLNextID("Saved_Selections")
    
    txt_key.Text = ll_NextID
        
    ls_ADD_Request = ReplaceHolders(UserControl.Controls, Me, mt_ClassInfoLst(0).RequestAdd)
        
    ExecuteSQLSafe mo_Db, ls_ADD_Request, 1
    
    Item_AddDB = True

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

Private Sub Item_Delete()
On Error GoTo ErrHandler
    
    If grd_selection.SelectedCount = 0 Then Exit Sub
    
    txt_key.Text = grd_selection.SelectedLine(0, "Sel_Id")
    
    If MsgBox(MsgText(C_ERRORRAISE + 53, ms_Language_Code, "#Do you really want to delete the selected item?"), vbExclamation + vbDefaultButton2 + vbYesNo) <> vbYes Then Exit Sub

    If Not Item_DeleteDB() Then Exit Sub
    
    grd_selection.DeleteLine
        
    RaiseEvent OnItemDelete(eSavedSel, CLng(txt_key.Text))

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

    Dim ls_DEL_Request As Variant
    
    ls_DEL_Request = ReplaceHolders(UserControl.Controls, Me, mt_ClassInfoLst(0).RequestDel)
    
    ExecuteSQLSafe mo_Db, ls_DEL_Request, 1
    
    Item_DeleteDB = True

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

Private Sub Item_Exit()
On Error GoTo ErrHandler
    
    RaiseEvent OnExit
    
    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)
    
    mb_IsFullAccess = True
    
    Call Components_Settings
        
    Call InitComponents
    
    Call Load_ClassInfo
    
    Call LoadAllLabels
    
    LockScreen (False)
    
    mb_Initialized = True
    
    Load_A_Com = True
    
    Exit Function

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

Private Sub Components_Settings()
On Error GoTo ErrHandler
    
    Call Component_SetUp(lbl_label(0), "lbl_Description", 6)
    Call Component_SetUp(txt_Sel_Value, "Sel_Value" & SEP & "Text", 5)
    Call Component_SetUp(txt_Sel_Type, "Sel_Type" & SEP & "Text", 4)
    Call Component_SetUp(txt_ucode, "U_code" & SEP & "Text", 3)
    Call Component_SetUp(txt_key, "Sel_ID" & SEP & "Text", 2)
    
    
    Call Component_SetUp(grd_selection, "grd_selection", 1)
    Call Component_SetUp(txt_select, "Sel_Desc" & 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, "052")
    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
                
                Select Case UCase(lo_Control.Name)
                    Case "TXT_KEY"
                        lo_Control.Visible = False
                End Select
                
        End Select
    Next
    
    grd_selection.AllowExcelExport = False
    grd_selection.AllowPrint = False
    grd_selection.MultiSelect = False
    grd_selection.Title = "#Selections"
    
    ReDim lColumns(1)
    lColumns(0) = Join(Array("Sel_ID", 0, 0, "Sel_ID", "#Sel_ID"), SEP)
    lColumns(1) = Join(Array("Sel_Desc", 13000, 0, "Sel_Desc", "#Description"), SEP)
    
    If Not grd_selection.SetColumns(lColumns) Then
        Debug.Print "grd_selection.SetColumns error"
        Call Unload_A_Com
        End
    End If

    txt_key.Visible = False
    txt_ucode.Visible = False
    txt_Sel_Type.Visible = False
    txt_Sel_Value.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 tbl_main_action(ByVal as_Role As String, as_Language As String)

On Error GoTo ErrHandler
    
    Call LockScreen(True)

    tbl_main.Enabled = False
    
    Select Case as_Role
        Case "P"
            Call Item_Add
            
        Case "C"
            Call Item_Delete
            
        Case "T"
            Call Item_Exit
            
    End Select
    
    tbl_main.Enabled = True
    
    Call LockScreen(False)
    
    Exit Sub
ErrHandler:
    tbl_main.Enabled = True
    
    Call LockScreen(False)
    
    Select Case Err.Number
    
    Case 3007
        MsgBox MsgText(3054, ms_Language_Code, "#This data has been updated by another user. Please reload the data and try again."), vbInformation
    
    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
        Call Item_Exit
    
    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

