VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.UserControl TimeMgmt 
   ClientHeight    =   13350
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   18240
   ScaleHeight     =   13350
   ScaleWidth      =   18240
   Begin VB.Frame fra_MainFilter 
      Height          =   645
      Left            =   6555
      TabIndex        =   28
      Top             =   10185
      Width           =   7665
      Begin Project1.ArmCombobox cbo_UserFilter 
         Height          =   345
         Left            =   1725
         TabIndex        =   30
         Top             =   195
         Width           =   3285
         _ExtentX        =   5794
         _ExtentY        =   609
      End
      Begin VB.Label lbl_Label 
         Caption         =   "#User"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   238
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   270
         Index           =   5
         Left            =   135
         TabIndex        =   29
         Tag             =   "lbl_UserFilter"
         Top             =   225
         Width           =   1500
      End
   End
   Begin VB.Frame fra_Detail 
      Height          =   3960
      Left            =   1485
      TabIndex        =   20
      Top             =   2505
      Width           =   8355
      Begin VB.TextBox txt_Code 
         Height          =   345
         Left            =   7350
         TabIndex        =   31
         Top             =   2520
         Visible         =   0   'False
         Width           =   780
      End
      Begin Project1.A_calocx cal_Date 
         Height          =   375
         Left            =   225
         TabIndex        =   1
         Top             =   1290
         Width           =   1830
         _ExtentX        =   3228
         _ExtentY        =   661
      End
      Begin Project1.ToolbarControl tlb_Detail 
         Height          =   690
         Left            =   60
         TabIndex        =   22
         Top             =   180
         Width           =   8145
         _ExtentX        =   14367
         _ExtentY        =   1217
      End
      Begin VB.TextBox txt_Comment 
         Height          =   330
         Left            =   180
         MaxLength       =   500
         TabIndex        =   7
         Top             =   3375
         Width           =   8025
      End
      Begin VB.Frame fra_DayTime 
         Height          =   1155
         Left            =   210
         TabIndex        =   21
         Top             =   1800
         Width           =   8010
         Begin VB.TextBox txt_EndTime 
            Height          =   330
            Left            =   4260
            MaxLength       =   5
            TabIndex        =   6
            Top             =   690
            Width           =   795
         End
         Begin VB.TextBox txt_StartTime 
            Height          =   330
            Left            =   2505
            MaxLength       =   5
            TabIndex        =   5
            Top             =   690
            Width           =   795
         End
         Begin VB.OptionButton opt_DayTime 
            Caption         =   "#Part of the day"
            Height          =   315
            Index           =   1
            Left            =   285
            TabIndex        =   4
            Tag             =   "opt_DayTimePart"
            Top             =   705
            Width           =   2010
         End
         Begin VB.OptionButton opt_DayTime 
            Caption         =   "#All day"
            Height          =   315
            Index           =   0
            Left            =   285
            TabIndex        =   3
            Tag             =   "opt_DayTimeAll"
            Top             =   270
            Width           =   2010
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#End time"
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   8.25
               Charset         =   238
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   270
            Index           =   3
            Left            =   4275
            TabIndex        =   27
            Tag             =   "lbl_EndTime"
            Top             =   420
            Width           =   1650
         End
         Begin VB.Label lbl_Label 
            Caption         =   "#Start time"
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   8.25
               Charset         =   238
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   270
            Index           =   2
            Left            =   2505
            TabIndex        =   26
            Tag             =   "lbl_StartTime"
            Top             =   435
            Width           =   1650
         End
      End
      Begin Project1.ArmCombobox cbo_ReasonType 
         Height          =   345
         Left            =   2910
         TabIndex        =   2
         Top             =   1275
         Width           =   5310
         _ExtentX        =   9366
         _ExtentY        =   609
      End
      Begin VB.Label lbl_Label 
         Caption         =   "#Explanation"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   238
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   270
         Index           =   4
         Left            =   195
         TabIndex        =   25
         Tag             =   "lbl_Explanation"
         Top             =   3120
         Width           =   1650
      End
      Begin VB.Label lbl_Label 
         Caption         =   "#Reason/Type"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   238
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   270
         Index           =   1
         Left            =   2910
         TabIndex        =   24
         Tag             =   "lbl_ReasonType"
         Top             =   990
         Width           =   1650
      End
      Begin VB.Label lbl_Label 
         Caption         =   "#Date"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   238
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   270
         Index           =   0
         Left            =   255
         TabIndex        =   23
         Tag             =   "lbl_Date"
         Top             =   990
         Width           =   1650
      End
   End
   Begin VB.Frame fra_Main 
      Height          =   8970
      Index           =   3
      Left            =   2625
      TabIndex        =   17
      Top             =   165
      Width           =   12510
      Begin Project1.ArmGrid grd_Main 
         Height          =   7275
         Index           =   3
         Left            =   180
         TabIndex        =   18
         Tag             =   "grd_MainSummaryWorkMonth"
         Top             =   1110
         Width           =   12150
         _ExtentX        =   21431
         _ExtentY        =   12832
      End
      Begin Project1.ToolbarControl tlb_Main 
         Height          =   690
         Index           =   3
         Left            =   135
         TabIndex        =   19
         Top             =   195
         Width           =   12165
         _ExtentX        =   21458
         _ExtentY        =   1217
      End
   End
   Begin VB.Frame fra_Main 
      Height          =   8970
      Index           =   2
      Left            =   1815
      TabIndex        =   14
      Top             =   375
      Width           =   12510
      Begin Project1.ArmGrid grd_Main 
         Height          =   7275
         Index           =   2
         Left            =   180
         TabIndex        =   15
         Tag             =   "grd_MainSummaryMonth"
         Top             =   1110
         Width           =   12150
         _ExtentX        =   21431
         _ExtentY        =   12832
      End
      Begin Project1.ToolbarControl tlb_Main 
         Height          =   690
         Index           =   2
         Left            =   135
         TabIndex        =   16
         Top             =   195
         Width           =   12165
         _ExtentX        =   21458
         _ExtentY        =   1217
      End
   End
   Begin VB.Frame fra_Main 
      Height          =   8970
      Index           =   1
      Left            =   1050
      TabIndex        =   11
      Top             =   525
      Width           =   12510
      Begin Project1.ArmGrid grd_Main 
         Height          =   7275
         Index           =   1
         Left            =   180
         TabIndex        =   12
         Tag             =   "grd_MainSummaryDay"
         Top             =   1110
         Width           =   12150
         _ExtentX        =   21431
         _ExtentY        =   12832
      End
      Begin Project1.ToolbarControl tlb_Main 
         Height          =   690
         Index           =   1
         Left            =   135
         TabIndex        =   13
         Top             =   195
         Width           =   12165
         _ExtentX        =   21458
         _ExtentY        =   1217
      End
   End
   Begin MSComctlLib.TabStrip tbs_Main 
      Height          =   375
      Left            =   690
      TabIndex        =   9
      Top             =   9765
      Width           =   8520
      _ExtentX        =   15028
      _ExtentY        =   661
      Placement       =   1
      _Version        =   393216
      BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
         NumTabs         =   4
         BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "#Detail"
            Object.Tag             =   "tbs_MainDetail"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab2 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "#Summary per day"
            Object.Tag             =   "tbs_MainSummaryDay"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab3 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "#Summary per month"
            Object.Tag             =   "tbs_MainSummaryMonth"
            ImageVarType    =   2
         EndProperty
         BeginProperty Tab4 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "#Working time per month"
            Object.Tag             =   "tbs_SummaryWorkMonth"
            ImageVarType    =   2
         EndProperty
      EndProperty
   End
   Begin VB.Frame fra_Main 
      Height          =   8970
      Index           =   0
      Left            =   330
      TabIndex        =   0
      Top             =   705
      Width           =   12510
      Begin Project1.ArmGrid grd_Main 
         Height          =   7275
         Index           =   0
         Left            =   180
         TabIndex        =   10
         Tag             =   "grd_MainDetail"
         Top             =   1110
         Width           =   12150
         _ExtentX        =   21431
         _ExtentY        =   12832
      End
      Begin Project1.ToolbarControl tlb_Main 
         Height          =   690
         Index           =   0
         Left            =   135
         TabIndex        =   8
         Top             =   195
         Width           =   12165
         _ExtentX        =   21458
         _ExtentY        =   1217
      End
   End
