VERSION 5.00
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.UserControl MediaManager 
   ClientHeight    =   7635
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   10755
   ScaleHeight     =   7635
   ScaleWidth      =   10755
   Begin VB.Frame frm_frames 
      Caption         =   "#Classification within product range"
      Height          =   3315
      Index           =   4
      Left            =   150
      TabIndex        =   9
      Tag             =   "opt_prod"
      Top             =   4290
      Visible         =   0   'False
      Width           =   10515
      Begin Project1.ToolbarControl tlb_product 
         Height          =   690
         Left            =   1860
         TabIndex        =   12
         Top             =   270
         Width           =   2835
         _ExtentX        =   5001
         _ExtentY        =   1217
      End
      Begin Project1.ArmCombobox cbo_category 
         Height          =   345
         Left            =   6840
         TabIndex        =   13
         Top             =   810
         Width           =   3195
         _ExtentX        =   5636
         _ExtentY        =   609
      End
      Begin Project1.ArmGrid grd_product 
         Height          =   1005
         Left            =   180
         TabIndex        =   17
         Tag             =   "grd_productCols"
         Top             =   1260
         Width           =   4275
         _ExtentX        =   7541
         _ExtentY        =   1773
      End
      Begin MSForms.Label lbl_labels 
         Height          =   255
         Left            =   5700
         TabIndex        =   14
         Tag             =   "lbl_category"
         Top             =   870
         Width           =   1095
         Caption         =   "#Category"
         Size            =   "1931;450"
         FontHeight      =   165
         FontCharSet     =   0
         FontPitchAndFamily=   2
      End
   End
   Begin VB.Frame frm_frames 
      Caption         =   "#Media Short Code Classification"
      Height          =   2085
      Index           =   3
      Left            =   6060
      TabIndex        =   8
      Tag             =   "frm_media_short"
      Top             =   2550
      Visible         =   0   'False
      Width           =   4695
      Begin Project1.ToolbarControl tlb_short_code 
         Height          =   690
         Left            =   210
         TabIndex        =   11
         Top             =   240
         Width           =   2835
         _ExtentX        =   5001
         _ExtentY        =   1217
      End
      Begin Project1.ArmGrid grd_short 
         Height          =   1005
         Left            =   120
         TabIndex        =   16
         Tag             =   "grd_shortCols"
         Top             =   930
         Width           =   4275
         _ExtentX        =   7541
         _ExtentY        =   1773
      End
   End
   Begin VB.Frame frm_frames 
      Caption         =   "#Marketing Classification"
      Height          =   2085
      Index           =   2
      Left            =   6060
      TabIndex        =   7
      Tag             =   "opt_market"
      Top             =   360
      Visible         =   0   'False
      Width           =   4695
      Begin Project1.ArmGrid grd_marketing 
         Height          =   1005
         Left            =   210
         TabIndex        =   15
         Tag             =   "grd_marketingCols"
         Top             =   930
         Width           =   4275
         _ExtentX        =   7541
         _ExtentY        =   1773
      End
      Begin Project1.ToolbarControl tlb_marketing 
         Height          =   690
         Left            =   480
         TabIndex        =   10
         Top             =   240
         Width           =   2835
         _ExtentX        =   5001
         _ExtentY        =   1217
      End
   End
   Begin VB.Frame frm_frames 
      Caption         =   "#Media"
      Height          =   5655
      Index           =   0
      Left            =   240
      TabIndex        =   0
      Tag             =   "frm_media"
      Top             =   270
      Visible         =   0   'False
      Width           =   5445
      Begin Project1.ArmTreeView tvw_main 
         Height          =   2385
         Left            =   480
         TabIndex        =   6
         Top             =   2190
         Width           =   3315
         _ExtentX        =   5847
         _ExtentY        =   4207
      End
      Begin Project1.ArmCombobox cbo_view 
         Height          =   345
         Left            =   120
         TabIndex        =   5
         Top             =   1650
         Width           =   3255
         _ExtentX        =   5741
         _ExtentY        =   609
      End
      Begin VB.Frame frm_frames 
         Caption         =   "Display"
         Height          =   525
         Index           =   1
         Left            =   120
         TabIndex        =   2
         Tag             =   "frm_Display"
         Top             =   990
         Width           =   3255
         Begin VB.OptionButton opt_Internet 
            Caption         =   "#Internet"
            Height          =   192
            Index           =   1
            Left            =   1680
            TabIndex        =   4
            Tag             =   "opt_Internet"
            Top             =   240
            Width           =   1500
         End
         Begin VB.OptionButton opt_Internet 
            Caption         =   "#All"
            Height          =   192
            Index           =   0
            Left            =   150
            TabIndex        =   3
            Tag             =   "opt_All"
            Top             =   240
            Value           =   -1  'True
            Width           =   1500
         End
      End
      Begin Project1.ToolbarControl tlb_main 
         Height          =   690
         Left            =   810
         TabIndex        =   1
         Top             =   240
         Width           =   2835
         _ExtentX        =   5001
         _ExtentY        =   1217
      End
   End
End
Attribute VB_Name = "MediaManager"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' **************************************************************************************************
' **************************************** TOOL CONSTANTS ******************************************
' **************************************************************************************************
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"
Private Const SEP As String = SEP1 + SEP2
Private Const C_MODULE_NAME As String = "Media Manager"     ' module name used in log table
Private Const C_MODULE_LOC_NAME As String = "image"         ' module name used for localization
Private Const C_SCREENMODE_STACK_SIZE As Long = 1           ' size of stack for active screens

Private Const C_TLB_SCREEN_ID As Long = 2429                ' screen ID for toolbar
Private Const C_TLB_MAIN As Long = 2438                     ' main toolbar ID
Private Const C_TLB_MARKETING As Long = 2439                ' toolbar for marketing classification grid
Private Const C_TLB_SHORT_CODE As Long = 2440               ' toolbar for media short classification grid
Private Const C_TLB_PRODUCT_RANGE As Long = 2441            ' toolbar for classification within product range grid

Private Const C_TOOLBARFACE_MAIN_LST As String = "0"        ' toolbar for main list
Private Const C_TOOLBARFACE_MKT_LST As String = "0"         ' toolbar for marketing
Private Const C_TOOLBARFACE_SHORT_LST As String = "0"       ' toolbar for short code
Private Const C_TOOLBARFACE_PRD_LST As String = "0"         ' toolbar for product range

Private Const SIFYB_CM_ERROR_MESSAGE = 2400                 ' const for base of error messages ids

' ****************************************** TOOL CONSTANTS ***************************************

' **************************************************************************************************
' **************************************** USER DEFINED ERRORS *************************************
' **************************************************************************************************
Private Enum ArmErr
    DBCnxFailed = vbObjectError + 1              ' Unable to connect to the database
    CPTAlreadyInitialized = vbObjectError + 2    ' We try to initialize a component that is already initialized
    CPTNotInitialized = vbObjectError + 3        ' We try to use or free that is not initialized yet
    InvalidArgument = vbObjectError + 4
    PropertyNotSet = vbObjectError + 5
    SQLFailure = vbObjectError + 6               ' A SQL runtime error has occured : syntax wrong....
    SQLBadRowAffectedCount = vbObjectError + 7   ' A SQL request has not affected the expected rowcount (ex: one Update do nothing)
    SQLBadRowExpectedCount = vbObjectError + 8   ' A SQL request does not return the expected rowcount : select an item return nothing...
    DrivingError = vbObjectError + 9
    CompFncFailed = vbObjectError + 10           ' when component function fail
    GridLoadFailed = vbObjectError + 11          ' load function failed ... bad sql
    QuietException = vbObjectError + 12          ' do not display error message
    SQLTableReferenceConstraint = vbObjectError + 13 ' A SQL request cannot be executed : Table reference constraint
    DuplicityDetected = vbObjectError + 2301     ' detected row with same unique id
End Enum

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

' **************************************************************************************************
' *************************************** CONTROL MEMBERS ******************************************
' **************************************************************************************************
' common global variables
Dim mua_ActiveMode()    As ArmScreenMode
Dim mo_productRights    As UserRights_t
Dim mo_marketingRights  As UserRights_t
Dim mo_shortRights      As UserRights_t
Private ms_LanguageCode As String           ' Language code
Private mb_Initialized  As Boolean          ' Initialized user control flag
Private mb_Initializing As Boolean          ' Flag of initializing
Private ms_LoginName    As String           ' login name
Private ml_UserCode     As Long             ' User code
Private ms_Title        As String           ' Title of form
Private ms_searchPathReq As String          ' JN 28/1/2008 task 409 fix2

Dim mo_ListMediaPathSecurity As New Collection
Dim ml_codePageCursor As Long           ' code pages used to translate controls

Private Enum ArmScreenMode
    smRefreshOnly                       ' do not change active screen, only refresh active
    smMain
End Enum

Private Type UserRights_t
    allowAdd As Boolean
    allowUpd As Boolean
    allowDel As Boolean
End Type

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

Dim ml_DEBUG_CursorCount As Long

' *************************************** CONTROL MEMBERS ******************************************

' **************************************************************************************************
' *********************************** PUBLIC CONTROL EVENTS ****************************************
' **************************************************************************************************
Public Event quit()
' *********************************** PUBLIC CONTROL EVENTS ****************************************

' **************************************************************************************************
' ********************************* PUBLIC CONTROL PROPERTIES **************************************
' **************************************************************************************************
' database controler property
' Params:
' ao_db (ARMSYSCOMLib.ArmDb) - ArmSysCom instance
#If LIVE Then
Public Property Set DB(ByRef ao_DB As Object)
#Else
Public Property Set DB(ByRef ao_DB As ARMSYSCOMLib.ArmDb)
#End If

On Error GoTo ErrHandler
    If Not mo_Db Is Nothing Then Err.Raise ArmErr.CPTAlreadyInitialized
    If ao_DB Is Nothing Then Err.Raise ArmErr.InvalidArgument
    
    Set mo_Db = ao_DB
    
    Exit Property
ErrHandler:
    Call ErrorMessage("ArmDb(Set)")
End Property


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

Public Sub Move(ByVal aLeft As Single, ByVal aTop As Single, ByVal aWidth As Single, ByVal aHeight As Single)
    Call UserControl.Extender.Move(aLeft, aTop, aWidth, aHeight)
End Sub
Public Property Let Visible(ByVal aVisible As Boolean)
    UserControl.Extender.Visible = aVisible
End Property
Public Property Get Visible() As Boolean
    Visible = UserControl.Extender.Visible
End Property
' User code used in logs
Public Property Let U_Code(ByVal al_UserCode As Long)
On Error GoTo ErrHandler
    
    If mb_Initialized Then Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    ml_UserCode = al_UserCode
    Exit Property
ErrHandler:
    Call ErrorMessage("U_Code(Let)")
End Property

' Setting language code
Public Property Let Language_Code(ByVal as_newValue As String)
On Error GoTo ErrHandler
    If mb_Initialized Then Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    If Len(as_newValue) <> 1 Then Call Err.Raise(ArmErr.InvalidArgument, "", "Language_code must contains only 1 char")
    
    ms_LanguageCode = as_newValue
    
    Exit Property
ErrHandler:
     Call ErrorMessage("Language_Code")
End Property
' ********************************* PUBLIC CONTROL PROPERTIES **************************************

