VERSION 5.00
Begin VB.UserControl Rpt_Area_Mtnc 
   ClientHeight    =   6615
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   11160
   ScaleHeight     =   6615
   ScaleWidth      =   11160
   Begin VB.Frame frm_rpt_area_detail 
      Caption         =   "#Area detail"
      Height          =   4980
      Left            =   270
      TabIndex        =   0
      Tag             =   "frm_rpt_area_detail"
      Top             =   1260
      Visible         =   0   'False
      Width           =   10755
      Begin Project1.ArmCombobox cbo_market 
         Height          =   345
         Left            =   1380
         TabIndex        =   24
         Top             =   615
         Width           =   4020
         _ExtentX        =   7091
         _ExtentY        =   609
      End
      Begin VB.Frame frm_area_login 
         Caption         =   "#Users assignement"
         Height          =   2670
         Left            =   135
         TabIndex        =   18
         Tag             =   "frm_area_login"
         Top             =   1110
         Width           =   9480
         Begin VB.PictureBox pic_Out 
            AutoSize        =   -1  'True
            Height          =   408
            Left            =   4110
            ScaleHeight     =   345
            ScaleWidth      =   345
            TabIndex        =   22
            TabStop         =   0   'False
            Top             =   1455
            Width           =   408
         End
         Begin VB.PictureBox pic_In 
            AutoSize        =   -1  'True
            Height          =   408
            Left            =   4110
            ScaleHeight     =   345
            ScaleWidth      =   345
            TabIndex        =   21
            TabStop         =   0   'False
            Top             =   735
            Width           =   408
         End
         Begin VB.ListBox lst_selected 
            Appearance      =   0  'Flat
            Height          =   2175
            Left            =   4830
            Sorted          =   -1  'True
            TabIndex        =   20
            Top             =   240
            Width           =   3555
         End
         Begin VB.ListBox lst_available 
            Appearance      =   0  'Flat
            Height          =   2175
            ItemData        =   "Rpt_Area_Mtnc.ctx":0000
            Left            =   135
            List            =   "Rpt_Area_Mtnc.ctx":0002
            Sorted          =   -1  'True
            TabIndex        =   19
            Top             =   240
            Width           =   3555
         End
      End
      Begin VB.Frame fra_manipulation 
         Caption         =   "#Manipulation"
         Height          =   1185
         Left            =   75
         TabIndex        =   4
         Tag             =   "frm_maintenance"
         Top             =   3705
         Width           =   9525
         Begin VB.CheckBox chk_dropped 
            Caption         =   "#Dropped"
            Height          =   255
            Left            =   6555
            TabIndex        =   10
            Tag             =   "chk_dropped"
            Top             =   780
            Width           =   1515
         End
         Begin VB.TextBox txt_dropDate 
            Alignment       =   2  'Center
            Enabled         =   0   'False
            Height          =   330
            Left            =   8250
            TabIndex        =   9
            Tag             =   "txt_dropDate"
            Text            =   "02/02/2001"
            Top             =   322
            Width           =   1095
         End
         Begin VB.TextBox txt_updUser 
            Enabled         =   0   'False
            Height          =   330
            Left            =   3870
            TabIndex        =   8
            Tag             =   "txt_updUser"
            Text            =   "L. Cockayne"
            Top             =   742
            Width           =   2415
         End
         Begin VB.TextBox txt_lastUpd 
            Alignment       =   2  'Center
            Enabled         =   0   'False
            Height          =   330
            Left            =   1740
            TabIndex        =   7
            Tag             =   "txt_lastUpd"
            Text            =   "02/02/2001"
            Top             =   742
            Width           =   1095
         End
         Begin VB.TextBox txt_creator 
            Enabled         =   0   'False
            Height          =   330
            Left            =   3870
            TabIndex        =   6
            Tag             =   "txt_creator"
            Text            =   "L. Cockayne"
            Top             =   322
            Width           =   2415
         End
         Begin VB.TextBox txt_Date 
            Alignment       =   2  'Center
            Enabled         =   0   'False
            Height          =   330
            Left            =   1740
            TabIndex        =   5
            Tag             =   "txt_Date"
            Text            =   "02/02/2001"
            Top             =   322
            Width           =   1095
         End
         Begin VB.Label lbl_label 
            Caption         =   "#Drop date"
            Height          =   255
            Index           =   6
            Left            =   6660
            TabIndex        =   15
            Tag             =   "lbl_dropDate"
            Top             =   360
            Width           =   1530
         End
         Begin VB.Label lbl_label 
            Caption         =   "#By"
            Height          =   255
            Index           =   5
            Left            =   3150
            TabIndex        =   14
            Tag             =   "lbl_creator"
            Top             =   780
            Width           =   690
         End
         Begin VB.Label lbl_label 
            Caption         =   "#Last updade"
            Height          =   255
            Index           =   4
            Left            =   150
            TabIndex        =   13
            Tag             =   "lbl_dateUpd"
            Top             =   780
            Width           =   1530
         End
         Begin VB.Label lbl_label 
            Caption         =   "#By"
            Height          =   255
            Index           =   3
            Left            =   3150
            TabIndex        =   12
            Tag             =   "lbl_ByUser"
            Top             =   360
            Width           =   690
         End
         Begin VB.Label lbl_label 
            Caption         =   "#Creation date"
            Height          =   255
            Index           =   2
            Left            =   150
            TabIndex        =   11
            Tag             =   "lbl_date"
            Top             =   360
            Width           =   1530
         End
      End
      Begin VB.TextBox txt_rar_code 
         Height          =   285
         Left            =   570
         TabIndex        =   2
         Text            =   "Text1"
         Top             =   300
         Width           =   1230
      End
      Begin VB.TextBox txt_rar_desc 
         Height          =   300
         Left            =   1920
         TabIndex        =   1
         Text            =   "Text1"
         Top             =   285
         Width           =   7680
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#Market"
         Height          =   270
         Index           =   1
         Left            =   90
         TabIndex        =   23
         Tag             =   "lbl_Market"
         Top             =   645
         Width           =   1020
      End
      Begin VB.Label lbl_labels 
         Caption         =   "#ID"
         Height          =   270
         Index           =   0
         Left            =   75
         TabIndex        =   3
         Tag             =   "lbl_rar_code"
         Top             =   315
         Width           =   420
      End
   End
   Begin Project1.ArmGrid grd_area 
      Height          =   2655
      Left            =   60
      TabIndex        =   16
      Tag             =   "grd_area"
      Top             =   765
      Visible         =   0   'False
      Width           =   10800
      _ExtentX        =   19050
      _ExtentY        =   4683
   End
   Begin Project1.ToolbarControl tlb_main 
      Height          =   690
      Left            =   0
      TabIndex        =   17
      Top             =   0
      Width           =   10935
      _ExtentX        =   19288
      _ExtentY        =   1217
   End
End
Attribute VB_Name = "Rpt_Area_Mtnc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

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


Private Const SEP = "®©"
Private Const C_SEP As String = "@@"
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"
Private Const FRM_SPACE_VER = 120
Private Const FRM_SPACE_HOR = 100

Private Const SCREEN_NAME As String = "Rpt_Area_Mtnc"
Private Const C_SCREENMODE_STACK_SIZE As Long = 5           ' size of stack for active screens
Private Const C_TLB_RPT_USER_MTNC_ID As Long = 140          ' ID of toolbar - the same for both details
Private Const C_TOOLBARFACE_ITEM_LST As String = "0"        ' toolbar for main list
Private Const C_TOOLBARFACE_ITEM_MTNC As String = "1"       ' for add, update
Private Const C_TOOLBARFACE_ITEM_MTNC2 As String = "2"       ' for delete