End
Attribute VB_Name = "TimeMgmt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Function GetTempPath Lib "Kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function GetLocaleInfo Lib "Kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Private Declare Function GetTimeZoneInformation Lib "Kernel32.dll" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
 
#If ENV = LIVE Then
    Dim mo_DB As Object
#Else
    Dim mo_DB As ARMSYSCOMLib.ArmDb
#End If

#If ENV = LIVE Then
    Dim mo_FSO As Object
#Else
    Dim mo_FSO As Scripting.FileSystemObject
#End If

Private ms_Language_Code                As String       'current user interface language
Private ml_U_code                       As Long         'U_Code (GEN_Systems_Users) of logged user
Private ms_LoginName                    As String       'contain loginname
Private mb_InternalInit                 As Boolean      'framework is doing some own control manipulation, all events should handle
Private mb_Initialized                  As Boolean      'framework is doing some own control manipulation, all events should handle
Private ms_DecimalSeparator             As String       'locale decimal separator
Private ms_ThousandSeparator            As String       'locale thousand separator
Private mc_ScreenLabels                 As Long         'cursor containing screen constants for current component
Private ms_DefaultStartTime             As String       'locale thousand separator
Private ms_DefaultEndTime               As String       'locale thousand separator
Private mb_TabNeedRefresh(3)            As Boolean
Private ml_TimeZoneOffset               As Long
Private mb_IsPowerUser                  As Boolean
Private me_ScreenMode                   As eMode

Private Const SEP = "®©"
Private Const C_SEP As String = "@@"
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"

Private Const SCREEN_NAME As String = "TimeMgmt"
Private Const BASE_MSGID As Long = 9200
Private Const LOCALE_USER_DEFAULT = &H400
Private Const ICON_RELOAD = 115

Private Const SW_SHOWNORMAL = 1

Private Const LOCALE_SDECIMAL = &HE ' Decimal separator
Private Const LOCALE_STHOUSAND = &HF ' Thousand separator
Private Const CL_COLOR_ENABLED As Long = &H80000005
Private Const CL_COLOR_DISABLED As Long = &H8000000F
Private Const CL_COLOR_LOCKED As Long = &H80000018
Private Const C_ERRORRAISE As Long = 2500

Private Const FRM_SPACE_VER = 120
Private Const FRM_SPACE_HOR = 100

Private Type SYSTEMTIME
  wYear            As Integer
  wMonth           As Integer
  wDayOfWeek       As Integer
  wDay             As Integer
  wHour            As Integer
  wMinute          As Integer
  wSecond          As Integer
  wMilliseconds    As Integer
End Type

Private Type TIME_ZONE_INFORMATION
  Bias             As Long
  StandardName(63) As Byte
  StandardDate     As SYSTEMTIME
  StandardBias     As Long
  DaylightName(63) As Byte
  DaylightDate     As SYSTEMTIME
  DaylightBias     As Long
End Type

Private Const TIME_ZONE_ID_INVALID = &HFFFFFFFF
Private Const TIME_ZONE_ID_UNKNOWN = 0
Private Const TIME_ZONE_ID_STANDARD = 1
Private Const TIME_ZONE_ID_DAYLIGHT = 2

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
End Enum

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

Private Enum eWorkReasonType
    rtOffice = 1
    rFlexTime = 2
End Enum

Private Enum eMode
    emNone
    emList
    emView
    emAdd
    emUpdate
    emDelete
End Enum

Public Event quit()

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 Function Load_A_Com() As Boolean
On Error GoTo ErrHandler

Dim ll_Index As Long
Dim lo_Control As Object

    
    Load_A_Com = False
    
    If mb_Initialized Then
        Call Err.Raise(ArmErr.CPTAlreadyInitialized)
    End If
    mb_InternalInit = False
    ms_DecimalSeparator = Format(0, ".")
    mc_ScreenLabels = 0
    Dim sBuffer As String
    Dim nBufferLen As Long
    nBufferLen = 255
    sBuffer = String$(nBufferLen, vbNullChar)
    nBufferLen = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_STHOUSAND, sBuffer, nBufferLen)
    If nBufferLen > 0 Then
        ms_ThousandSeparator = Left$(sBuffer, nBufferLen - 1)
    End If
    
    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
    
    Set mo_FSO = CreateObject("Scripting.FileSystemObject")
    
    If Not GetTimeInfo(, , ml_TimeZoneOffset) Then
        Call Err.Raise(ArmErr.CompFncFailed, "GetTimeInfo", "GetTimeInfo failed")
    End If
    ms_DefaultStartTime = GetAConfigDataByCountry(mo_DB, "TMG_Default_StartTime")
    ms_DefaultEndTime = GetAConfigDataByCountry(mo_DB, "TMG_Default_EndTime")
    mb_IsPowerUser = InStr(1, SEP & GetAConfigData(mo_DB, "TMG_PowerUser") & SEP, SEP & ml_U_code & SEP, vbBinaryCompare) > 0
    Call NeedRefreshAllTabs
    Call InitComponents
    me_ScreenMode = eMode.emList
    mb_Initialized = True
    Load_A_Com = True
    Exit Function
ErrHandler:
    Load_A_Com = False
    Call ErrorMessage("Load_A_COM")
End Function

Public Function UnLoad_A_Com() As Boolean
On Error GoTo ErrHandler
    
    Dim lo_Control As Object
    
    If mc_ScreenLabels <> 0 Then Call mo_DB.Close(mc_ScreenLabels)
    mc_ScreenLabels = 0
   
    For Each lo_Control In UserControl.Controls
        Select Case UCase(TypeName(lo_Control))
        Case "ARMCOMBOBOX", "TOOLBARCONTROL", "ARMGRID", "ARMTREEVIEW", "ARMCHECKVIEW", "ARMPICKER"
            Call lo_Control.UnLoad_A_Com
        End Select
    Next
    
    Set mo_DB = Nothing
    Set mo_FSO = Nothing
    
    mb_Initialized = False
    UnLoad_A_Com = True
    Exit Function
ErrHandler:
    UnLoad_A_Com = False
    Call ErrorMessage("Unload_A_Com")
End Function


Private Sub InitComponents()
On Error GoTo ErrHandler

