VERSION 5.00
Begin VB.UserControl SPA_Admin_PG_MKT_BI 
   ClientHeight    =   9705
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   15255
   ScaleHeight     =   9705
   ScaleWidth      =   15255
   Begin VB.Frame fra_detail 
      Height          =   8775
      Left            =   0
      TabIndex        =   9
      Tag             =   "fra_Detail"
      Top             =   840
      Width           =   15135
      Begin VB.Frame frm_JP_Experimental 
         Caption         =   "JP experimental"
         Height          =   1815
         Left            =   9840
         TabIndex        =   15
         Top             =   720
         Width           =   4335
         Begin VB.CommandButton Command1 
            Caption         =   "Loop all"
            Height          =   495
            Left            =   120
            TabIndex        =   17
            Top             =   360
            Width           =   975
         End
         Begin VB.TextBox txt_JP_Exp_allItems 
            Height          =   1335
            Left            =   1200
            MultiLine       =   -1  'True
            TabIndex        =   16
            Top             =   360
            Width           =   3015
         End
      End
      Begin VB.CheckBox chk_inclSpecialProducts 
         Caption         =   "#Include special products"
         Height          =   375
         Left            =   120
         TabIndex        =   14
         Tag             =   "chk_inclSpecPrd"
         Top             =   870
         Width           =   3825
      End
      Begin VB.CommandButton cmd_remove_from_linked 
         Height          =   615
         Left            =   9720
         Style           =   1  'Graphical
         TabIndex        =   7
         Tag             =   "cmd_remove_from_linked"
         Top             =   5520
         Visible         =   0   'False
         Width           =   855
      End
      Begin VB.CommandButton cmd_add_to_linked 
         Height          =   615
         Left            =   8520
         Style           =   1  'Graphical
         TabIndex        =   6
         Tag             =   "cmd_add_to_linked"
         Top             =   5520
         Width           =   855
      End
      Begin VB.TextBox txt_SPM_Code 
         Height          =   330
         Left            =   360
         TabIndex        =   13
         Text            =   "SPM_Code"
         Top             =   0
         Visible         =   0   'False
         Width           =   1785
      End
      Begin VB.CommandButton cmd_TVReLoad 
         Height          =   735
         Left            =   120
         Style           =   1  'Graphical
         TabIndex        =   12
         Tag             =   "cmd_TVReLoad"
         Top             =   1860
         Visible         =   0   'False
         Width           =   735
      End
      Begin VB.TextBox txt_productGroup 
         Height          =   375
         Left            =   10440
         TabIndex        =   2
         Text            =   "SPG_SDesc"
         Top             =   360
         Width           =   4575
      End
      Begin VB.TextBox txt_authMarket 
         Height          =   375
         Left            =   3000
         TabIndex        =   1
         Text            =   "SPM_SDesc"
         Top             =   360
         Width           =   4575
      End
      Begin Project1.ArmGrid grd_productLinked 
         Height          =   2520
         Left            =   4080
         TabIndex        =   8
         Tag             =   "grd_productLinked"
         Top             =   6120
         Width           =   10950
         _ExtentX        =   19315
         _ExtentY        =   4445
      End
      Begin Project1.ArmGrid grd_productAvail 
         Height          =   4680
         Left            =   4080
         TabIndex        =   5
         Tag             =   "grd_productAvail"
         Top             =   840
         Width           =   10950
         _ExtentX        =   19315
         _ExtentY        =   8255
      End
      Begin Project1.ArmCombobox cbo_View 
         Height          =   345
         Left            =   90
         TabIndex        =   3
         Top             =   1380
         Width           =   3870
         _ExtentX        =   6826
         _ExtentY        =   609
      End
      Begin Project1.ArmTreeView tvw_Main 
         Height          =   6780
         Left            =   120
         TabIndex        =   4
         Top             =   1860
         Width           =   3825
         _ExtentX        =   6747
         _ExtentY        =   11959
      End
      Begin VB.Label lbl_label 
         Caption         =   "#Authorization market"
         Height          =   240
         Index           =   0
         Left            =   120
         TabIndex        =   11
         Tag             =   "lbl_AuthMarket"
         Top             =   412
         Width           =   2865
      End
      Begin VB.Label lbl_label 
         Caption         =   "#Product group"
         Height          =   240
         Index           =   1
         Left            =   7680
         TabIndex        =   10
         Tag             =   "lbl_ProductGroup"
         Top             =   412
         Width           =   2625
      End
   End
   Begin Project1.ToolbarControl tlb_main 
      Height          =   690
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   15165
      _ExtentX        =   26749
      _ExtentY        =   1217
   End
End
Attribute VB_Name = "SPA_Admin_PG_MKT_BI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' **************************************************************************************************
' ************************************* EXTERNAL DECLARATIONS **************************************
' **************************************************************************************************
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 LockWindowUpdate Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _
   (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function LoadIconFromDLL Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As Long) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PictDesc, riid As Guid, ByVal fPictureOwnsHandle As Long, ipic As IPicture) As Long
' **************************************************************************************************

' **************************************************************************************************
' **************************************** TOOL CONSTANTS ******************************************
' **************************************************************************************************
Private Const LOCALE_USER_DEFAULT = &H400
Private Const LOCALE_SDECIMAL = &HE ' Decimal separator
Private Const LOCALE_STHOUSAND = &HF ' Thousand separator
Private Const CL_COLOR_ENABLED As Long = &H80000005
Private Const CL_COLOR_DISABLED As Long = &H8000000F
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"
Private Const SEP As String = SEP1 + SEP2
Private Const ICON_RELOAD = 115
Private Const ICON_UP = 125
Private Const ICON_DOWN = 124
Private Const C_APPNAME As String = "SPA_Admin_PG_MKT_BI"             ' for error log
Private Const C_SCREENNAME As String = "SPA_Admin_PG_MKT_BI"   ' for loading screen constants
Private Const C_SCREENMODE_STACK_SIZE As Long = 5           ' size of stack for active screens
Private Const C_TOOLBARFACE_ITEM_ADD As String = "0"
Private Const SIFYB_CM_ERROR_MESSAGE = 8000                 ' const for base of error messages ids
' ****************************************** TOOL CONSTANTS ***************************************

'**********************************************************************************************************************************
'**********************************************************************************************************************************
' FRAMEWORK CUSTOM TYPES
'**********************************************************************************************************************************
'**********************************************************************************************************************************

Private Type PictDesc
    cbSizeofStruct As Long
    picType As Long
    hImage As Long
    xExt As Long
    yExt As Long
End Type

Private Type Guid
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Type TTreeViewInfo
    Levels As Long
    NodeRequest() As String
    GridRequest() As String
    ExcelRequest() As String
    CountRequest() As String
    FindRequest() As String
    Images() As Integer
    SelectedImages() As Integer
    TreeViewCode As String
    Loaded As Boolean
End Type

Private Enum eTvwSelMethod
    etmNone = 0
    etmNode = 1         ' User click on the last node of a branch
    etmBranch = 2       ' User click on a branch and use the load button
    etmCheckBoxes = 3   ' User click on the load button when checkboxes mode is set
End Enum

' **************************************************************************************************
' **************************************** USER DEFINED ERRORS *************************************
' **************************************************************************************************
Private Enum ArmErr
    DBCnxFailed = vbObjectError + 1             ' Unable to connect to the database
    CPTAlreadyInitialized = vbObjectError + 2   ' We try to initialize a component that is already initialized
    CPTNotInitialized = vbObjectError + 3       ' We try to use or free that is not initialized yet
    InvalidArgument = vbObjectError + 4
    PropertyNotSet = vbObjectError + 5
    CompFncFailed = vbObjectError + 6           ' when component function fail
    QuietException = vbObjectError + 7          ' do not display error message
    WarMsgSelectRow = vbObjectError + 8
    SQLBadRowAffectedCount = vbObjectError + 9  ' A SQL request has not affected the expected rowcount (ex: one Update do nothing)
    SQLBadRowExpectedCount = vbObjectError + 10 ' A SQL request does not return the expected rowcount : select an item return nothing...
End Enum

Private Enum ErrMsg
    ErrMsgNone = 0
    ErrMsgMandatoryAreEmpty = SIFYB_CM_ERROR_MESSAGE + 1
    ErrMsgDuplicateOrder = SIFYB_CM_ERROR_MESSAGE + 2
    ErrMsgDuplicateLevel = SIFYB_CM_ERROR_MESSAGE + 3
    ErrMsgMissingLevel = SIFYB_CM_ERROR_MESSAGE + 4
    ErrMsgNumericRequired = SIFYB_CM_ERROR_MESSAGE + 5
    ErrMsgItemIsDeleted = SIFYB_CM_ERROR_MESSAGE + 19
    ErrMsg_M590 = SIFYB_CM_ERROR_MESSAGE + 590              'The SAP code $BI_SAP_CODE$ already appears in another product group for this authorisation market
End Enum

' *************************************** USER DEFINED ERRORS **************************************

' **************************************************************************************************
' *************************************** CONTROL MEMBERS ******************************************
' **************************************************************************************************
Dim ml_U_Code As Long                   ' if this is user loging app, needed to log errors into A_Log
Dim ms_LoginName As String
Dim ms_Language_Code As String
Dim mb_Initialized As Boolean           ' True if the component is already initialized
Dim mb_Initializing As Boolean          ' Flag of initializing
Dim mua_ActiveMode() As ArmScreenMode
Dim ms_Title As String                  ' title of user control - can be assigned as Caption to the parent form or title for printing
Dim ms_DecimalSeparator As String       ' decimal separator obtained from local settings
Dim ms_ThousandSeparator As String      'locale thousand separator
Dim moa_ListFieldsMandatory As Variant  ' all mandatory controls
Dim moa_ListFieldsToDisable() As Control            ' common disabled control
Dim mo_dataSrc As Dictionary            ' for item restore purpose
Dim mt_TreeViewInfos() As TTreeViewInfo


Private Enum ArmScreenMode
    smRefreshOnly
    smMain
    smAdd
End Enum


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

' *************************************** CONTROL MEMBERS ******************************************
Public Event OnExit()
Public Event OnItemAdd()
Public Event OnItemRestore()


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


' mb_Initialized is a read-only property, indicates the status of the component
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 Initialized() As Boolean
    Initialized = mb_Initialized
End Property
Public Sub Zorder()
  Call UserControl.Extender.Zorder
End Sub
Public Property Let U_Code(ByVal al_U_Code As Long)
On Error GoTo ErrHandler
    
    If Initialized Then Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    
    ml_U_Code = al_U_Code
    Exit Property
ErrHandler:
    Call ErrorHandler(Extender.Name & ".U_Code(Let)")
End Property

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

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

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

Public Property Get Title() As String
    Title = ms_Title
End Property

Public Sub Run(ByVal ae_ScrMode As SPA_Mode, ByVal as_SrzFields As String)
On Error GoTo ErrHandler

    Debug.Assert (mb_Initialized = True)
    
    Call LockScreen(True)       'JN: i am not sure if this is necessary if called from other control which already locked the screen
    
    Call FillDataSrcArray(mo_dataSrc, as_SrzFields)
    
    Select Case ae_ScrMode
        Case SPA_Mode.emAdd
            Call Item_AddInit(mo_dataSrc)
        Case Else
            Debug.Assert (False)
    End Select
    
    Call LockScreen(False)
    
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".Run")
End Sub