Private Type T_RPT_Area
    Login As String
    Desc As String
    RAR_CODE As Long
End Type

Private Type T_Rights_Area
    RAR_CODE As Long
    Rights As String
End Type

Private lta_Logins() As T_RPT_Area
Private mta_Rights() As T_Rights_Area

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

Private Enum ArmErr
    DBCnxFailed = C_ERRORRAISE + 1             ' Unable to connect to the database
    CPTAlreadyInitialized = C_ERRORRAISE + 2   ' We try to initialize a component that is already initialized
    CPTNotInitialized = C_ERRORRAISE + 3       ' We try to use or free that is not initialized yet
    InvalidArgument = C_ERRORRAISE + 4
    PropertyNotSet = C_ERRORRAISE + 5
    SQLFailure = C_ERRORRAISE + 6               ' A SQL runtime error has occured : syntax wrong....
    SQLBadRowAffectedCount = C_ERRORRAISE + 7   ' A SQL request has not affected the expected rowcount (ex: one Update do nothing)
    SQLBadRowExpectedCount = C_ERRORRAISE + 8   ' A SQL request does not return the expected rowcount : select an item return nothing...
    DrivingError = C_ERRORRAISE + 9
    CompFncFailed = C_ERRORRAISE + 10           ' when component function fail
    GridLoadFailed = C_ERRORRAISE + 11          ' load function failed ... bad sql
    InvalidValue = C_ERRORRAISE + 12          ' load function failed ... bad sql
    QuietException = vbObjectError + 13          ' do not display error message
    ErrMsgMandatoryAreEmpty = 2400 + 1
    WarMsgDoYouRemove = 2400 + 2
    ErrMsgIConcurency = 2400 + 3
    WarMsgSelectRow = 2400 + 4
    ErrCodeOutExists = 2440                     ' Code out already defined
    RecordAlreadyDropped = 2441                  ' Record is dropped

End Enum

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

Private Enum ArmScreenMode
    smRefreshOnly                       ' do not change active screen, only refresh active
    smMain
    smAdd
    smUpdate
    smDelete
    smView
End Enum

Private ms_Language_Code As String
Private ms_LoginName As String
Private ml_U_code As Long
Private mb_Initialized As Boolean
Private mb_Initializing As Boolean          ' Flag of initializing
Private mc_ScreenLabels                 As Long         'cursor containing screen constants for current component
Private mua_ActiveMode() As ArmScreenMode

'**********************************************************************************************************************************
'**********************************************************************************************************************************
' FRAMEWORK EVENTS
'**********************************************************************************************************************************
'**********************************************************************************************************************************

Public Event quit()

' FRAMEWORK PROPERTIES
' please DO NOT change anything in this part of code
'**********************************************************************************************************************************
'**********************************************************************************************************************************

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

Public Property Let Top(ByVal aTop As Single)
    UserControl.Extender.Top = aTop
End Property
Public Property Get Top() As Single
    Top = UserControl.Extender.Top
End Property

Public Property Let Height(ByVal aHeight As Single)
    UserControl.Extender.Height = aHeight
End Property
Public Property Get Height() As Single
    Height = UserControl.Extender.Height
End Property

Public Property Let Left(ByVal aLeft As Single)
    UserControl.Extender.Left = aLeft
End Property
Public Property Get Left() As Single
    Left = UserControl.Extender.Left
End Property

Public Property Let Width(ByVal aWidth As Single)
    UserControl.Extender.Width = aWidth
End Property
Public Property Get Width() As Single
    Width = UserControl.Extender.Width
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 Get Initialized() As Boolean
    Initialized = mb_Initialized
End Property

Property Let LoginName(as_Login As String)
    ms_LoginName = as_Login
End Property

Property Let U_Code(al_Code As Long)
    ml_U_code = al_Code
End Property

Property Let Language_Code(AString As String)
    ms_Language_Code = AString
End Property

Public Property Set ArmDb(ByRef local_connection As Object)
    If Not (local_connection Is Nothing) Then
        Set mo_Db = local_connection
    End If
End Property

Public Sub Load_A_Com()
Dim lo_Control As Object
On Error GoTo ErrHandler
    If mb_Initialized Then
        Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    End If
    
    mc_ScreenLabels = 0

    
    For Each lo_Control In UserControl.Controls
        Select Case UCase(TypeName(lo_Control))
        Case "ARMCOMBOBOX"
            Set lo_Control.ArmDb = mo_Db
            Call lo_Control.Load_A_Com
        Case "ARMPICKER"
            Set lo_Control.ArmDb = mo_Db
            Call lo_Control.Load_A_Com
        Case "TOOLBARCONTROL"
            lo_Control.Language = ms_Language_Code
            lo_Control.Load_A_Com
        Case "ARMGRID"
            Set lo_Control.ArmDb = mo_Db
            Call lo_Control.Load_A_Com
        Case "ARMTREEVIEW"
            Set lo_Control.ArmDb = mo_Db
            lo_Control.Language = ms_Language_Code
            Call lo_Control.Load_A_Com
        Case "ARMCHECKVIEW"
            Set lo_Control.ArmDb = mo_Db
            Call lo_Control.Load_A_Com
        Case "A_CALOCX"
            lo_Control.Language = ms_Language_Code
            Call lo_Control.reinit_cal
        End Select
    Next
    
    Call grd_area.SetColumns(Array( _
    Join(Array("rar_code", "0", "1", "rar_code", "#rar_code"), SEP), _
    Join(Array("rar_desc", "3000", "0", "rar_desc", "#description", "", "", "Left"), SEP), _
    Join(Array("BMK_code", "0", "0", "BMK_code", "#BMK_code"), SEP), _
    Join(Array("BMK_desc", "3000", "0", "BMK_desc", "#Market", "", "", "Left"), SEP), _
    Join(Array("z_creation", "1000", "0", "z_creation", "#z_creation", "DATE", "", "Left"), SEP), _
    Join(Array("z_creator", "2000", "0", "z_creator", "#z_creator", "", "", "Left"), SEP), _
    Join(Array("z_last_upd", "1000", "0", "z_last_upd", "#z_last_upd", "DATE", "", "Left"), SEP), _
    Join(Array("z_last_upd_user", "2000", "0", "z_last_upd_user", "#z_last_upd_user", "", "", "Left"), SEP), _
    Join(Array("drop_flag", "500", "0", "drop_flag", "#drop_flag"), SEP), _
    Join(Array("drop_date", "0", "0", "drop_date", "#drop_date", "DATE"), SEP), _
    Join(Array("iConcurrency", "0", "0", "iConcurrency", "#iConcurrency"), SEP)))
    
    Call DefineRights
    
    grd_area.Requests = Array("EXEC Cap_rpt_area_Lst '" & ms_LoginName & "', '" & ms_Language_Code & "'")
    
    mb_Initialized = UBound(mta_Rights) > 0

    Exit Sub
ErrHandler:
    Call ErrorMessage("Load_A_COM")
End Sub

Public Function HaveRights() As Boolean
    HaveRights = UBound(mta_Rights) > 0
End Function

Private Sub DefineRights()
    Const C_REQ As String = "Alias_Cap_RPT_Area_Lst '$LOGIN_NAME$'"
On Error GoTo ErrHandler
    Dim ls_Req As String
    Dim ll_Cursor As Long
    Dim ll_i As Long
    
    ls_Req = Replace(C_REQ, "$LOGIN_NAME$", ms_LoginName, , , vbTextCompare)
    ll_Cursor = OpenSQLSafe(mo_Db, ls_Req)
    
    ReDim mta_Rights(0 To mo_Db.RowCount(ll_Cursor) - 1) As T_Rights_Area
    
    ll_i = 0
    While Not mo_Db.EOF(ll_Cursor)
        mta_Rights(ll_i).RAR_CODE = mo_Db.GetFields(ll_Cursor, "RAR_Code")
        mta_Rights(ll_i).Rights = mo_Db.GetFields(ll_Cursor, "Rights")
        ll_i = ll_i + 1
        Call mo_Db.Next(ll_Cursor)
    Wend
    
    
    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("DefineRights")