Dim ls_Request As String
    Call tlb_Main(0).SetToolbarInfoStringParameters("001EESFGIDRW®08783®QE/BAC®AAABBBCCCEWWFwwJFFYTT", "001")
    Call tlb_Main(0).DisplayFace("0")
    tlb_Main(0).ButtonVisible("B") = mb_IsPowerUser
    tlb_Main(0).ButtonVisible("C") = mb_IsPowerUser
    
    Call grd_Main(0).SetColumns(Array( _
        "TMG_Code®©0®©1®©TMG_Code®©#TMG_Code", _
        "TMG_StartTime®©0®©0®©TMG_StartTime®©#TMG_StartTime", _
        "TMG_EndTime®©0®©0®©TMG_EndTime®©#TMG_EndTime", _
        "TMG_Duration®©0®©0®©TMG_Duration®©#TMG_Duration", _
        "Date®©2000®©0®©Date®©#Date", _
        "StartTime®©1600®©0®©StartTime®©#Start", _
        "EndTime®©1600®©0®©EndTime®©#End", _
        "Duration®©1000®©0®©Duration®©#Duration", _
        "TMGT_Name®©2000®©0®©TMGT_Name®©#Type", _
        "TMG_Comment®©6000®©0®©TMG_Comment®©#Comment"))
    grd_Main(0).FetchAll = False
    
    Call tlb_Main(1).SetToolbarInfoStringParameters("001EESFGIDRW®08783®QE/BAC®JFFYTT", "001")
    Call tlb_Main(1).DisplayFace("0")
    Call grd_Main(1).SetColumns(Array( _
        "TMG_StartDate®©0®©1®©TMG_StartDate®©#TMG_StartDate", _
        "Date®©2000®©0®©Date®©#Date", _
        "TMG_Duration®©0®©0®©TMG_Duration®©#TMG_Duration", _
        "Duration®©2000®©0®©Duration®©#Duration" _
        ))
    grd_Main(1).FetchAll = False
    
    Call tlb_Main(2).SetToolbarInfoStringParameters("001EESFGIDRW®08783®QE/BAC®JFFYTT", "001")
    Call tlb_Main(2).DisplayFace("0")
    Call grd_Main(2).SetColumns(Array( _
        "Month®©4000®©1®©Month®©#Month", _
        "TMGT_Name®©6000®©0®©TMGT_Name®©#Type", _
        "TMG_Duration®©0®©0®©TMG_Duration®©#TMG_Duration", _
        "Duration®©2000®©0®©Duration®©#Duration"))
    grd_Main(2).FetchAll = False
    
    Call tlb_Main(3).SetToolbarInfoStringParameters("001EESFGIDRW®08783®QE/BAC®JFFYTT", "001")
    Call tlb_Main(3).DisplayFace("0")
    Call grd_Main(3).SetColumns(Array( _
        "Month®©4000®©1®©Month®©#Month", _
        "TMG_Duration®©0®©0®©TMG_Duration®©#TMG_Duration", _
        "Duration®©2000®©0®©Duration®©#Duration"))
    grd_Main(3).FetchAll = False
    
    Call tlb_Detail.SetToolbarInfoStringParameters("002EE®013463®QESFGIDRABCHJKLMNOPQTUVWXYZ/BAC®NTT®113463®QESFGIDRABCHJKLMNOPQTUVWXYZ/BAC®AHHNTT®213463®QESFGIDRABCHJKLMNOPQTUVWXYZ/BAC®AHHNTT®313463®QESFGIDRABCHJKLMNOPQTUVWXYZ/BAC®AHHNTT", "002")
    
    ls_Request = "exec TMG_ReasonType_lst $Language_Code$,$TMGT_IsWorkingTime$,$TMGT_IsSelectable$"
    ls_Request = ReplacePlaceHolder(ls_Request, "$TMGT_IsWorkingTime$", "NULL")
    If mb_IsPowerUser Then
        ls_Request = ReplacePlaceHolder(ls_Request, "$TMGT_IsSelectable$", "NULL")
    Else
        ls_Request = ReplacePlaceHolder(ls_Request, "$TMGT_IsSelectable$", SQLStr("X"))
    End If
    cbo_ReasonType.Request = ReplaceCommonPlaceholders(ls_Request)
    
    cbo_UserFilter.Request = "exec TMG_GEN_Systems_Users_lst"
    Call cbo_UserFilter.Load
    Call cbo_UserFilter.SearchItem(ml_U_code)
    fra_Detail.Visible = False
    Call LoadLabels(mo_DB, Me, SCREEN_NAME, ms_Language_Code)
    Call tbs_Main_Click
    Exit Sub
ErrHandler:
    Call ErrorHandler("InitComponents")
End Sub

Private Function Item_Check() As Boolean
On Error GoTo ErrHandler
Dim ld_Date As Date

    Item_Check = False
    If Trim(cal_Date.date_courte) = "" Then
        Call MsgBox(MsgText(BASE_MSGID + 1, ms_Language_Code, "Date is mandatory"))
        Call cal_Date.SetFocus
        Exit Function
    End If
    If cbo_ReasonType.SelectedItem Is Nothing Then
        Call MsgBox(MsgText(BASE_MSGID + 2, ms_Language_Code, "Reason\type is mandatory"))
        Exit Function
    End If
    txt_StartTime.Text = FormatTimeEntry(txt_StartTime.Text)
    If Trim(txt_StartTime.Text) = "" Then
        Call MsgBox(MsgText(BASE_MSGID + 3, ms_Language_Code, "Start time is mandatory"))
        Call txt_StartTime.SetFocus
        Exit Function
    End If
    txt_EndTime.Text = FormatTimeEntry(txt_EndTime.Text)
    If Trim(txt_EndTime.Text) = "" Then
        Call MsgBox(MsgText(BASE_MSGID + 4, ms_Language_Code, "End time is mandatory"))
        Call txt_EndTime.SetFocus
        Exit Function
    End If
    If Trim(txt_Comment.Text) = "" Then
        Call MsgBox(MsgText(BASE_MSGID + 5, ms_Language_Code, "Explanation is mandatory"))
        Call txt_Comment.SetFocus
        Exit Function
    End If
    If Not CheckTime(txt_StartTime.Text) Then
        Call MsgBox(MsgText(BASE_MSGID + 6, ms_Language_Code, "Start time has not correct format hh:mm"))
        Call txt_StartTime.SetFocus
        Exit Function
    End If
    If Not CheckTime(txt_EndTime.Text) Then
        Call MsgBox(MsgText(BASE_MSGID + 7, ms_Language_Code, "End time has not correct format hh:mm"))
        Call txt_EndTime.SetFocus
        Exit Function
    End If
    If GetTime(txt_StartTime.Text) >= GetTime(txt_EndTime.Text) Then
        Call MsgBox(MsgText(BASE_MSGID + 8, ms_Language_Code, "End time must be greater than start time"))
        Call txt_EndTime.SetFocus
        Exit Function
    End If
    ld_Date = SelectValue("SELECT getdate()")
    If cal_Date.date_dt < Int(ld_Date - 10) Then
        Call MsgBox(MsgText(BASE_MSGID + 9, ms_Language_Code, "Date must be greater or equal than today - 10 days"))
        Call cal_Date.SetFocus
        Exit Function
    End If
    Item_Check = True
    Exit Function
ErrHandler:
    Call ErrorHandler("Item_Check")
End Function

Private Sub Item_CheckIn()
On Error GoTo ErrHandler
Dim ls_Request As String
Dim ll_TMG_Code As Long

    If CanCheckIn Then
        ll_TMG_Code = GetSequenceCode("TMG_WorkingTime")
        ls_Request = "exec TMG_WorkingTime_ins2 $TMG_Code$,$U_Code$,$TMGT_Code$,$TMG_TimeZoneOffset$"
        ls_Request = ReplacePlaceHolder(ls_Request, "$TMG_Code$", ll_TMG_Code)
        ls_Request = ReplacePlaceHolder(ls_Request, "$TMGT_Code$", eWorkReasonType.rtOffice)
        ls_Request = ReplaceCommonPlaceholders(ls_Request)
        Call ExecuteSQLSafe(mo_DB, ls_Request, 1)
        mb_TabNeedRefresh(0) = True
        Call tbs_Main_Click
    Else
        Call MsgBox(MsgText(BASE_MSGID + 10, ms_Language_Code, "#Cannot check in before you check out first"))
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_CheckIn")
End Sub