Public Sub Load_A_COM()
Dim lo_Control As Object
On Error GoTo ErrHandler
    If Initialized Then Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    If mo_Db Is Nothing Then Call Err.Raise(ArmErr.PropertyNotSet, "", "mo_Db")
    If Len(ms_Language_Code) < 1 Then Call Err.Raise(ArmErr.PropertyNotSet, "", "ms_Language_Code")

    ' get decimal separator for conversion from string to double
    ms_DecimalSeparator = Format(0, ".")
    Dim sBuffer As String
    Dim nBufferLen As Long
    nBufferLen = 255
    sBuffer = String$(nBufferLen, vbNullChar)
    nBufferLen = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_STHOUSAND, sBuffer, nBufferLen)
    If nBufferLen > 0 Then
        ms_ThousandSeparator = Left$(sBuffer, nBufferLen - 1)
    End If

    ' Set Db
    ' Call Load_A_Com
    ' Initialize toolbars
    Debug.Assert (Not mo_Db Is Nothing)
    
    For Each lo_Control In UserControl.Controls
        Select Case UCase(TypeName(lo_Control))
        Case "ARMCOMBOBOX"
            Set lo_Control.ArmDb = mo_Db
            Call lo_Control.Load_A_COM
        Case "ARMPICKER"
            Set lo_Control.ArmDb = mo_Db
            Call lo_Control.Load_A_COM
        Case "TOOLBARCONTROL"
            lo_Control.Language = ms_Language_Code
            lo_Control.HideTips = True
            lo_Control.Load_A_COM
        Case "ARMGRID"
            Set lo_Control.ArmDb = mo_Db
            Call lo_Control.Load_A_COM
        Case "ARMTREEVIEW"
            Set lo_Control.ArmDb = mo_Db
            lo_Control.Language = ms_Language_Code
            Call lo_Control.Load_A_COM
        Case "ARMCHECKVIEW"
            Set lo_Control.ArmDb = mo_Db
            Call lo_Control.Load_A_COM
        Case "A_CALOCX"
            lo_Control.Language = ms_Language_Code
            Call lo_Control.reinit_cal
        End Select
    Next
    
    ReDim Preserve mua_ActiveMode(0)
    mua_ActiveMode(UBound(mua_ActiveMode)) = ArmScreenMode.smMain
    
    Set mo_dataSrc = New Dictionary
    mo_dataSrc.CompareMode = TextCompare

    ' init controls
    
    ReDim moa_ListFieldsMandatory(0 To 1)
    moa_ListFieldsMandatory(0) = Array(txt_authMarket, 0)
    moa_ListFieldsMandatory(1) = Array(txt_productGroup, 1)
    
    
    InitMandatoryLabels (moa_ListFieldsMandatory)
     
    Call FillControlArray(moa_ListFieldsToDisable, Array(txt_authMarket, txt_productGroup))
    
    Call InitComponents
    
    Call LoadLabels(UserControl.Controls, C_SCREENNAME, ms_Language_Code)
    Call ChangeCharset(UserControl.Controls, GetCodePageFromLanguage(mo_Db, ms_Language_Code))
    
    Call Components_Settings
    
    ' set layout
    Call InitCtrlSize
    
    mb_Initialized = True

    ' display starting face
    Call UpdateUI(ArmScreenMode.smMain)
    
    Exit Sub
ErrHandler:
    Call ErrorMessage(Extender.Name & ".Load_A_Com()")
End Sub

Private Sub FillControlArray(ByRef ao_ctrlArray() As Control, ByRef ao_array As Variant)
On Error GoTo ErrHandler
    Dim ll_i As Long
    If Not IsArray(ao_array) Then
        Exit Sub
    End If
    
    ReDim ao_ctrlArray(LBound(ao_array) To UBound(ao_array)) As Control
    
    For ll_i = LBound(ao_array) To UBound(ao_array)
        Set ao_ctrlArray(ll_i) = ao_array(ll_i)
    Next

    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".FillControlArray()")
End Sub

Public Sub Unload_A_COM()
Dim lo_Control As Object
On Error GoTo ErrHandler
    If Not Initialized Then Call Err.Raise(ArmErr.CPTNotInitialized)
    
    For Each lo_Control In UserControl.Controls
        Select Case UCase(TypeName(lo_Control))
        Case "ARMCOMBOBOX", "TOOLBARCONTROL", "ARMGRID", "ARMTREEVIEW", "ARMCHECKVIEW", "ARMPICKER"
            Call lo_Control.Unload_A_COM
        End Select
    Next
    
    Set mo_Db = Nothing
    Exit Sub
ErrHandler:
    Call ErrorMessage(Extender.Name & ".Unload_A_Com()")
End Sub

Private Sub Components_Settings()
On Error GoTo ErrHandler

    Call Component_SetUp(txt_authMarket, "SPM_SDesc" & SEP & "Text")
    Call Component_SetUp(txt_SPM_Code, "SPM_Code" & SEP & "Num")
    
    Call Component_SetUp(txt_productGroup, "SPG_SDesc" & SEP & "Text")
    Call Component_SetUp(chk_inclSpecialProducts, "chk_inclSpecPrd" & SEP & "Text")

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

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

On Error GoTo ErrHandler
    
    ao_cpt.Tag = as_Tag
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("Component_SetUp")
End Sub

Private Sub UpdateUI(Optional ByVal au_Mode As ArmScreenMode = ArmScreenMode.smRefreshOnly)
On Error GoTo ErrHandler

    ' set active face
    If au_Mode <> smRefreshOnly Then
        If UBound(mua_ActiveMode) = C_SCREENMODE_STACK_SIZE - 1 Then
            ' move array left
            Debug.Print ("Stack is too small. Increase C_SCREENMODE_STACK_SIZE constant please.")
            Dim ll_Index As Long
            For ll_Index = 1 To UBound(mua_ActiveMode)
                mua_ActiveMode(ll_Index - 1) = mua_ActiveMode(ll_Index)
            Next
        Else
            ' allocate one more item
            ReDim Preserve mua_ActiveMode(UBound(mua_ActiveMode) + 1)
        End If
        mua_ActiveMode(UBound(mua_ActiveMode)) = au_Mode
    End If

    tlb_Main.Redraw = False

    ' hide all frames
    fra_detail.Visible = False
    tlb_Main.Visible = False

    ' we have clean screen we can display proper controls
    Select Case activeScreenMode
        Case smMain
        Case smAdd
            fra_detail.Visible = True
            tlb_Main.Visible = True
            Call tlb_Main.DisplayFace(C_TOOLBARFACE_ITEM_ADD)
        Case Else
            Debug.Assert (False)
    End Select
    
    ' todo:apply rights on toolbar
    Call UpdateMainToolbar

    tlb_Main.Redraw = True

    ' to display face immidiatelly
    UserControl.Refresh
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".UpdateUI()")
End Sub

' ************************************************************************************
' **************************** FRAMEWORK FUNCTIONS ***********************************
' ************************************************************************************

Private Property Get activeScreenMode(Optional ByVal al_fromTop As Long = 0) As ArmScreenMode
On Error GoTo ErrHandler
    Debug.Assert (IsArray(mua_ActiveMode))
    activeScreenMode = mua_ActiveMode(UBound(mua_ActiveMode) - al_fromTop)
    Exit Property
ErrHandler:
     Call ErrorHandler(Extender.Name & ".activeScreenMode(Get)")
End Property

Private Sub popScreenMode()
On Error GoTo ErrHandler
    Debug.Assert (UBound(mua_ActiveMode) >= 1)
    ReDim Preserve mua_ActiveMode(UBound(mua_ActiveMode) - 1)
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".popScreenMode")
End Sub

Private Sub popScreenModeUntil(ByVal ae_goTo As ArmScreenMode)
On Error GoTo ErrHandler
    While activeScreenMode <> ae_goTo
        Call popScreenMode
    Wend
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".popScreenModeUntil")
End Sub


Private Sub InitComponents()
Const CL_REQUEST_TB As String = "A_ToolbarDef_sel 1, 2422, 2823, $id$"
Const VIEW_REQUEST = "exec TreeView_View_t_lst $ViewCode$,$Language_Code$"

On Error GoTo ErrHandler
    Dim lo_ctrl As Object
    Dim ll_cursor As Long
    Dim ll_i As Long
    
    'JP experimental frame
    frm_JP_Experimental.Visible = (ms_LoginName = "JPTROVO")

    ' main toolbar
    ll_cursor = OpenSQLSafe(mo_Db, Replace(CL_REQUEST_TB, "$id$", "NULL"))
    If mo_Db.Find(ll_cursor, "id", TLB_SPA_PG_MKT_BI_ID) >= 0 Then
        Call tlb_Main.SetToolbarInfoStringParameters(mo_Db.GetFields(ll_cursor, "info"), Left(mo_Db.GetFields(ll_cursor, "info"), 3))
    Else
        Call Err.Raise(ArmErr.InvalidArgument, "mo_Db.Find", "Toolbar id(" & TLB_SPA_PG_MKT_BI_ID & ") not found in DB")
    End If

    Call mo_Db.Close(ll_cursor)
    ll_cursor = 0
    
    grd_productAvail.MultiSelect = True
    grd_productAvail.Title = "#Available items"
    grd_productAvail.AllowExcelExport = True
    grd_productAvail.ExportTitles = True
    grd_productAvail.ExportOnlyVisibleColumns = True
    Call grd_productAvail.SetColumns(Array( _
          Join(Array("BI_SAP_Code", 1200, 1, "BI_SAP_Code", "#SAP Code", "String", "", "Left"), SEP) _
        , Join(Array("BI_Desc", 6000, 0, "BI_Desc", "#BI Desc", "String", "", "Left"), SEP) _
        , Join(Array("BI_SHORT_code", 1600, 0, "BI_SHORT_code", "#Short code", "String", "", "Left"), SEP) _
        , Join(Array("VDate_End", 0, 0, "VDate_End", "#Used until", "Date", "", "Left"), SEP) _
        , Join(Array("VDate_Free", 1200, 0, "VDate_Free", "#Free from", "Date", "", "Left"), SEP) _
        , Join(Array("change", 0, 0, "change", "", "String", "", "Left"), SEP) _
        ))
    
    grd_productLinked.MultiSelect = True
    grd_productLinked.Title = "#Linked items"
    grd_productLinked.AllowExcelExport = True
    grd_productLinked.ExportTitles = True
    Call grd_productLinked.SetColumns(Array( _
          Join(Array("BI_SAP_Code", 1200, 1, "BI_SAP_Code", "#SAP CODE", "String", "", "Left"), SEP) _
        , Join(Array("BI_Desc", 6000, 0, "BI_Desc", "#BI Desc", "String", "", "Left"), SEP) _
        , Join(Array("BI_SHORT_code", 1600, 0, "BI_SHORT_code", "#Short code", "String", "", "Left"), SEP) _
        , Join(Array("VDate_End", 0, 0, "VDate_End", "#Used until", "Date", "", "Left"), SEP) _
        , Join(Array("VDate_Free", 1200, 0, "VDate_Free", "#Free from", "Date", "", "Left"), SEP) _
        , Join(Array("change", 0, 0, "change", "", "String", "", "Left"), SEP) _
        ))
    
    Dim ls_req As String
    ls_req = ReplacePlaceHolder(VIEW_REQUEST, "$ViewCode$", SQLStr(C_SCREENNAME))
    ls_req = ReplacePlaceHolder(ls_req, "$Language_Code$", SQLStr(ms_Language_Code))
    
    cbo_View.Request = ls_req
    Call cbo_View.Load
    If cbo_View.Count = 0 Then
        cbo_View.Visible = False
    Else
        Dim ll_Idx As Long, ll_Count As Long
        ll_Count = cbo_View.Count - 1
        ReDim mt_TreeViewInfos(ll_Count)
        For ll_Idx = 0 To ll_Count
            mt_TreeViewInfos(ll_Idx).Loaded = False
            mt_TreeViewInfos(ll_Idx).TreeViewCode = cbo_View.ComboItems(ll_Idx + 1).Key
        Next
        
        Call cbo_View.SearchItem("X", "TV_Default", 0)
    End If
    
    cmd_TVReLoad.Picture = LoadIconFromA_Icons(ICON_RELOAD)
    cmd_add_to_linked.Picture = LoadIconFromA_Icons(ICON_DOWN)
    cmd_remove_from_linked.Picture = LoadIconFromA_Icons(ICON_UP)
    Call SetTreeDelayedMode(True)
    
    Exit Sub