End Sub

Public Sub Unload_A_Com()
    
On Error GoTo ErrHandler
    
    Dim lo_Control As Object
    Dim ll_Index As Long
    
    For Each lo_Control In UserControl.Controls
        Select Case UCase(TypeName(lo_Control))
        Case "ARMCOMBOBOX", "TOOLBARCONTROL", "ARMGRID", "ARMTREEVIEW", "ARMCHECKVIEW", "ARMPICKER"
            Call lo_Control.Unload_A_Com
        End Select
    Next
    
    If mc_ScreenLabels <> 0 Then mo_Db.Close (mc_ScreenLabels)
    mc_ScreenLabels = 0

    Set mo_Db = Nothing
    mb_Initialized = False
    Exit Sub
ErrHandler:
    Call ErrorMessage("Unload_A_Com")
End Sub

Public Function Init_control() As Boolean
Dim ll_Index As Long

On Error GoTo ErrHandler
    
    ReDim Preserve mua_ActiveMode(0)
    mua_ActiveMode(UBound(mua_ActiveMode)) = ArmScreenMode.smMain
    
    tlb_main.Visible = False
    grd_area.Visible = False
    frm_rpt_area_detail.Visible = False

    pic_In.Picture = LoadResPicture(RES_RIGHT, 1)
    pic_Out.Picture = LoadResPicture(RES_LEFT, 1)
    Call ChangeCharset(UserControl.Controls, GetCodePageFromLanguage(mo_Db, ms_Language_Code))
    Call LoadLabels(mo_Db, Me, SCREEN_NAME, ms_Language_Code)
    
    Call grd_area.Refresh
    
    Dim ll_Cursor As Long
    ll_Cursor = OpenSQLSafe(mo_Db, "EXEC Cap_rpt_login_Lst")
    
    ReDim lta_Logins(0 To mo_Db.RowCount(ll_Cursor) - 1) As T_RPT_Area
    Dim ll_Idx As Long

    ll_Idx = 0
    While Not mo_Db.EOF(ll_Cursor)
        lta_Logins(ll_Idx).Login = mo_Db.GetFields(ll_Cursor, "SR_Code")
        lta_Logins(ll_Idx).Desc = CapitalLetter(mo_Db.GetFields(ll_Cursor, "login_desc")) & " (" & mo_Db.GetFields(ll_Cursor, "SR_Code") & ")"
        lta_Logins(ll_Idx).RAR_CODE = 0
        Call mo_Db.Next(ll_Cursor)
        ll_Idx = ll_Idx + 1
    Wend
    
    Call mo_Db.Close(ll_Cursor)
    
    cbo_Market.Request = "EXEC Business_market_RPT_Area_Lst '" & ms_LoginName & "','" & ms_Language_Code & "'"
    
    Call LoadToolbars
    tlb_main.Visible = True
    
    Call Item_Empty
    Call ResetScreen(activeScreenMode)
    Call UpdateUI
    
    Init_control = True
    Exit Function
ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
        ll_Cursor = 0
    End If
    Init_control = False
    Call ErrorMessage("Init_control")
End Function

Private Function CapitalLetter(ByVal as_str As String) As String
On Error GoTo ErrHandler
    CapitalLetter = ""
    Dim i As Long
    
    If as_str <> "" Then
        as_str = LCase(as_str)
       Mid$(as_str, 1, 1) = UCase$(Mid$(as_str, 1, 1))
       For i = 1 To Len(as_str) - 1
          If Mid$(as_str, i, 2) = Chr$(13) + Chr$(10) Then
             ' Capitalize words preceded by carriage return plus
             ' linefeed combination. This only applies when the
             ' text box's MultiLine property is set to True:
             Mid$(as_str, i + 2, 1) = UCase$(Mid$(as_str, i + 2, 1))
          End If
          If Mid$(as_str, i, 1) = " " Then
             ' Capitalize words preceded by a space:
             Mid$(as_str, i + 1, 1) = UCase$(Mid$(as_str, i + 1, 1))
          End If
       Next
    End If
    CapitalLetter = as_str
    Exit Function
ErrHandler:
     Call ErrorHandler(Extender.Name & ".CapitalLetter")
End Function

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

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