Private Sub Item_CheckOut()
On Error GoTo ErrHandler
Dim ls_Request As String
Dim ll_TMG_Code As Long

    ll_TMG_Code = LastCheckOut
    If ll_TMG_Code = 0 Then
        Call MsgBox(MsgText(BASE_MSGID + 11, ms_Language_Code, "#Cannot check out before you check in first"))
    Else
        ls_Request = "exec TMG_WorkingTime_upd2 $TMG_Code$,$U_Code$"
        ls_Request = ReplacePlaceHolder(ls_Request, "$TMG_Code$", ll_TMG_Code)
        ls_Request = ReplaceCommonPlaceholders(ls_Request)
        Call ExecuteSQLSafe(mo_DB, ls_Request, 1)
        Call NeedRefreshAllTabs
        Call tbs_Main_Click
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_CheckOut")
End Sub

Private Sub Item_AddInit()
On Error GoTo ErrHandler
    
    me_ScreenMode = eMode.emAdd
    Call Item_Clear
    If Not cbo_ReasonType.SearchItem(eWorkReasonType.rFlexTime) Then
        Call cbo_ReasonType.Load
        Call cbo_ReasonType.SearchItem(eWorkReasonType.rFlexTime)
    End If
    cal_Date.date_courte = Format(Date, "dd\/mm\/yyyy")
    Call tlb_Detail.DisplayFace("1")
    Call EnableFrame(UserControl.Controls, fra_Detail, True)
    opt_DayTime(0).value = True
    Call opt_DayTime_Click(0)
    Call ShowDetail(True)
    Call cal_Date.SetFocus
    DoEvents
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_AddInit")
End Sub

Private Sub Item_UpdateInit()
On Error GoTo ErrHandler

    me_ScreenMode = eMode.emUpdate
    Call Item_Clear
    Call Item_Load(grd_Main(0).CurrentKey(0))
    Call tlb_Detail.DisplayFace("2")
    Call EnableFrame(UserControl.Controls, fra_Detail, True)
    Call ShowDetail(True)
    Call cal_Date.SetFocus
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_UpdateInit")
End Sub

Private Sub Item_DeleteInit()
On Error GoTo ErrHandler
    
    me_ScreenMode = eMode.emDelete
    Call Item_Clear
    Call Item_Load(grd_Main(0).CurrentKey(0))
    Call tlb_Detail.DisplayFace("3")
    Call EnableFrame(UserControl.Controls, fra_Detail, False)
    Call ShowDetail(True)
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_DeleteInit")
End Sub

Private Sub Item_ViewInit()
On Error GoTo ErrHandler
    
    me_ScreenMode = eMode.emView
    Call Item_Clear
    Call Item_Load(grd_Main(0).CurrentKey(0))
    Call tlb_Detail.DisplayFace("0")
    Call EnableFrame(UserControl.Controls, fra_Detail, False)
    Call ShowDetail(True)
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_ViewInit")
End Sub

Private Sub Item_Add()
On Error GoTo ErrHandler
    Dim ls_Request As String
    
    ls_Request = "exec TMG_WorkingTime_ins $TMG_Code$,$U_Code$,$TMGT_Code$,$TMG_StartTime$,$TMG_EndTime$,$TMG_Comment$,$TMG_TimeZoneOffset$"
    txt_Code.Text = GetSequenceCode("TMG_WorkingTime")
    ls_Request = ReplacePlaceHolder(ls_Request, "$TMG_Code$", txt_Code.Text)
    If cbo_ReasonType.SelectedItem Is Nothing Then
        ls_Request = ReplacePlaceHolder(ls_Request, "$TMGT_Code$", "NULL")
    Else
        ls_Request = ReplacePlaceHolder(ls_Request, "$TMGT_Code$", cbo_ReasonType.SelectedItem.Key)
    End If
    ls_Request = ReplacePlaceHolder(ls_Request, "$TMG_StartTime$", SQLDateTime(cal_Date.date_dt + GetTime(txt_StartTime.Text)))
    ls_Request = ReplacePlaceHolder(ls_Request, "$TMG_EndTime$", SQLDateTime(cal_Date.date_dt + GetTime(txt_EndTime.Text)))
    ls_Request = ReplacePlaceHolder(ls_Request, "$TMG_Comment$", SQLStr(txt_Comment.Text))
    ls_Request = ReplaceCommonPlaceholders(ls_Request)
    Call ExecuteSQLSafe(mo_DB, ls_Request, 1)
    
    If grd_Main(0).Rows = 0 Then
        Call grd_Main(0).AddLine(Empty)
    Else
        Call grd_Main(0).InsertLine(0, Empty)
    End If
    grd_Main(0).Row = 0
    Call UpdateLocalGrid
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Add")
End Sub

Private Sub UpdateLocalGrid()
On Error GoTo ErrHandler

    grd_Main(0).SelectedLine(0, "TMG_Code") = txt_Code.Text
    grd_Main(0).SelectedLine(0, "TMG_StartTime") = cal_Date.date_dt + GetTime(txt_StartTime.Text)
    grd_Main(0).SelectedLine(0, "TMG_EndTime") = cal_Date.date_dt + GetTime(txt_EndTime.Text)
    grd_Main(0).SelectedLine(0, "TMG_Duration") = DateDiff("n", cal_Date.date_dt + GetTime(txt_StartTime.Text), cal_Date.date_dt + GetTime(txt_EndTime.Text))
    grd_Main(0).SelectedLine(0, "Date") = Format(cal_Date.date_dt, "dd\/mm\/yyyy")
    grd_Main(0).SelectedLine(0, "StartTime") = txt_StartTime.Text
    grd_Main(0).SelectedLine(0, "EndTime") = txt_EndTime.Text
    grd_Main(0).SelectedLine(0, "Duration") = right("00" & (grd_Main(0).SelectedLine(0, "TMG_Duration") \ 60), 2) & "H " & right("00" & (grd_Main(0).SelectedLine(0, "TMG_Duration") Mod 60), 2)
    grd_Main(0).SelectedLine(0, "TMGT_Name") = cbo_ReasonType.Text
    grd_Main(0).SelectedLine(0, "TMG_Comment") = txt_Comment.Text
    Exit Sub
ErrHandler:
    Call ErrorHandler("UpdateLocalGrid")
End Sub

Private Sub Item_Update()
On Error GoTo ErrHandler
    Dim ls_Request As String
    
    ls_Request = "exec TMG_WorkingTime_upd $TMG_Code$,$U_Code$,$TMGT_Code$,$TMG_StartTime$,$TMG_EndTime$,$TMG_Comment$,$TMG_TimeZoneOffset$,$U_Code_Upd$"
    ls_Request = ReplacePlaceHolder(ls_Request, "$TMG_Code$", txt_Code.Text)
    If cbo_ReasonType.SelectedItem Is Nothing Then
        ls_Request = ReplacePlaceHolder(ls_Request, "$TMGT_Code$", "NULL")
    Else
        ls_Request = ReplacePlaceHolder(ls_Request, "$TMGT_Code$", cbo_ReasonType.SelectedItem.Key)
    End If
    ls_Request = ReplacePlaceHolder(ls_Request, "$TMG_StartTime$", SQLDateTime(cal_Date.date_dt + GetTime(txt_StartTime.Text)))
    ls_Request = ReplacePlaceHolder(ls_Request, "$TMG_EndTime$", SQLDateTime(cal_Date.date_dt + GetTime(txt_EndTime.Text)))
    ls_Request = ReplacePlaceHolder(ls_Request, "$TMG_Comment$", SQLStr(txt_Comment.Text))
    ls_Request = ReplacePlaceHolder(ls_Request, "$U_Code_Upd$", ml_U_code)
    ls_Request = ReplaceCommonPlaceholders(ls_Request)
    Call ExecuteSQLSafe(mo_DB, ls_Request, 1)
    If grd_Main(0).SearchKey(True, txt_Code.Text) Then
        Call UpdateLocalGrid
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Update")
End Sub