ErrHandler:
    If ll_cursor <> 0 Then
        Call mo_Db.Close(ll_cursor)
        ll_cursor = 0
    End If
    Call ErrorHandler(Extender.Name & ".InitComponents()")
End Sub

Private Sub InitMandatoryLabels(ByRef av_ListFieldsMandatory As Variant)
On Error GoTo ErrHandler

Dim ll_Index As Long
Dim lo_Label As Label

    For ll_Index = 0 To UBound(av_ListFieldsMandatory)
        If av_ListFieldsMandatory(ll_Index)(1) >= 0 Then
            Set lo_Label = lbl_Label(av_ListFieldsMandatory(ll_Index)(1))
            lo_Label.FontBold = True
        End If
    Next
    Exit Sub
ErrHandler:
    Call ErrorHandler("InitMandatoryLabels")
End Sub

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

    as_Request = ReplacePlaceHolder(as_Request, "$language_code$", SQLStr(ms_Language_Code))
    as_Request = ReplacePlaceHolder(as_Request, "$Z_Creator$", SqlInt(ml_U_Code))
    as_Request = ReplacePlaceHolder(as_Request, "$U_Code$", SqlInt(ml_U_Code))
    as_Request = ReplacePlaceHolder(as_Request, "$Z_Last_Upd_User$", SqlInt(ml_U_Code))
    ReplaceCommonPlaceholders = as_Request
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".ReplaceCommonPlaceholders")
End Function

Private Function ReplacePlaceHolder(ByVal as_Request As String, ByVal as_PlaceHolder As String, ByVal as_DefaultValue As String) As String
On Error GoTo ErrHandler
    
    ReplacePlaceHolder = Replace(as_Request, as_PlaceHolder, as_DefaultValue, , , vbTextCompare)

    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".ReplacePlaceholder")
End Function
Private Sub InitCtrlSize()
On Error GoTo ErrHandler
Const c_margin As Long = 60
    ' ??????????
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".InitCtrlSize()")
End Sub

Private Sub LoadDataToForm(ByRef as_detailData As Dictionary, 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 as_detailData.Exists(lValues(0)) Then
                                Select Case lValues(1)
                                    Case "Text"
                                        lControl.Text = as_detailData(lValues(0))
                                    Case "Num"
                                        lControl.Text = Replace(as_detailData(lValues(0)), ms_DecimalSeparator, ".", , , vbTextCompare)
                                    Case "Date"
                                        If as_detailData(lValues(0)) = "00:00:00" Or as_detailData(lValues(0)) = "" Then
                                            lControl.Text = ""
                                        Else
                                            lControl.Text = Format(as_detailData(lValues(0)), "dd\/mm\/yyyy")
                                        End If
                                End Select
                            End If
                    
                    Case "ARMCOMBOBOX"
                        ls_TempTag = lControl.Tag & SEP
                        lValues = Split(ls_TempTag, SEP)
                        If as_detailData.Exists(lValues(0)) Then
                            If as_detailData(lValues(0)) = 0 Or as_detailData(lValues(0)) = "" Then
                                Set lControl.SelectedItem = Nothing
                            Else
                                If lControl.SearchItem(as_detailData(lValues(0)), 0, 0, True) = False Then
                                    If lControl.AddItem(Array(as_detailData(lValues(0)), as_detailData(lValues(1))), True) Is Nothing Then
                                        Err.Raise 2222, "", ""
                                    End If
                                End If
                            End If
                        End If
                        
                    Case "OPTIONBUTTON"
                        lValues = Split(lControl.Tag, SEP)
                        If as_detailData.Exists(lValues(0)) Then
                            If UCase(lValues(2)) Like UCase(as_detailData(lValues(0))) Then
                                lControl.Value = True
                            End If
                        End If
                        
                    Case "CHECKBOX"
                        If as_detailData.Exists(lControl.Tag) Then
                            If UCase(as_detailData(lControl.Tag)) Like "X" Then
                                lControl.Value = vbChecked
                            Else
                                lControl.Value = vbUnchecked
                            End If
                        End If
                        
                    Case "A_CALOCX"
                        lControl.date_courte = as_detailData(lControl.Tag)
                        
                    Case "LABEL", "FRAME", "DIRLISTBOX", "FILELISTBOX", "DRIVELISTBOX", "TOOLBARCONTROL", "COMMANDBUTTON"
                        'Do Nothing
                    
                    Case "ARMGRID"
                        ' LOAD GRID
                    Case "ARMPICKER"
                        ls_TempTag = lControl.Tag & SEP
                        lValues = Split(ls_TempTag, SEP)
                        If as_detailData.Exists(lValues(0)) Then
                            lControl.ItemCode = as_detailData(lValues(0))
                            lControl.ItemDescription = as_detailData(lValues(1))
                            If lControl.ItemCode = "0" And lControl.ItemDescription = "" Then lControl.ItemCode = ""
                        End If
                    
                    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

' Load the labels of a containers
Private Sub LoadLabels(ByRef aControls As Variant, ByVal as_ScreenName As String, ByVal as_Language As String)

On Error GoTo ErrHandler

    Dim lIdx As Long, lCount As Long, lLabels As Long
    Dim lControl As Control
    
    lLabels = OpenSQLSafe(mo_Db, "exec Screen_Csts '" & as_ScreenName & "','" & as_Language & "'")
    Debug.Assert (lLabels <> 0)
    
    lCount = aControls.Count - 1
    
    For lIdx = 0 To lCount
        Set lControl = aControls.Item(lIdx)
            Select Case UCase(TypeName(lControl))
                Case "LABEL", "FRAME", "COMMANDBUTTON", "OPTIONBUTTON", "MENU", "CHECKBOX"
                    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
                        ' once translation is done and control is not in array CLEAR tag
                        If Not TypeOf lControl Is Frame And Not TypeOf lControl Is Label Then
                            lControl.Tag = ""
                        End If
                    End If
                Case "ARMGRID"
                    If mo_Db.Find(lLabels, "FIELD_NAME", lControl.Tag, , 1) >= 0 Then
                      Call lControl.LoadConstants(ptStatic, mo_Db.GetFields(lLabels, "LOCAL_TEXT"), ctColumns)
                        End If
                    If mo_Db.Find(lLabels, "FIELD_NAME", lControl.Tag & "_Title", , 1) >= 0 Then
                      lControl.Title = mo_Db.GetFields(lLabels, "LOCAL_TEXT")
                    End If
                Case "TABSTRIP"
                    If mo_Db.Find(lLabels, "FIELD_NAME", lControl.Tag, , 1) >= 0 Then
                        Dim lsa_TextArr() As String
                        Dim ll_Index As Long
                        
                        lsa_TextArr = Split(mo_Db.GetFields(lLabels, "LOCAL_TEXT"), SEP)
                        
                        For ll_Index = LBound(lsa_TextArr, 1) To UBound(lsa_TextArr, 1)
                            lControl.Tabs(ll_Index + 1).Caption = lsa_TextArr(ll_Index)
                        Next
                    End If
                    ' once translation is done and control is not in array CLEAR tag
                    lControl.Tag = ""
                Case "MSFLEXGRID", "TOOLBARCONTROL", "TEXTBOX", "ARMCHECKVIEW", "ARMCOMBOBOX", "A_CALOCX", "OPTIONBUTTON", "ARMTREEVIEW", "LISTBOX", "PICTUREBOX", "TOOLBR", "SPINBUTTON"
                    ' Do nothing !
                Case Else
                    'debug.print "LoadLabels " & UCase(TypeName(lControl))
            End Select
        Set lControl = Nothing
    Next
    
    ' SPECIAL INITIALIZATION
    ' Title
    If mo_Db.Find(lLabels, "FIELD_NAME", "title", , 1) >= 0 Then
        ms_Title = mo_Db.GetFields(lLabels, "LOCAL_TEXT")
    End If

    Call mo_Db.Close(lLabels)

    Exit Sub

ErrHandler:
    If lLabels > 0 Then
        Call mo_Db.Close(lLabels)
    End If
    Call ErrorHandler(Extender.Name & ".LoadLabels")
End Sub

Private Function GetContainedControlsChain(ByVal ao_parent As Object) As Collection
On Error GoTo ErrHandler
    Dim lo_retCollection As New Collection
    Dim lo_Control As Object
    
    For Each lo_Control In Controls
        If Not TypeOf lo_Control.Container Is SPA_Admin_PG_MKT_BI Then
            If ao_parent.hwnd = lo_Control.Container.hwnd Then
                If TypeOf lo_Control Is Frame Then
                    Dim lo_aux_collection As New Collection
                    Dim ll_i As Long
                    Set lo_aux_collection = GetContainedControlsChain(lo_Control)
                    For ll_i = 1 To lo_aux_collection.Count
                        lo_retCollection.Add (lo_aux_collection.Item(ll_i))
                    Next
                Else
                    Call lo_retCollection.Add(lo_Control)
                End If
            End If
        End If
    Next
    Set GetContainedControlsChain = lo_retCollection
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".GetContainedControlsChain()")
End Function

' as_Name equals to Tag definition string

Private Function GetControl(ByVal ao_array As Object, ByVal as_Name As String) As Object
On Error GoTo ErrHandler
    Dim lo_ctrl As Object
    For Each lo_ctrl In ao_array
        If StrComp(lo_ctrl.Tag, as_Name, vbTextCompare) = 0 Then
            Set GetControl = lo_ctrl
            Exit For
        End If
    Next
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".GetControl()")
End Function

Private Sub SetEnabled(ByVal ao_srcCtrl As Object, ByVal ab_Value As Boolean)
On Error GoTo ErrHandler
    Dim lo_ctrl As Object
    For Each lo_ctrl In ao_srcCtrl
        Call SetEnabledCtrl(lo_ctrl, ab_Value)
    Next
    Exit Sub
ErrHandler:
     Call ErrorHandler(Extender.Name & ".SetEnabled()")
End Sub

Private Sub SetEnabledCtrl(ByRef ao_ctrl As Control, ByVal ab_Value As Boolean)
On Error GoTo ErrHandler
        Select Case UCase(TypeName(ao_ctrl))
        Case "TEXTBOX"
            ao_ctrl.Locked = Not ab_Value
            ao_ctrl.BackColor = IIf(ab_Value, CL_COLOR_ENABLED, CL_COLOR_DISABLED)
        Case "TABSTRIP", "A_CALOCX", "ARMGRID", "ARMCOMBOBOX", "FRAME", "DIRLISTBOX", "DRIVELISTBOX", "FILELISTBOX", "OPTIONBUTTON", "ARMTREEVIEW", "COMMANDBUTTON", "PICTUREBOX", "CHECKBOX", "IMAGECOMBO"
            ao_ctrl.Enabled = ab_Value
        End Select
    Exit Sub
ErrHandler:
     Call ErrorHandler(Extender.Name & ".SetEnabledCtrl()")
End Sub


' loads values from cursor into form. if cursor=0 then reset whole detail
Private Sub Item_LoadValues(ByRef as_detailData As Dictionary)
On Error GoTo ErrHandler
    Dim ls_req As String
    mb_Initializing = True
    
    ' load main record
    Call LoadDataToForm(as_detailData, UserControl.Controls, Me)
    
    mb_Initializing = False

    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_LoadValues")
End Sub


' clear all controls values
Private Sub Item_Clear()
On Error GoTo ErrHandler
    mb_Initializing = True
    Call ClearForm(UserControl.Controls, fra_detail, Array(grd_productAvail, cbo_View))
    mb_Initializing = False
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_Clear")
End Sub


' initialize update mode
Private Sub Item_AddInit(ByRef ao_detailData As Dictionary)
On Error GoTo ErrHandler
    ' clearing form
    Call ResetScreen(ArmScreenMode.smAdd)
    Call Item_Clear
    
    If ao_detailData.Exists("Z_Creation") Then
        ao_detailData("Z_Creation") = Format(Now, "DD/MM/YYYY")
    Else
        Call ao_detailData.Add("Z_Creation", Format(Now, "DD/MM/YYYY"))
    End If
    Call Item_LoadValues(ao_detailData)
        
    Call cmd_TVReLoad_Click
    
    Call SetTreeDelayedMode(True)

    Call UpdateUI(ArmScreenMode.smAdd)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_AddInit")