' ************************************************************************************
' ********************** ERROR-HANDLING SUPPORT FUNCTIONS ****************************
' ************************************************************************************
' Standard error handler
Private Sub ErrorHandler(ByVal as_Fct As String)
    Err.Raise Err.Number, 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_U_code))
    ls_Req = Replace(ls_Req, "$APP$", SQLStr(SCREEN_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(Extender.Name & ".LogMessage - " & Err.Number & ": " & Err.Description)
End Sub

' ********************** ERROR-HANDLING SUPPORT FUNCTIONS ****************************
' ************************************************************************************
' FRAMEWORK DB-ACCESS FUNCTIONS
' please do not change this code
' ************************************************************************************

' Return the result of a SQL request
' Convert SQL runtime errors and process errors to VB Error
#If ENV = LIVE 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
    
    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 ENV = LIVE 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 GetDbError(ByVal lo_Db As ARMSYSCOMLib.ArmDb) As String
On Error GoTo ErrHandler
    
    If IsArray(lo_Db.SQLErrorMessages) Then
        Debug.Assert (IsArray(mo_Db.SQLErrorCodes))
        ' Display errors msgBox
        GetDbError = Join(lo_Db.SQLErrorCodes, ",") & vbCrLf & Join(lo_Db.SQLErrorMessages, vbCrLf)
    Else
        ' ExecuteSQL failed but no error message?
        GetDbError = "Unknown error"
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler("GetDbError()")
End Function

Private Function GetNextID(ByVal as_Key As String) As String
On Error GoTo ErrHandler
Dim ls_Data As String

    ls_Data = mo_Db.SQLNextID(as_Key)
    If ls_Data = "" Then
        Err.Raise ArmErr.CompFncFailed, "mo_Db.SQLNextID", "SQLNextID failed for key: " & as_Key
    End If
    GetNextID = ls_Data
    Exit Function
ErrHandler:
    Call ErrorHandler("GetNextID()")
End Function

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

Private 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
        UserControl.Enabled = False
        LockWindowUpdate UserControl.hwnd
        lb_Locked = True
    End If
    
    ' Unlock
    If ll_Count = 0 Then
        DoEvents ' Flush events
        LockWindowUpdate 0
        UserControl.Enabled = True
        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 Function BeginTran(as_Tran As String) As Boolean

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

    BeginTran = True
    Exit Function
    
ErrHandler:
    'try to log error
    Call LogMessage("BeginTran: " & as_Tran)
    Call mo_Db.Disconnect
    Set mo_Db = Nothing
    MsgBox "A Fatal error occured in " & SCREEN_NAME & ".BeginTran, your application will be close. Please contact your IT support", vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
    End
End Function

Private Function CommitTran(as_Tran As String) As Boolean

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

    CommitTran = True
    Exit Function
    
ErrHandler:
    'try to log error
    Call LogMessage("CommitTran: " & as_Tran)
    Call mo_Db.Disconnect
    Set mo_Db = Nothing
    MsgBox "A Fatal error occured in " & SCREEN_NAME & ".CommitTran, your application will be close. Please contact your IT support", vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
    End

End Function

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

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


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

    RollbackTran = True
    Exit Function
    
ErrHandler:
    'try to log error
    Call LogMessage("RollbackTran: " & as_Tran)
    Call mo_Db.Disconnect
    Set mo_Db = Nothing
    MsgBox "A Fatal error occured in " & SCREEN_NAME & ".RollbackTran, your application will be close. Please contact your IT support", vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
    End
End Function

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

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

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

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

On Error GoTo ErrHandler

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

Private Sub ChangeCharset(ByRef ao_Container As Object, Optional ByVal aCodePage As Long)

On Error GoTo ErrHandler
   
    Dim lc_Control As Control
    Dim ll_Charset As Long
    
    On Error Resume Next
    ll_Charset = GetCharSetFromCodePage(aCodePage)
    
    For Each lc_Control In ao_Container
        Select Case UCase(TypeName(lc_Control))
        Case "TABSTRIP", "TEXTBOX", "LABEL", "FRAME", "COMMANDBUTTON", _
              "LISTVIEW", "CHECKBOX", "OPTIONBUTTON", _
              "ARMCHECKVIEW", "ARMTREEVIEW", "ARMGRID", "ARMCOMBOBOX", "ARMCHECKVIEW0", "ARMPICKER"
            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 lo_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
Dim lc_Labels As Long
Dim lsa_ControlTag() As String
    
    On Error GoTo Trace_Err

    If mc_ScreenLabels = 0 Then
        ls_Request = "exec screen_csts '" & as_ScreenName & "','" & as_Language & "'"
        mc_ScreenLabels = OpenSQLSafe(ao_Armdb, ls_Request)
    End If
    lc_Labels = mc_ScreenLabels
    
    If lc_Labels = 0 Then
        Exit Sub
    End If
    
    On Error GoTo WithoutTag
    If ao_Container.Tag <> "" Then
        li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", ao_Container.Tag, , 1)
        If li_Label >= 0 Then
            ao_Container.Caption = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
        End If
    End If
WithoutTag:
    
    On Error GoTo Trace_Err
    
    ' Iterate the container for loading the label of each element which has defined a tag
    For Each lo_Control In UserControl.Controls
        
        If HasContainer(lo_Control, ao_Container) Or _
          ((ao_Container Is Me) And (UCase(TypeName(lo_Control)) = "MENU")) Then
            Select Case UCase(TypeName(lo_Control))
                Case UCase("TabStrip") ' Component is a tabstrip, we load the caption of each tab defined
                    Dim lo_Tbs
                    Set lo_Tbs = lo_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 = lo_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 = lo_Control
                    If lo_TextBox.Tag <> "" Then
                        lsa_ControlTag = Split(lo_Control.Tag, SEP)
                        li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lsa_ControlTag(0), , 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("Label"), UCase("Frame"), UCase("CommandButton"), UCase("CheckBox"), UCase("OptionButton")
                    If lo_Control.Tag <> "" Then
                        lsa_ControlTag = Split(lo_Control.Tag, SEP)
                        li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lsa_ControlTag(0), , 1)
                        If li_Label >= 0 Then
                            lo_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", lo_Control.Tag, , 1)
                    If li_Label >= 0 Then
                      Call lo_Control.LoadConstants(ptStatic, ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT"), ctColumns)
                    End If
                    li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lo_Control.Tag & "_Title", , 1)
                    If li_Label >= 0 Then
                      lo_Control.Title = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                    End If
                Case UCase("Menu")
                    If lo_Control.Tag <> "" Then
                        li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lo_Control.Tag, , 1)
                        If li_Label >= 0 Then
                            lo_Control.Caption = ao_Armdb.GetFields(lc_Labels, "LOCAL_TEXT")
                        End If
                    End If
            End Select
        End If
    Next
        
Trace_End:
    Exit Sub
    
Trace_Err:
      
End Sub


Private Function HasContainer(ByVal lo_Control As Control, ByRef lo_Container As Object) As Boolean
    Dim ll_Index As Long
    Dim lo_Object As Object

    On Error GoTo CleanUp   'not all controls support Container property
    HasContainer = False
    While Not (lo_Control Is Nothing)
        If lo_Control.Container Is lo_Container Then
            HasContainer = True
            Exit Function
        End If
        Set lo_Control = lo_Control.Container
    Wend

CleanUp:

End Function

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

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

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


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

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

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

    SQLDateTime = "NULL"
    If IsNull(av_Data) Then av_Data = ""
    If (Trim(CStr(av_Data)) <> "") And (CStr(av_Data) <> "0") Then
        SQLDateTime = "'" & Format(av_Data, "yyyy-mm-dd hh:mm:ss") & "'"
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler("SqlDateTime")
End Function


Private Function SQLStr(ByVal as_Value As String, Optional ByVal al_MaxLen As Long = 8000, Optional ByVal ab_EmptyNULL As Boolean = False) As String
    If as_Value = "" And ab_EmptyNULL Then
        SQLStr = "NULL"
    Else
        SQLStr = "'" & Replace(Left(as_Value, IIf(Len(as_Value) <= al_MaxLen, Len(as_Value), al_MaxLen)), "'", "''") & "'"
    End If
End Function



Private Function ReplacePlaceHolder(ByVal as_Request As String, ByVal as_PlaceHolder As String, ByVal as_DefaultValue As String) As String
On Error GoTo ErrHandler
    
    as_Request = Replace(as_Request, as_PlaceHolder, as_DefaultValue, , , vbTextCompare)
    
    ReplacePlaceHolder = as_Request
    Exit Function
ErrHandler:
    Call ErrorHandler("ReplacePlaceholder")
End Function


Public Sub Resize()
On Error GoTo ErrHandler

Dim ll_Index As Long

    If Width < 10000 Or Height < 5200 Then Exit Sub
    
    Call tlb_main.Move(FRM_SPACE_HOR, FRM_SPACE_VER, Width - 3 * FRM_SPACE_HOR, tlb_main.Height)
    Call grd_area.Move(tlb_main.Left, tlb_main.Top + tlb_main.Height + FRM_SPACE_HOR, tlb_main.Width, Height - (tlb_main.Top + tlb_main.Height + FRM_SPACE_HOR))
     
    Call frm_rpt_area_detail.Move(grd_area.Left, grd_area.Top, grd_area.Width, grd_area.Height)
    Call fra_manipulation.Move(FRM_SPACE_HOR, frm_rpt_area_detail.Height - fra_manipulation.Height - FRM_SPACE_VER)
   
    Call frm_area_login.Move(FRM_SPACE_HOR, cbo_Market.Top + cbo_Market.Height, frm_rpt_area_detail.Width - (2 * FRM_SPACE_HOR), frm_rpt_area_detail.Height - (cbo_Market.Top + cbo_Market.Height + fra_manipulation.Height + (3 * FRM_SPACE_VER)))
    
    lst_available.Height = frm_area_login.Height - (3 * FRM_SPACE_HOR)
    lst_Selected.Height = frm_area_login.Height - (3 * FRM_SPACE_HOR)
    
    Exit Sub
ErrHandler:
    Call ErrorMessage("Resize")
End Sub

Private Sub grd_area_DblClick()
On Error GoTo ErrHandler
    If grd_area.SelectedCount = 0 Then Exit Sub
    
    Call Item_ViewInit(grd_area.SelectedKey(0))
    Exit Sub
ErrHandler:
    Call ErrorMessage("grd_area_DblClick")
End Sub

Private Sub grd_area_RowColChange()
On Error GoTo ErrHandler
    If grd_area.SelectedCount = 0 Then Exit Sub
    
    Call ApplyRights(tlb_main)

    Exit Sub
ErrHandler:
    Call ErrorMessage("grd_area_RowColChange")
End Sub