Private Sub Item_Delete()
On Error GoTo ErrHandler
    Dim ls_Request As String
    
    ls_Request = "exec TMG_WorkingTime_del $TMG_Code$,$U_Code_Del$"
    ls_Request = ReplacePlaceHolder(ls_Request, "$TMG_Code$", txt_Code.Text)
    ls_Request = ReplacePlaceHolder(ls_Request, "$U_Code_Del$", ml_U_code)
    ls_Request = ReplaceCommonPlaceholders(ls_Request)
    Call ExecuteSQLSafe(mo_DB, ls_Request, 1)
    If grd_Main(0).SearchKey(True, txt_Code.Text) Then
        Call grd_Main(0).DeleteSelectedLines
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("Item_Delete")
End Sub

Private Sub Item_Load(ByVal al_Key As Long)
On Error GoTo ErrHandler
    Dim ls_Request As String
    Dim lc_Cursor As Long
    
    mb_InternalInit = True
    ls_Request = "exec TMG_WorkingTime_sel $TMG_Code$,$Language_Code$"
    ls_Request = ReplacePlaceHolder(ls_Request, "$TMG_Code$", al_Key)
    ls_Request = ReplaceCommonPlaceholders(ls_Request)
    lc_Cursor = OpenSQLSafe(mo_DB, ls_Request, 1)
    txt_Code.Text = mo_DB.GetFields(lc_Cursor, "TMG_Code")
    Call cbo_ReasonType.AddItem(Array(mo_DB.GetFields(lc_Cursor, "TMGT_Code"), mo_DB.GetFields(lc_Cursor, "TMGT_Name")), True)
    
    cal_Date.date_courte = Format(ParseDateTime(mo_DB.GetFields(lc_Cursor, "TMG_StartTime")), "dd\/mm\/yyyy")
    opt_DayTime(1).value = True
    Call opt_DayTime_Click(1)
    
    txt_StartTime.Text = Format(ParseDateTime(mo_DB.GetFields(lc_Cursor, "TMG_StartTime")), "hh:mm")
    txt_EndTime.Text = Format(ParseDateTime(mo_DB.GetFields(lc_Cursor, "TMG_EndTime")), "hh:mm")
    txt_Comment.Text = mo_DB.GetFields(lc_Cursor, "TMG_Comment")
    Call mo_DB.Close(lc_Cursor)
    mb_InternalInit = False
    Exit Sub
ErrHandler:
    mb_InternalInit = False
    Call mo_DB.Close(lc_Cursor)
    Call ErrorHandler("Item_Load")
End Sub

Private Sub Item_Clear()
On Error GoTo ErrHandler
    mb_InternalInit = True
    txt_Code.Text = ""
    cal_Date.date_courte = ""
    Call cbo_ReasonType.Clear
    opt_DayTime(0).value = True
    txt_StartTime.Text = ""
    txt_EndTime.Text = ""
    txt_Comment.Text = ""
    mb_InternalInit = False
    Exit Sub
ErrHandler:
    mb_InternalInit = False
    Call ErrorHandler("Item_Clear")
End Sub

Private Sub ShowDetail(ByVal ab_Visible As Boolean)
On Error GoTo ErrHandler
    If ab_Visible Then
        tlb_Main(0).Enabled = False
        tbs_Main.Enabled = False
        fra_Detail.ZOrder
        fra_Detail.Visible = True
    Else
        fra_Detail.Visible = False
        tlb_Main(0).Enabled = True
        tbs_Main.Enabled = True
    End If
    Exit Sub
ErrHandler:
    Call ErrorHandler("ShowDetail")
End Sub

Private Function CanCheckIn() As Boolean
On Error GoTo ErrHandler
Dim lc_Cursor As Long
Dim ls_Request As String
    
    CanCheckIn = False
    ls_Request = "exec TMG_WorkingTime_sel2 $U_Code$"
    ls_Request = ReplaceCommonPlaceholders(ls_Request)
    lc_Cursor = OpenSQLSafe(mo_DB, ls_Request)
    CanCheckIn = mo_DB.RowCount(lc_Cursor) = 0
    Call mo_DB.Close(lc_Cursor)
    Exit Function
ErrHandler:
    Call mo_DB.Close(lc_Cursor)
    Call ErrorHandler("CanCheckIn")
End Function

Private Function LastCheckOut() As Long
On Error GoTo ErrHandler
Dim lc_Cursor As Long
Dim ls_Request As String

    LastCheckOut = 0
    ls_Request = "exec TMG_WorkingTime_sel2 $U_Code$"
    ls_Request = ReplaceCommonPlaceholders(ls_Request)
    lc_Cursor = OpenSQLSafe(mo_DB, ls_Request)
    If mo_DB.RowCount(lc_Cursor) = 1 Then
        LastCheckOut = mo_DB.GetFields(lc_Cursor, "TMG_Code")
    End If
    Call mo_DB.Close(lc_Cursor)
    Exit Function
ErrHandler:
    Call ErrorHandler("LastCheckOut")
End Function

Private Sub NeedRefreshAllTabs()
On Error GoTo ErrHandler
Dim ll_Idx As Long
    For ll_Idx = 0 To UBound(mb_TabNeedRefresh)
        mb_TabNeedRefresh(ll_Idx) = True
    Next
    Exit Sub
ErrHandler:
    Call ErrorHandler("NeedRefreshAllTabs")
End Sub

Private Function GetTime(ByVal as_Time As String) As Date
On Error GoTo ErrHandler
    
    Dim lsa_Time() As String
    
    lsa_Time = Split(as_Time, ":")
    If UBound(lsa_Time) = 2 Then
        GetTime = TimeSerial(Val(lsa_Time(0)), Val(lsa_Time(1)), Val(lsa_Time(2)))
    ElseIf UBound(lsa_Time) = 1 Then
        GetTime = TimeSerial(Val(lsa_Time(0)), Val(lsa_Time(1)), 0)
    Else
        Err.Raise ArmErr.InvalidArgument, "Split", "as_Time=" & as_Time
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler("GetTime()")
End Function

Private Function FormatTimeEntry(ByVal as_Time As String) As String
On Error GoTo ErrHandler
    
    If InStr(1, as_Time, ":", vbTextCompare) <= 0 Then
        If isNumeric(as_Time) Then
            FormatTimeEntry = as_Time & ":00"
            Exit Function
        End If
    End If
    FormatTimeEntry = as_Time
    Exit Function
ErrHandler:
    Call ErrorHandler("FormatTimeEntry()")
End Function

Private Function CheckTime(ByVal as_Time As String) As Boolean
On Error GoTo ErrHandler
    
    Dim lsa_Time() As String
    Dim ll_Hour As Long, ll_Minute As Long, ll_Second As Long
    
    CheckTime = False
    
    lsa_Time = Split(as_Time, ":")
    If UBound(lsa_Time) < 1 Or UBound(lsa_Time) > 2 Then
        Exit Function
    End If
    
    If Not isNumeric(lsa_Time(0)) Then
        Exit Function
    End If
    ll_Hour = Val(lsa_Time(0))
    If ll_Hour < 0 Or ll_Hour > 23 Then
        Exit Function
    End If
    
    If Not isNumeric(lsa_Time(1)) Then
        Exit Function
    End If
    ll_Minute = Val(lsa_Time(1))
    If ll_Minute < 0 Or ll_Minute > 59 Then
        Exit Function
    End If
    
    ll_Second = 0
    If UBound(lsa_Time) > 1 Then
        If Not isNumeric(lsa_Time(2)) Then
            Exit Function
        End If
        ll_Second = Val(lsa_Time(2))
    End If
    If ll_Second < 0 Or ll_Second > 59 Then
        Exit Function
    End If
    CheckTime = True
    Exit Function