End Sub

' workw with smView, smUpdate and smDelete mode
Private Sub Item_Restore(ByRef as_detailData As Dictionary)
On Error GoTo ErrHandler
    ' clearing form
    Call ResetScreen(activeScreenMode)
    Call Item_Clear
    
    Call Item_LoadValues(as_detailData)
    
    RaiseEvent OnItemRestore
    
    Call grd_productAvail.Refresh
    
    Call UpdateUI

    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_Restore")
End Sub

' adds current edited item
Private Sub Item_Add()
On Error GoTo ErrHandler

    ' check values and throw message if neccessary
    If Not Item_Check() Then
        Exit Sub
    End If
    
    RaiseEvent OnItemAdd

    Call Item_Exit
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_Add")
End Sub

Private Sub ClearData(ByRef ao_data As Dictionary, aa_exceptions As Variant)
On Error GoTo ErrHandler
    Dim ll_i As Long
    Dim lv_Keys As Variant
    lv_Keys = ao_data.keys
    For ll_i = LBound(lv_Keys) To UBound(lv_Keys)
        If Not ContaintValue(aa_exceptions, lv_Keys(ll_i)) Then
            Call ao_data.Remove(lv_Keys(ll_i))
        End If
    Next

    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".ClearData")
End Sub

Private Function ContaintValue(ByRef aa_array As Variant, ByVal as_Value As String) As Boolean
On Error GoTo ErrHandler
    ContaintValue = False
    Dim ll_i As Long
    For ll_i = LBound(aa_array) To UBound(aa_array)
        If aa_array(ll_i) = as_Value Then
            ContaintValue = True
            Exit For
        End If
    Next
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".ContaintValue")
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", "Date"
                                    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"
        
                        If Not lControl.SelectedItem Is Nothing Then
                            ls_SrzString = ls_SrzString & lValues(0) & SEP1 & lControl.SelectedItem.Key & SEP
                            ls_SrzString = ls_SrzString & lValues(1) & SEP1 & lControl.SelectedItem.GetData(1) & SEP
                        Else
                            ls_SrzString = ls_SrzString & lValues(0) & SEP1 & "NULL" & SEP
                            ls_SrzString = ls_SrzString & lValues(1) & SEP1 & "" & SEP
                        End If
                    Case "OPTIONBUTTON"
                        
                    Case "CHECKBOX"
                    Dim a As CheckBox
                        ls_SrzString = ls_SrzString & lValues(0) & SEP1 & IIf(lControl.Value = vbChecked, "X", "") & SEP

                    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 "ARMPICKER"
                        ls_SrzString = ls_SrzString & lValues(0) & SEP1 & lControl.ItemCode & SEP
                        ls_SrzString = ls_SrzString & lValues(1) & SEP1 & lControl.ItemDescription & SEP
                    
                    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:
    Call ErrorHandler("Build_SrzString")
End Function

Private Sub FillDataSrcArray(ByRef ao_dataSrc As Dictionary, ByVal as_SrzFields As String)
On Error GoTo ErrHandler
    
    Dim ll_i As Long
    Dim lsa_DataFields() As String
    Dim lv_Values As Variant
    Call ao_dataSrc.RemoveAll
    lsa_DataFields = Split(as_SrzFields, SEP)
    
    For ll_i = LBound(lsa_DataFields) To UBound(lsa_DataFields)
        lv_Values = Split(lsa_DataFields(ll_i), SEP1)
        If UBound(lv_Values) >= 1 Then
            If Not ao_dataSrc.Exists(lv_Values(0)) Then Call ao_dataSrc.Add(lv_Values(0), lv_Values(1))
        End If
    Next
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("FillDataSrcArray")
End Sub

Private Sub SetCheckBoxDB(ByVal al_cursor As Long, ByVal as_keyField As String, ByRef ao_CheckBox As VB.CheckBox, Optional ByVal as_checked As String = "X")
On Error GoTo ErrHandler
    Dim lv_val As Variant
    lv_val = mo_Db.GetFields(al_cursor, as_keyField)
    If Not IsEmpty(lv_val) Then
        ao_CheckBox.Value = IIf(lv_val = as_checked, vbChecked, vbUnchecked)
    Else
        ao_CheckBox.Value = vbUnchecked
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SetCheckBoxDB")
End Sub


Private Sub SetComboBoxTextDB(ByVal al_cursor As Long, ByVal as_keyField As String, ByVal as_DescField As String, ByRef ao_Combobox As ArmCombobox, Optional ByVal ab_clearIfNotExists As Boolean = True)
On Error GoTo ErrHandler
    Dim lv_val As Variant
    lv_val = mo_Db.GetFields(al_cursor, CVar(Array(as_keyField, as_DescField)))
    If Not IsEmpty(lv_val) Then
        Debug.Assert (UBound(lv_val) = 1)
        Call SetComboBoxText(ao_Combobox, CStr(lv_val(0)), CStr(lv_val(1)))
    Else
        If ab_clearIfNotExists Or mo_Db.GetFieldIndex(al_cursor, as_keyField) <> -1 Then
            Call ao_Combobox.Clear
        End If
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SetComboBoxTextDB")
End Sub

' Sets combobox selected item
' Params:
' ao_ComboBox (ArmCombobox)
' as_Key (String)
' as_Desc (String)
Private Sub SetComboBoxText(ByRef ao_Combobox As ArmCombobox, ByVal as_Key As String, ByVal as_Desc As String)
On Error GoTo ErrHandler
    If Not ao_Combobox.SearchItem(as_Key) Then
        ' key not found ... set value from parameter
        If as_Key = "" Or as_Key = "0" Then     ' zero or empty string is not valid key
            Set ao_Combobox.SelectedItem = Nothing
        Else
            Call ao_Combobox.AddItem(Array(as_Key, as_Desc), True)
            ' to make vb raise event
            Call ao_Combobox.SearchItem(as_Key)
        End If
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SetComboBoxText")
End Sub

' exits mode to main
Private Sub Item_Exit()
On Error GoTo ErrHandler
    
    ' pop last item in screen mode stack
    Call popScreenModeUntil(smMain)
    
    Call ResetScreen(activeScreenMode)
    Call UpdateUI
    
    RaiseEvent OnExit
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_ExitToGrid")
End Sub

Private Function Item_Check() As Boolean
On Error GoTo ErrHandler
        
    Dim lv_MsgReplaceInfo(0, 1) As String
    Dim lo_Control As Object
    Dim ls_LabelCaption As String
    Dim ll_CtrlIndex As Long
    Dim lb_Found As Boolean
    Dim lo_mandatoryField As Variant
    
    If Not IsArray(moa_ListFieldsMandatory) Then
        Item_Check = True
        Exit Function
    End If
    
    For Each lo_mandatoryField In moa_ListFieldsMandatory
        Set lo_Control = lo_mandatoryField(0)
        If lo_mandatoryField(1) >= 0 Then
            ls_LabelCaption = lbl_Label(lo_mandatoryField(1)).Caption
        Else
            ls_LabelCaption = ""
        End If
        Select Case UCase(TypeName(lo_Control))
            Case "FRAME", "LABEL", "MSFLEXGRID", "TOOLBARCONTROL"
                ' Do nothing !
            
            Case "TEXTBOX"
                If lo_Control.Visible And (lo_Control.Text = "") Then
                    lv_MsgReplaceInfo(0, 0) = "$LabelCaption$"
                    lv_MsgReplaceInfo(0, 1) = ls_LabelCaption
                    Call MsgBox(MsgText(2120, ms_Language_Code, "The field " & lv_MsgReplaceInfo(0, 1) & " is mandatory.", lv_MsgReplaceInfo), vbInformation)
                    lo_Control.SetFocus
                    Exit Function
                End If
            Case "ARMCHECKVIEW"
                 If lo_Control.Visible And (lo_Control.RoleList("EDIT").CheckedCount = 0) Then
                    lv_MsgReplaceInfo(0, 0) = "$LabelCaption$"
                    lv_MsgReplaceInfo(0, 1) = ls_LabelCaption
                    Call MsgBox(MsgText(2120, ms_Language_Code, "The field " & lv_MsgReplaceInfo(0, 1) & " is mandatory.", lv_MsgReplaceInfo), vbInformation)
                    Call lo_Control.SetFocus
                    Exit Function
                  End If
            Case "ARMGRID", "ARMCHECKVIEW", "COMMANDBUTTON", "A_CALOCX", "ARMTREEVIEW", "LISTBOX", "PICTUREBOX", "TABSTRIP"
            Case "OPTIONBUTTON", "CHECKBOX"
                'probably array of controls
            Case "OBJECT"
                lb_Found = False
                For ll_CtrlIndex = 0 To lo_Control.Count - 1
                    If UCase(TypeName(lo_Control(ll_CtrlIndex))) = "CHECKBOX" Then
                        If lo_Control(ll_CtrlIndex).Value = vbChecked Then
                            lb_Found = True
                            Exit For
                        End If
                    ElseIf UCase(TypeName(lo_Control(ll_CtrlIndex))) = "OPTIONBUTTON" Then
                        If lo_Control(ll_CtrlIndex).Value Then
                            lb_Found = True
                            Exit For
                        End If
                    Else
                        ' unknown array ???
                        lb_Found = True
                        Exit For
                    End If
                Next
                If Not lb_Found Then
                    lv_MsgReplaceInfo(0, 0) = "$LabelCaption$"
                    lv_MsgReplaceInfo(0, 1) = ls_LabelCaption
                    Call MsgBox(MsgText(2120, ms_Language_Code, "The field " & lv_MsgReplaceInfo(0, 1) & " is mandatory.", lv_MsgReplaceInfo), vbInformation)
                    Exit Function
                End If
            Case "ARMCOMBOBOX"
                If lo_Control.Visible And (lo_Control.SelectedItem Is Nothing) Then
                    lv_MsgReplaceInfo(0, 0) = "$LabelCaption$"
                    lv_MsgReplaceInfo(0, 1) = ls_LabelCaption
                    Call MsgBox(MsgText(2120, ms_Language_Code, "The field " & lv_MsgReplaceInfo(0, 1) & " is mandatory.", lv_MsgReplaceInfo), vbInformation)
                    Call lo_Control.SetFocus
                    Exit Function
                End If
            Case "ARMPICKER"
                If lo_Control.Visible And (CStr(lo_Control.ItemCode) = "") Then
                    lv_MsgReplaceInfo(0, 0) = "$LabelCaption$"
                    lv_MsgReplaceInfo(0, 1) = ls_LabelCaption
                    Call MsgBox(MsgText(2120, ms_Language_Code, "The field " & lv_MsgReplaceInfo(0, 1) & " is mandatory.", lv_MsgReplaceInfo), vbInformation)
                    lo_Control.SetFocus
                    Exit Function
                End If
            Case "LISTVIEW"
                 If lo_Control.Visible And (GetCheckedCount(lo_Control) = 0) Then
                    lv_MsgReplaceInfo(0, 0) = "$LabelCaption$"
                    lv_MsgReplaceInfo(0, 1) = ls_LabelCaption
                    Call MsgBox(MsgText(2120, ms_Language_Code, "The field " & lv_MsgReplaceInfo(0, 1) & " is mandatory.", lv_MsgReplaceInfo), vbInformation)
                    Call lo_Control.SetFocus
                    Exit Function
                  End If
            Case Else
                Debug.Print "Item_CheckMandatory " & UCase(TypeName(lo_Control))
        End Select
    Next

    Item_Check = True

    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_Check")
End Function

Private Function GetCheckedCount(ByRef ao_ListView As MSComctlLib.ListView) As Long
On Error GoTo ErrHandler