' **************************************************************************************************
' ******************************* PUBLIC USER CONTROL METHODS **************************************
' **************************************************************************************************
' initialize user control
Public Function Load_A_Com()
    On Error GoTo ErrHandler
    Load_A_Com = False
    
    If mb_Initialized Then Err.Raise ArmErr.CPTAlreadyInitialized
    If mo_Db Is Nothing Then Err.Raise ArmErr.PropertyNotSet, "ArmDb not initialized"
    If ms_LanguageCode = "" Then Err.Raise ArmErr.PropertyNotSet, "LanguageCode not initialized"
    If ml_UserCode = 0 Then Err.Raise ArmErr.PropertyNotSet, "UserCode not initialized"
    
    ' init debug variable
    ml_DEBUG_CursorCount = mo_Db.CursorCount
    
    ' open code page cursor
    ml_codePageCursor = OpenCodePageCursor(mo_Db)
    
    Call def_permission
    Call init_Path          ' for external forms only
    
    ' init armDb
    Set tlb_Main.ArmDb = mo_Db
    Set tlb_marketing.ArmDb = mo_Db
    Set tlb_Product.ArmDb = mo_Db
    Set tlb_short_code.ArmDb = mo_Db
    Set cbo_Category.ArmDb = mo_Db
    Set Cbo_View.ArmDb = mo_Db
    Set grd_marketing.ArmDb = mo_Db
    Set grd_product.ArmDb = mo_Db
    Set grd_short.ArmDb = mo_Db
    Set tvw_Main.ArmDb = mo_Db

    ' Initialize language
    tlb_Main.Language = ms_LanguageCode
    tlb_marketing.Language = ms_LanguageCode
    tlb_Product.Language = ms_LanguageCode
    tlb_short_code.Language = ms_LanguageCode
    
    ' init controls and set layouts
    Call ChangeCharset(UserControl.Controls, GetCodePageFromLanguage(ml_codePageCursor, ms_LanguageCode))
    Call InitComponents
    Call InitCtrlSize
    ReDim Preserve mua_ActiveMode(0)
    mua_ActiveMode(UBound(mua_ActiveMode)) = ArmScreenMode.smMain

    ' load labels
    Call LoadLabels(mo_Db, UserControl.Controls, C_MODULE_LOC_NAME, ms_LanguageCode)

    mb_Initialized = True

    mb_Initializing = True      ' suppres event processing
    ' display starting face
    Call ResetScreen(activeScreenMode)
    Call UpdateUI
    ' set default values
    Call SetComboBoxText(Cbo_View, "ArboTitre", "Media Title by directories")
    Call loadMainTreeView(tvw_Main, "ArboTitre", "")
    mb_Initializing = False
    
    Load_A_Com = True
    Exit Function
ErrHandler:
    Call ErrorMessage("Load_A_Com")
End Function

' uninitialize user control
Public Sub Unload_A_Com()
On Error GoTo ErrHandler

    Call mo_Db.Close(ml_codePageCursor)
    ml_codePageCursor = 0
    
    Set tlb_Main.ArmDb = Nothing
    Set tlb_marketing.ArmDb = Nothing
    Set tlb_Product.ArmDb = Nothing
    Set tlb_short_code.ArmDb = Nothing
    Set cbo_Category.ArmDb = Nothing
    Set Cbo_View.ArmDb = Nothing
    Set grd_marketing.ArmDb = Nothing
    Set grd_product.ArmDb = Nothing
    Set grd_short.ArmDb = Nothing
    Set tvw_Main.ArmDb = Nothing


    Call tlb_Main.Unload_A_Com
    Call tlb_marketing.Unload_A_Com
    Call tlb_Product.Unload_A_Com
    Call tlb_short_code.Unload_A_Com
    Call cbo_Category.Unload_A_Com
    Call cbo_Category.Unload_A_Com
    Call grd_marketing.Unload_A_Com
    Call grd_product.Unload_A_Com
    Call grd_short.Unload_A_Com
    Call tvw_Main.Unload_A_Com
    
    
    mb_Initialized = False

' DEBUG
    Debug.Assert (mo_Db.CursorCount = ml_DEBUG_CursorCount)
    
    Set mo_Db = Nothing
    
    Exit Sub
ErrHandler:
    If ml_codePageCursor <> 0 Then
        Call mo_Db.Close(ml_codePageCursor)
    End If
     Call ErrorMessage("Unload_A_COM")
End Sub
' ******************************* PUBLIC USER CONTROL METHODS **************************************


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

Private Function OpenCodePageCursor(ByRef ao_Armdb As Object) As Long
On Error GoTo ErrHandler
Const C_REQ As String = "SELECT Language_code, Code_Page FROM Language"
    Dim ll_Cursor As Long
    
    ll_Cursor = OpenSQLSafe(ao_Armdb, C_REQ)
    Debug.Assert (ll_Cursor <> 0)
    
    OpenCodePageCursor = ll_Cursor
    Exit Function
ErrHandler:
    Call ErrorHandler("LoadCodePageCursor")
End Function

Private Function GetCodePageFromLanguage(ByVal al_codePageCursor As Long, ByVal as_Language As String) As Long
On Error GoTo ErrHandler
    Debug.Assert (al_codePageCursor <> 0)
    Dim ll_codePage As Long
    
    If mo_Db.Find(al_codePageCursor, "Language_code", as_Language) > -1 Then
        ll_codePage = CLng(mo_Db.GetFields(al_codePageCursor, "Code_Page"))
    Else
        ll_codePage = 0
    End If
    
    GetCodePageFromLanguage = ll_codePage
    Exit Function
ErrHandler:
    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("ChangeCharset")
End Sub


' Load the labels of a containers
Private Sub LoadLabels(ByRef ao_Armdb As ArmDb, ByRef ao_Container As Object, ByVal as_ScreenName As String, ByVal as_Language As String)
Dim lc_Labels As Long       ' The cursor of the labels
Dim lc_Control As Control   ' A control of the container
Dim li_Idx As Integer, li_Count As Integer
Dim li_Label As Integer      ' A label idx
Dim ls_Request As String
    
    On Error GoTo Trace_Err
    Call LockScreen(True)
    
    ls_Request = "exec Screen_csts '" & as_ScreenName & "','" & as_Language & "'"
    lc_Labels = OpenSQLSafe(ao_Armdb, ls_Request)
    
    If lc_Labels = 0 Then
        GoTo Trace_End
    End If
    
    
    li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", "title", , 1)
    If li_Label >= 0 Then
        ms_Title = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
    End If
    
    ' Iterate the container for loading the label of each element which has defined a tag
    For Each lc_Control In ao_Container
        Select Case UCase(TypeName(lc_Control))
            Case UCase("TabStrip") ' Component is a tabstrip, we load the caption of each tab defined
                Dim lo_Tbs
                Set lo_Tbs = lc_Control ' Cast for use of intellisense
                li_Count = lo_Tbs.Tabs.Count
                For li_Idx = 1 To li_Count
                    If lo_Tbs.Tabs(li_Idx).Tag <> "" Then
                        li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lo_Tbs.Tabs(li_Idx).Tag, , 1)
                        If li_Label >= 0 Then
                            lo_Tbs.Tabs(li_Idx).Caption = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                        End If
                    End If
                Next
                Set lo_Tbs = Nothing
            
            Case UCase("ListView") ' Component is a listview, we load the caption of each columns
                Dim lo_ListView As ListView
                Set lo_ListView = lc_Control
                li_Count = lo_ListView.ColumnHeaders.Count
                For li_Idx = 1 To li_Count
                    If lo_ListView.ColumnHeaders(li_Idx).Tag <> "" Then
                        li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lo_ListView.ColumnHeaders(li_Idx).Tag, , 1)
                        If li_Label >= 0 Then
                            lo_ListView.ColumnHeaders(li_Idx).Text = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                        End If
                    End If
                Next
                Set lo_ListView = Nothing
        
            Case UCase("TextBox")  ' Component is a textbox
                Dim lo_TextBox As TextBox
                Set lo_TextBox = lc_Control
                If lo_TextBox.Tag <> "" Then
                    li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lo_TextBox.Tag, , 1)
                    If li_Label >= 0 Then
                        lo_TextBox.Text = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                    End If
                End If
                Set lo_TextBox = Nothing
            
            Case UCase("OptionButton") ' Component is option button
                Dim lValues As Variant
                Dim ls_Value As String
                lValues = Split(lc_Control.Tag, SEP)
                        
                If UBound(lValues) > 0 Then
                    ls_Value = lValues(0)
                Else
                    ls_Value = lc_Control.Tag
                End If
                
                If ls_Value <> "" Then
                    'Print #1, lc_Control.Tag & "," & lc_Control.Caption
                    li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", ls_Value, , 1)
                    If li_Label >= 0 Then
                        lc_Control.Caption = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                    End If
                End If
            Case UCase("Label"), UCase("Frame"), UCase("CommandButton"), UCase("CheckBox")
                If lc_Control.Tag <> "" Then
                    'Print #1, lc_Control.Tag & "," & lc_Control.Caption
                    li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lc_Control.Tag, , 1)
                    If li_Label >= 0 Then
                        lc_Control.Caption = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                    End If
                End If
            Case UCase("ArmGrid")
                li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lc_Control.Tag, , 1)
                If li_Label >= 0 Then
                  Call lc_Control.LoadConstants(ptStatic, ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT"), ctColumns)
                End If
                li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lc_Control.Name, , 1)
                If li_Label >= 0 Then
                  lc_Control.Title = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                End If
            Case UCase("Menu")
                If lc_Control.Name <> "" Then
                    li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lc_Control.Name, , 1)
                    If li_Label >= 0 Then
                        lc_Control.Caption = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                    End If
                End If
        End Select
    Next
        
Trace_End:
    Call ao_Armdb.Close(lc_Labels)
    Call LockScreen(False)
    Exit Sub
    
Trace_Err:
    Call LockScreen(False)
    Call ao_Armdb.Close(lc_Labels)
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("activeScreenMode(Get)")
End Property

Private Sub LoadToolbar(ByVal al_tlbCursor As Long, ByVal al_tlbID As Long, ByVal as_ToolbarKey As String, ByRef ao_tlb As ToolbarControl)
On Error GoTo ErrHandler
    If mo_Db.Find(al_tlbCursor, "id", al_tlbID) < 0 Then
        Call Err.Raise(CompFncFailed, "mo_Db.Find", "Toolbar definition is missing." & "(" & al_tlbID & ")")
    End If
    Call ao_tlb.Load_A_Com
    Call ao_tlb.SetToolbarInfoStringParameters(mo_Db.GetFields(al_tlbCursor, "info"), as_ToolbarKey)
    Exit Sub
ErrHandler:
    Call ErrorHandler("LoadToolbar")
End Sub