ErrHandler:
    Call ErrorHandler("CheckTime()")
End Function

Private Sub cbo_UserFilter_ComboItemSelected()
On Error GoTo ErrHandler
    
    grd_Main(0).Requests = ReplaceCommonPlaceholders("exec TMG_WorkingTime_lst1 $Language_Code$,$U_Code$")
    grd_Main(1).Requests = ReplaceCommonPlaceholders("exec TMG_WorkingTime_lst2 $Language_Code$,$U_Code$")
    grd_Main(2).Requests = ReplaceCommonPlaceholders("exec TMG_WorkingTime_lst3 $Language_Code$,$U_Code$")
    grd_Main(3).Requests = ReplaceCommonPlaceholders("exec TMG_WorkingTime_lst4 $Language_Code$,$U_Code$")
    Call NeedRefreshAllTabs
    Call tbs_Main_Click
    Exit Sub
ErrHandler:
    Call ErrorMessage("cbo_UserFilter_ComboItemSelected")
End Sub

Private Sub grd_Main_ItemSelected(Index As Integer)
On Error GoTo ErrHandler

    If Index = 0 Then
        Call Item_ViewInit
    End If
    Exit Sub
ErrHandler:
    Call ErrorMessage("grd_Main_ItemSelected")
End Sub

Private Sub grd_Main_RowLoaded(Index As Integer, ByVal al_Row As Long)
On Error GoTo ErrHandler
Dim ll_Duration As Long

    If Index = 0 Then
        grd_Main(Index).Data(al_Row, "Date") = Format(ParseDateTime(grd_Main(Index).Data(al_Row, "TMG_StartTime")), "dd\/mm\/yyyy")
        grd_Main(Index).Data(al_Row, "StartTime") = Format(ParseDateTime(grd_Main(Index).Data(al_Row, "TMG_StartTime")), "Hh:Mm")
        If ParseDateTime(grd_Main(Index).Data(al_Row, "TMG_EndTime")) > 0 Then
            grd_Main(Index).Data(al_Row, "EndTime") = Format(ParseDateTime(grd_Main(Index).Data(al_Row, "TMG_EndTime")), "Hh:Mm")
            ll_Duration = grd_Main(Index).Data(al_Row, "TMG_Duration")
            grd_Main(Index).Data(al_Row, "Duration") = right("00" & (ll_Duration \ 60), 2) & "H " & right("00" & (ll_Duration Mod 60), 2)
        End If
    ElseIf Index = 1 Then
        grd_Main(Index).Data(al_Row, "Date") = Format(grd_Main(Index).Data(al_Row, "TMG_StartDate"), "dd\/mm\/yyyy")
        ll_Duration = grd_Main(Index).Data(al_Row, "TMG_Duration")
        grd_Main(Index).Data(al_Row, "Duration") = right("00" & (ll_Duration \ 60), 2) & "H " & right("00" & (ll_Duration Mod 60), 2)
    ElseIf Index = 2 Then
        ll_Duration = grd_Main(Index).Data(al_Row, "TMG_Duration")
        grd_Main(Index).Data(al_Row, "Duration") = right("000" & (ll_Duration \ 60), 3) & "H " & right("00" & (ll_Duration Mod 60), 2)
    ElseIf Index = 3 Then
        ll_Duration = grd_Main(Index).Data(al_Row, "TMG_Duration")
        grd_Main(Index).Data(al_Row, "Duration") = right("000" & (ll_Duration \ 60), 3) & "H " & right("00" & (ll_Duration Mod 60), 2)
    End If
    Exit Sub
ErrHandler:
    Call ErrorMessage("grd_Main_RowLoaded")
End Sub

Private Sub opt_DayTime_Click(Index As Integer)
On Error GoTo ErrHandler

    If mb_InternalInit Then Exit Sub
    If Index = 0 Then
        txt_StartTime.Text = ms_DefaultStartTime
        txt_EndTime.Text = ms_DefaultEndTime
    Else
        txt_StartTime.Text = Format(Now, "hh:mm")
        txt_EndTime.Text = ""
    End If
    txt_StartTime.Locked = Index = 0
    txt_StartTime.BackColor = IIf(Index = 1, vbWindowBackground, vbButtonFace)
    txt_EndTime.BackColor = IIf(Index = 1, vbWindowBackground, vbButtonFace)
    txt_EndTime.Locked = Index = 0
    Exit Sub
ErrHandler:
    Call ErrorMessage("opt_DayTime_Click")
End Sub

Private Sub tlb_detail_action(ByVal as_Role As String, as_Language As String)
On Error GoTo ErrHandler
    
    Select Case as_Role
    Case "H"
        If me_ScreenMode = eMode.emAdd Then
            If Not Item_Check Then Exit Sub
            Call Item_Add
        ElseIf me_ScreenMode = eMode.emUpdate Then
            If Not Item_Check Then Exit Sub
            Call Item_Update
        ElseIf me_ScreenMode = eMode.emDelete Then
            Call Item_Delete
        End If
        me_ScreenMode = eMode.emList
        Call ShowDetail(False)
        Call NeedRefreshAllTabs
    Case "T"
        me_ScreenMode = eMode.emList
        Call ShowDetail(False)
    End Select
    Exit Sub
ErrHandler:
    Call ErrorMessage("tlb_Detail_action")
End Sub

Private Sub tlb_Main_action(Index As Integer, ByVal as_Role As String, as_Language As String)
On Error GoTo ErrHandler
    
    Select Case as_Role
    Case "W"
        If MsgBox(MsgText(BASE_MSGID + 12, ms_Language_Code, "#Are you sure you want to check in ?"), vbYesNo) = vbYes Then
            Call Item_CheckIn
        End If
    Case "w"
        If MsgBox(MsgText(BASE_MSGID + 13, ms_Language_Code, "#Are you sure you want to check out ?"), vbYesNo) = vbYes Then
            Call Item_CheckOut
        End If
    Case "A"
        Call Item_AddInit
    Case "B"
        If grd_Main(0).SelectedCount = 1 Then
            Call Item_UpdateInit
        Else
            Call MsgBox(MsgText(BASE_MSGID + 14, ms_Language_Code, "#Please, select single row"))
        End If
    Case "C"
        If grd_Main(0).SelectedCount = 1 Then
            Call Item_DeleteInit
        Else
            Call MsgBox(MsgText(BASE_MSGID + 14, ms_Language_Code, "#Please, select single row"))
        End If
    Case "F"
        Call grd_Main(Index).Refresh
    Case "T"
        RaiseEvent quit
    End Select
    Exit Sub
ErrHandler:
    Call ErrorMessage("tlb_Main_action")
End Sub

Private Sub tbs_Main_Click()
On Error GoTo ErrHandler
    Dim ll_Idx As Long
    
    For ll_Idx = 0 To tbs_Main.Tabs.Count - 1
        fra_Main(ll_Idx).Visible = tbs_Main.Tabs(ll_Idx + 1).Selected
    Next
    
    ll_Idx = tbs_Main.SelectedItem.Index - 1
    If mb_TabNeedRefresh(ll_Idx) Then
        Call grd_Main(ll_Idx).Refresh
        mb_TabNeedRefresh(ll_Idx) = False
    End If
    
    Exit Sub