Dim lo_item As MSComctlLib.ListItem
Dim ll_Count As Long

    ll_Count = 0
    For Each lo_item In ao_ListView.ListItems
        If lo_item.Checked Then ll_Count = ll_Count + 1
    Next
    GetCheckedCount = ll_Count
    Exit Function
ErrHandler:
    Call ErrorHandler("GetCheckedCount")
End Function

Private Sub SetFocusToCtrl(ByRef ao_ctrl As Object)
On Error GoTo ErrHandler
    If ao_ctrl.Visible Then
        ao_ctrl.SetFocus
    End If
    Exit Sub
ErrHandler:
    Call ErrorMessage(Extender.Name & ".SetFocusToCtrl")
End Sub

Private Sub LockScreen(ByVal ab_lock As Boolean)

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

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

Private Sub ResetScreen(ByVal au_Mode As ArmScreenMode)
On Error GoTo ErrHandler
    ' apply face
    Dim lo_ctrl As Object

    Select Case au_Mode
        Case smMain
            ' enable filtering a browsing
            Call SetEnabled(GetContainedControlsChain(fra_detail), False)
            
        Case smAdd
            ' we are in Update section
            Call SetEnabled(GetContainedControlsChain(fra_detail), True)
            
            
            Dim lIdx As Long, lCount As Long
            
            If IsArray(moa_ListFieldsToDisable) Then
                lCount = UBound(moa_ListFieldsToDisable)
            
                For lIdx = 0 To lCount
                    Call SetEnabledCtrl(moa_ListFieldsToDisable(lIdx), False)
                Next
            End If
        Case Else
            Debug.Assert (False)
    End Select

    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".ResetScreen()")
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 Function IsSub(ByVal av_Name As Object, ByRef aav_Names As Variant)
On Error GoTo ErrHandler
    IsSub = False
    
    Dim ll_Idx As Long
    For ll_Idx = LBound(aav_Names) To UBound(aav_Names)
    
        If av_Name Is aav_Names(ll_Idx) Then
            IsSub = True
            Exit Function
        End If
    Next ll_Idx
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".IsSub")
End Function

' Clear values for each control to not initiliazed
Private Sub ClearForm(ByRef aControls As Variant, ByRef aContainer As Object, Optional ByRef aav_Except As Variant)
On Error GoTo ErrHandler
 
    'mb_internal = True
 
    Dim lIdx As Long, lCount As Long, lControl As Object
    lCount = aControls.Count - 1
    For lIdx = 0 To lCount
        Dim lb_Process As Boolean
        lb_Process = True
        Set lControl = aControls.Item(lIdx)
        If Not IsMissing(aav_Except) Then
            If IsSub(lControl, aav_Except) Then
                lb_Process = False
            End If
        End If
        If HasContainer(lControl, aContainer) And lb_Process Then
            Select Case UCase(TypeName(lControl))
                Case "TEXTBOX"
                    lControl.Text = ""
                Case "ARMCOMBOBOX"
'                    Set lControl.SelectedItem = Nothing
                    Call lControl.Clear
                Case "A_CALOCX"
                    lControl.reinit_cal
                Case "CHECKBOX"
                    lControl.Value = vbUnchecked
                Case "ARMCHECKVIEW"
                    lControl.UnCheckAll lControl.GetVisibleList
                    Dim ll_Idx As Long
                    For ll_Idx = 1 To lControl.RoleCount
                        lControl.RoleList(ll_Idx).ClearList
                    Next
                    lControl.SetVisibleList lControl.GetVisibleList
                    
                Case "FRAME", "LABEL", "TOOLBARCONTROL", "PICTUREBOX", "COMMANDBUTTON"
 
                Case "ARMGRID"
                    lControl.ClearGrid
                Case "LISTBOX"
                    lControl.ListIndex = -1
                Case "OPTIONBUTTON"
                    lControl.Value = False
                Case "TABSTRIP", "DRIVELISTBOX", "DIRLISTBOX", "FILELISTBOX", "TOOLBARCONTROL", "LINE"
                
                Case "ARMPICKER"
                    Call lControl.Clear
                
                Case Else
                    Debug.Print "ClearForm " & UCase(TypeName(lControl))
            End Select
        End If
 
        Set lControl = Nothing
    Next
 
   ' mb_internal = False
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".ClearForm")
End Sub

' ************************************************************************************
' **************************** DB-ACCESS FUNCTIONS ***********************************
' ************************************************************************************
#If LIVE = 1 Then
Private Sub ExecuteSQLSafe(ByVal ao_DB As Object, ByVal as_Request As String, Optional ByVal al_RowAffectedCount = -1)
#Else
Private Sub ExecuteSQLSafe(ByVal ao_DB As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional ByVal al_RowAffectedCount = -1)
#End If
On Error GoTo ErrHandler
    ' First execute the request
    If Not ao_DB.ExecuteSQL(as_Request) Then
        Call Err.Raise(CompFncFailed, "ao_Db.ExecuteSQL - " & "SQL : " & as_Request, "SQL Error: " & GetDbError(ao_DB))
    End If

    If al_RowAffectedCount <> -1 Then
        ' Then check the rowcount
        If ao_DB.SQLRowsAffected <> al_RowAffectedCount Then
            Call Err.Raise(SQLBadRowAffectedCount, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_DB.SQLRowsAffected)
        End If
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".ExecuteSQLSafe")
End Sub

#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
        Call Err.Raise(CompFncFailed, "ao_Db.OpenSQL - " & "SQL : " & as_Request, "SQL Error: " & GetDbError(ao_DB))
    End If
    
    If al_RowExpectedCount <> -1 Then
        ' Then check the rowcount
        If ao_DB.RowCount(lc_Data) <> al_RowExpectedCount Then
            Call Err.Raise(SQLBadRowExpectedCount, "SQL : " & as_Request, al_RowExpectedCount & "<>" & ao_DB.RowCount(lc_Data))
        End If
    End If
    OpenSQLSafe = lc_Data
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".OpenSQLSafe")
End Function

Private Function GetComboKey(ByVal ao_Combo As ArmCombobox) As String
On Error GoTo ErrHandler

    GetComboKey = ""
    If Not (ao_Combo.SelectedItem Is Nothing) Then
        GetComboKey = Trim(CStr(ao_Combo.SelectedItem.Key))
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler("GetComboKey")
End Function

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

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

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

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

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

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

Private Function SQLStr(ByVal as_str As String, Optional ByVal al_MaxLen As Long = 8000) As String
On Error GoTo ErrHandler
    SQLStr = "'" & Replace(Left(as_str, IIf(Len(as_str) <= al_MaxLen, Len(as_str), al_MaxLen)), "'", "''") & "'"
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SqlStr")
End Function

' safe retieving selected item from combobox
Private Function SQLComboBoxValue(ByRef ao_Combobox As ArmCombobox, Optional ByVal as_DefaultValue As String = "NULL", Optional ByVal ab_KeyTitle As Boolean = True) As String
On Error GoTo ErrHandler
    If IsComboboxSelected(ao_Combobox) Then
        SQLComboBoxValue = "'" & IIf(ab_KeyTitle, ao_Combobox.SelectedItem.Key, ao_Combobox.SelectedItem.DisplayText) & "'"
    Else
        SQLComboBoxValue = as_DefaultValue
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SQLComboBoxValue")
End Function

Private Function SQLOptionButtonValue(ByRef ao_options As Object) As String
On Error GoTo ErrHandler
    SQLOptionButtonValue = ""
    Dim opt_obj As OptionButton
    For Each opt_obj In ao_options
        If opt_obj.Value Then
            SQLOptionButtonValue = opt_obj.Tag
            Exit For
        End If
    Next
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SQLOptionButtonValue")
End Function

Private Function IsComboboxSelected(ByRef as_combo As ArmCombobox) As Boolean
On Error GoTo ErrHandler
    IsComboboxSelected = False
    If Not as_combo.SelectedItem Is Nothing Then
        If Not IsEmpty(as_combo.SelectedItem.Key) Then
            IsComboboxSelected = True
        End If
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".IsComboboxSelected")
End Function

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

Private Function LoadIconFromA_Icons(ai_IconIndex As Integer) As Picture
Dim hIcon As Long
Dim hInst As Long
Dim oNewPic As Picture
Dim tPicConv As PictDesc
Dim IGuid As Guid

On Error GoTo ErrHandler
  
    hInst = LoadLibrary("c:\arm_apps\dll\A_icons.dll")
    If hInst = 0 Then
      Set LoadIconFromA_Icons = Nothing
      Exit Function
    End If
    
    hIcon = LoadIconFromDLL(hInst, ai_IconIndex)
    If hIcon = 0 Then
      Set LoadIconFromA_Icons = Nothing
      Exit Function
    End If
      
    With tPicConv
      .cbSizeofStruct = Len(tPicConv)
      .picType = vbPicTypeIcon
      .hImage = hIcon
    End With
     
    ' Fill in magic IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
    With IGuid
          .Data1 = &H7BF80980
          .Data2 = &HBF32
          .Data3 = &H101A
          .Data4(0) = &H8B
          .Data4(1) = &HBB
          .Data4(2) = &H0
          .Data4(3) = &HAA
          .Data4(4) = &H0
          .Data4(5) = &H30
          .Data4(6) = &HC
          .Data4(7) = &HAB
    End With
    OleCreatePictureIndirect tPicConv, IGuid, True, oNewPic
      
    Set LoadIconFromA_Icons = oNewPic
    Call FreeLibrary(hInst)
    Exit Function
ErrHandler:
    Call FreeLibrary(hInst)
    Call ErrorHandler("LoadIconFromFile")
End Function

Private Sub SetTreeDelayedMode(ByVal ab_Delayed As Boolean)
On Error GoTo ErrHandler
Dim ll_Index As Long
    
    tvw_Main.Visible = Not ab_Delayed
    cmd_TVReLoad.Visible = ab_Delayed
    grd_productAvail.Visible = Not ab_Delayed
    Exit Sub
ErrHandler:
    Call ErrorHandler("SetTreeDelayedMode")
End Sub

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

' ************************************************************************************
' **************************** REDIM FUNCTION ****************************************
' ************************************************************************************
Sub SafeRedimString(ByRef as_Array() As String, al_NumElements As Long)

On Error GoTo ErrHandler

  If al_NumElements = 0 Then
          ReDim as_Array(-1 To -1)
  Else
          'MS REDIMM
          Call SafeRedimPreserve(as_Array, al_NumElements - 1)
  End If
  Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SafeRedimString()")
End Sub

Sub SafeRedim(ByRef av_Array() As Variant, al_NumElements As Long)

On Error GoTo ErrHandler

  If al_NumElements = 0 Then
          ReDim av_Array(-1 To -1)
  Else
          'MS REDIMM
          Call SafeRedimPreserve(av_Array, al_NumElements - 1)
  End If
  Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".SafeRedim()")
End Sub
' **************************** REDIM FUNCTION ****************************************

' ************************************************************************************
' ********************** ERROR-HANDLING SUPPORT FUNCTIONS ****************************
' ************************************************************************************
#If LIVE = 1 Then
Private Function GetDbError(ByVal lo_Db As Object) As String
#Else
Private Function GetDbError(ByVal lo_Db As ARMSYSCOMLib.ArmDb) As String
#End If
On Error GoTo ErrHandler
    If IsArray(lo_Db.SQLErrorMessages) Then
        Debug.Assert (IsArray(lo_Db.SQLErrorCodes))
        ' Display errors msgBox
        GetDbError = Join(lo_Db.SQLErrorCodes, ",") & vbCrLf & Join(lo_Db.SQLErrorMessages, vbCrLf)
    Else
        ' ExecuteSQL failed but no error message?
        GetDbError = "Unknown error"
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".GetDbError()")
End Function

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