Private Sub ApplyRights(ByRef ao_tlb As ToolbarControl)
On Error GoTo ErrHandler
    If grd_area.SelectedCount = 0 Then Exit Sub
    ao_tlb.Redraw = False
    
    Dim ll_rar_code As Long
    Dim ll_i As Long
    
    ao_tlb.ButtonVisible("A") = False     ' insert
    ao_tlb.ButtonVisible("B") = False     ' update
    ao_tlb.ButtonVisible("C") = False     ' delete
    
    
    ll_rar_code = grd_area.SelectedLine(0, "rar_code")
    Dim lb_canAdd As Boolean
    lb_canAdd = False
    
    For ll_i = LBound(mta_Rights) To UBound(mta_Rights)
        If InStr(1, mta_Rights(ll_i).Rights, "I", vbTextCompare) > 0 Then
            lb_canAdd = True
        End If
        
        If mta_Rights(ll_i).RAR_CODE = ll_rar_code Then
            ao_tlb.ButtonVisible("A") = True    ' insert
            ao_tlb.ButtonVisible("B") = True    ' update
            ao_tlb.ButtonVisible("C") = True    ' delete
            
            ao_tlb.ButtonEnabled("B") = InStr(1, mta_Rights(ll_i).Rights, "U", vbTextCompare) > 0     ' update
            ao_tlb.ButtonEnabled("C") = InStr(1, mta_Rights(ll_i).Rights, "D", vbTextCompare) > 0     ' delete
            If lb_canAdd Then Exit For
        End If
    Next
    ao_tlb.ButtonEnabled("A") = lb_canAdd     ' insert is allowed if there is at least one area with possibility to add users into area

    tlb_main.Redraw = True
    Exit Sub
ErrHandler:
    tlb_main.Redraw = True
    Call ErrorHandler("ApplyRights")
End Sub




Private Sub pic_In_Click()
On Error GoTo ErrHandler
    If lst_available.SelCount = 0 Then Exit Sub
    
    Call lst_Selected.AddItem(lst_available.List(lst_available.ListIndex))
    lst_Selected.ItemData(lst_Selected.NewIndex) = lst_available.ItemData(lst_available.ListIndex)
    lst_Selected.Selected(lst_Selected.NewIndex) = True
    Call lst_available.RemoveItem(lst_available.ListIndex)
    
    Exit Sub
ErrHandler:
    Call ErrorMessage("pic_In_Click")
End Sub

Private Sub pic_Out_Click()
On Error GoTo ErrHandler
    If lst_Selected.SelCount = 0 Then Exit Sub

    Call lst_available.AddItem(lst_Selected.List(lst_Selected.ListIndex))
    lst_available.ItemData(lst_available.NewIndex) = lst_Selected.ItemData(lst_Selected.ListIndex)
    lst_available.Selected(lst_available.NewIndex) = True
    Call lst_Selected.RemoveItem(lst_Selected.ListIndex)

    Exit Sub