ErrHandler:
    Call ErrorMessage("tbs_Main_Click")
End Sub

Private Function ParseDateTime(ByVal as_DateText As String) As Date
On Error GoTo ErrHandler
Dim ll_Idx As Long
Dim ll_Msc As Long
Dim lsa_Date() As String, lsa_Time() As String

    ParseDateTime = 0
    If Trim(as_DateText) = "" Then
        Exit Function
    End If
    ll_Msc = 0
    ll_Idx = InStrRev(as_DateText, ".")
    If ll_Idx > 0 Then
        ll_Msc = CLng(Mid(as_DateText, ll_Idx + 1))
        as_DateText = Left(as_DateText, ll_Idx - 1)
    End If
    ll_Idx = InStrRev(as_DateText, " ")
    If ll_Idx > 0 Then
        lsa_Date = Split(Left(as_DateText, ll_Idx), "-")
        If UBound(lsa_Date) <> 2 Then
            Err.Raise ArmErr.InvalidArgument, "ParseDateTime", "Invalid datetime format: " & as_DateText
        End If
        lsa_Time = Split(Mid(as_DateText, ll_Idx + 1), ":")
        If UBound(lsa_Time) <> 2 Then
            Err.Raise ArmErr.InvalidArgument, "ParseDateTime", "Invalid datetime format: " & as_DateText
        End If
        ParseDateTime = DateSerial(Val(lsa_Date(0)), Val(lsa_Date(1)), Val(lsa_Date(2))) + _
                        TimeSerial(Val(lsa_Time(0)), Val(lsa_Time(1)), Val(lsa_Time(2)))
    Else
        Err.Raise ArmErr.InvalidArgument, "ParseDateTime", "Invalid datetime format: " & as_DateText
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler("ParseDateTime")
End Function

Public Sub Resize()
On Error GoTo ErrHandler

Dim ll_Idx As Long

    fra_MainFilter.Visible = mb_IsPowerUser
    Call fra_MainFilter.Move(0, 0, Width)
    Call tbs_Main.Move(0, Height - tbs_Main.Height, Width)
    For ll_Idx = 0 To 3
        If mb_IsPowerUser Then
            Call fra_Main(ll_Idx).Move(0, fra_MainFilter.Height, Width, Height - tbs_Main.Height - fra_MainFilter.Height)
        Else
            Call fra_Main(ll_Idx).Move(0, 0, Width, Height - tbs_Main.Height)
        End If
        Call tlb_Main(ll_Idx).Move(0, 0, fra_Main(ll_Idx).Width)
        Call grd_Main(ll_Idx).Move(0, tlb_Main(ll_Idx).Height, fra_Main(ll_Idx).Width, fra_Main(ll_Idx).Height - tlb_Main(ll_Idx).Height)
    Next
    Call fra_Detail.Move((Width - fra_Detail.Width) / 2, (Height - fra_Detail.Height) / 2)
    Exit Sub
ErrHandler:
    Call ErrorMessage("Resize")
End Sub

' 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
' Standard error handler
Private Sub ErrorHandler(ByVal as_Fct As String)
  
    Call Err.Raise(Err.Number, as_Fct & SEP1 & Err.Source, Err.Description)
End Sub