Private Sub InitComponents()
Const CL_REQUEST_TB As String = "EXEC A_ToolbarDef_sel NULL, NULL, $screenID$, NULL"
On Error GoTo ErrHandler
    mb_Initializing = True
    
    ms_Title = "#" & C_MODULE_NAME

    ' load toolbars
    Dim ll_Cursor As Long
    ll_Cursor = OpenSQLSafe(mo_Db, Replace(CL_REQUEST_TB, "$screenID$", C_TLB_SCREEN_ID))
    
    Call LoadToolbar(ll_Cursor, C_TLB_MAIN, "060", tlb_Main)
    Call LoadToolbar(ll_Cursor, C_TLB_MARKETING, "061", tlb_marketing)
    Call LoadToolbar(ll_Cursor, C_TLB_SHORT_CODE, "062", tlb_short_code)
    Call LoadToolbar(ll_Cursor, C_TLB_PRODUCT_RANGE, "063", tlb_Product)
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    grd_marketing.Load_A_Com
    grd_marketing.MultiSelect = False
    grd_marketing.AllowPrint = True
    grd_marketing.Title = "#Marketing Classification"
    Call grd_marketing.SetColumns(Array( _
    Join(Array("CODE", 0, 1, "PM2_kcode", "#Code"), SEP), _
    Join(Array("VIEWTYPE", 2000, 0, "TV_desc", "#View type"), SEP), _
    Join(Array("MEDIAPURP", 2000, 0, "M_desc", "#Purpose of media"), SEP), _
    Join(Array("MARKET", 2000, 0, "MKS_desc", "#Market segment"), SEP), _
    Join(Array("SOURCE", 2000, 0, "AT_desc", "#Source type"), SEP), _
    Join(Array("SUPPORT", 2000, 0, "S_desc", "#Support type"), SEP)))

    grd_product.Load_A_Com
    grd_product.Title = "#Classification within product range"
    grd_product.MultiSelect = False
    grd_product.AllowPrint = True
    grd_product.SetColumns Array( _
        Join(Array("MPC_CODE", 0, 1, "MPC_code", "#Code"), SEP), _
        Join(Array("INTERNET", 1100, 0, "internet_flag", "#Internet flag"), SEP), _
        Join(Array("BML", 2700, 0, "BML_desc", "#Material"), SEP), _
        Join(Array("COLOUR", 2000, 0, "COLOUR_desc", "#Colour"), SEP), _
        Join(Array("PE", 3000, 0, "PE_desc", "#Edge detail/Product group"), SEP), _
        Join(Array("PF", 1700, 0, "PF_desc", "#Product family"), SEP), _
        Join(Array("PP", 1700, 0, "PP_desc", "#Pattern"), SEP), _
        Join(Array("PS", 1700, 0, "PS_desc", "#Product range"), SEP), _
        Join(Array("SF", 1700, 0, "SF_desc", "#Surface"), SEP), _
        Join(Array("PM", 1500, 0, "PM_desc", "#Module"), SEP))

    grd_short.Load_A_Com
    grd_short.Title = "#Media Short Code Classification"
    grd_short.MultiSelect = False
    grd_short.AllowPrint = True
    grd_short.SetColumns Array( _
        Join(Array("MSC_code", 0, 1, "MSC_code", "#Code"), SEP), _
        Join(Array("ICONC", 0, 0, "iConcurrency", "#iConcurrency"), SEP), _
        Join(Array("MD_code", 2000, 0, "MD_code", "#Media Code"), SEP), _
        Join(Array("PT_title", 3000, 0, "PT_title", "#Media Title"), SEP), _
        Join(Array("CG_CODE", 0, 0, "CG_Code", "#CG_Code"), SEP), _
        Join(Array("CG_Desc", 1000, 0, "CG_Desc", "#Categories"), SEP), _
        Join(Array("BI_MKT_Code", 1000, 0, "BI_MKT_Code", "#Short Code"), SEP), _
        Join(Array("internet_flag", 1000, 0, "internet_flag", "#Internet"), SEP), _
        Join(Array("drop_date", 2000, 0, "drop_date", "#Drop date"), SEP))
    
    cbo_Category.Load_A_Com
    cbo_Category.FirstBlankItem = False
    cbo_Category.Request = ""   '"EXEC Media_Product_Classif_CG_t_lst @MD_code, '" & ms_LanguageCode & "'"
    
    Cbo_View.Load_A_Com
    Cbo_View.FirstBlankItem = False
    Cbo_View.Request = "EXEC MediaManager_lvl1_t_lst '','" & ms_LanguageCode & "','" & ms_LoginName & "'"
    
    tvw_Main.Load_A_Com
    tvw_Main.Language = ms_LanguageCode
    tvw_Main.StartDemandLevel = 1
    tvw_Main.UseImages = True
    tvw_Main.RemoveNodeDuplicity = False
    
    mb_Initializing = False
    Exit Sub
ErrHandler:
    If ll_Cursor <> 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorHandler("InitComponents")
End Sub

' initialize controls position and size
Private Sub InitCtrlSize()
On Error GoTo ErrHandler
    Dim ll_frmSpace As Long, lLeft As Long, lTop As Long, lWidth As Long, lHeight As Long
    Dim lo_auxObj As Object
    
    ll_frmSpace = 60
    
    ' Media frame location
    Call frm_frames(0).Move(ll_frmSpace, 0, frm_frames(0).Width, UserControl.ScaleHeight - frm_frames(4).Height - ll_frmSpace)
    
    ' Product range frame
    lTop = frm_frames(0).Top + frm_frames(0).Height + ll_frmSpace
    Call frm_frames(4).Move(ll_frmSpace, lTop, UserControl.ScaleWidth - 4 * ll_frmSpace)
    
    ' marketing classification
    lLeft = frm_frames(0).Left + frm_frames(0).Width + ll_frmSpace
    lHeight = (frm_frames(0).Height - ll_frmSpace) / 2
    Call frm_frames(2).Move(lLeft, 0, UserControl.ScaleWidth - lLeft - 3 * ll_frmSpace, lHeight)
    
    ' short code
    Call frm_frames(3).Move(lLeft, frm_frames(2).Top + frm_frames(2).Height + ll_frmSpace, UserControl.ScaleWidth - lLeft - 3 * ll_frmSpace, lHeight)
    
    Call tlb_Main.Move(ll_frmSpace, 220, frm_frames(0).Width - ll_frmSpace - ll_frmSpace)
    Call tlb_marketing.Move(ll_frmSpace, 220, frm_frames(2).Width - ll_frmSpace - ll_frmSpace)
    Call tlb_short_code.Move(ll_frmSpace, 220, frm_frames(3).Width - ll_frmSpace - ll_frmSpace)
    Call tlb_Product.Move(ll_frmSpace, 220, frm_frames(4).Width - ll_frmSpace - ll_frmSpace)
    
    ' display frame
    Call frm_frames(1).Move(ll_frmSpace, tlb_Main.Top + tlb_Main.Height)
    Call Cbo_View.Move(ll_frmSpace, frm_frames(1).Top + frm_frames(1).Height + ll_frmSpace)
    
    ' treeview
    Call tvw_Main.Move(ll_frmSpace, Cbo_View.Top + Cbo_View.Height, frm_frames(0).Width - 2 * ll_frmSpace, frm_frames(0).Height - Cbo_View.Top - Cbo_View.Height - ll_frmSpace)
    
    ' product range cbo
    Call cbo_Category.Move(ll_frmSpace + lbl_labels.Width, tlb_Product.Top + tlb_Product.Height)
    Call lbl_labels.Move(ll_frmSpace, cbo_Category.Top + cbo_Category.Height - lbl_labels.Height)
    
    ' grids
    Call grd_marketing.Move(ll_frmSpace, tlb_marketing.Top + tlb_marketing.Height, frm_frames(2).Width - 2 * ll_frmSpace, frm_frames(2).Height - tlb_marketing.Top - tlb_marketing.Height - ll_frmSpace)
    Call grd_short.Move(ll_frmSpace, tlb_short_code.Top + tlb_short_code.Height, frm_frames(3).Width - 2 * ll_frmSpace, frm_frames(3).Height - tlb_short_code.Top - tlb_short_code.Height - ll_frmSpace)
    Call grd_product.Move(ll_frmSpace, cbo_Category.Top + cbo_Category.Height, frm_frames(4).Width - 2 * ll_frmSpace, frm_frames(4).Height - cbo_Category.Top - cbo_Category.Height - ll_frmSpace)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("InitCtrlSize")
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
        lb_Locked = True
    End If
    
    ' Unlock
    If ll_Count = 0 Then
        DoEvents ' Flush events
        UserControl.Refresh ' Repaint immediately
        Screen.MousePointer = ll_Mousepointer
        lb_Locked = False
    End If
    
    Err.Number = ll_errNumber
    Err.Source = ls_ErrSrc
    Err.Description = ls_ErrDesc
    
    Exit Sub
    
ErrHandler:
    Call ErrorHandler("LockScreen")
End Sub

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
            For Each lo_ctrl In frm_frames
                lo_ctrl.Enabled = True
            Next
        Case Else
            Debug.Assert (False)
    End Select

    Exit Sub
ErrHandler:
    Call ErrorHandler("ResetScreen()")
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

    ' apply face
    Dim lo_ctrl As Object

    ' hide all frames
    For Each lo_ctrl In frm_frames
        lo_ctrl.Visible = False
    Next
    
    ' we have clean screen we can display proper controls
    Select Case activeScreenMode
        Case smMain
            frm_frames(0).Visible = True
            frm_frames(1).Visible = True
            frm_frames(2).Visible = False
            frm_frames(3).Visible = False
            frm_frames(4).Visible = False
            
            Call tlb_Main.DisplayFace(C_TOOLBARFACE_MAIN_LST)
            Call tlb_marketing.DisplayFace(C_TOOLBARFACE_MKT_LST)
            Call tlb_Product.DisplayFace(C_TOOLBARFACE_PRD_LST)
            Call tlb_short_code.DisplayFace(C_TOOLBARFACE_SHORT_LST)
            Call ApplyRightsOnToolbar(tlb_Main, tvw_Main.SelectedItem)
            Call ApplyStdRights(tlb_marketing, mo_marketingRights)
            Call ApplyStdRights(tlb_Product, mo_productRights)
            Call ApplyStdRights(tlb_short_code, mo_shortRights)
        Case Else
            Debug.Assert (False)
    End Select
    
    ' to display face immidiatelly
    UserControl.Refresh
    Exit Sub
ErrHandler:
    Call ErrorHandler("UpdateUI()")
End Sub