' display standard error message
Private Sub ErrorMessage(ByVal as_Fct As String)
    If Err.Number = QuietException Then Exit Sub
    Dim ll_oldMP As MousePointerConstants
    
    'save mouse pointer
    ll_oldMP = Screen.MousePointer
    Screen.MousePointer = vbDefault
    
    Dim ls_ErrSource As String
    Dim ls_errDescription As String
    ls_ErrSource = as_Fct & SEP1 & Err.Source
    ls_errDescription = Err.Description
    
    Call LogMessage(App.ProductName & " exception raised. Err.Number:" & Err.Number & ", Err.Source:" & ls_ErrSource & ", Err.Description " & ls_errDescription & ".", "E", False)
    Call MsgBox("Error occured, please contact IT" & vbCrLf & ls_ErrSource & vbCrLf & "Description: " & ls_errDescription, , "Error message: " & as_Fct)
    
    'restore mouse pointer
    Screen.MousePointer = ll_oldMP
End Sub

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

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

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

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_U_Code))
    ls_req = Replace(ls_req, "$APP$", SQLStr(C_APPNAME & " " & App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision, 50))
    ls_req = Replace(ls_req, "$MSG$", 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()")
End Sub

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

Private Function SendMessage(ByVal as_msg As String, Optional Buttons As VbMsgBoxStyle = vbOKOnly) As VbMsgBoxResult
On Error GoTo ErrHandler
    Call LockScreen(True)
    SendMessage = MsgBox(as_msg, Buttons)
    Call LockScreen(False)
    Exit Function
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage(Extender.Name & ".SendMessage")
End Function

' function return original container
Private Function MoveControlToFront(ByRef ao_ctrl As Object) As Object
On Error GoTo ErrHandler
    Set MoveControlToFront = ao_ctrl.Container
    ao_ctrl.Top = ao_ctrl.Container.Top + ao_ctrl.Top
    ao_ctrl.Left = ao_ctrl.Container.Left + ao_ctrl.Left
    Set ao_ctrl.Container = ao_ctrl.Container.Container
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".MoveControlToFront")
End Function

' recalculate position correctly only in case of one level hierachical change
Private Function MoveControlToFrame(ByRef ao_ctrl As Object, ByRef ao_Frame As VB.Frame) As Object
On Error GoTo ErrHandler
    Set MoveControlToFrame = ao_ctrl.Container
    Set ao_ctrl.Container = ao_Frame
    ao_ctrl.Top = ao_ctrl.Top - ao_Frame.Top
    ao_ctrl.Left = ao_ctrl.Left - ao_Frame.Left
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".MoveControlToFrame")
End Function

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

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

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

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

On Error GoTo ErrHandler

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

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

ErrHandler:
    Call ErrorHandler(Extender.Name & ".ChangeCharset")
End Sub


Private Function ReplacePlaceholderByControlValue(ByVal as_Request As String, ByRef ao_Control As Object) As String
On Error GoTo ErrHandler

Dim lsa_Columns() As String

    If Trim(ao_Control.Tag) = "" Then
        ReplacePlaceholderByControlValue = as_Request
        Exit Function
    End If
    
    Select Case UCase(TypeName(ao_Control))
        Case "ARMCOMBOBOX"
            lsa_Columns = Split(ao_Control.Tag, SEP)
            
            If UBound(lsa_Columns) >= 0 Then
                If GetComboKey(ao_Control) = "" Then
                    as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", "NULL")
                Else
                    as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SQLStr(GetComboKey(ao_Control)))
                End If
            End If
            If UBound(lsa_Columns) >= 1 Then
                as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(1) & "$", SQLStr(ao_Control.Text))
            End If
        Case "ARMPICKER"
            lsa_Columns = Split(ao_Control.Tag, SEP)
            
            If UBound(lsa_Columns) >= 0 Then
                If (Trim(CStr(ao_Control.ItemCode)) = "") Or (CStr(ao_Control.ItemCode) = "0") Then
                    as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", "NULL")
                Else
                    as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SQLStr(Trim(CStr(ao_Control.ItemCode))))
                End If
            End If
            If UBound(lsa_Columns) >= 1 Then
                as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(1) & "$", SQLStr(Trim(ao_Control.ItemDescription)))
            End If
        Case "CHECKBOX"
            lsa_Columns = Split(ao_Control.Tag, SEP)
            If ao_Control.Value = vbChecked Then
                as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SQLStr("X"))
            Else
                as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SQLStr(""))
            End If
        Case "TEXTBOX"
            lsa_Columns = Split(ao_Control.Tag, SEP)
            If UBound(lsa_Columns) > 0 Then
                
                Select Case lsa_Columns(1)
                    Case "Text"
                        as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SQLStr(ao_Control.Text))
                    Case "Num"
                        If ao_Control.Text = "" Then
                            as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", "0")
                        Else
                            Dim ls_number As String
                            ls_number = Replace(Trim(ao_Control.Text), ms_ThousandSeparator, "", , , vbTextCompare)
                            ls_number = Replace(ls_number, ms_DecimalSeparator, ".", , , vbTextCompare)
                            as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", ls_number)
                        End If
                    Case "Date"
                        If Not IsDate(ao_Control.Text) Then
                            as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", "NULL")
                        Else
                            as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SqlDate(CDate(ao_Control.Text)))
                        End If
                End Select
            Else
                as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SQLStr(ao_Control.Text))
            End If
        Case "A_CALOCX"
            lsa_Columns = Split(ao_Control.Tag, SEP)
            as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SqlDate(ao_Control.date_dt))
        Case "TABSTRIP"
            lsa_Columns = Split(ao_Control.Tag, SEP)
            If ao_Control.SelectedItem Is Nothing Then
                as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", "NULL")
            Else
                as_Request = ReplacePlaceHolder(as_Request, "$" & lsa_Columns(0) & "$", SQLStr(ao_Control.SelectedItem.Key))
            End If
    End Select
    ReplacePlaceholderByControlValue = as_Request
    Exit Function
ErrHandler:
    Call ErrorHandler("ReplacePlaceholderByControlValue")
End Function

Private Function ReplaceRequestByFrameData(ByVal as_Request As String, ByVal ao_Frame As Frame)
On Error GoTo ErrHandler

Dim lo_Control As Control
   
    For Each lo_Control In UserControl.Controls
        If HasContainer(lo_Control, ao_Frame) Then
            as_Request = ReplacePlaceholderByControlValue(as_Request, lo_Control)
        End If
    Next
    ReplaceRequestByFrameData = as_Request
    Exit Function
ErrHandler:
    Call ErrorHandler("ReplaceRequestByFrameData")
End Function

Private Function GetArrayItem(ByVal as_serialStr As String, ByVal as_Key As String) As String
On Error GoTo ErrHandler
    Dim lsa_fullData() As String
    Dim lsa_item    As Variant
    Dim ll_i As Long
    GetArrayItem = ""
    lsa_fullData = Split(as_serialStr, SEP)
    For ll_i = LBound(lsa_fullData) To UBound(lsa_fullData)
        lsa_item = Split(lsa_fullData(ll_i), SEP1)
        If UBound(lsa_item) >= 1 Then
            If StrComp(as_Key, lsa_item(0), vbTextCompare) = 0 Then
                GetArrayItem = lsa_item(1)
                Exit Function
            End If
        End If
    Next
ErrHandler:
    Call ErrorHandler(Extender.Name & ".GetArrayItem")
End Function


Private Sub cbo_View_ComboItemSelected()
On Error GoTo ErrHandler

    If mb_Initialized = False Then
       Exit Sub
    End If
    
    Call LockScreen(True)
    
     If Not cbo_View.SelectedItem Is Nothing Then
        
        Call LoadTreeView(tvw_Main, GetTreeViewInfo(mt_TreeViewInfos, C_SCREENNAME, cbo_View.SelectedItem.Key))
        If tvw_Main.Count > 0 Then
            Set tvw_Main.SelectedItem = tvw_Main.Nodes(1)
            Call tvw_Main_NodeClick(tvw_Main.SelectedItem)
        Else
            Call tvw_Main_NodeClick(Nothing)
        End If
        Call SetTreeDelayedMode(False)
    End If
    
    Call LockScreen(False)
    Exit Sub
    
ErrHandler:
    Call LogMessage("cbo_Views_ComboItemSelected")
    Call LockScreen(False)
    MsgBox MsgText(666, ms_Language_Code, "#Unable to load the combo " & " type of view."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
End Sub


Private Sub chk_inclSpecialProducts_Click()
    On Error GoTo ErrHandler
    
    Call LockScreen(True)
    SetTreeDelayedMode (True)
    Call LockScreen(False)
    Exit Sub
    
ErrHandler:
    Call ErrorMessage("chk_inclSpecialProducts_Click")
End Sub

Private Sub cmd_TVReLoad_Click()
On Error GoTo ErrHandler
    
    Call cbo_View_ComboItemSelected
    Exit Sub
ErrHandler:
    Call ErrorMessage("cmd_TVReLoad_Click")
End Sub


Private Sub Command1_Click()
    Dim ll_i As Long
    Dim lsa_keys() As String
    
    lsa_keys = Split(txt_JP_Exp_allItems.Text, ",")
    
    Dim ll_Counter As Long
    ll_Counter = 0
    
    For ll_i = LBound(lsa_keys) To UBound(lsa_keys)
        If grd_productAvail.SearchKey(True, Trim(lsa_keys(ll_i))) Then
            ll_Counter = ll_Counter + 1
            ' delete the line
            Call grd_productAvail_DblClick
        End If
    Next
    
    MsgBox ("Found " & ll_Counter & " of " & (UBound(lsa_keys) - LBound(lsa_keys) + 1))

End Sub

Private Sub frm_JP_Experimental_DblClick()
    frm_JP_Experimental.Visible = False
End Sub

Private Sub grd_productLinked_DblClick()
On Error GoTo ErrHandler
    Dim ll_i As Long
    For ll_i = 0 To grd_productLinked.SelectedCount - 1
        Call BaseItem_Remove(grd_productLinked.SelectedLine(0, "BI_SAP_Code"))
    Next
    Exit Sub
ErrHandler:
    Call ErrorMessage(Extender.Name & ".grd_productAvail_DblClick")
End Sub

Private Sub BaseItem_Remove(ByVal as_BI_SAP_Code As Variant)
On Error GoTo ErrHandler
    ' physicaly remove line from bottom grid, set color to standard if item fount in upper grid
    If grd_productAvail.SearchKey(True, as_BI_SAP_Code) Then
        grd_productAvail.LineColor(grd_productAvail.Row) = COLOR_WHITE
        grd_productAvail.SelectedLine(0, "change") = ""
    End If
    
    ' REMOVE from bottom grid
    Call grd_productLinked.DeleteLine(as_BI_SAP_Code)
    Exit Sub
ErrHandler:
    Call ErrorMessage(Extender.Name & ".BaseItem_Remove")
End Sub

Private Sub BaseItem_Add(ByVal as_BI_SAP_Code As Variant, ByVal al_Row As Long)
On Error GoTo ErrHandler
    
    If Not TestGridContaintRow(grd_productLinked, "BI_SAP_Code", as_BI_SAP_Code, True) Then
        ' additional check if item is linked to another market. do not chcek PG
        Dim ll_errCode As ErrMsg
        ll_errCode = Item_checkMTK(as_BI_SAP_Code)
        If ll_errCode = ErrMsgNone Then
            Call AddLineToGrid(grd_productLinked, grd_productAvail, al_Row)
        
            grd_productAvail.LineColor(al_Row) = COLOR_ADDLINE
            grd_productAvail.Data(al_Row, "change") = "D"
        Else
            MsgBox Replace(MsgText(ll_errCode, ms_Language_Code, "#The SAP code $BI_SAP_CODE$ already appears in another product group for this authorisation market."), "$BI_SAP_CODE$", as_BI_SAP_Code, , , vbTextCompare), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
        End If
    Else
        MsgBox Replace(MsgText(ErrMsg_M590, ms_Language_Code, "#The SAP code $BI_SAP_CODE$ already appears in another product group for this authorisation market."), "$BI_SAP_CODE$", as_BI_SAP_Code, , , vbTextCompare), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
    End If

    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".BaseItem_Add")
End Sub