' display standard error message
Private Sub ErrorMessage(ByVal as_Fct As String)
    Dim ls_ErrSource As String
    Dim ls_ErrDescription As String
    ls_ErrSource = as_Fct & SEP1 & Err.Source
    ls_ErrDescription = Err.Description
    
    Call LogMessage(SCREEN_NAME & " exception raised. Err.Number:" & Err.Number & ", Err.Source:" & ls_ErrSource & ", Err.Description " & ls_ErrDescription & ".", "E", False)
    Call MsgBox("Error occured, please contact IT. Application will now shutdown." & vbCrLf & ls_ErrSource & vbCrLf & "Description: " & ls_ErrDescription, vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
    End
End Sub

' logs message to database
Private Sub LogMessage(ByVal as_logMsg As String, Optional ByVal as_logType As String = "E", Optional ab_ExitOnException As Boolean = False)
    Dim ll_errNumber As Long
    Dim ls_ErrDescription As String, ls_ErrSource As String
    
    ll_errNumber = Err.Number
    ls_ErrDescription = Err.Description
    ls_ErrSource = Err.Source

On Error GoTo ErrHandler

Const LOG_REQUEST As String = "EXEC A_log_ins $UCODE$,$LOGTYPE$,$MSG$,$APP$"
    Dim ls_req As String
    Dim ll_Cursor As Long
    Dim ls_Source As String, ls_Msg As String
    
    ls_Source = SCREEN_NAME & " " & App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision
    ls_Msg = as_logMsg & SEP1 & ll_errNumber & " : " & ls_ErrDescription & " - " & ls_ErrSource
    
    ls_req = ReplacePlaceHolder(LOG_REQUEST, "$UCODE$", CStr(ml_U_code))
    ls_req = ReplacePlaceHolder(ls_req, "$LOGTYPE$", SQLStr(as_logType))
    ls_req = ReplacePlaceHolder(ls_req, "$MSG$", Left(Trim(SQLStr(ls_Msg)), 4000))
    ls_req = ReplacePlaceHolder(ls_req, "$APP$", Left(Trim(SQLStr(ls_Source)), 50))
    
    Call ExecuteSQLSafe(mo_DB, ls_req)
    
    Err.Number = ll_errNumber
    Err.Description = ls_ErrDescription
    Err.Source = ls_ErrSource
    Exit Sub
    
ErrHandler:
    If ab_ExitOnException Then
        Call MsgBox("A fatal error occured. Unable to log error into database, the application will be close. Please report the following message to your IT support: " & vbCrLf & _
            "Number:" & Err.Number & vbCrLf & "Description:" & Err.Description, vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
        End
    End If
    Err.Number = ll_errNumber
    Err.Description = ls_ErrDescription
    Err.Source = ls_ErrSource
End Sub


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

Private 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

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

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

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

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

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

    SqlDate = "NULL"
    If IsNull(av_Data) Then av_Data = ""
    If (Trim(CStr(av_Data)) <> "") And (CStr(av_Data) <> "0") Then
        SqlDate = "'" & Format(av_Data, "yyyy-mm-dd") & "'"
    End If
    Exit Function
ErrHandler:
    Call ErrorHandler("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_Data As String) As String
On Error GoTo ErrHandler

    SQLStr = "'" & Replace(as_Data, "'", "''") & "'"
    Exit Function
ErrHandler:
    Call ErrorHandler("SqlStr")
End Function

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

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

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

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

    as_Request = ReplacePlaceHolder(as_Request, "$TMG_TimeZoneOffset$", ml_TimeZoneOffset)
    as_Request = ReplacePlaceHolder(as_Request, "$Language_Code$", SQLStr(ms_Language_Code))
    If cbo_UserFilter.SelectedItem Is Nothing Then
        as_Request = ReplacePlaceHolder(as_Request, "$U_Code$", "NULL")
    Else
        as_Request = ReplacePlaceHolder(as_Request, "$U_Code$", cbo_UserFilter.SelectedItem.Key)
    End If
    ReplaceCommonPlaceholders = as_Request
    Exit Function
ErrHandler:
    Call ErrorHandler("ReplaceCommonPlaceHolders")
End Function


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

Public Function GetTimeInfo(Optional ByRef as_TimeZone As String, Optional ByRef ab_DayLightSavings As Boolean, Optional ByRef al_GMTOffset As Long) As Boolean
On Error GoTo ErrorHandler
  
  Dim lt_TZ_Info     As TIME_ZONE_INFORMATION
  Dim ll_ReturnValue As Long
  
  ll_ReturnValue = GetTimeZoneInformation(lt_TZ_Info)
  Select Case ll_ReturnValue
    Case TIME_ZONE_ID_INVALID
      GetTimeInfo = False
      Exit Function
    Case TIME_ZONE_ID_UNKNOWN
      ab_DayLightSavings = False
    Case TIME_ZONE_ID_STANDARD
      ab_DayLightSavings = False
    Case TIME_ZONE_ID_DAYLIGHT
      ab_DayLightSavings = True
  End Select
  
  With lt_TZ_Info
    as_TimeZone = .StandardName
    as_TimeZone = Left(as_TimeZone, InStr(as_TimeZone, Chr(0)) - 1)
    al_GMTOffset = .Bias / 60            ' Deviding by 60 returns HOURS
    al_GMTOffset = al_GMTOffset * (-1)
  End With
  
  GetTimeInfo = True
  Exit Function
ErrorHandler:
    Call ErrorHandler("GetTimeInfo")
End Function

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

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

' 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) 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.Name <> "" Then
                        li_Label = ao_Armdb.Find(lc_Labels, "FIELD_NAME", lo_Control.Name, , 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 Sub EnableFrame(ByRef aControls As Variant, ByRef aContainer As Object, ByVal ab_Enabled As Boolean)
On Error GoTo ErrHandler
    
    Dim lIdx As Long, lCount As Long
    Dim lControl As Control
    
    lCount = aControls.Count - 1
    
    For lIdx = 0 To lCount
        Set lControl = aControls.Item(lIdx)
        If HasContainer(lControl, aContainer) Then
            Select Case UCase(TypeName(lControl))
                Case "TOOLBARCONTROL"
                    'lControl.Visible = ab_Enabled
                
                Case "FRAME", "LABEL", "MSFLEXGRID"
                    ' Do nothing !
                
                Case "TEXTBOX"
                    lControl.Locked = Not ab_Enabled
                    lControl.BackColor = IIf(ab_Enabled, CL_COLOR_ENABLED, CL_COLOR_DISABLED)
                
                Case "ARMGRID", "TABSTRIP"
                
                Case "ARMCHECKVIEW"
                    If ab_Enabled Then
                        Call lControl.SetVisibleList("EDIT")
                    Else
                        Call lControl.SetVisibleList("VIEW")
                    End If
                    
                Case "DIRLISTBOX", "DRIVELISTBOX", "FILELISTBOX"
                    lControl.Enabled = ab_Enabled
                    lControl.BackColor = IIf(ab_Enabled, CL_COLOR_ENABLED, CL_COLOR_DISABLED)

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

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 GetSequenceCode(as_SequenceName As String) As Long
On Error GoTo ErrHandler

Dim ls_Sequence As String
Dim ls_Message As String
Dim lv_SqlCodes As Variant, lv_SqlMessages As Variant

    'get new sequence number
    ls_Sequence = mo_DB.SQLNextID(as_SequenceName)
    If ls_Sequence = "" Then
        lv_SqlCodes = mo_DB.SQLErrorCodes
        lv_SqlMessages = mo_DB.SQLErrorMessages
        If IsArray(lv_SqlMessages) Then
            ls_Message = Join(lv_SqlMessages, ",")
        End If
        Err.Raise ArmErr.CompFncFailed, "SQLNextID", ls_Message & " - " & as_SequenceName
    End If
    GetSequenceCode = Val(ls_Sequence)
    Exit Function
ErrHandler:
    Call ErrorHandler("GetSequenceCode")
End Function

Private Function TestVersion(ByVal as_version As String) As Boolean
On Error GoTo ErrHandler
    
    TestVersion = (GetAConfigData(mo_DB, "TMG_Version") = as_version)
    Exit Function
ErrHandler:
    Call ErrorHandler("TestVersion")
End Function

Private Function GetU_Code(ByVal as_LoginName As String) As Long
On Error GoTo ErrHandler
    Dim lc_Cursor As Long
    Dim ls_Request As String
    
    GetU_Code = 0
    ls_Request = "SELECT U_Code FROM gen_systems_users WHERE U_login_name = $LoginName$"
    ls_Request = ReplacePlaceHolder(ls_Request, "$LoginName$", SQLStr(as_LoginName))
    lc_Cursor = OpenSQLSafe(mo_DB, ls_Request)
    If mo_DB.RowCount(lc_Cursor) = 1 Then
        GetU_Code = mo_DB.GetFields(lc_Cursor, "U_Code")
    End If
    Call mo_DB.Close(lc_Cursor)
    Exit Function
ErrHandler:
    Call mo_DB.Close(lc_Cursor)
    Call ErrorHandler("GetU_Code")
End Function

Private Function GetAConfigDataByCountry(ByRef ao_DB As ArmDb, ByVal as_Key As String) As String
On Error GoTo ErrHandler

    GetAConfigDataByCountry = ""
    
    Const C_REQ As String = "SELECT A.CFG_Value" & vbCrLf & _
                            "FROM security_identity SI" & vbCrLf & _
                            " INNER JOIN A_Config A ON CFG_Key='$KEY$'+'_' + SI.CT_code" & vbCrLf & _
                            "WHERE SI.login_Name = '$LOGIN$'"
    Dim ll_Cursor As Long
    Dim ls_req As String
    
    ls_req = Replace(C_REQ, "$KEY$", as_Key, , , vbTextCompare)
    ls_req = Replace(ls_req, "$LOGIN$", ms_LoginName, , , vbTextCompare)
    
    ll_Cursor = OpenSQLSafe(ao_DB, ls_req)
    
    If ao_DB.RowCount(ll_Cursor) = 1 Then
        GetAConfigDataByCountry = ao_DB.GetFields(ll_Cursor, "CFG_Value")
    End If
    Call ao_DB.Close(ll_Cursor)
    
    Exit Function
ErrHandler:
    Call ao_DB.Close(ll_Cursor)
    Call ErrorHandler("GetAConfigDataByCountry")
End Function

Private Function GetAConfigData(ByRef ao_DB As ArmDb, ByVal as_Key As String) As String
On Error GoTo ErrHandler
    
    Const C_REQ As String = "SELECT CFG_Value FROM A_Config WHERE CFG_Key='$KEY$'"
    Dim ll_Cursor As Long
    
    ll_Cursor = OpenSQLSafe(ao_DB, Replace(C_REQ, "$KEY$", as_Key, , , vbTextCompare))
    
    If ao_DB.RowCount(ll_Cursor) = 1 Then
        GetAConfigData = ao_DB.GetFields(ll_Cursor, "CFG_Value")
    Else
        Call ao_DB.Close(ll_Cursor)
        Err.Raise ArmErr.CompFncFailed, "OpenSQLSafe", "A_Config value missing : " & as_Key
    End If
    Call ao_DB.Close(ll_Cursor)
    
    Exit Function
ErrHandler:
    Call ao_DB.Close(ll_Cursor)
    Call ErrorHandler("GetAConfigData")
End Function

Private Function SelectValue(ByVal as_Request As String) As Variant
On Error GoTo ErrHandler
Dim ll_Cursor As Long

  ll_Cursor = OpenSQLSafe(mo_DB, as_Request)
  If ll_Cursor > 0 Then
    If mo_DB.RowCount(ll_Cursor) = 1 Then
      SelectValue = mo_DB.GetFields(ll_Cursor, 0)
    End If
    Call mo_DB.Close(ll_Cursor)
  End If
  Exit Function
ErrHandler:
  Call mo_DB.Close(ll_Cursor)
  Call ErrorHandler("SelectValue as_Request=" & as_Request)
End Function