' update searchlist view options
Private Sub loadMainTreeView(ByRef ao_tvw As ArmTreeView, ByVal as_viewType As String, ByVal as_internet As String)
On Error GoTo ErrHandler

    Select Case as_viewType
    Case "bySection"
        tvw_Main.Levels = 2
        tvw_Main.Images = Array(1, 3)
        tvw_Main.SelectedImages = Array(2, 3)
        ao_tvw.NodeRequests = Array( _
           "EXEC MediaMngr_lvl2_" & as_viewType & "_t_lst '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'", _
           "EXEC MediaMngr_lvl3_" & as_viewType & "_t_lst '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0$")
        
        ao_tvw.CountRequests = Array( _
           "EXEC MediaMngr_lvl2_" & as_viewType & "_t_count '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0$")

        ao_tvw.FindRequests = Array( _
           "EXEC MediaMngr_lvl2_" & as_viewType & "_t_search $0$, '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'", _
           "EXEC MediaMngr_lvl3_" & as_viewType & "_t_search $0$, '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'")
    
    Case "byType", "ByBaseMaterial", "BySurface"
        tvw_Main.Levels = 3
        tvw_Main.Images = Array(1, 1, 3)
        tvw_Main.SelectedImages = Array(2, 2, 3)
        ao_tvw.NodeRequests = Array( _
           "EXEC MediaMngr_lvl2_" & as_viewType & "_t_lst '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'", _
           "EXEC MediaMngr_lvl3_" & as_viewType & "_t_lst '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0$", _
           "EXEC MediaMngr_lvl4_" & as_viewType & "_t_lst '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0@0$, $0$")
        
        ao_tvw.CountRequests = Array( _
           "EXEC MediaMngr_lvl2_" & as_viewType & "_t_count '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0$", _
           "EXEC MediaMngr_lvl3_" & as_viewType & "_t_count '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0@0$, $0$")
    
        ao_tvw.FindRequests = Array( _
           "EXEC MediaMngr_lvl2_" & as_viewType & "_t_search $0$, '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'", _
           "EXEC MediaMngr_lvl3_" & as_viewType & "_t_search $0$, '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'", _
           "EXEC MediaMngr_lvl4_" & as_viewType & "_t_search $0$, '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'")
    Case "ArboTitre", "ArboCode"
        tvw_Main.Levels = 4
        tvw_Main.Images = Array(1, 1, 1, 3)
        tvw_Main.SelectedImages = Array(2, 2, 2, 3)
        ao_tvw.NodeRequests = Array( _
           "EXEC MediaMngr_lvl2_" & as_viewType & "_t_lst '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'", _
           "EXEC MediaMngr_lvl3_" & as_viewType & "_t_lst '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0$", _
           "EXEC MediaMngr_lvl4_" & as_viewType & "_t_lst '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0@0$, $0$", _
           "EXEC MediaMngr_lvl5_" & as_viewType & "_t_lst '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0$")
        
        ao_tvw.CountRequests = Array( _
           "EXEC MediaMngr_lvl2_" & as_viewType & "_t_count '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0$", _
           "EXEC MediaMngr_lvl3_" & as_viewType & "_t_count '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0@0$, $0$", _
           "EXEC MediaMngr_lvl4_" & as_viewType & "_t_count '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0$")
    
        ao_tvw.FindRequests = Array( _
           "EXEC MediaMngr_lvl2_" & as_viewType & "_t_search $0$, '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'", _
           "EXEC MediaMngr_lvl3_" & as_viewType & "_t_search $0$, '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'", _
           "EXEC MediaMngr_lvl4_" & as_viewType & "_t_search $0$, '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'", _
           "EXEC MediaMngr_lvl5_" & as_viewType & "_t_search $0$, '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'")
    Case "byProd"
        tvw_Main.Levels = 6
        tvw_Main.Images = Array(1, 1, 1, 1, 1, 3)
        tvw_Main.SelectedImages = Array(2, 2, 2, 2, 2, 3)
        ao_tvw.NodeRequests = Array( _
           "EXEC MediaMngr_lvl2_" & as_viewType & "_t_lst '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'", _
           "EXEC MediaMngr_lvl3_" & as_viewType & "_t_lst '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0$", _
           "EXEC MediaMngr_lvl4_" & as_viewType & "_t_lst '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0@0$, $0$", _
           "EXEC MediaMngr_lvl5_" & as_viewType & "_t_lst '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0@0$, $1@0$, $0$", _
           "EXEC MediaMngr_lvl6_" & as_viewType & "_t_lst '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0@0$, $1@0$, $2@0$, $0$", _
           "EXEC MediaMngr_lvl7_" & as_viewType & "_t_lst '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0@0$, $1@0$, $2@0$, $3@0$, $0$")

        ao_tvw.CountRequests = Array( _
           "EXEC MediaMngr_lvl2_" & as_viewType & "_t_count '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0$", _
           "EXEC MediaMngr_lvl3_" & as_viewType & "_t_count '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0@0$, $0$", _
           "EXEC MediaMngr_lvl4_" & as_viewType & "_t_count '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0@0$, $1@0$, $0$", _
           "EXEC MediaMngr_lvl5_" & as_viewType & "_t_count '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0@0$, $1@0$, $2@0$, $0$", _
           "EXEC MediaMngr_lvl6_" & as_viewType & "_t_count '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "', $0@0$, $1@0$, $2@0$, $3@0$, $0$")
    
        ao_tvw.FindRequests = Array( _
           "EXEC MediaMngr_lvl2_" & as_viewType & "_t_search $0$, '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'", _
           "EXEC MediaMngr_lvl3_" & as_viewType & "_t_search $0$, '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'", _
           "EXEC MediaMngr_lvl4_" & as_viewType & "_t_search $0$, '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'", _
           "EXEC MediaMngr_lvl5_" & as_viewType & "_t_search $0$, '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'", _
           "EXEC MediaMngr_lvl6_" & as_viewType & "_t_search $0$, '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'", _
           "EXEC MediaMngr_lvl7_" & as_viewType & "_t_search $0$, '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'")
    Case Else: Call Err.Raise(ArmErr.InvalidArgument, , "Unsupported view type!")
    End Select

    ms_searchPathReq = "EXEC MediaMngr_lvl" & tvw_Main.Levels + 1 & "_" & as_viewType & "_t_searchPath $0$, '" & as_internet & "', '" & ms_LanguageCode & "', '" & ms_LoginName & "'"       ' JN 28/1/2008 task 409 fix2
    If Not ao_tvw.LoadTree(LoadTypeChildsDemand) Then
        Err.Raise CompFncFailed, "ao_tvw.LoadTree", "Treeview of items cannot be loaded."
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("loadMainTreeView")
End Sub

Private Sub FillMarketingGrid(ByVal as_mediaCode As String)
On Error GoTo ErrHandler
    Const C_REQ As String = "EXEC media_advert_classif_t_lst '$MEDIACODE$', '$LANG$'"
    Dim ls_Req As String
    
    ls_Req = Replace(C_REQ, "$MEDIACODE$", SQLStr(as_mediaCode))
    ls_Req = Replace(ls_Req, "$LANG$", tlb_marketing.Language)
    
    If Not grd_marketing.Load(ls_Req, True) Then
        Err.Raise CompFncFailed, "grd_marketing.Load", "Grid lines cannot be loaded."
    End If
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("FillMarketingGrid")
End Sub

Private Sub FillShortGrid(ByVal as_mediaCode As String)
On Error GoTo ErrHandler
    Const C_REQ As String = "EXEC Media_Short_Classif_t_lst '$MEDIACODE$', '$LANG$'"
    Dim ls_Req As String
    
    ls_Req = Replace(C_REQ, "$MEDIACODE$", SQLStr(as_mediaCode))
    ls_Req = Replace(ls_Req, "$LANG$", tlb_short_code.Language)
    
    If Not grd_short.Load(ls_Req, True) Then
        Err.Raise CompFncFailed, "grd_short.Load", "Grid lines cannot be loaded."
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("FillShortGrid")
End Sub

Private Sub FillCategoryCbo(ByVal as_mediaCode As String)
On Error GoTo ErrHandler
    Const C_REQ As String = "EXEC MediaMngr_Product_Classif_CG_lst '$MEDIACODE$', '$LANG$'"

    Dim ls_Req As String
    Dim ls_oldSel As String
    ls_Req = Replace(C_REQ, "$MEDIACODE$", SQLStr(as_mediaCode))
    ls_Req = Replace(ls_Req, "$LANG$", tlb_Product.Language)
    
    If Not cbo_Category.SelectedItem Is Nothing Then
        ls_oldSel = cbo_Category.SelectedItem.Key
    End If
    Call cbo_Category.Clear
    cbo_Category.Request = ls_Req
    Call cbo_Category.Load
    If ls_oldSel <> "" Then
        If Not cbo_Category.SearchItem(ls_oldSel) Then
            If cbo_Category.Count > 0 Then
                Set cbo_Category.SelectedItem = cbo_Category.ComboItems(1)
            End If
        End If
    ElseIf cbo_Category.Count > 0 Then
        Set cbo_Category.SelectedItem = cbo_Category.ComboItems(1)
    End If
    
    Exit Sub
ErrHandler:
    Call ErrorHandler("FillCategoryCbo")
End Sub

Private Sub FillProductGrid(ByVal as_category As String, ByVal as_mediaCode As String)
On Error GoTo ErrHandler
    Const C_REQ As String = "EXEC Media_Product_Classif_t_lst '$CATEGORY$', '$MEDIACODE$', '$LANG$'"
    Dim ls_Req As String
    
    If as_category = "C001" Or as_category = "C006" Then
        ' #Surface, #Module are visible
        grd_product.Columns("SF").Width = 1700
        grd_product.Columns("PM").Width = 1500
    Else
        ' #Surface, #Module are hidden
        grd_product.Columns("SF").Width = 0
        grd_product.Columns("PM").Width = 0
    End If
    
    ls_Req = Replace(C_REQ, "$CATEGORY$", SQLStr(as_category))
    ls_Req = Replace(ls_Req, "$MEDIACODE$", SQLStr(as_mediaCode))
    ls_Req = Replace(ls_Req, "$LANG$", tlb_Product.Language)

    If Not grd_product.Load(ls_Req, True) Then
        Err.Raise CompFncFailed, "grd_product.Load", "Grid lines cannot be loaded."
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("FillProductGrid")
End Sub
' retrieve selected optionButton from option button group
Private Function GetOptionButtonSelected(ByRef aao_OptionGroup As Object) As VB.OptionButton
On Error GoTo ErrHandler
    Dim lo_OptionButton As OptionButton
    For Each lo_OptionButton In aao_OptionGroup
        If lo_OptionButton.value Then
            Set GetOptionButtonSelected = lo_OptionButton
            Exit Function
        End If
    Next
    Call Err.Raise(ArmErr.CompFncFailed, , "Option not selected!")
    Exit Function
ErrHandler:
    Call ErrorHandler("GetOptionButtonSelected")
End Function

' 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("SetComboBoxText")
End Sub

Private Function GetPathAutorization(ByVal ls_MediaPathCode As String) As Integer
'------------------------------------------------------------------
' Name : GetPathAutorization
'
' Purpose : Return the defined User availble Action for a Media Path
'
' Parameters :  li_MediaPathCode : ID of the media path
'
' Return values : return the action
'
' review : Sept/29/1999 by JJB
'------------------------------------------------------------------

On Error GoTo ErrHandler
    GetPathAutorization = mo_ListMediaPathSecurity.Item(ls_MediaPathCode)
Exit Function

ErrHandler:
'Media Path Code not found we will return 0
    GetPathAutorization = 0
End Function

Private Sub init_Path()
'------------------------------------------------------------------
' Name : init_Path
'
' Purpose : init gs_MediaPath var
'
' Parameters : None
'
' Return values : None
'
' review : Sept/29/1999 by JJB
'------------------------------------------------------------------
Dim ls_Req As String
Dim ll_Cursor As Long

Dim lb_One As Boolean
ReDim gs_MediaPath(4, 0) As String

On Error GoTo ErrHandler

    ls_Req = "EXEC Media_Path_lst 'media_manager','" & ms_LanguageCode & "'"
    ll_Cursor = OpenSQLSafe(mo_Db, ls_Req)
    
    lb_One = KO
    Do While Not mo_Db.EOF(ll_Cursor)
        If lb_One Then
            ReDim Preserve gs_MediaPath(4, UBound(gs_MediaPath, 2) + 1)
        End If
        'PT_ID
        gs_MediaPath(0, UBound(gs_MediaPath, 2)) = mo_Db.GetFields(ll_Cursor, "PT_ID")
        'Check user autorization for this directory (get Action of this media path)
        gs_MediaPath(1, UBound(gs_MediaPath, 2)) = GetPathAutorization(gs_MediaPath(0, UBound(gs_MediaPath, 2)))
        'PT_userPath
        gs_MediaPath(2, UBound(gs_MediaPath, 2)) = mo_Db.GetFields(ll_Cursor, "PT_userPath")
        'PT_realPath
        gs_MediaPath(3, UBound(gs_MediaPath, 2)) = mo_Db.GetFields(ll_Cursor, "PT_realPath")
        Call mo_Db.Next(ll_Cursor)
        lb_One = OK
    Loop
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0

Exit Sub

ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorHandler("init_Path")
End Sub

Private Sub TreeViewPrintNode(lo_Node As Node)
'------------------------------------------------------------------
' Name :TreeViewPrintNode
'
' Purpose : Print in the opened printer flow, the tree (started at the given node)
'
' Param :   lo_Node :
'
' review : 16/Mar/2000 by JJB
'------------------------------------------------------------------

'This routine is called recursively to work down the tree and
' print the information
On Error GoTo ErrHandler

    Dim lo_CursNode As Node
    Set lo_CursNode = lo_Node

    Do While Not lo_CursNode Is Nothing
        Printer.Print Tab(3 + (lo_CursNode.Tag.ml_Level * 2)); lo_CursNode.Text
        If (lo_CursNode.children > 0) Then
            TreeViewPrintNode lo_CursNode.Child
        End If
        Set lo_CursNode = lo_CursNode.Next
    Loop
Exit Sub

ErrHandler:
    Call ErrorHandler("TreeViewPrintNode")
End Sub

Public Sub GridPrint(ByRef ao_grid As ArmGrid, ByVal as_category As String)
On Error GoTo ErrHandler

    Dim i As Integer
    Dim j As Integer
    Dim li_HRecord As Integer
    Dim li_LPaper As Integer
    
    Printer.Font.Name = "Arial"
    Printer.Font.Charset = ao_grid.Font.Charset
    
    Printer.Scale (0, 0)-(3000, 3000)
    li_HRecord = 0
    li_LPaper = 100
    For i = 0 To ao_grid.Rows - 1
        If Printer.CurrentY > (3000 - li_HRecord) Then
            Printer.NewPage
        End If
        If Printer.CurrentY = 0 Then
            Printer.Font.Bold = -1
            Printer.Font.Size = 12
            Printer.Print Date;
            Printer.Font.Size = 24
            Printer.Print Tab(11); ao_grid.Title;
            Printer.Font.Size = 12
            Printer.Print Tab(li_LPaper - 5); Printer.Page
            Printer.Print ""
            Printer.Print ""
            Printer.Print as_category
            Printer.Print ""
        End If
        li_HRecord = Printer.CurrentY
        Call GridPrintLine(ao_grid, i)
        li_HRecord = Printer.CurrentY - li_HRecord
        If Printer.CurrentY < (3000 - li_HRecord) Then
            Printer.Print ""
        End If
    Next i
    Printer.EndDoc
    
Exit Sub
ErrHandler:
    Call ErrorHandler("GridPrint")
End Sub

Public Sub GridPrintLine(ByRef ao_grid As ArmGrid, ByVal al_Row As Long)
On Error GoTo ErrHandler

    Dim j As Integer
    
    For j = 0 To ao_grid.Cols - 1
        If ao_grid.Columns(j).Width <> 0 Then
            Printer.Font.Bold = True
            Printer.Print ao_grid.Columns(j).Title;
            Printer.Font.Bold = False
            Printer.Print Tab(30); ao_grid.Columns(j).GetData(al_Row)
        End If
    Next j
    Printer.Print ""

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

Private Function Grid_Search(ByRef ao_grid As ArmGrid) As Long
On Error GoTo ErrHandler
    Dim ls_searchItem       As String
    Dim ll_retVal           As Long

    ll_retVal = 0
    
    ls_searchItem = ""
    ls_searchItem = InputBox("Search " & ao_grid.Title, ms_Title, ls_searchItem)
    
    If ls_searchItem <> "" Then
        ll_retVal = ao_grid.SearchText(True, ls_searchItem)
        If ll_retVal >= 0 Then
            Do
                ls_searchItem = InputBox("Search " & ao_grid.Title, ms_Title, ls_searchItem)
                If ls_searchItem <> "" Then
                    ll_retVal = ao_grid.SearchText(False, ls_searchItem)
                End If
            Loop While ls_searchItem <> "" And ll_retVal >= 0
        End If
    End If
    Grid_Search = ll_retVal
    Exit Function
ErrHandler:
    Call ErrorHandler("Grid_Search")
End Function

Public Sub Item_Marketing_Add(ByVal av_Data As Variant)
On Error GoTo ErrHandler
    Call grd_marketing.AddLine(av_Data)
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Marketing_Add")
End Sub

Public Sub Item_Marketing_Upd(ByVal av_Key As Variant, ByVal av_Data As Variant)
On Error GoTo ErrHandler
    Dim ll_i As Long
    If grd_marketing.SearchKey(True, av_Key) Then
        For ll_i = LBound(av_Data) To UBound(av_Data)
            grd_marketing.Data(grd_marketing.Row, ll_i) = av_Data(ll_i)
        Next
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Marketing_Upd")
End Sub

Public Sub Item_Marketing_Del(ByVal av_Key As Variant)
On Error GoTo ErrHandler
    Call grd_marketing.DeleteLine(av_Key)
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Marketing_Del")
End Sub

Public Property Get Item_Marketing_Code() As String
On Error GoTo ErrHandler
    Item_Marketing_Code = grd_marketing.CurrentKey(0)
    Exit Property
ErrHandler:
    Call ErrorHandler("Item_Marketing_Code")
End Property

Public Property Get Item_Marketing_GridLine() As Variant
On Error GoTo ErrHandler
    Dim lv_ret As Variant
    Dim ll_i As Long
    ReDim lv_ret(grd_marketing.Cols - 1) As Variant
    
    For ll_i = 1 To grd_marketing.Cols
        lv_ret(ll_i - 1) = grd_marketing.CurrentLine(ll_i - 1)
    Next
    Item_Marketing_GridLine = lv_ret
    Exit Property
ErrHandler:
    Call ErrorHandler("Item_Marketing_GridLine")
End Property

Public Property Get Item_Marketing_GridColumnLabels() As Variant
On Error GoTo ErrHandler
    Dim lv_ret As Variant
    Dim ll_i As Long
    ReDim lv_ret(grd_marketing.Cols - 1) As Variant
    
    For ll_i = 1 To grd_marketing.Cols
        lv_ret(ll_i - 1) = grd_marketing.Columns(ll_i - 1).Title
    Next
    Item_Marketing_GridColumnLabels = lv_ret
    Exit Property
ErrHandler:
    Call ErrorHandler("Item_Marketing_GridColumnLabels")
End Property


Public Sub Item_Product_Add(ByVal av_Data As Variant)
On Error GoTo ErrHandler
    Call grd_product.AddLine(av_Data)
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Product_Add")
End Sub

Public Sub Item_Product_Upd(ByVal av_Key As Variant, ByVal av_Data As Variant)
On Error GoTo ErrHandler
    Dim ll_i As Long
    If grd_product.SearchKey(True, av_Key) Then
        For ll_i = LBound(av_Data) To UBound(av_Data)
            grd_product.Data(grd_product.Row, ll_i) = av_Data(ll_i)
        Next
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Product_Upd")
End Sub

Public Sub Item_Product_Del(ByVal av_Key As Variant)
On Error GoTo ErrHandler
    Call grd_product.DeleteLine(av_Key)
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Product_Del")
End Sub

Public Property Get Item_Product_Code() As String
On Error GoTo ErrHandler
    Item_Product_Code = grd_product.CurrentKey(0)
    Exit Property
ErrHandler:
    Call ErrorHandler("Item_Product_Code")
End Property

Public Property Get Item_Product_GridLine() As Variant
On Error GoTo ErrHandler
    Dim lv_ret As Variant
    Dim ll_i As Long
    ReDim lv_ret(grd_product.Cols - 1) As Variant
    
    For ll_i = 1 To grd_product.Cols
        lv_ret(ll_i - 1) = grd_product.CurrentLine(ll_i - 1)
    Next
    Item_Product_GridLine = lv_ret
    Exit Property
ErrHandler:
    Call ErrorHandler("Item_Product_GridLine")
End Property

Public Property Get Item_Product_CategoryData() As Variant
On Error GoTo ErrHandler
    Dim lv_ret As Variant
    Dim ll_i As Long
    If Not cbo_Category.SelectedItem Is Nothing Then
        ReDim lv_ret(cbo_Category.SelectedItem.GetDataSize - 1) As Variant
        
        For ll_i = 1 To cbo_Category.SelectedItem.GetDataSize
            lv_ret(ll_i - 1) = cbo_Category.SelectedItem.GetData(ll_i - 1)
        Next
    End If
    Item_Product_CategoryData = lv_ret
    Exit Property
ErrHandler:
    Call ErrorHandler("Item_Product_CategoryData")
End Property

Public Sub Item_Product_CategoryAdd(ByVal as_Key As String, ByVal av_Data As Variant, Optional ab_selectIfFirst As Boolean = True)
On Error GoTo ErrHandler
    ' check if category is in combobox
    Dim ll_i As Long
    For ll_i = 1 To cbo_Category.Count
        If cbo_Category.ComboItems(ll_i).Key = as_Key Then
            Exit Sub
        End If
    Next
    ' item not found
    Call cbo_Category.AddItem(av_Data)
    If ab_selectIfFirst And cbo_Category.Count = 1 Then
        Set cbo_Category.SelectedItem = cbo_Category.ComboItems(0)
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Product_CategoryAdd")
End Sub

Public Property Get Item_Product_GridColumnLabels() As Variant
On Error GoTo ErrHandler
    Dim lv_ret As Variant
    Dim ll_i As Long
    ReDim lv_ret(grd_product.Cols - 1) As Variant
    
    For ll_i = 1 To grd_product.Cols
        lv_ret(ll_i - 1) = grd_product.Columns(ll_i - 1).Title
    Next
    lv_ret(0) = lbl_labels.Caption              ' index 0 => label for category
    Item_Product_GridColumnLabels = lv_ret
    Exit Property
ErrHandler:
    Call ErrorHandler("Item_Product_GridColumnLabels")
End Property

Public Sub Item_Short_Add(ByVal av_Data As Variant)
On Error GoTo ErrHandler
    Call grd_short.AddLine(av_Data)
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Short_Add")
End Sub

Public Sub Item_Short_Upd(ByVal av_Key As Variant, ByVal av_Data As Variant)
On Error GoTo ErrHandler
    Dim ll_i As Long
    If grd_short.SearchKey(True, av_Key) Then
        For ll_i = LBound(av_Data) To UBound(av_Data)
            grd_short.Data(grd_short.Row, ll_i) = av_Data(ll_i)
        Next
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Short_Upd")
End Sub

Public Sub Item_Short_Del(ByVal av_Key As Variant)
On Error GoTo ErrHandler
    Call grd_short.DeleteLine(av_Key)
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Short_Del")
End Sub

Public Sub Item_Short_FillGrid()
On Error GoTo ErrHandler
    Dim lv_oldKey As Variant
    lv_oldKey = grd_short.SelectedKey(0)
    Call FillShortGrid(tvw_Main.SelectedItem.Tag.IDValue)
    Call grd_short.SearchKey(True, lv_oldKey)
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Short_FillGrid")
End Sub
' ************************** FRAMEWORK FUNCTIONS *************************************

' ************************************************************************************
' ***************************** SECURITY FUNCTIONS ***********************************
' ************************************************************************************

' fill mo_ListMediaPathSecurity variable for later use
Private Sub def_permission()
Dim ls_Req As String
Dim li_Curs As Integer
Dim ll_Cursor As Long

On Error GoTo ErrHandler
    ' security for main record
    For li_Curs = 1 To mo_ListMediaPathSecurity.Count
        mo_ListMediaPathSecurity.Remove 1
    Next
    
    ls_Req = "EXEC Media_Security2_lst 'media_manager', '" & ms_LoginName & "'"
    ll_Cursor = OpenSQLSafe(mo_Db, ls_Req)
    mo_Db.First (ll_Cursor)
    While Not mo_Db.EOF(ll_Cursor)
        mo_ListMediaPathSecurity.Add Item:=mo_Db.GetFields(ll_Cursor, "Action"), Key:=CStr(mo_Db.GetFields(ll_Cursor, "PT_ID"))
        Call mo_Db.Next(ll_Cursor)
    Wend
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    'security for marketing
    Call InitStdRights(mo_marketingRights, "media_advert_classif")
    
    'security for product
    Call InitStdRights(mo_productRights, "Media_Products_Classif")

    'security for short code
    Call InitStdRights(mo_shortRights, "Media_Short_Classif")

Exit Sub
ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorHandler("def_permission")
End Sub

Private Sub InitStdRights(ByRef ao_rightObj As UserRights_t, ByVal as_objName As String)
On Error GoTo ErrorHandler
    Dim ls_Req As String
    Dim ll_Cursor As Long

    ao_rightObj.allowAdd = False
    ao_rightObj.allowUpd = False
    ao_rightObj.allowDel = False
    
    If ms_LanguageCode = "E" Then
        ls_Req = "EXEC Check_Security '" & as_objName & "', '" & ms_LoginName & "'"
        ll_Cursor = OpenSQLSafe(mo_Db, ls_Req)
        mo_Db.First (ll_Cursor)
        
        While Not mo_Db.EOF(ll_Cursor)
            Select Case mo_Db.GetFields(ll_Cursor, "Action")
            Case "Insert"
                ao_rightObj.allowAdd = True
            Case "Delete"
                ao_rightObj.allowDel = True
            Case "Update"
                ao_rightObj.allowUpd = True
            End Select
            Call mo_Db.Next(ll_Cursor)
        Wend
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
Exit Sub

ErrorHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorHandler("InitStdRights")
End Sub

Private Sub ApplyRightsOnToolbar(ByRef ao_toolbar As ToolbarControl, ByRef av_itemnode As Node)
On Error GoTo ErrorHandler
    
    ao_toolbar.ButtonVisible("A") = (mo_ListMediaPathSecurity.Count > 0)
    If av_itemnode Is Nothing Then
        ao_toolbar.ButtonVisible("B") = False
        ao_toolbar.ButtonVisible("C") = False
        ao_toolbar.ButtonVisible("U") = False
    Else
        If av_itemnode.Tag.ml_Level + 1 = tvw_Main.Levels And (getItemAuthorization(av_itemnode) And MEDIA_UPDATE) = MEDIA_UPDATE Then
            ao_toolbar.ButtonVisible("B") = True
            ao_toolbar.ButtonVisible("C") = True
        Else
            ao_toolbar.ButtonVisible("B") = False
            ao_toolbar.ButtonVisible("C") = False
        End If
        ao_toolbar.ButtonVisible("U") = (av_itemnode.Tag.ml_Level + 1 = tvw_Main.Levels)
    End If
    
    Exit Sub
ErrorHandler:
    Call ErrorHandler("ApplyRightsOnToolbar()")
End Sub

Private Sub ApplyStdRights(ByRef ao_toolbar As ToolbarControl, ByRef ao_rights As UserRights_t)
On Error GoTo ErrorHandler
    ao_toolbar.ButtonVisible("A") = ao_rights.allowAdd
    ao_toolbar.ButtonVisible("B") = ao_rights.allowUpd
    ao_toolbar.ButtonVisible("C") = ao_rights.allowDel
    Exit Sub
ErrorHandler:
    Call ErrorHandler("ApplyStdRights()")
End Sub
Private Function getItemAuthorization(ByRef av_itemnode As Node) As Long
On Error GoTo ErrorHandler
    getItemAuthorization = 0
    If isNumeric(av_itemnode.Tag.GetData(3)) Then
        getItemAuthorization = av_itemnode.Tag.GetData(3)
    End If
    Exit Function
ErrorHandler:
    Call ErrorHandler("getItemAuthorization()")
End Function
' ************************************************************************************

' ************************************************************************************
' **************************** DB-ACCESS FUNCTIONS ***********************************
' ************************************************************************************
' Return the result of a SQL request
' Convert SQL runtime errors and process errors to VB Error
#If LIVE = 1 Then
Private Function OpenSQLSafe(ByVal ao_DB As Object, ByVal as_Request As String, Optional ByVal al_RowExpectedCount = -1) As Long
#Else
Private Function OpenSQLSafe(ByVal ao_DB As ARMSYSCOMLib.ArmDb, ByVal as_Request As String, Optional ByVal al_RowExpectedCount = -1) As Long
#End If

On Error GoTo ErrHandler

    Dim lc_Data As Long
    lc_Data = ao_DB.OpenSQL(as_Request)
    
    If lc_Data = 0 Then
        Err.Raise ArmErr.SQLFailure, "SQL : " & as_Request, Join(ao_DB.SQLErrorCodes, SEP2) & SEP1 & Join(ao_DB.SQLErrorMessages, SEP2)
    End If
'    Debug.Print 1 / 0
    If al_RowExpectedCount <> -1 Then
        ' Then check the rowcount
        If ao_DB.RowCount(lc_Data) <> al_RowExpectedCount Then
            Err.Raise ArmErr.SQLBadRowExpectedCount, "SQL : " & as_Request, al_RowExpectedCount & "<>" & ao_DB.RowCount(lc_Data)
        End If
    End If

    OpenSQLSafe = lc_Data

    Exit Function

ErrHandler:

    Call ErrorHandler("OpenSQLSafe")

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

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

    If al_RowAffectedCount <> -1 Then
        ' Then check the rowcount
        If ao_DB.SQLRowsAffected <> al_RowAffectedCount Then
            
            If ab_DuplicityCheck Then
                Err.Raise ArmCusErr.DuplicityDetected, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_DB.SQLRowsAffected
            Else
                Err.Raise ArmErr.SQLBadRowAffectedCount, "SQL : " & as_Request, al_RowAffectedCount & "<>" & ao_DB.SQLRowsAffected
            End If
        End If
    End If

    Exit Sub

ErrHandler:
    Call ErrorHandler("ExecuteSQLSafe")
End Sub
Private Function SQLStr(ByVal as_str As String, Optional ByVal al_MaxLen As Long = 8000) As String
    SQLStr = Replace(Left(as_str, IIf(Len(as_str) <= al_MaxLen, Len(as_str), al_MaxLen)), "'", "''")
End Function

' **************************** DB-ACCESS FUNCTIONS ***********************************

' ************************************************************************************
' ********************** ERROR-HANDLING SUPPORT FUNCTIONS ****************************
' ************************************************************************************
' Standard error handler
Private Sub ErrorHandler(ByVal as_Fct As String)
    Err.Raise Err.Number, UserControl.Name & "." & UserControl.Ambient.DisplayName & "::" & as_Fct & SEP1 & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Sub
' display standard error message
' Params:
' as_Fct (String) - Error CallStack
' 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


' logs message to database
Private Sub LogMessage(ByVal as_logMsg As String, Optional ByVal as_logType As String = "I", Optional ab_throwException As Boolean = True)
On Error GoTo ErrHandler
Const InsertReq As String = "EXEC A_log_ins $UCODE$, '$LOGTYPE$', '$MSG$', '$APP$'"
    Dim ls_Req As String
    Dim ll_Cursor As Long
    
    ls_Req = Replace(InsertReq, "$UCODE$", CStr(ml_UserCode))
    ls_Req = Replace(ls_Req, "$APP$", SQLStr(C_MODULE_NAME & " " & 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("LogMessage - " & Err.Number & ": " & Err.Description)
End Sub
' ********************** ERROR-HANDLING SUPPORT FUNCTIONS ****************************

Private Sub cbo_category_ComboItemSelected()
On Error GoTo ErrHandler
    If mb_Initializing Then Exit Sub
    Call LockScreen(True)
    If Not tvw_Main.SelectedItem Is Nothing Then
        Call FillProductGrid(cbo_Category.SelectedItem.Key, tvw_Main.SelectedItem.Tag.IDValue)
    End If
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage("cbo_Category_ComboItemSelected")
End Sub

Private Sub cbo_View_ComboItemSelected()
On Error GoTo ErrHandler
    If mb_Initializing Then Exit Sub
    Call LockScreen(True)
    
    Debug.Assert (Not Cbo_View.SelectedItem Is Nothing)
    Call loadMainTreeView(tvw_Main, Cbo_View.SelectedItem.Key, IIf(GetOptionButtonSelected(opt_Internet).Index = 1, "X", ""))
    If gs_MediaCode <> "" Then
        If Not tvw_Main.FindSQL("C:" & gs_MediaCode, tvw_Main.Levels - 1) Then
            gs_MediaCode = ""
        End If
    End If

    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage("cbo_view_ComboItemSelected")
End Sub

Private Sub grd_short_DblClick()
On Error GoTo ErrHandler
    If tvw_Main.SelectedItem Is Nothing Then Exit Sub       ' no media selected
    Call LockScreen(True)
    Dim lo_mtncForm As C_Formulaire
    Set lo_mtncForm = New C_Formulaire
    Set lo_mtncForm.MediaManager = Me
    lo_mtncForm.b_FromCMain = OK
    lo_mtncForm.i_FieldCount = 4
    lo_mtncForm.s_ScreenConstantsReq = "EXEC Screen_Csts 'mtnc_MShortClas', '" & ms_LanguageCode & "'"
    lo_mtncForm.s_Req = "EXEC Media_Short_Classif_del '$ID$',$iConc$ "
    C_Formulaire.e_Action = vbMoreInfo
    '
    lo_mtncForm.s_ID = grd_short.SelectedKey(0)(0)
    lo_mtncForm.i_Concurency = grd_short.SelectedLine(0, "ICONC")
    lo_mtncForm.Field1.s_InitialValue = grd_short.SelectedLine(0, "MD_code")
    lo_mtncForm.Field2.s_InitialValue = grd_short.SelectedLine(0, "PT_title")
    lo_mtncForm.Field3.e_Type = vbComboBox
    lo_mtncForm.Field3.s_FillReq = "Exec Categories_Cbo '" & tlb_short_code.Language & "'"
    lo_mtncForm.Field3.s_InitialCode = grd_short.SelectedLine(0, "CG_CODE")
    lo_mtncForm.Field3.s_InitialValue = grd_short.SelectedLine(0, "CG_Desc")
    lo_mtncForm.Field4.s_InitialValue = grd_short.SelectedLine(0, "BI_MKT_Code")
    lo_mtncForm.b_chkInt = IIf(grd_short.SelectedLine(0, "internet_flag") = "X", OK, KO)
    lo_mtncForm.s_DropDate = grd_short.SelectedLine(0, "drop_date")
    lo_mtncForm.show 1
    
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage("grd_short_DblClick")
End Sub

Private Sub opt_Internet_Click(Index As Integer)
On Error GoTo ErrHandler
    If mb_Initializing Then Exit Sub
    Call LockScreen(True)

    Debug.Assert (Not Cbo_View.SelectedItem Is Nothing)
    Call loadMainTreeView(tvw_Main, Cbo_View.SelectedItem.Key, IIf(GetOptionButtonSelected(opt_Internet).Index = 1, "X", ""))

    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage("opt_Internet_Click")
End Sub

Private Sub tlb_Main_action(ByVal as_Role As String, as_Language As String)
On Error GoTo ErrHandler
    Dim lv_itemKey As Variant
    Dim ls_nodeText As String
    Dim lo_actNode As Node
    Dim lo_actNodeInfo As NodeInfo

    Call LockScreen(True)
    Select Case as_Role
        Case "A" ' add mode
            gs_Action = "add"
            gb_Return = False
            frm_techinfo.show 1
            If gb_Return Then
' fix2 JN 28/1/2008 begin
                Set tvw_Main.SelectedItem = Nothing
                Call FindInTreeView(tvw_Main, GetCurrentPath(gs_MediaCode))
                If Not tvw_Main.SelectedItem Is Nothing Then
                            Call tvw_Main_NodeClick(tvw_Main.SelectedItem)
                        End If
' fix2 JN 28/1/2008 end
                Call ApplyRightsOnToolbar(tlb_Main, tvw_Main.SelectedItem)
            End If

        Case "B" ' update mode
            gs_Action = "upd"
            If Not tvw_Main.SelectedItem Is Nothing Then
                If (getItemAuthorization(tvw_Main.SelectedItem) And MEDIA_UPDATE) = MEDIA_UPDATE Then
                    gs_MediaCode = tvw_Main.SelectedItem.Tag.IDValue
                    gb_Return = False
                    frm_techinfo.show 1
                    If gb_Return Then
                        If tvw_Main.FindSQL("C:" & gs_MediaCode, tvw_Main.Levels - 1) Then
                            ' update data from found node into visible nodes
'                            Do
                                tvw_Main.SelectedItem.Tag.TextValue = tvw_Main.FoundNodeInfo.GetData(tvw_Main.Levels)
                                tvw_Main.SelectedItem.Text = tvw_Main.FoundNodeInfo.GetData(tvw_Main.Levels)
'                            Loop While tvw_main.FindNext()
                        End If
                        Call ApplyRightsOnToolbar(tlb_Main, tvw_Main.SelectedItem)
                    End If
                Else
                    SendMessage 77, "You can't update this object", ms_LanguageCode
                End If
            Else
                SendMessage 1, "Select record first, please", ms_LanguageCode
            End If
    
        Case "C" ' delete mode
            gs_Action = "del"
            If Not tvw_Main.SelectedItem Is Nothing Then
                If (getItemAuthorization(tvw_Main.SelectedItem) And MEDIA_UPDATE) = MEDIA_UPDATE Then
                    gs_MediaCode = tvw_Main.SelectedItem.Tag.IDValue
                    gb_Return = False
                    frm_techinfo.show 1
                    If gb_Return Then
                        Call tvw_Main.RemoveNode(tvw_Main.SelectedItem)
                        gs_MediaCode = ""
                        Call ApplyRightsOnToolbar(tlb_Main, tvw_Main.SelectedItem)
                    End If
                Else
                    SendMessage 78, "You can't delete this object", ms_LanguageCode
                End If
            Else
                SendMessage 1, "Select record first, please", ms_LanguageCode
            End If
    
        Case "D" ' PRINT
            If Printers.Count > 0 Then
                Printer.Font.Name = "Arial"
                Printer.Font.Charset = tvw_Main.Font.Charset

                Printer.Font.Size = 14
                Printer.Font.Bold = OK
                Printer.Print ms_Title
                Printer.Print ""
                Printer.Font.Size = 12
                Printer.Font.Bold = KO
                Call TreeViewPrintNode(tvw_Main.Nodes(1).Root)
                Printer.EndDoc
            
            Else
                SendMessage 135, "No printer is installed on your computer. Please, contact your system administrator.", ms_LanguageCode
            End If
            
        Case "F" ' REFRESH
            Call tvw_Main.Refresh
        Case "T" 'exit module
                RaiseEvent quit
        Case "U" ' media
            If Not tvw_Main.SelectedItem Is Nothing Then
                gs_MediaCode = tvw_Main.SelectedItem.Tag.IDValue
                Media_dsp.ms_Caller = "media"
                Media_dsp.ms_Title = tvw_Main.SelectedItem.Text
                Media_dsp.show 1
            Else
                SendMessage 1, "Select record first, please", ms_LanguageCode
            End If
        
        Case "S" ' help
            frm_help.show 1
        Case "E" ' audit
            If Not tvw_Main.SelectedItem Is Nothing Then
                gs_MediaCode = tvw_Main.SelectedItem.Tag.IDValue
                Dim i As Long
                For i = 0 To 29
                    gs_GridColumn2(i, 1) = i
                Next i
                gs_Param2Req1 = "EXEC Screen_Csts 'aud_MedManager', '" & ms_LanguageCode & "'"
                gs_Param2Req2 = "EXEC Audit_MediaManager_t_lst '" & gs_MediaCode & "','" & ms_LanguageCode & "'"
                gi_GridWidth2(0) = 1500
                gi_GridWidth2(1) = 1500
                gi_GridWidth2(2) = 1500
                gi_GridWidth2(3) = 3000
                For i = 4 To 29
                    gi_GridWidth2(i) = 1
                Next i
                gi_GridNbColumns = 4
                C_audit.show 1
            Else
                SendMessage 1, "Select record first, please", ms_LanguageCode
            End If
        Case Else
            Debug.Assert (False)
    End Select

    Call LockScreen(False)
    Exit Sub
ErrHandler:
    If Err.Number = 364 Then Resume Next
    
    Call LockScreen(False)
    Call ErrorMessage("tlb_main_action")
End Sub

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

    On Error GoTo onError:
    
    FindInTreeView = False
    If aPath = "" Then Exit Function
    
    Dim lValues As Variant
    lValues = Split(aPath, SEP & SEP)

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

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

    Exit Function
onError:
    Call ErrorHandler("FindInTreeView")
End Function

' go to he db for the path
Private Function GetCurrentPath(ByVal as_mediaCode As String) As String
On Error GoTo ErrHandler
Dim ls_Req As String
Dim ll_Cursor As Long
Dim ls_retVal As String
Dim Index As Long

    ls_Req = Replace(ms_searchPathReq, "$0$", "'C:" & as_mediaCode & "'")
    ll_Cursor = OpenSQLSafe(mo_Db, ls_Req)
    
    If Not mo_Db.EOF(ll_Cursor) Then
        For Index = 0 To mo_Db.FieldCount(ll_Cursor) - 1 Step 2
            ls_retVal = ls_retVal & IIf(Index = 0, "", SEP & SEP) & (mo_Db.GetFields(ll_Cursor, Index) & SEP & mo_Db.GetFields(ll_Cursor, Index + 1))
        Next
    End If
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    GetCurrentPath = ls_retVal

    Exit Function
ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call ErrorHandler("GetCurrentPath")
End Function

Private Sub tlb_marketing_action(ByVal as_Role As String, as_Language As String)
On Error GoTo ErrHandler
    If tvw_Main.SelectedItem Is Nothing Then Exit Sub       ' no media selected
    Dim lo_mtncForm As frm_mtnc_mc

    Call LockScreen(True)
    Select Case as_Role
        Case "A" ' add mode
            Set lo_mtncForm = New frm_mtnc_mc
            Set lo_mtncForm.MediaManager = Me
            gs_Action = "add"
            lo_mtncForm.show 1
        Case "B" ' update mode
            If grd_marketing.SelectedCount > 0 Then
                Set lo_mtncForm = New frm_mtnc_mc
                Set lo_mtncForm.MediaManager = Me
                gs_Action = "upd"
                lo_mtncForm.show 1
            Else
                SendMessage 1, "Select record first, please", ms_LanguageCode
            End If

        Case "C" ' delete mode
            If grd_marketing.SelectedCount > 0 Then
                Set lo_mtncForm = New frm_mtnc_mc
                Set lo_mtncForm.MediaManager = Me
                gs_Action = "del"
                lo_mtncForm.show 1
            Else
                SendMessage 1, "Select record first, please", ms_LanguageCode
            End If

        Case "D" ' PRINT
            If Printers.Count > 0 Then
                Call GridPrint(grd_marketing, "")
            Else
                SendMessage 135, "No printer is installed on your computer. Please, contact your system administrator.", ms_LanguageCode
            End If
        Case "Q"    ' marketing language change
            Dim lo_Collection As New Collection
            Call lo_Collection.Add(grd_marketing)
            Call ChangeCharset(lo_Collection, GetCodePageFromLanguage(ml_codePageCursor, as_Language))
            Call FillMarketingGrid(tvw_Main.SelectedItem.Tag.IDValue)
        Case "F" ' REFRESH
            Call grd_marketing.Refresh
        Case "M"    ' SEARCH
            Call Grid_Search(grd_marketing)
        Case Else
            Debug.Assert (False)
    End Select

    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage("tlb_marketing_action")
End Sub

Private Sub tlb_product_action(ByVal as_Role As String, as_Language As String)
On Error GoTo ErrHandler
    If tvw_Main.SelectedItem Is Nothing Then Exit Sub       ' no media selected
    Dim lo_mtncForm As frm_mtnc_cwpr

    Call LockScreen(True)
    Select Case as_Role
        Case "A" ' add mode
            Set lo_mtncForm = New frm_mtnc_cwpr
            Set lo_mtncForm.MediaManager = Me
            gs_TableName = "media_manager"
            gs_Action = "add"
            lo_mtncForm.show 1
        Case "B" ' update mode
            If grd_product.SelectedCount > 0 Then
                If Not cbo_Category.SelectedItem Is Nothing Then
                    Set lo_mtncForm = New frm_mtnc_cwpr
                    Set lo_mtncForm.MediaManager = Me
                    gs_TableName = "media_manager"
                    gs_Action = "upd"
                    lo_mtncForm.show 1
                End If
            Else
                SendMessage 1, "Select record first, please", ms_LanguageCode
            End If

        Case "C" ' delete mode
            If grd_product.SelectedCount > 0 Then
                Set lo_mtncForm = New frm_mtnc_cwpr
                Set lo_mtncForm.MediaManager = Me
                gs_TableName = "media_manager"
                gs_Action = "del"
                lo_mtncForm.show 1
            Else
                SendMessage 1, "Select record first, please", ms_LanguageCode
            End If

        Case "D" ' PRINT
            If Printers.Count > 0 Then
                If Not cbo_Category.SelectedItem Is Nothing Then
                    Call GridPrint(grd_product, cbo_Category.SelectedItem.DisplayText)
                End If
            Else
                SendMessage 135, "No printer is installed on your computer. Please, contact your system administrator.", ms_LanguageCode
            End If
        Case "Q"    ' marketing language change
            Dim lo_Collection As New Collection
            Call lo_Collection.Add(grd_product)
            Call lo_Collection.Add(cbo_Category)
            Call ChangeCharset(lo_Collection, GetCodePageFromLanguage(ml_codePageCursor, as_Language))
            Call FillCategoryCbo(tvw_Main.SelectedItem.Tag.IDValue)
            If Not cbo_Category.SelectedItem Is Nothing Then
                Call FillProductGrid(cbo_Category.SelectedItem.Key, tvw_Main.SelectedItem.Tag.IDValue)
            Else
                Call grd_product.ClearGrid
            End If
        Case "F" ' REFRESH
            Call grd_product.Refresh
        Case "M"    ' SEARCH
            Call Grid_Search(grd_product)
        Case Else
            Debug.Assert (False)
    End Select

    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage("tlb_product_action")
End Sub

Private Sub tlb_short_code_action(ByVal as_Role As String, as_Language As String)
On Error GoTo ErrHandler
    If tvw_Main.SelectedItem Is Nothing Then Exit Sub       ' no media selected

    Dim ll_Cursor As Long
    Dim ls_MediaTitle As String
    Dim lo_mtncForm As C_Formulaire
    
    Call LockScreen(True)
    Select Case as_Role
        Case "A" ' add mode
            ll_Cursor = OpenSQLSafe(mo_Db, "EXEC Media_Title_sel '" & gs_MediaCode & "','E'")
            If Not mo_Db.EOF(ll_Cursor) Then
                ls_MediaTitle = mo_Db.GetFields(ll_Cursor, "PT_title")
            End If
            Call mo_Db.Close(ll_Cursor)
            ll_Cursor = 0
        
            Set lo_mtncForm = New C_Formulaire
            Set lo_mtncForm.MediaManager = Me
            lo_mtncForm.b_CloseAfterAdd = OK
            lo_mtncForm.b_FromCMain = OK
            
            lo_mtncForm.i_FieldCount = 4
            lo_mtncForm.s_ScreenConstantsReq = "EXEC Screen_Csts 'mtnc_MShortClas', '" & ms_LanguageCode & "'"
            lo_mtncForm.s_Req = "EXEC Media_Short_Classif_ins '$Field1$','$Field4$','$Field3.Code$','$chk_Int$','$DropFlag$','$DropDate$'"
            lo_mtncForm.e_Action = vbAdd
            lo_mtncForm.Field1.b_Locked = OK
            lo_mtncForm.Field1.s_InitialValue = gs_MediaCode
            lo_mtncForm.Field2.b_Locked = OK
            lo_mtncForm.Field2.s_InitialValue = ls_MediaTitle
            lo_mtncForm.Field3.e_Type = vbComboBox
            lo_mtncForm.Field3.s_FillReq = "Exec Categories_Cbo '" & as_Language & "'"
            lo_mtncForm.Field3.b_Mandatory = OK
            lo_mtncForm.Field4.b_Mandatory = OK
            lo_mtncForm.Field4.s_CheckExistance = "EXEC BI_Marketing_Search '$Field4$', '$Field3.Code$'"
            lo_mtncForm.Field4.s_FieldDepend = "Field3"
            lo_mtncForm.s_ReturnLine = "$ID$" & Chr(9) & "$iConc$" & Chr(9) & "$Field1$" & Chr(9) & "$Field2$" & Chr(9) & "$Field3.Code$" & Chr(9) & "$Field3.Desc$" & Chr(9) & "$Field4$" & Chr(9) & "$chk_Int$" & Chr(9) & "$DropDate$"
            lo_mtncForm.show 1
        Case "B" ' update mode
            If grd_short.SelectedCount > 0 Then
                Set lo_mtncForm = New C_Formulaire
                Set lo_mtncForm.MediaManager = Me
                lo_mtncForm.b_FromCMain = OK
                lo_mtncForm.i_FieldCount = 4
                lo_mtncForm.s_ScreenConstantsReq = "EXEC Screen_Csts 'mtnc_MShortClas', '" & ms_LanguageCode & "'"
                lo_mtncForm.s_Req = "EXEC Media_Short_Classif_upd '$ID$','$Field1$','$Field4$','$Field3.Code$','$chk_Int$','$DropFlag$','$DropDate$',$iConc$"
                lo_mtncForm.e_Action = vbUpdate
                lo_mtncForm.Field1.b_Locked = OK
                lo_mtncForm.Field2.b_Locked = OK
                '
                lo_mtncForm.s_ID = grd_short.SelectedKey(0)(0)
                lo_mtncForm.i_Concurency = grd_short.SelectedLine(0, "ICONC")
                lo_mtncForm.Field1.s_InitialValue = grd_short.SelectedLine(0, "MD_code")
                lo_mtncForm.Field2.s_InitialValue = grd_short.SelectedLine(0, "PT_title")
                lo_mtncForm.Field3.e_Type = vbComboBox
                lo_mtncForm.Field3.s_FillReq = "Exec Categories_Cbo '" & as_Language & "'"
                lo_mtncForm.Field3.s_InitialCode = grd_short.SelectedLine(0, "CG_CODE")
                lo_mtncForm.Field3.s_InitialValue = grd_short.SelectedLine(0, "CG_Desc")
                lo_mtncForm.Field3.b_Mandatory = OK
                lo_mtncForm.Field4.s_InitialValue = grd_short.SelectedLine(0, "BI_MKT_Code")
                lo_mtncForm.Field4.b_Mandatory = OK
                lo_mtncForm.Field4.s_CheckExistance = "EXEC BI_Marketing_Search '$Field4$', '$Field3.Code$'"
                lo_mtncForm.b_chkInt = IIf(grd_short.SelectedLine(0, "internet_flag") = "X", OK, KO)
                lo_mtncForm.s_DropDate = grd_short.SelectedLine(0, "drop_date")
                lo_mtncForm.s_ReturnLine = "$ID$" & Chr(9) & "$iConc$" & Chr(9) & "$Field1$" & Chr(9) & "$Field2$" & Chr(9) & "$Field3.Code$" & Chr(9) & "$Field3.Desc$" & Chr(9) & "$Field4$" & Chr(9) & "$chk_Int$" & Chr(9) & "$DropDate$"
                lo_mtncForm.show 1
            Else
                SendMessage 1, "Select record first, please", ms_LanguageCode
            End If

        Case "C" ' delete mode
            If grd_short.SelectedCount > 0 Then

                Set lo_mtncForm = New C_Formulaire
                Set lo_mtncForm.MediaManager = Me
                lo_mtncForm.b_FromCMain = OK
                lo_mtncForm.i_FieldCount = 4
                lo_mtncForm.s_ScreenConstantsReq = "EXEC Screen_Csts 'mtnc_MShortClas', '" & ms_LanguageCode & "'"
                lo_mtncForm.s_Req = "EXEC Media_Short_Classif_del '$ID$',$iConc$ "
                lo_mtncForm.e_Action = vbDelete
                '
                lo_mtncForm.s_ID = grd_short.SelectedKey(0)(0)
                lo_mtncForm.i_Concurency = grd_short.SelectedLine(0, "ICONC")
                lo_mtncForm.Field1.s_InitialValue = grd_short.SelectedLine(0, "MD_code")
                lo_mtncForm.Field2.s_InitialValue = grd_short.SelectedLine(0, "PT_title")
                lo_mtncForm.Field3.e_Type = vbComboBox
                lo_mtncForm.Field3.s_FillReq = "Exec Categories_Cbo '" & as_Language & "'"
                lo_mtncForm.Field3.s_InitialCode = grd_short.SelectedLine(0, "CG_CODE")
                lo_mtncForm.Field3.s_InitialValue = grd_short.SelectedLine(0, "CG_Desc")
                lo_mtncForm.Field4.s_InitialValue = grd_short.SelectedLine(0, "BI_MKT_Code")
                lo_mtncForm.b_chkInt = IIf(grd_short.SelectedLine(0, "internet_flag") = "X", OK, KO)
                lo_mtncForm.s_DropDate = grd_short.SelectedLine(0, "drop_date")
                lo_mtncForm.show 1
            Else
                SendMessage 1, "Select record first, please", ms_LanguageCode
            End If

        Case "D" ' PRINT
            If Printers.Count > 0 Then
                Call GridPrint(grd_short, "")
            Else
                SendMessage 135, "No printer is installed on your computer. Please, contact your system administrator.", ms_LanguageCode
            End If
        Case "Q"    ' marketing language change
            Dim lo_Collection As New Collection
            Call lo_Collection.Add(grd_short)
            Call ChangeCharset(lo_Collection, GetCodePageFromLanguage(ml_codePageCursor, as_Language))
            Call FillShortGrid(tvw_Main.SelectedItem.Tag.IDValue)
        Case "F" ' REFRESH
            Call grd_short.Refresh
        Case "M"    ' SEARCH
            Call Grid_Search(grd_short)
        Case Else
            Debug.Assert (False)
    End Select

    Call LockScreen(False)
    Exit Sub
ErrHandler:
    If ll_Cursor <> 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Call LockScreen(False)
    Call ErrorMessage("tlb_short_code_action")
End Sub

Private Sub tvw_main_DblClick()
On Error GoTo ErrHandler
    Call LockScreen(True)
    Debug.Assert (Not tvw_Main.SelectedItem Is Nothing)
    If tvw_Main.SelectedItem.Tag.ml_Level + 1 = tvw_Main.Levels Then
        gs_Action = "moreinfo"
        gs_MediaCode = tvw_Main.SelectedItem.Tag.IDValue
        If gs_MediaCode <> "" Then
            frm_techinfo.show 1
        End If
    End If
    
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    Call LockScreen(False)
    Call ErrorMessage("tvw_main_DblClick")
End Sub

Private Sub tvw_Main_NodeClick(ByVal Node As MSComctlLib.Node)
On Error GoTo ErrHandler
    Call LockScreen(True)
    Debug.Assert (Not tvw_Main.SelectedItem Is Nothing)
    If tvw_Main.SelectedItem.Tag.ml_Level + 1 = tvw_Main.Levels Then
        If gs_MediaCode <> tvw_Main.SelectedItem.Tag.IDValue Then
            gs_MediaCode = tvw_Main.SelectedItem.Tag.IDValue
            mb_Initializing = True
            grd_marketing.Redraw = False
            grd_product.Redraw = False
            grd_short.Redraw = False
            Call FillShortGrid(gs_MediaCode)
            Call FillCategoryCbo(tvw_Main.SelectedItem.Tag.IDValue)
            If Not cbo_Category.SelectedItem Is Nothing Then
                Call FillProductGrid(cbo_Category.SelectedItem.Key, gs_MediaCode)
            Else
                Call grd_product.ClearGrid
            End If
            Call FillMarketingGrid(gs_MediaCode)
            mb_Initializing = False
            grd_marketing.Redraw = True
            grd_product.Redraw = True
            grd_short.Redraw = True
            frm_frames(2).Visible = True
            frm_frames(3).Visible = True
            frm_frames(4).Visible = True
        End If
    Else
        frm_frames(2).Visible = False
        frm_frames(3).Visible = False
        frm_frames(4).Visible = False
        Call grd_marketing.ClearGrid
        Call cbo_Category.Clear
        Call grd_product.ClearGrid
        Call grd_short.ClearGrid
        gs_MediaCode = ""
    End If
    Call ApplyRightsOnToolbar(tlb_Main, tvw_Main.SelectedItem)
    Call LockScreen(False)
    Exit Sub
ErrHandler:
    mb_Initializing = False
    Call LockScreen(False)
    Call ErrorMessage("tvw_main_NodeClick")
End Sub