Private Sub cmd_remove_from_linked_Click()
On Error GoTo ErrHandler
    Dim ll_i As Long
    For ll_i = 0 To grd_productLinked.SelectedCount - 1
        Call BaseItem_Remove(grd_productLinked.SelectedLine(0, "BI_SAP_Code"))
    Next
    Exit Sub
ErrHandler:
    Call ErrorMessage(Extender.Name & ".btn_remove_from_linked_Click")
End Sub

Private Sub cmd_add_to_linked_Click()
On Error GoTo ErrHandler
    Dim ll_i As Long
    For ll_i = 0 To grd_productAvail.SelectedCount - 1
        Call BaseItem_Add(grd_productAvail.SelectedLine(ll_i, "BI_SAP_Code"), grd_productAvail.Row + ll_i)
    Next
    Exit Sub
ErrHandler:
    Call ErrorMessage(Extender.Name & ".cmd_add_to_linked_Click")
End Sub

Private Sub grd_productAvail_DblClick()
On Error GoTo ErrHandler
    ' move product to lower grid
    Dim ll_i As Long
    For ll_i = 0 To grd_productAvail.SelectedCount - 1
        Call BaseItem_Add(grd_productAvail.SelectedLine(ll_i, "BI_SAP_Code"), grd_productAvail.Row + ll_i)
    Next
    Exit Sub
ErrHandler:
    Call ErrorMessage(Extender.Name & ".grd_productAvail_DblClick")
End Sub

Private Sub grd_productAvail_RowLoaded(ByVal al_Row As Long)
On Error GoTo ErrHandler
    ' check if currently loaded row is contained in linked products
    If TestGridContaintRow(grd_productLinked, "BI_SAP_Code", grd_productAvail.Data(al_Row, "BI_SAP_Code"), True) Then
        ' put line in green
        grd_productAvail.LineColor(al_Row) = COLOR_ADDLINE
        grd_productAvail.Data(al_Row, "change") = "D"
    ElseIf grd_productAvail.Data(al_Row, "VDate_End") = Date Then
        ' put line in blue
        grd_productAvail.LineColor(al_Row) = COLOR_UPDLINE
    End If
    Exit Sub
ErrHandler:
    Call ErrorMessage(Extender.Name & ".grd_productAvail_RowLoaded")
End Sub


Private Sub tlb_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)
    tlb_Main.Enabled = False

    Select Case as_Role
        Case "I" 'Refresh update
            Call Item_Restore(mo_dataSrc)
            
        Case "H" 'validate mode add
            Select Case activeScreenMode
                Case ArmScreenMode.smAdd
                    Call Item_Add
                Case Else
                    Debug.Assert (False)
            End Select
        Case "F"    ' refresh filters
            Call cbo_View.SearchItem("X", "TV_Default", 0)
        Case "T"
            Call Item_Exit
    End Select
    
    tlb_Main.Enabled = True
    
    Call LockScreen(False)
    
    DoCheck = False

    Exit Sub

ErrHandler:
    
    DoCheck = False
    
    tlb_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("tlb_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

    Exit Sub
End Sub

Public Sub ImportLinkedGrid(ByRef ao_srcGrid As ArmGrid)
On Error GoTo ErrHandler
    Call CopyGridData(ao_srcGrid, grd_productLinked)
    Exit Sub
ErrHandler:
    Call ErrorMessage("ImportLinkedGrid")
End Sub

Public Sub ExportLinkedGrid(ByRef ao_dstGrid As ArmGrid)
On Error GoTo ErrHandler
    Call CopyGridData(grd_productLinked, ao_dstGrid)
    Exit Sub
ErrHandler:
    Call ErrorMessage("ExportLinkedGrid")
End Sub

Private Sub CopyGridData(ByRef ao_srcGrid As ArmGrid, ByRef ao_destGrid As ArmGrid)
On Error GoTo ErrHandler
    Call ao_destGrid.ClearGrid
    
    ' copy data
    Dim ll_Row As Long
    Dim ll_Col As Long
    ao_destGrid.Rows = ao_srcGrid.Rows
    For ll_Row = 0 To ao_srcGrid.Rows - 1
        For ll_Col = 0 To ao_destGrid.Cols - 1
            ao_destGrid.Data(ll_Row, ll_Col) = ao_srcGrid.Data(ll_Row, ao_destGrid.Columns(ll_Col).Name)
        Next
        ao_destGrid.LineColor(ll_Row) = ao_srcGrid.LineColor(ll_Row)
    Next

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

Private Function GetGridColMaxValue(ByRef ao_grid As ArmGrid, ByVal as_colName As String, ByVal as_like As String) As Long
On Error GoTo ErrHandler
    Dim ll_Row As Long
    Dim ls_Data As String
    Dim ll_retVal As Long
    ll_retVal = 0
    For ll_Row = 0 To ao_grid.Rows - 1
        ls_Data = ao_grid.Data(ll_Row, as_colName)
        If Len(ls_Data) > Len(as_like) Then
            If StrComp(Left(ls_Data, Len(as_like)), as_like, vbTextCompare) = 0 Then
                ls_Data = right(ao_grid.Data(ll_Row, as_colName), Len(ao_grid.Data(ll_Row, as_colName)) - Len(as_like))
                If isNumeric(ls_Data) Then
                    If CLng(ls_Data) > ll_retVal Then ll_retVal = CLng(ls_Data)
                End If
            End If
        End If
    Next
    GetGridColMaxValue = ll_retVal
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".GetGridColMaxValue")
End Function

' special type od serialized string filed1_name sep1 data1 sep1 data2 sep field2_name ....
Private Function Build_SrzStringFromGrid(ByRef ao_grid As Control) As String
On Error GoTo ErrHandler
    Dim ls_ret As String
    Dim ls_Data As String
    Dim ll_Row As Long
    Build_SrzStringFromGrid = ""
    
    Dim ll_Col As Long
    Dim lo_Column As ArmColumn
    
    For ll_Col = 0 To ao_grid.Cols - 1
        Set lo_Column = ao_grid.Columns(ll_Col)
        ls_Data = ""
        For ll_Row = 0 To ao_grid.Rows - 1
            ls_Data = IIf(ll_Row = 0, "", ls_Data & SEP1) & lo_Column.GetData(ll_Row)
        Next
        ls_ret = IIf(ll_Col = 0, "", ls_ret & SEP) & lo_Column.FieldName & SEP1 & ls_Data
    Next
    
    Build_SrzStringFromGrid = ls_ret
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Build_SrzStringFromGrid")
End Function

Private Function Build_SrzStringFromGridLine(ByRef ao_grid As Control, Optional ByVal al_Row As Long = -1) As String
On Error GoTo ErrHandler
    Dim ls_ret As String
    Build_SrzStringFromGridLine = ""
    If al_Row = -1 Then
        If ao_grid.SelectedCount > 0 Then
            al_Row = ao_grid.Row
        Else
            Call Err.Raise(ArmErr.InvalidArgument, "", "No row selected in grid.")
        End If
    End If
    
    Dim ll_Col As Long
    Dim lo_Column As ArmColumn
    
    For ll_Col = 0 To ao_grid.Cols - 1
        Set lo_Column = ao_grid.Columns(ll_Col)
        ls_ret = IIf(ll_Col = 0, "", ls_ret & SEP) & lo_Column.FieldName & SEP1 & lo_Column.GetData(al_Row)
    Next
    
    Build_SrzStringFromGridLine = ls_ret
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Build_SrzStringFromGridLine")
End Function

Private Sub AddLineToGrid(ByRef ao_grid As ArmGrid, ByRef ao_srcGrid As ArmGrid, ByVal al_srcRow As Long, Optional ByVal ab_insertAtBeginning As Boolean = False)
On Error GoTo ErrHandler
    
    ' insert row at the end of grid
    Debug.Assert (ao_grid.Cols > 0)
    Dim lo_Column As ArmColumn
    Dim ll_Index As Long
    Dim lsa_newRow() As Variant
    ReDim lsa_newRow(0 To ao_grid.Cols - 1)
    
    Call ao_grid.DeselectRow
    
    For ll_Index = 0 To ao_grid.Cols - 1
        Set lo_Column = ao_grid.Columns(ll_Index)
        lsa_newRow(ll_Index) = ao_srcGrid.Data(al_srcRow, lo_Column.Name)
    Next
    
    If ab_insertAtBeginning Then
        Call ao_grid.InsertLine(0, lsa_newRow)
        Call ao_grid.FirstLine
    Else
        Call ao_grid.AddLine(lsa_newRow)
    End If
    ao_grid.LineColor(ao_grid.Row) = COLOR_ADDLINE
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("AddLineToGrid")
End Sub

Private Sub DeleteLineToGrid(ByVal ao_grid As ArmGrid, ByVal av_KeyFields As Variant, ByVal al_KeyVal As Variant)
On Error GoTo ErrHandler
    
    Dim ll_Col As Long
    Dim lo_Column As ArmColumn
    Dim lba_bckKeys() As Boolean
    Dim lv_bckKey As Variant
    ReDim lba_bckKeys(0 To ao_grid.Cols - 1)
    
    ' backup keys
    lv_bckKey = ao_grid.CurrentKey
    For ll_Col = 0 To ao_grid.Cols - 1
        Set lo_Column = ao_grid.Columns(ll_Col)
        lba_bckKeys(ll_Col) = lo_Column.Key
        lo_Column.Key = IsInArray(lo_Column.FieldName, av_KeyFields)
    Next

    ' delete all lines
    ao_grid.FirstLine
    Do While ao_grid.SearchKey(False, al_KeyVal)
        If ao_grid.CurrentLine("change") = "A" Then
            ' if line is new then delete line
            ao_grid.DeleteLine
        Else
            ' line is not realy deletable
            ao_grid.CurrentLine("change") = "D"
            ao_grid.LineColor(ao_grid.Row) = COLOR_DELLINE
            If Not ao_grid.NextLine Then
                Exit Do
            End If
        End If
    Loop
    
    ' restore keys
    For ll_Col = 0 To ao_grid.Cols - 1
        ao_grid.Columns(ll_Col).Key = lba_bckKeys(ll_Col)
    Next
    Call ao_grid.SearchKey(True, lv_bckKey)

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

Private Sub UpdateLineToGrid(ByVal ao_grid As ArmGrid, ByRef ao_dataSrc As Dictionary, ByVal av_keyCols As Variant)
On Error GoTo ErrHandler

    Debug.Assert (ao_grid.Cols > 0)
    Dim ll_Row As Long, ll_RowCount As Long, ll_Col As Long
    Dim lo_Column As ArmColumn
    
    ll_RowCount = ao_grid.Rows - 1
    For ll_Row = 0 To ll_RowCount
        If IsKeyRow(ao_grid, ll_Row, av_keyCols, ao_dataSrc) Then
            For ll_Col = 0 To ao_grid.Cols - 1
                Set lo_Column = ao_grid.Columns(ll_Col)
                If ao_dataSrc.Exists(lo_Column.FieldName) Then
                    Call lo_Column.SetData(ll_Row, ao_dataSrc(lo_Column.FieldName))
                End If
            Next
            ao_grid.LineColor(ll_Row) = COLOR_UPDLINE
        End If
    Next

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

Private Function IsInArray(ByVal as_val As String, ByRef av_Array As Variant) As Boolean
On Error GoTo ErrHandler
    Dim ll_i As Long
    IsInArray = False
    For ll_i = LBound(av_Array) To UBound(av_Array)
        If StrComp(av_Array(ll_i), as_val, vbTextCompare) <> 0 Then Exit Function
    Next
    IsInArray = True
    Exit Function
ErrHandler:
    Call ErrorHandler("IsInArray")
End Function