ErrHandler:
    Call ErrorMessage("pic_Out_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

    Call LockScreen(True)
    Select Case as_Role
        Case "A" ' add mode
            Select Case activeScreenMode
                Case smMain
                    Call Item_AddInit
                Case Else
                    Debug.Assert (False)
            End Select
        Case "B" ' update mode
            Select Case activeScreenMode
                Case smMain
                    If grd_area.SelectedCount = 0 Then
                        Call SendMessage(WarMsgSelectRow, "#Please select a row.", ms_Language_Code)
                    ElseIf grd_area.SelectedLine(0, "Drop_Flag") = "X" Then
                        Call SendMessage(RecordAlreadyDropped, "#Item already dropped.", ms_Language_Code)
                    Else
                        Call Item_UpdateInit(grd_area.SelectedKey(0))
                    End If
                Case Else
                    Debug.Assert (False)
            End Select
        Case "C" ' delete mode
            Select Case activeScreenMode
                Case smMain
                    If grd_area.SelectedCount = 0 Then
                        Call SendMessage(WarMsgSelectRow, "#Please select a row.", ms_Language_Code)
                    ElseIf grd_area.SelectedLine(0, "Drop_Flag") = "X" Then
                        Call SendMessage(RecordAlreadyDropped, "#Item already dropped.", ms_Language_Code)
                    Else
                        Call Item_DeleteInit(grd_area.SelectedKey(0))
                    End If
                Case Else
                    Debug.Assert (False)
            End Select
        Case "T" ' exit to previous screen mode
            Select Case activeScreenMode
                Case smMain
                    'exit module
                    RaiseEvent quit
                Case smAdd, smUpdate, smDelete, smView
                    ' pop screen mode
                    Call popScreenMode
                    
                    Call ResetScreen(activeScreenMode)
                    Call UpdateUI
                
                Case Else
                    Debug.Assert (False)
            End Select
                
        Case "H" ' confirm
            Dim lo_exitGrid As ArmGrid
            
            Select Case activeScreenMode
                Case smAdd
                    lv_itemKey = Item_Add ' store new claim
                    Set lo_exitGrid = grd_area
                Case smUpdate
                    lv_itemKey = Item_Update(grd_area.SelectedKey(0), grd_area.SelectedLine(0, "iConcurrency"))  ' update existing claim
                    Set lo_exitGrid = grd_area
                Case smDelete
                    lv_itemKey = Item_Delete(grd_area.SelectedKey(0), grd_area.SelectedLine(0, "iConcurrency"))  ' delete existing claim
                    Set lo_exitGrid = grd_area
                Case Else
                    Debug.Assert (False)
            End Select
            If Not IsEmpty(lv_itemKey) Then
                Dim old_sm As ArmScreenMode
                old_sm = activeScreenMode
                
                Call Item_ExitToGrid(lo_exitGrid, lv_itemKey)
                If old_sm = smAdd Then
                    Debug.Assert (activeScreenMode = smMain)
                    Debug.Assert (lo_exitGrid.Row <> -1)
                    Debug.Assert (lo_exitGrid.SelectedKey(0)(0) = lv_itemKey(0))
                End If
            End If

        Case "I" ' restore values
            Select Case activeScreenMode
                Case smAdd
                    Call Item_Clear
                    Call Item_AddLoadValues
                Case smUpdate
                    Call LoadDataFromGrid(grd_area)
                Case Else
                    Debug.Assert (False)
            End Select
        Case Else
            Debug.Assert (False)
    End Select

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

Private Sub UserControl_Resize()
    Call Resize
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
            Call SetEnabledCtrl(tlb_main, True)
            Call SetEnabledCtrl(grd_area, True)
            
            ' disable detail controls
            Call SetEnabled(GetContainedControlsChain(frm_rpt_area_detail), False)
            
        Case smAdd
            ' we are in Add section
            Call SetEnabledCtrl(tlb_main, True)
            Call SetEnabledCtrl(grd_area, False)
            
            ' enable detail controls
            Call SetEnabled(GetContainedControlsChain(frm_rpt_area_detail), True)
            
            Call SetEnabled(GetContainedControlsChain(fra_manipulation), False)
            Call SetEnabledCtrl(txt_rar_code, False)
        
        Case smUpdate
            ' we are in Update section
            Call SetEnabledCtrl(tlb_main, True)
            Call SetEnabledCtrl(grd_area, False)
            
            ' disable detail controls
            Call SetEnabled(GetContainedControlsChain(frm_rpt_area_detail), True)
            
            Call SetEnabled(GetContainedControlsChain(fra_manipulation), False)
            Call SetEnabledCtrl(txt_rar_code, False)
            
        Case smDelete, smView
            ' we are in PreView section
            Call SetEnabledCtrl(tlb_main, True)
            Call SetEnabledCtrl(grd_area, False)
            
            ' disable detail controls
            Call SetEnabled(GetContainedControlsChain(frm_rpt_area_detail), False)
        
        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

    frm_rpt_area_detail.Visible = False
    grd_area.Visible = False
    tlb_main.Redraw = False
    
    ' we have clean screen we can display proper controls
    Select Case activeScreenMode
        Case smMain
            grd_area.Visible = True
            
            Call tlb_main.DisplayFace(C_TOOLBARFACE_ITEM_LST)
            Call ApplyRights(tlb_main)
        Case smAdd
            ' we are in Add section
            frm_rpt_area_detail.Visible = True
            
            lst_available.Visible = True
            pic_In.Visible = True
            pic_Out.Visible = True
            
            Call tlb_main.DisplayFace(C_TOOLBARFACE_ITEM_MTNC)
        Case smUpdate
            ' we are in Update section
            frm_rpt_area_detail.Visible = True
            
            lst_available.Visible = True
            pic_In.Visible = True
            pic_Out.Visible = True
            
            Call tlb_main.DisplayFace(C_TOOLBARFACE_ITEM_MTNC)
        Case smDelete
            ' we are in Delete section
            frm_rpt_area_detail.Visible = True
            
            lst_available.Visible = False
            pic_In.Visible = False
            pic_Out.Visible = False
            
            Call tlb_main.DisplayFace(C_TOOLBARFACE_ITEM_MTNC2)
        Case smView
            ' we are in View section
            frm_rpt_area_detail.Visible = True
            
            lst_available.Visible = False
            pic_In.Visible = False
            pic_Out.Visible = False
            
            Call tlb_main.DisplayFace(C_TOOLBARFACE_ITEM_MTNC2)
            tlb_main.ButtonVisible("H") = False
        Case Else
            Debug.Assert (False)
    End Select
    
    tlb_main.Redraw = True

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

Private Sub LoadDataFromGrid(ByRef ao_grid As ArmGrid, Optional ByVal ll_Row As Long = -1)
On Error GoTo ErrHandler
    If ll_Row = -1 Then
        ll_Row = ao_grid.Row
    End If

    txt_rar_code.Text = ao_grid.Data(ll_Row, "rar_code")
    txt_rar_desc.Text = ao_grid.Data(ll_Row, "rar_desc")
    
    txt_Date.Text = Format(ao_grid.Data(ll_Row, "z_creation"), "dd\/mm\/yyyy")
    Txt_Creator.Text = ao_grid.Data(ll_Row, "z_creator")
    txt_lastUpd.Text = Format(ao_grid.Data(ll_Row, "z_last_upd"), "dd\/mm\/yyyy")
    txt_updUser.Text = ao_grid.Data(ll_Row, "z_last_upd_user")
    txt_dropDate.Text = Format(ao_grid.Data(ll_Row, "drop_date"), "dd\/mm\/yyyy")
    chk_dropped.value = IIf(ao_grid.Data(ll_Row, "drop_flag") = "X", 1, 0)
    
    If Not cbo_Market.SearchItem(ao_grid.Data(ll_Row, "bmk_code")) Then
        Call cbo_Market.Load
        Call cbo_Market.SearchItem(ao_grid.Data(ll_Row, "bmk_code"))
    End If
    
    ' LOAD checkview
    Dim ll_Cursor As Long
    ll_Cursor = OpenSQLSafe(mo_Db, "EXEC Cap_rpt_login_Lst2")
    lst_available.Clear
    lst_Selected.Clear
    
    Dim ll_i As Long
    Dim ll_rar_code As Long
    ll_rar_code = ao_grid.Data(ll_Row, "rar_code")
    
    For ll_i = LBound(lta_Logins) To UBound(lta_Logins)
        If mo_Db.FindBinary(ll_Cursor, "SR_Code", lta_Logins(ll_i).Login) > -1 Then
            If mo_Db.GetFields(ll_Cursor, "rar_code") = ll_rar_code Then
                lst_Selected.AddItem (lta_Logins(ll_i).Desc)
                lst_Selected.ItemData(lst_Selected.NewIndex) = ll_i
                lta_Logins(ll_i).RAR_CODE = txt_rar_code.Text
            End If
        Else
            Call lst_available.AddItem(lta_Logins(ll_i).Desc)
            lst_available.ItemData(lst_available.NewIndex) = ll_i
            lta_Logins(ll_i).RAR_CODE = 0
        End If
    Next

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

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

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


Private Function GetContainedControlsChain(ByVal ao_parent As Object) As Collection
On Error GoTo ErrHandler
    Dim lo_retCollection As New Collection
    Dim lo_Control As Object

    For Each lo_Control In Controls
        If Not TypeOf lo_Control.Container Is Rpt_Area_Mtnc Then
            If ao_parent.hwnd = lo_Control.Container.hwnd Then
                If TypeOf lo_Control Is Frame Then
                    Dim lo_aux_collection As New Collection
                    Dim ll_i As Long
                    Set lo_aux_collection = GetContainedControlsChain(lo_Control)
                    For ll_i = 1 To lo_aux_collection.Count
                        lo_retCollection.Add (lo_aux_collection.Item(ll_i))
                    Next
                Else
                    Call lo_retCollection.Add(lo_Control)
                End If
            End If
        End If
    Next
    Set GetContainedControlsChain = lo_retCollection
    Exit Function
ErrHandler:
    Call ErrorHandler("GetContainedControlsChain()")
End Function

Private Function LoadToolbars() As Boolean
On Error GoTo ErrHandler
    Const CL_REQUEST_TB As String = "A_ToolbarDef_sel 1, 3, 4, $id$"
    Dim ll_Cursor As Long

    ll_Cursor = OpenSQLSafe(mo_Db, Replace(CL_REQUEST_TB, "$id$", "NULL"))
    If mo_Db.Find(ll_Cursor, "id", C_TLB_RPT_USER_MTNC_ID) >= 0 Then
        Call tlb_main.SetToolbarInfoStringParameters(mo_Db.GetFields(ll_Cursor, "info"), Left(mo_Db.GetFields(ll_Cursor, "info"), 3))
    Else
        Call Err.Raise(ArmErr.InvalidArgument, "mo_Db.Find", "Toolbar id(" & C_TLB_RPT_USER_MTNC_ID & ") not found in DB")
    End If
    
    Call mo_Db.Close(ll_Cursor)
    ll_Cursor = 0
    
    LoadToolbars = True
    Exit Function
ErrHandler:
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
    End If
    LoadToolbars = False
    Call ErrorHandler("LoadToolbars()")
End Function

' initialize add mode
Private Sub Item_AddInit()
On Error GoTo ErrHandler
    ' clearing form
    Call ResetScreen(ArmScreenMode.smAdd)
    Call Item_Clear
    Call Item_AddLoadValues
    Call UpdateUI(ArmScreenMode.smAdd)
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_AddInit")
End Sub

Private Sub Item_AddLoadValues()
On Error GoTo ErrHandler

    ' load values into the listboxes
    Dim ll_i As Long
    For ll_i = LBound(lta_Logins) To UBound(lta_Logins)
        Call lst_available.AddItem(lta_Logins(ll_i).Desc)
        lst_available.ItemData(lst_available.NewIndex) = ll_i
    Next
    
    txt_rar_code.Text = "NEW"
    txt_rar_desc.Text = ""
    
    txt_Date.Text = Format(Now, "dd\/mm\/yyyy")
    Txt_Creator.Text = ms_LoginName
    txt_lastUpd.Text = Format(Now, "dd\/mm\/yyyy")
    txt_updUser.Text = ms_LoginName

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

' initialize delete mode
Private Sub Item_DeleteInit(ByVal as_detailKey As Variant)
On Error GoTo ErrHandler
    Call ResetScreen(ArmScreenMode.smDelete)
    Call Item_Clear
    If grd_area.SearchKey(True, as_detailKey) Then
        Call LoadDataFromGrid(grd_area)
        chk_dropped.value = 1
        txt_dropDate.Text = Format(Now, "dd\/mm\/yyyy")
    End If
    Call UpdateUI(ArmScreenMode.smDelete)
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_DeleteInit")
End Sub

' initialize delete mode
Private Sub Item_ViewInit(ByVal as_detailKey As Variant)
On Error GoTo ErrHandler
    Call ResetScreen(ArmScreenMode.smView)
    Call Item_Clear
    If grd_area.SearchKey(True, as_detailKey) Then
        Call LoadDataFromGrid(grd_area)
    End If
    Call UpdateUI(ArmScreenMode.smView)
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_ViewInit")
End Sub
' initialize update mode
Private Sub Item_UpdateInit(ByVal as_detailKey As Variant)
On Error GoTo ErrHandler
    
    Call ResetScreen(ArmScreenMode.smUpdate)
    Call Item_Clear
        
    If grd_area.SearchKey(True, as_detailKey) Then
        Call LoadDataFromGrid(grd_area)
    End If
    Call UpdateUI(ArmScreenMode.smUpdate)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_UpdateInit")
End Sub

' adds current edited item
Private Function Item_Add() As Variant
On Error GoTo ErrHandler
    ' check values and throw message if neccessary
    If txt_rar_desc.Text = "" Then
        Call SendMessage(ErrMsgMandatoryAreEmpty, "#Mandatory fields are not filled.", ms_Language_Code)
        Exit Function
    End If
    
    Dim lb_inTransaction As Boolean
    
    Dim ls_newCode As String
    ' get new code
    ls_newCode = mo_Db.SQLNextID("RAR_CODE")
    If ls_newCode = "" Then
        Call Err.Raise(CompFncFailed, "Item_Add", "Cannot generate next ID for RAR_CODE.")
    End If

    ASC_BeginTransaction mo_Db, "CM_ADD"
    lb_inTransaction = True
    
    Call Item_AddDB(CLng(ls_newCode))
    Call Item_UpdateLinkDB(CLng(ls_newCode))
    
    ASC_CommitTransaction mo_Db, "CM_ADD"
    lb_inTransaction = False
    
    ' refresh rights
    Call DefineRights
    
    Item_Add = CVar(Array(CLng(ls_newCode)))
    Exit Function
ErrHandler:
    If lb_inTransaction Then
        ASC_RollBackTransaction mo_Db, "CM_ADD"
        lb_inTransaction = False
    End If
    If Err.Number = SQLBadRowAffectedCount Then
        Call MsgBox("Error occured while inserting record, please contact IT")
        Exit Function
    End If

    Call ErrorHandler(Extender.Name & ".Item_Add")
End Function

' update current edited item
Private Function Item_Update(ByVal av_oldKey As Variant, ByVal al_iCOnc As Long) As Variant
On Error GoTo ErrHandler
    Debug.Assert (txt_rar_code.Text = av_oldKey(0))
    
    ' update data per tab
    Dim lb_inTransaction As Boolean
    
    ASC_BeginTransaction mo_Db, "CM_UPDATE"
    lb_inTransaction = True

    ' save tab
    Call Item_UpdateDB(av_oldKey(0), al_iCOnc)
    Call Item_UpdateLinkDB(av_oldKey(0))

    
    ASC_CommitTransaction mo_Db, "CM_UPDATE"
    lb_inTransaction = False
    
    Item_Update = CVar(Array(av_oldKey(0)))

    Exit Function
ErrHandler:
    If lb_inTransaction Then
        ASC_RollBackTransaction mo_Db, "CM_UPDATE"
        lb_inTransaction = False
    End If
   If Err.Number = SQLBadRowAffectedCount Then
        Err.Clear
        SendMessage ErrMsgIConcurency, "#Someone changed detail of this record and detail screen will be reloaded.", ms_Language_Code
        Call LoadDataFromGrid(grd_area)
        Exit Function
    End If
    Call ErrorHandler(Extender.Name & ".Item_Update")
End Function

' deletes claim item
Private Function Item_Delete(ByVal av_oldKey As Variant, ByVal al_iCOnc As Long) As Variant
On Error GoTo ErrHandler
    
    Dim lb_inTransaction As Boolean
    
    If SendMessage(WarMsgDoYouRemove, "#Delete record ?", ms_Language_Code, vbQuestion + vbYesNo, "Delete ") = vbYes Then
        
        ASC_BeginTransaction mo_Db, "CM_DEL"
        lb_inTransaction = True
    
        Call Item_DeleteDB(av_oldKey(0), al_iCOnc)
        
        ASC_CommitTransaction mo_Db, "CM_DEL"
        lb_inTransaction = False
        
        Item_Delete = av_oldKey
    End If
    Exit Function
ErrHandler:
    If lb_inTransaction Then
        ASC_RollBackTransaction mo_Db, "CM_DEL"
        lb_inTransaction = False
    End If
   If Err.Number = SQLBadRowAffectedCount Then
        Err.Clear
        SendMessage ErrMsgIConcurency, "#Someone changed detail of this record and detail screen will be reloaded.", ms_Language_Code
        Call LoadDataFromGrid(grd_area)
        Exit Function
    End If
    Call ErrorHandler(Extender.Name & ".Item_Delete")
End Function

Private Sub Item_AddDB(ByVal al_rar_code As Long)
On Error GoTo ErrHandler
Const C_REQ As String = "exec cap_rpt_area_ins $rar_code$, $rar_desc$, $bmk_code$, $z_creator$"
Const C_REQ_R As String = "INSERT INTO alias_cap_rpt_area VALUES( $ALIAS$, $rar_code$, 'E', 'SIUD', GETDATE(), $z_creator$, GETDATE(), $z_creator$, 1, '', '', NULL )"
    Dim ls_Req As String
    
    ' common placeholders
    ls_Req = Replace(C_REQ, "$rar_code$", al_rar_code)
    ls_Req = Replace(ls_Req, "$rar_desc$", SQLStr(txt_rar_desc.Text, 80), , , vbTextCompare)
    ls_Req = Replace(ls_Req, "$bmk_code$", SQLStr(cbo_Market.SelectedItem.Key, 4), , , vbTextCompare)
    ls_Req = Replace(ls_Req, "$z_creator$", SQLStr(ms_LoginName, 8), , , vbTextCompare)

    Call ExecuteSQLSafe(mo_Db, ls_Req, 1)
    
    ' add rights on new area for current user's Aliases
    ls_Req = Replace(C_REQ_R, "$rar_code$", al_rar_code)
    ls_Req = Replace(ls_Req, "$ALIAS$", SQLStr(cbo_Market.SelectedItem.GetData(3), 30), , , vbTextCompare)
    ls_Req = Replace(ls_Req, "$z_creator$", SQLStr(ms_LoginName, 8), , , vbTextCompare)
    
    Call ExecuteSQLSafe(mo_Db, ls_Req)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_AddDb")
End Sub

Private Sub Item_UpdateDB(ByVal al_rar_code As Long, ByVal al_iCOnc As Long)
On Error GoTo ErrHandler
Const C_REQ As String = "exec cap_rpt_area_upd $rar_code$, $rar_desc$, $bmk_code$, $z_creator$, $iConc$"
    Dim ls_Req As String
    
        ' common placeholders
    ls_Req = Replace(C_REQ, "$rar_code$", al_rar_code)
    ls_Req = Replace(ls_Req, "$rar_desc$", SQLStr(txt_rar_desc.Text, 80), , , vbTextCompare)
    ls_Req = Replace(ls_Req, "$bmk_code$", SQLStr(cbo_Market.SelectedItem.Key, 4), , , vbTextCompare)
    ls_Req = Replace(ls_Req, "$z_creator$", SQLStr(ms_LoginName, 15), , , vbTextCompare)
    ls_Req = Replace(ls_Req, "$iConc$", al_iCOnc, , , vbTextCompare)
    
    Call ExecuteSQLSafe(mo_Db, ls_Req, 1)
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_UpdateDb")
End Sub


Private Sub Item_UpdateLinkDB(ByVal al_rar_code As Long)
On Error GoTo ErrHandler
Const C_REQ_INS As String = "exec Cap_rpt_login_area_ins '$SR_CODE$', $RAR_CODE$"
Const C_REQ_DEL As String = "exec Cap_rpt_login_area_del '$SR_CODE$'"
    Dim ls_Req As String
    Dim ll_i As Long
    
    For ll_i = 0 To lst_Selected.ListCount - 1
        If lta_Logins(lst_Selected.ItemData(ll_i)).RAR_CODE = 0 Then
            ' item was selected by user
            ' remove him from current selection
            ls_Req = Replace(C_REQ_DEL, "$SR_CODE$", lta_Logins(lst_available.ItemData(ll_i)).Login)
            Call ExecuteSQLSafe(mo_Db, ls_Req)
            
            ls_Req = Replace(C_REQ_INS, "$SR_CODE$", lta_Logins(lst_Selected.ItemData(ll_i)).Login)
            ls_Req = Replace(ls_Req, "$RAR_CODE$", al_rar_code)
            Call ExecuteSQLSafe(mo_Db, ls_Req, 1)
        End If
    Next
    
    For ll_i = 0 To lst_available.ListCount - 1
        If lta_Logins(lst_available.ItemData(ll_i)).RAR_CODE <> 0 Then
            ' item was unselected by user
            Debug.Assert (al_rar_code = lta_Logins(lst_available.ItemData(ll_i)).RAR_CODE)
            ls_Req = Replace(C_REQ_DEL, "$SR_CODE$", lta_Logins(lst_available.ItemData(ll_i)).Login)
            Call ExecuteSQLSafe(mo_Db, ls_Req)
        End If
    Next
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_UpdateDb")
End Sub

Private Sub Item_DeleteDB(ByVal al_rar_code As Long, ByVal al_iCOnc As Long)
On Error GoTo ErrHandler
Const C_REQ As String = "exec cap_rpt_area_del $rar_code$, $z_creator$, $iConc$"
Const C_REQ_DEL_LINK As String = "exec Cap_rpt_login_area_del2 $rar_code$"
    Dim ls_Req As String

    ' 1. remove all logins linked to deleted area
    ls_Req = Replace(C_REQ_DEL_LINK, "$rar_code$", al_rar_code)
    Call ExecuteSQLSafe(mo_Db, ls_Req)
    
    
    ' 2. delete area
    ls_Req = Replace(C_REQ, "$rar_code$", al_rar_code)
    ls_Req = Replace(ls_Req, "$z_creator$", SQLStr(ms_LoginName, 15), , , vbTextCompare)
    ls_Req = Replace(ls_Req, "$iConc$", al_iCOnc, , , vbTextCompare)
    Call ExecuteSQLSafe(mo_Db, ls_Req, 1)

    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_DeleteDb")
End Sub
' exits mode to main
Private Sub Item_ExitToGrid(ByRef ao_grid As ArmGrid, ByVal av_gridKey As Variant)
On Error GoTo ErrHandler
    
    ' close detail cursors
    Select Case activeScreenMode
        Case ArmScreenMode.smAdd
        
            Call ao_grid.AddLine(av_gridKey)
            Call ao_grid.SearchKey(True, av_gridKey)
            ao_grid.SelectedLine(0, "rar_desc") = txt_rar_desc.Text
            ao_grid.SelectedLine(0, "z_creation") = txt_Date.Text
            ao_grid.SelectedLine(0, "z_creator") = Txt_Creator.Text
            ao_grid.SelectedLine(0, "bmk_code") = cbo_Market.SelectedItem.Key
            ao_grid.SelectedLine(0, "bmk_desc") = cbo_Market.SelectedItem.DisplayText
            ao_grid.SelectedLine(0, "z_last_upd") = txt_lastUpd.Text
            ao_grid.SelectedLine(0, "z_last_upd_user") = txt_updUser.Text
            ao_grid.SelectedLine(0, "rar_desc") = txt_rar_desc.Text
            ao_grid.SelectedLine(0, "drop_date") = ""
            ao_grid.SelectedLine(0, "drop_flag") = ""
            ao_grid.SelectedLine(0, "iConcurrency") = 1
        Case ArmScreenMode.smUpdate
    
            Call ao_grid.SearchKey(True, av_gridKey)
            ao_grid.SelectedLine(0, "rar_desc") = txt_rar_desc.Text
            ao_grid.SelectedLine(0, "bmk_code") = cbo_Market.SelectedItem.Key
            ao_grid.SelectedLine(0, "bmk_desc") = cbo_Market.SelectedItem.DisplayText
            ao_grid.SelectedLine(0, "z_last_upd") = txt_lastUpd.Text
            ao_grid.SelectedLine(0, "z_last_upd_user") = txt_updUser.Text
            ao_grid.SelectedLine(0, "rar_desc") = txt_rar_desc.Text
            ao_grid.SelectedLine(0, "iConcurrency") = ao_grid.SelectedLine(0, "iConcurrency") + 1
        
        Case ArmScreenMode.smDelete
            Call ao_grid.SearchKey(True, av_gridKey)
            ao_grid.SelectedLine(0, "drop_date") = txt_dropDate.Text
            ao_grid.SelectedLine(0, "drop_flag") = IIf(chk_dropped.value = 1, "X", "")
            ao_grid.SelectedLine(0, "z_last_upd_user") = txt_updUser.Text
            ao_grid.SelectedLine(0, "iConcurrency") = ao_grid.SelectedLine(0, "iConcurrency") + 1
        Case smView
        Case Else
            Debug.Assert (False)
    End Select

    ' pop last item in screen mode stack
    Call popScreenMode
    
    Call ResetScreen(activeScreenMode)
    Call UpdateUI
    
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_ExitToGrid")
End Sub

' clear all controls values
Private Sub Item_Clear()
On Error GoTo ErrHandler
    mb_Initializing = True
    txt_rar_code.Text = ""
    txt_rar_desc.Text = ""
    
    Set cbo_Market.SelectedItem = Nothing
    
    txt_Date.Text = ""
    Txt_Creator.Text = ""
    txt_lastUpd.Text = ""
    txt_updUser.Text = ""
    txt_dropDate.Text = ""
    chk_dropped.value = 0
    
    Dim ll_i As Long
    For ll_i = LBound(lta_Logins) To UBound(lta_Logins)
        lta_Logins(ll_i).RAR_CODE = 0
    Next
    
    Call lst_available.Clear
    Call lst_Selected.Clear
    
    mb_Initializing = False
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_Clear")
End Sub

Private Sub Item_Empty()
On Error GoTo ErrHandler
    mb_Initializing = True
    txt_rar_code.Text = ""
    txt_rar_desc.Text = ""
    
    txt_Date.Text = ""
    Txt_Creator.Text = ""
    txt_lastUpd.Text = ""
    txt_updUser.Text = ""
    txt_dropDate.Text = ""
    chk_dropped.value = 0
    
    Call lst_available.Clear
    Call lst_Selected.Clear
    
    mb_Initializing = False
    Exit Sub
ErrHandler:
    Call ErrorHandler(Extender.Name & ".Item_Empty")
End Sub