Private Function IsKeyRow(ByVal ao_grid As ArmGrid, ByVal al_Row As Long, ByVal av_keyCols As Variant, ByRef ao_dataSrc As Dictionary) As Boolean
On Error GoTo ErrHandler
    IsKeyRow = False
    Dim ll_i As Long
    For ll_i = LBound(av_keyCols) To UBound(av_keyCols)
        If StrComp(ao_grid.Data(al_Row, av_keyCols(ll_i)), ao_dataSrc(av_keyCols(ll_i)), vbTextCompare) <> 0 Then
            Exit Function
        End If
    Next
    IsKeyRow = True
    Exit Function
ErrHandler:
    Call ErrorHandler("IsKeyRow")
End Function


Private Sub UpdateMainToolbar()
On Error GoTo ErrHandler

    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".UpdateMainToolbar")
End Sub

Private Function TestGridContaintRow(ByRef ao_grid As ArmGrid, ByVal as_colName As String, ByVal as_colVal As String, ByVal ab_incSelectedRow As Boolean, Optional ByVal as_colChangeName As String = "change", Optional ByVal as_deletedValue As String = "D") As Boolean
On Error GoTo ErrHandler
    Dim ll_Row As Long
    TestGridContaintRow = False
    For ll_Row = 0 To ao_grid.Rows - 1
        If StrComp(ao_grid.Data(ll_Row, as_colChangeName), as_deletedValue, vbTextCompare) <> 0 Then
            If ab_incSelectedRow Or (Not ab_incSelectedRow And ll_Row <> ao_grid.Row) Then
                If StrComp(ao_grid.Data(ll_Row, as_colName), as_colVal, vbTextCompare) = 0 Then
                    TestGridContaintRow = True
                    Exit Function
                End If
            End If
        End If
    Next
    Exit Function
ErrHandler:
    Call ErrorHandler(Extender.Name & ".TestGridContaintRow")
End Function

Private Function LoadTreeView(ByRef aTV As ArmTreeView, ByRef aTreeViewInfo As TTreeViewInfo) As Boolean
On Error GoTo ErrorHandler
    
    Call aTV.Clear
    aTV.AllowCheckboxes = True
    aTV.AllowFind = False
    
    If aTreeViewInfo.Levels > 0 Then
      aTV.Levels = aTreeViewInfo.Levels
      aTV.StartDemandLevel = 1
      aTV.SelectedImages = aTreeViewInfo.SelectedImages
      aTV.Images = aTreeViewInfo.Images
      aTV.NodeRequests = ApplyTVFilters(aTreeViewInfo.NodeRequest)
      aTV.GridRequests = aTreeViewInfo.GridRequest
      
      If Not aTV.LoadTree(LoadTypeChildsDemand) Then
          Call Err.Raise(ArmErr.CompFncFailed, "aTV.LoadTree", "")
      End If
    End If
    Exit Function
ErrorHandler:
    Call ErrorHandler("LoadTreeView")
End Function

Private Function GetTreeViewInfoFromDB(ByVal AScreenName As String, ByVal aTVCode As String) As TTreeViewInfo
On Error GoTo ErrHandler

    Dim lTreeView As TTreeViewInfo
    Dim lRequest As String
    Dim lCurs As Long, lIdx As Long, lCount As Long
    
    ' Get the data from the DB
    lRequest = "EXEC Treeview_Parameters_lst '" & AScreenName & "', '" & aTVCode & "'"
    lCurs = OpenSQLSafe(mo_Db, lRequest)
    
    lCount = mo_Db.RowCount(lCurs) - 1
    
    If lCount < 0 Then
        Call Err.Raise(ArmErr.InvalidArgument, lRequest, "AScreenName=" & AScreenName & " lCount=" & lCount)
    End If
    
    ReDim lTreeView.NodeRequest(lCount)
    ReDim lTreeView.GridRequest(lCount)
    ReDim lTreeView.ExcelRequest(lCount)
    ReDim lTreeView.FindRequest(lCount)
    ReDim lTreeView.CountRequest(lCount)
    ReDim lTreeView.Images(lCount)
    ReDim lTreeView.SelectedImages(lCount)
    
    Dim lLevel As Long
    Dim ls_req As String
    
    For lIdx = 0 To lCount
        lLevel = mo_Db.GetFields(lCurs, "TV_Level")
        ls_req = ReplaceCommonPlaceholders(mo_Db.GetFields(lCurs, "TV_NodeRequest"))
        ls_req = Replace(ls_req, "$SPM_Code$", txt_SPM_Code.Text, , , vbTextCompare)
        lTreeView.NodeRequest(lLevel) = ls_req
        lTreeView.GridRequest(lLevel) = mo_Db.GetFields(lCurs, "TV_GridRequest")
        lTreeView.Images(lLevel) = mo_Db.GetFields(lCurs, "TV_Images")
        lTreeView.SelectedImages(lLevel) = mo_Db.GetFields(lCurs, "TV_SelectedImages")
        mo_Db.Next (lCurs)
    Next
    
    lTreeView.TreeViewCode = aTVCode
    lTreeView.Levels = lCount + 1
    lTreeView.Loaded = True
    GetTreeViewInfoFromDB = lTreeView
    
    Call mo_Db.Close(lCurs)
    Exit Function
ErrHandler:
    Call mo_Db.Close(lCurs)
    Call ErrorHandler("GetTreeViewInfoFromDB")
End Function

Private Function GetTreeViewInfo(ByRef aTVInfos() As TTreeViewInfo, ByVal AScreenName As String, ByVal aTVCode As String) As TTreeViewInfo
On Error GoTo ErrHandler
    Dim lIdx As Long, lCount As Long
    Dim lTreeView As TTreeViewInfo, lFound As Boolean
    
    ' Search in the array
    lCount = UBound(aTVInfos)
    lFound = False
    For lIdx = 0 To lCount
        If aTVInfos(lIdx).TreeViewCode = aTVCode Then
            If Not aTVInfos(lIdx).Loaded Then
                aTVInfos(lIdx) = GetTreeViewInfoFromDB(AScreenName, aTVCode)
            End If
            lTreeView = aTVInfos(lIdx)
            lFound = True
            Exit For
        End If
    Next
    
    If Not lFound Then
        Call Err.Raise(ArmErr.InvalidArgument, "TreeviewInfo", "TreeViewInfo not found. AScreenName=" & AScreenName & " aTVCode=" & aTVCode)
    End If
    
    GetTreeViewInfo = lTreeView
    Exit Function
ErrHandler:
    Call ErrorHandler("GetTreeViewInfo")

End Function

Private Function ApplyTVFilters(ByVal av_Request As Variant) As Variant
On Error GoTo ErrHandler
    Dim lv_Requests As Variant
    Dim ls_includeSpecPrd As String
    
    If IsArray(av_Request) Then
        ReDim lv_Requests(UBound(av_Request))
        Dim ll_Idx As Long, ll_Count As Long
        ll_Count = UBound(lv_Requests)
        For ll_Idx = 0 To ll_Count
            lv_Requests(ll_Idx) = ReplaceCommonPlaceholders(av_Request(ll_Idx))
            lv_Requests(ll_Idx) = ReplaceRequestByFrameData(lv_Requests(ll_Idx), fra_detail)
        Next
    Else
        ReDim lv_Requests(0)
        lv_Requests(0) = ReplaceCommonPlaceholders(av_Request)
        lv_Requests(0) = ReplaceRequestByFrameData(lv_Requests(0), fra_detail)
    End If

    ApplyTVFilters = lv_Requests
    Exit Function
ErrHandler:
    Call ErrorHandler("ApplyTVFilters")
End Function

Private Sub tvw_Main_NodeClick(ByVal Node As MSComctlLib.Node)
On Error GoTo ErrHandler
    
    If mb_Initializing Then Exit Sub
    
    Call LockScreen(True)
    
    Dim lv_Requests As Variant
        
    If tvw_Main.Checkboxes = True Then
        lv_Requests = ApplyTVFilters(tvw_Main.CheckedNodesRequests)
    Else
        lv_Requests = ApplyTVFilters(tvw_Main.SelectedNodeRequest)
    End If
        
    If Not grd_productAvail.Load(lv_Requests, False, , , (tvw_Main.NodeInfo(Node).ml_Level < tvw_Main.Levels - 1)) Then
        Err.Raise ArmErr.CompFncFailed, "grd_productAvail", "Method Load failed: " & lv_Requests(0)
    End If
    
    Call LockScreen(False)
    Exit Sub

ErrHandler:
    Call LogMessage("tvw_Main_NodeClick")
    Call LockScreen(False)
    MsgBox MsgText(666, ms_Language_Code, "#There is a problem while loading data."), vbInformation + vbOKOnly, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
End Sub

' check if base_item exists in other active market
Private Function Item_checkMTK(ByVal as_BI_SAP_Code As String) As ErrMsg
On Error GoTo ErrHandler
Const C_REQ As String = "EXEC SPA_PG_MKT_BI_chk $BI_SAP_Code$, $SPM_Code$"
    Item_checkMTK = ErrMsgNone
    
    Dim ll_cursor As Long
    Dim ls_req As String
    
    ls_req = ReplaceRequestByFrameData(C_REQ, fra_detail)
    ls_req = ReplacePlaceHolder(ls_req, "$BI_SAP_Code$", SQLStr(as_BI_SAP_Code, 20))
    ll_cursor = OpenSQLSafe(mo_Db, ls_req)
    
    If mo_Db.RowCount(ll_cursor) > 0 Then
        Item_checkMTK = ErrMsg_M590
    End If
    
    Call mo_Db.Close(ll_cursor)
    
    Exit Function
ErrHandler:
    If ll_cursor > 0 Then
        Call mo_Db.Close(ll_cursor)
    End If
    Call ErrorHandler(Extender.Name & ".Item_checkMTK")
End Function

Private Sub UserControl_Terminate()
'    Call ScanControls
End Sub



Public Function ScanControls() As Boolean
On Error GoTo ErrHandler
    Dim lc_Control As Control
    Dim li_Counter As Integer
    Dim ls_StringBuilder As String
    Dim ll_Index As Long
    
    For Each lc_Control In UserControl.Controls
        'label
        If TypeOf lc_Control Is Label Then
            ll_Index = -1
            On Error Resume Next
            ll_Index = lc_Control.Index
            If ll_Index = -1 Then
                Debug.Print (UserControl.Name & ";" & lc_Control.Tag & ";E;E;;" & lc_Control.Caption)
            Else
                Debug.Print (UserControl.Name & ";" & lc_Control.Tag & ";E;E;;" & lc_Control.Caption)
            End If
        End If
        'check box
        If TypeOf lc_Control Is CheckBox Then
            Debug.Print (UserControl.Name & ";" & lc_Control.Tag & ";E;E;;" & lc_Control.Caption)
        End If
        'tabstrip
        If TypeOf lc_Control Is TabStrip Then
            For li_Counter = 1 To lc_Control.Tabs.Count
                Debug.Print (UserControl.Name & ";" & lc_Control.Tag & ";E;E;;" & lc_Control.Tabs.Item(li_Counter))
            Next
        End If
        'option button
        If TypeOf lc_Control Is OptionButton Then
            Debug.Print (UserControl.Name & ";" & lc_Control.Tag & ";E;E;;" & lc_Control.Caption)
        End If
        'grid
        If TypeOf lc_Control Is ArmGrid Then
            Debug.Print (UserControl.Name & ";" & lc_Control.Tag & "_Title;E;E;;" & lc_Control.Title)
            If Not lc_Control.Cols = 0 Then
                ls_StringBuilder = ""
                For li_Counter = 0 To lc_Control.Cols - 1
                    If li_Counter = lc_Control.Cols - 1 Then
                        ls_StringBuilder = ls_StringBuilder & lc_Control.Columns(li_Counter).Title
                    Else
                        ls_StringBuilder = ls_StringBuilder & lc_Control.Columns(li_Counter).Title & SEP
                    End If
                Next
                Debug.Print (UserControl.Name & ";" & lc_Control.Tag & ";E;E;;" & ls_StringBuilder)
            End If
        End If
    Next
    ScanControls = True
    
    Exit Function
ErrHandler:
    ScanControls = False
    Call ErrorHandler("ScanControls")
End Function


