VERSION 5.00
Begin VB.UserControl ArmIVPOSup 
   ClientHeight    =   9390
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   10080
   ScaleHeight     =   9390
   ScaleWidth      =   10080
   Begin VB.Frame fraList 
      Height          =   5895
      Left            =   1560
      TabIndex        =   39
      Top             =   8880
      Visible         =   0   'False
      Width           =   7935
      Begin Project1.ArmGrid grList 
         Height          =   4935
         Left            =   120
         TabIndex        =   40
         Top             =   840
         Width           =   7695
         _ExtentX        =   13573
         _ExtentY        =   8705
      End
      Begin Project1.ToolbarControl tcList 
         Height          =   690
         Left            =   120
         TabIndex        =   41
         Top             =   120
         Width           =   4095
         _ExtentX        =   7223
         _ExtentY        =   1217
      End
   End
   Begin VB.Frame fraItem 
      Height          =   9015
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Visible         =   0   'False
      Width           =   8895
      Begin VB.Frame fraSuplier 
         Height          =   4455
         Left            =   120
         TabIndex        =   25
         Top             =   840
         Width           =   7455
         Begin VB.TextBox txt_SP_Name 
            Height          =   375
            Left            =   1560
            MaxLength       =   80
            TabIndex        =   1
            Tag             =   "txt_OrderBy"
            Top             =   240
            Width           =   5775
         End
         Begin VB.TextBox txt_SP_Addr1 
            Height          =   375
            Left            =   1560
            MaxLength       =   50
            TabIndex        =   2
            Tag             =   "txt_OrderBy"
            Top             =   840
            Width           =   4215
         End
         Begin VB.TextBox txt_SP_Addr2 
            Height          =   375
            Left            =   1560
            MaxLength       =   50
            TabIndex        =   3
            Tag             =   "txt_OrderBy"
            Top             =   1200
            Width           =   4215
         End
         Begin VB.TextBox txt_SP_Addr3 
            Height          =   375
            Left            =   1560
            MaxLength       =   50
            TabIndex        =   4
            Tag             =   "txt_OrderBy"
            Top             =   1560
            Width           =   4215
         End
         Begin VB.TextBox txt_SP_ZIP 
            Height          =   375
            Left            =   1560
            MaxLength       =   10
            TabIndex        =   5
            Tag             =   "txt_OrderBy"
            Top             =   1920
            Width           =   1335
         End
         Begin VB.TextBox txt_SP_Town 
            Height          =   375
            Left            =   4440
            MaxLength       =   50
            TabIndex        =   6
            Tag             =   "txt_OrderBy"
            Top             =   1920
            Width           =   2895
         End
         Begin VB.TextBox txt_SP_Country 
            Height          =   375
            Left            =   1560
            MaxLength       =   15
            TabIndex        =   7
            Tag             =   "txt_OrderBy"
            Top             =   2280
            Width           =   5775
         End
         Begin VB.TextBox txt_SP_Phone 
            Height          =   375
            Left            =   1560
            MaxLength       =   15
            TabIndex        =   8
            Tag             =   "txt_OrderBy"
            Top             =   2760
            Width           =   2295
         End
         Begin VB.TextBox txt_SP_Fax 
            Height          =   375
            Left            =   5040
            MaxLength       =   20
            TabIndex        =   9
            Tag             =   "txt_OrderBy"
            Top             =   2760
            Width           =   2295
         End
         Begin VB.TextBox txt_SP_RIB 
            Height          =   375
            Left            =   1560
            MaxLength       =   30
            TabIndex        =   10
            Tag             =   "txt_OrderBy"
            Top             =   3240
            Width           =   3015
         End
         Begin Project1.ArmCombobox cbo_PaiementType 
            Height          =   345
            Left            =   1560
            TabIndex        =   11
            Top             =   3600
            Width           =   3015
            _ExtentX        =   5318
            _ExtentY        =   609
         End
         Begin Project1.ArmCombobox cbo_PaiementTerms 
            Height          =   345
            Left            =   1560
            TabIndex        =   12
            Top             =   3960
            Width           =   3015
            _ExtentX        =   5318
            _ExtentY        =   609
         End
         Begin VB.Label lbl_SP_Name 
            Caption         =   "#Name"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   120
            TabIndex        =   37
            Tag             =   "lbl_SP_Name"
            Top             =   360
            Width           =   1335
         End
         Begin VB.Label lbl_SP_Addr1 
            Caption         =   "#Address 1"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   120
            TabIndex        =   36
            Tag             =   "lbl_SP_Addr1"
            Top             =   960
            Width           =   1335
         End
         Begin VB.Label lbl_SP_Addr2 
            Caption         =   "#Address 2"
            Height          =   255
            Left            =   120
            TabIndex        =   35
            Tag             =   "lbl_SP_Addr2"
            Top             =   1320
            Width           =   1335
         End
         Begin VB.Label lbl_SP_Addr3 
            Caption         =   "#Address 3"
            Height          =   255
            Left            =   120
            TabIndex        =   34
            Tag             =   "lbl_SP_Addr3"
            Top             =   1680
            Width           =   1335
         End
         Begin VB.Label lbl_SP_Zip 
            Caption         =   "#ZIP"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   120
            TabIndex        =   33
            Tag             =   "lbl_SP_Zip"
            Top             =   2040
            Width           =   1335
         End
         Begin VB.Label lbl_SP_Town 
            Caption         =   "#Town"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   3000
            TabIndex        =   32
            Tag             =   "lbl_SP_Town"
            Top             =   2040
            Width           =   1335
         End
         Begin VB.Label lbl_SP_Country 
            Caption         =   "#Country"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   120
            TabIndex        =   31
            Tag             =   "lbl_SP_Country"
            Top             =   2400
            Width           =   1335
         End
         Begin VB.Label lbl_SP_Phone 
            Caption         =   "#Phone"
            Height          =   255
            Left            =   120
            TabIndex        =   30
            Tag             =   "lbl_SP_Phone"
            Top             =   2880
            Width           =   1335
         End
         Begin VB.Label lbl_SP_Fax 
            Caption         =   "#Fax"
            Height          =   255
            Left            =   3960
            TabIndex        =   29
            Tag             =   "lbl_SP_Fax"
            Top             =   2880
            Width           =   1095
         End
         Begin VB.Label lbl_SP_RIB 
            Caption         =   "#RIB"
            Height          =   255
            Left            =   120
            TabIndex        =   28
            Tag             =   "lbl_SP_RIB"
            Top             =   3360
            Width           =   1335
         End
         Begin VB.Label lbl_PaiementType 
            Caption         =   "#Payment type"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   120
            TabIndex        =   27
            Tag             =   "lbl_PaiementType"
            Top             =   3720
            Width           =   1455
         End
         Begin VB.Label lbl_PaiementTerms 
            Caption         =   "#Payment terms"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   120
            TabIndex        =   26
            Tag             =   "lbl_PaiementTerms"
            Top             =   4080
            Width           =   1455
         End
      End
      Begin VB.Frame fraContacts 
         Height          =   3495
         Left            =   120
         TabIndex        =   13
         Top             =   5400
         Width           =   8535
         Begin VB.Frame fraItemContact 
            Height          =   1095
            Left            =   120
            TabIndex        =   20
            Top             =   2280
            Width           =   7455
            Begin VB.TextBox txt_SPC_Fax 
               Height          =   375
               Left            =   5160
               MaxLength       =   20
               TabIndex        =   19
               Tag             =   "txt_OrderBy"
               Top             =   600
               Width           =   2055
            End
            Begin VB.TextBox txt_SPC_Phone 
               Height          =   375
               Left            =   1440
               MaxLength       =   20
               TabIndex        =   18
               Tag             =   "txt_OrderBy"
               Top             =   600
               Width           =   2415
            End
            Begin VB.TextBox txt_SPC_First_Name 
               Height          =   375
               Left            =   5160
               MaxLength       =   50
               TabIndex        =   17
               Tag             =   "txt_OrderBy"
               Top             =   240
               Width           =   2055
            End
            Begin VB.TextBox txt_SPC_Name 
               Height          =   375
               Left            =   1440
               MaxLength       =   50
               TabIndex        =   16
               Tag             =   "txt_OrderBy"
               Top             =   240
               Width           =   2415
            End
            Begin VB.Label lbl_SPC_Fax 
               Caption         =   "#Fax"
               Height          =   255
               Left            =   3960
               TabIndex        =   24
               Tag             =   "lbl_SPC_Fax"
               Top             =   720
               Width           =   1095
            End
            Begin VB.Label lbl_SPC_Phone 
               Caption         =   "#Phone"
               Height          =   255
               Left            =   120
               TabIndex        =   23
               Tag             =   "lbl_SPC_Phone"
               Top             =   720
               Width           =   1215
            End
            Begin VB.Label lbl_SPC_First_Name 
               Caption         =   "#First name"
               BeginProperty Font 
                  Name            =   "Arial"
                  Size            =   8.25
                  Charset         =   0
                  Weight          =   700
                  Underline       =   0   'False
                  Italic          =   0   'False
                  Strikethrough   =   0   'False
               EndProperty
               Height          =   255
               Left            =   3960
               TabIndex        =   22
               Tag             =   "lbl_SPC_First_Name"
               Top             =   360
               Width           =   1095
            End
            Begin VB.Label lbl_SPC_Name 
               Caption         =   "#Last name"
               BeginProperty Font 
                  Name            =   "Arial"
                  Size            =   8.25
                  Charset         =   0
                  Weight          =   700
                  Underline       =   0   'False
                  Italic          =   0   'False
                  Strikethrough   =   0   'False
               EndProperty
               Height          =   255
               Left            =   120
               TabIndex        =   21
               Tag             =   "lbl_SPC_Name"
               Top             =   360
               Width           =   1215
            End
         End
         Begin Project1.ToolbarControl tcLines 
            Height          =   3135
            Left            =   7680
            TabIndex        =   15
            Top             =   240
            Width           =   690
            _ExtentX        =   1217
            _ExtentY        =   5530
         End
         Begin Project1.ArmGrid grContactLines 
            Height          =   2055
            Left            =   120
            TabIndex        =   14
            Top             =   240
            Width           =   7455
            _ExtentX        =   13150
            _ExtentY        =   3625
         End
      End
      Begin Project1.ToolbarControl tcItem 
         Height          =   690
         Left            =   120
         TabIndex        =   38
         Top             =   120
         Width           =   4455
         _ExtentX        =   7858
         _ExtentY        =   1217
      End
   End
End
Attribute VB_Name = "ArmIVPOSup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Const SEP As String = "®©"
Private Const SCREEN_NAME As String = "IVPO_SUP"

Const CL_COLOR_ENABLED As Long = &H80000005
Const CL_COLOR_DISABLED As Long = &H8000000F
Const C_ERRORRAISE As Long = 50000
    

Private Const TB_ITEM_VIEW As Long = 0
Private Const TB_ITEM_ADD As Long = 1
Private Const TB_ITEM_UPDATE As Long = 2
Private Const TB_ITEM_DELETE As Long = 3

Private Const TB_LC_LINE_ADD As Long = 0

Public Event Quit(al_SP_Code As Long)

#If LIVE Then
Private mDb As Object
Private mDbErr As Object
#Else
Private mDb As ArmDb
Private mDbErr As ArmDb
#End If

Private mNbOfCursorAtLoad As Integer

Private mInitialized As Boolean
Private mLoginName As String
Private mLanguage_Code As String
Private mUser_ID As Long
Private mb_ItemScreenOnly As Boolean

Private Type TSupplierContact
    SP_Code As Long
    SPC_Code As Long
    Name As String
    First_Name As String
    Fax As String
    Phone As String
End Type

Private Type TSupplier
    SP_Code As Long
    Name As String
    Addr1  As String
    Addr2 As String
    Addr3 As String
    Zip As String
    Town As String
    Fax As String
    Phone As String
    Country As String
    CP_Code As Long
    PT_Code As Long
    Paiment_Terms As String
    RIB As String
    Contacts() As TSupplierContact
End Type

Dim mNumber As Long
Dim mSource As String
Dim mDesc As String

Private mCurrentSupplier As TSupplier

Private Enum eMode
    emList = 0
    emView = 1
    emAdd = 2
    emUpdate = 3
    emDelete = 4
End Enum

Private mOldMode As eMode
Private mMode As eMode


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 ItemScreenOnly(ByVal ab_ItemScreenOnly As Boolean)
    mb_ItemScreenOnly = ab_ItemScreenOnly
End Property

Public Property Get ItemScreenOnly() As Boolean
    ItemScreenOnly = mb_ItemScreenOnly
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 Sub ZOrder()
  Call UserControl.Extender.ZOrder
End Sub

Public Function load_A_Com() As Boolean
    
    Const CL_REQUEST_TB As String = "SELECT Toolbar_Info FROM Toolbars_Users WHERE User_Code=$user_id$"
    
    Dim lIdx As Long, lCount As Long
    Dim ls_Toolbar_Info As String
    
    mNbOfCursorAtLoad = mDb.CursorCount
    
    mMode = emList
        
    Call LoadLabels(UserControl.Controls, SCREEN_NAME, mLanguage_Code)
    
    fraItem.Visible = False
    fraList.Visible = False
    
    Call InitCtrlSize
    
    Set cbo_PaiementTerms.ArmDb = mDb
    cbo_PaiementTerms.FirstBlankItem = False
    cbo_PaiementTerms.load_A_Com
    cbo_PaiementTerms.Request = "exec IV_Paiement_Terms_Lst"
    
    Set cbo_PaiementType.ArmDb = mDb
    cbo_PaiementType.FirstBlankItem = False
    cbo_PaiementType.load_A_Com
    cbo_PaiementType.Request = "exec IV_Paiement_Type_Lst"
    
    Set grContactLines.ArmDb = mDb
    grContactLines.load_A_Com
    grContactLines.AllowExcelExport = True
    grContactLines.ExportTitles = True
    grContactLines.MultiSelect = True
    grContactLines.UnBound = True
    
    Dim lColumns As Variant
    ReDim lColumns(5)
    lColumns(0) = Join(Array("SPC_CODE", 0, 1, "SPC_CODE", "#SPC_Code"), SEP)
    lColumns(1) = Join(Array("SP_CODE", 0, 0, "SPC_CODE", "#SP_Code"), SEP)
    lColumns(2) = Join(Array("SPC_Name", 2500, 0, "SPC_Name", lbl_SPC_Name.Caption), SEP)
    lColumns(3) = Join(Array("SPC_First_Name", 2500, 0, "SPC_First_Name", lbl_SPC_First_Name), SEP)
    lColumns(4) = Join(Array("SPC_Phone", 1200, 0, "SPC_Phone", lbl_SPC_Phone), SEP)
    lColumns(5) = Join(Array("SPC_Fax", 1200, 0, "SPC_Fax", lbl_SPC_Fax), SEP)
    If Not grContactLines.SetColumns(lColumns) Then
        'debug.print "grContactLines.SetColumns error"
        Call Unload_A_Com
        End
    End If
    
    Set grList.ArmDb = mDb
    grList.load_A_Com
    grList.AllowExcelExport = True
    grList.ExportTitles = True
    grList.MultiSelect = True
    ReDim lColumns(4)
    lColumns(0) = Join(Array("SP_Code", 0, 1, "SP_CODE", "#SP_Code"), SEP)
    lColumns(1) = Join(Array("SP_Name", 2500, 0, "SP_Name", lbl_SP_Name), SEP)
    lColumns(2) = Join(Array("SP_Adr1", 2500, 0, "SP_Adr1", lbl_SP_Addr1), SEP)
    lColumns(3) = Join(Array("SP_Zip", 1200, 0, "SP_Zip", lbl_SP_Zip), SEP)
    lColumns(4) = Join(Array("SP_Town", 1200, 0, "SP_Town", lbl_SP_Town), SEP)
    If Not grList.SetColumns(lColumns) Then
        'debug.print "grList.SetColumns error"
        Call Unload_A_Com
        End
    End If
    If Not ItemScreenOnly Then
    Call grList.Load("exec IV_Suppliers_grd", False)
    End If
    
    Dim lCursTB As Long
    'load design toolbars. If you want load user specific toolbars replace 0 for real user id
    lCursTB = mDb.OpenSQL(Replace(CL_REQUEST_TB, "$user_id$", 0))
    ls_Toolbar_Info = mDb.GetFields(lCursTB, "toolbar_info")
    Call mDb.Close(lCursTB)
    
    Call tcList.load_A_Com
    tcList.Language = "E"
    Call tcList.SetToolbarInfoStringParameters(ls_Toolbar_Info, "011")
    Call tcList.DisplayFace("0")
    
    Call tcItem.load_A_Com
    tcItem.Language = "E"
    Call tcItem.SetToolbarInfoStringParameters(ls_Toolbar_Info, "012")
    
    Call tcLines.load_A_Com
    tcLines.Language = "E"
    Call tcLines.SetToolbarInfoStringParameters(ls_Toolbar_Info, "013")
    
    Set mDbErr = mDb
    
    fraItem.Visible = False
    fraList.Visible = True
    
    mInitialized = True
    load_A_Com = True
End Function

Public Function Unload_A_Com() As Boolean
    
    tcList.Unload_A_Com
    tcItem.Unload_A_Com
    tcLines.Unload_A_Com
    
    grList.Unload_A_Com
    grContactLines.Unload_A_Com
    
    cbo_PaiementTerms.Unload_A_Com
    cbo_PaiementType.Unload_A_Com
    
    If mDb.CursorCount <> mNbOfCursorAtLoad Then
        'debug.print "cursors : " & mDb.CursorCount
    End If
    
    Set mDb = Nothing
    Set mDbErr = Nothing
    
    Unload_A_Com = True
End Function


#If LIVE Then
Public Property Set Db(ByRef ADB As Object)
#Else
Public Property Set Db(ByRef ADB As ArmDb)
#End If
    Set mDb = ADB
End Property

Public Property Get Initialized() As Boolean
    Initialized = mInitialized
End Property

Public Property Let LoginName(ByVal aLoginName As String)
    mLoginName = aLoginName
End Property

Public Property Let User_ID(ByVal aUser_ID As Long)
    mUser_ID = aUser_ID
End Property

Public Property Let Language_Code(ByVal aLanguage_Code As String)
    mLanguage_Code = aLanguage_Code
End Property

Private Function HasContainer(ByRef aControl As Control, ByRef aContainer As Object) As Boolean
    
    HasContainer = False
    Dim lControl As Control
    
    Set lControl = aControl
    While Not (lControl Is Nothing)
        On Error GoTo NotFound
        If lControl.Container Is aContainer Then
            Set lControl = Nothing
            HasContainer = True
            Exit Function
        End If
        Set lControl = lControl.Container
    Wend

NotFound:
    Set lControl = Nothing
    HasContainer = False
End Function


Private Sub EnableFrame(ByRef aControls As Variant, ByRef aContainer As Object, ByVal aEnabled As Boolean)
    
    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 "FRAME", "LABEL", "MSFLEXGRID", "TOOLBARCONTROL"
                    ' Do nothing !
                Case "TEXTBOX"
                    lControl.Locked = Not aEnabled
                    lControl.BackColor = IIf(aEnabled, CL_COLOR_ENABLED, CL_COLOR_DISABLED)
                Case "ARMGRID", "COMMANDBUTTON", "ARMCHECKVIEW"
                Case "ARMCOMBOBOX", "A_CALOCX", "OPTIONBUTTON", "ARMTREEVIEW", "LISTBOX", "PICTUREBOX"
                    lControl.Enabled = aEnabled
                Case Else
                    lControl.Enabled = aEnabled
                    'debug.print "EnableFrame " & UCase(TypeName(lControl))
            End Select
        End If
        Set lControl = Nothing
    Next

End Sub


' Apply default value on a screen
Private Sub ClearForm(ByRef aControls As Variant, ByRef aContainer As Object)
    
    Dim lIdx As Long, lCount As Long, lControl As Object
    lCount = aControls.Count - 1
    For lIdx = 0 To lCount
        Set lControl = aControls.Item(lIdx)
        If HasContainer(lControl, aContainer) Then
            Select Case UCase(TypeName(lControl))
                Case "TEXTBOX"
                    lControl.Text = ""
                Case "ARMCOMBOBOX"
                    Set lControl.SelectedItem = Nothing
                Case "A_CALOCX"
                    lControl.reinit_cal
                Case "CHECKBOX"
                    lControl.value = False
                Case "ARMCHECKVIEW"
                    'lControl.Reset
                Case "FRAME", "LABEL", "TOOLBARCONTROL", "PICTUREBOX"
                Case "ARMGRID"
                    lControl.ClearGrid
                Case "LISTBOX"
                    lControl.ListIndex = -1
                Case Else
                    'debug.print "ClearForm " & UCase(TypeName(lControl))
            End Select
        End If
        
        Set lControl = Nothing
    Next

End Sub

' Remarks : Not all fields are filled from  the FORM
Private Function FormToLocal(ByRef aSupplier As TSupplier) As Boolean
    
    aSupplier.Name = txt_SP_Name.Text
    aSupplier.Addr1 = txt_SP_Addr1.Text
    aSupplier.Addr2 = txt_SP_Addr2.Text
    aSupplier.Addr3 = txt_SP_Addr3.Text
    aSupplier.Country = txt_SP_Country.Text
    aSupplier.Phone = txt_SP_Phone.Text
    aSupplier.Fax = txt_SP_Fax.Text
    aSupplier.Zip = txt_SP_ZIP.Text
    aSupplier.Town = txt_SP_Town.Text
    
    If Not (cbo_PaiementTerms.SelectedItem Is Nothing) Then
      aSupplier.CP_Code = cbo_PaiementTerms.SelectedItem.Key
    End If
    If Not (cbo_PaiementType.SelectedItem Is Nothing) Then
      aSupplier.PT_Code = cbo_PaiementType.SelectedItem.Key
    End If
    aSupplier.RIB = txt_SP_RIB.Text
    
    Dim lIdx As Long, lCount As Long
    lCount = grContactLines.Rows - 1
    If lCount > -1 Then
        ReDim aSupplier.Contacts(lCount)
        For lIdx = 0 To lCount
            aSupplier.Contacts(lIdx).SP_Code = aSupplier.SP_Code
            aSupplier.Contacts(lIdx).SPC_Code = grContactLines.data(lIdx, "SPC_Code")
            aSupplier.Contacts(lIdx).Name = grContactLines.data(lIdx, "SPC_Name")
            aSupplier.Contacts(lIdx).First_Name = grContactLines.data(lIdx, "SPC_First_Name")
            aSupplier.Contacts(lIdx).Phone = grContactLines.data(lIdx, "SPC_Phone")
            aSupplier.Contacts(lIdx).Fax = grContactLines.data(lIdx, "SPC_Fax")
        Next
    Else
        ReDim aSupplier.Contacts(-1 To -1)
    End If
    FormToLocal = True
End Function

Private Sub Item_AddClear()
    Call ClearForm(UserControl.Controls, fraItem)
    txt_SP_Country.Text = "France"
End Sub

Private Sub InitCtrlSize()

    Const HSPACE As Long = 120
    Const VSPACE As Long = 120
    
    Dim lBuffer As Long
    lBuffer = HSPACE
    Call fraItem.Move(lBuffer, VSPACE, UserControl.Width - lBuffer - HSPACE, UserControl.Height - (VSPACE * 2))
    Call fraList.Move(lBuffer, VSPACE, UserControl.Width - lBuffer - HSPACE, UserControl.Height - (VSPACE * 2))
    grList.Height = fraList.Height - grList.Top - VSPACE
    grList.Width = fraList.Width - grList.Left - HSPACE
End Sub

Private Sub tcList_Action(ByVal as_Role As String, as_Language As String)

On Error GoTo Err_tcList
    
    Screen.MousePointer = vbHourglass

    Select Case as_Role
        Case "A"    ' Add a new Purchase order
            Call Item_AddInit
        
        Case "F"    ' Refresh the current list
            Call RefreshList
        
        Case "B"    ' Update the selected item
            Call List_ItemUpdate
        
        Case "C"    ' Delete the selected items
            Call List_ItemsDelete
        Case "T"    ' Exit from application
            Call Item_Quit
    End Select

    Screen.MousePointer = 0
    Exit Sub
    
Err_tcList:
    Screen.MousePointer = 0
    
    Select Case mNumber - C_ERRORRAISE
    Case 1000
        SendMessage 1007, "Unable to save this supplier", mLanguage_Code
    Case Else
        MsgBox "unexpected error : " & Err.Number & "," & Err.Description
    End Select
End Sub

Private Sub tcItem_Action(ByVal as_Role As String, as_Language As String)
    
On Error GoTo Err_tcItem
    
    Screen.MousePointer = vbHourglass
    Select Case as_Role
        Case "J"    ' Jump to previous item
            GotoPreviousItem
        Case "K"    ' Jump to next item
           GotoNextItem
            
        Case "B"    ' Want to update the item
            Call Item_UpdateInit
        Case "C"    ' Want to delete the item
            Call Item_DeleteInit
        
        Case "W"    ' Confirm the delete
            Call Item_Delete
            
        Case "Z"    ' Exit without saving modification, return to prev
            Call Item_ExitToView
        
        Case "N"    ' Reload (Update mode)
            Call Item_UpdateReinit
            
        Case "M"
            Call Item_Update
            
        Case "T"    ' Exit and return to grid
            Call Item_ExitToGrid
        
        Case "Q"    ' Exit from update
            Call Item_UpdateExit
        Case "H"    ' Add a new purchase order
            Call Item_Add

        Case "I"    ' Reset to initial state
            Call Item_AddClear
    End Select
    
    Screen.MousePointer = 0
    Exit Sub
    
Err_tcItem:
    Screen.MousePointer = 0
    
    Select Case mNumber - C_ERRORRAISE
    Case 1001
        SendMessage 1007, "Impossible to create this supplier.", mLanguage_Code
    Case 1002
        SendMessage 1008, "Impossible to update this supplier.", mLanguage_Code
    Case Else
        MsgBox "unexpected error : " & Err.Number & "," & Err.Description
    End Select

End Sub

Public Sub Item_AddInit()
    
    Call SetMode(emAdd)
        
    Call EnableFrame(UserControl.Controls, fraItem, True)
    Call Item_AddClear
    
    tcItem.DisplayFace (TB_ITEM_ADD)
    tcLines.DisplayFace (TB_LC_LINE_ADD)
    tcLines.Visible = True
    
    fraItemContact.Visible = True
    
    fraItem.ZOrder
    fraItem.Visible = True
    fraList.Visible = False
End Sub

Private Sub Item_Quit()
  RaiseEvent Quit(mCurrentSupplier.SP_Code)
End Sub

Private Sub Item_ExitToGrid()

  If mb_ItemScreenOnly Then
    Call Item_Quit
  Else
    SetMode (emList)
    fraItem.Visible = False
    fraList.Visible = True
    Call EnableFrame(UserControl.Controls, fraList, True)
  End If
End Sub

Private Sub tcLines_Action(ByVal as_Role As String, as_Language As String)

    Screen.MousePointer = vbHourglass
    
    Select Case as_Role
        Case "A"    ' Add a new line
            Call Item_LCAddCurrentContactLine
        Case "B"    ' Add a new line
            Call Item_LCUpdateCurrentContactLine
        Case "C"    ' Delete the selected lines
            Call Item_LCDeleteSelContactLines
        Case "I"    ' Clear the grid
            Call Item_LCClearContactLines
    End Select
    
    Screen.MousePointer = 0
End Sub

Private Sub Item_Add()
    
On Error GoTo Err_Item_Add
    
    If Not Item_Check Then Exit Sub
    
    ' New Purchase Order
    Dim lSupplier As TSupplier
    
    mSource = SCREEN_NAME & "/Item_Add: "
    
    If Not GetNextKey("IV_Suppliers", lSupplier.SP_Code) Then
        mSource = mSource & "GetNextKey"
        mDesc = "Unable to get a new key"
        Err.Raise mNumber, mSource, mDesc
    End If
    
   
    If Not FormToLocal(lSupplier) Then
        mSource = mSource & "FormToLocal"
        mDesc = "Error in Add"
        Err.Raise mNumber, mSource, mDesc
    End If
    
    'LocalTODB
    If Not LocalToDB_Add(lSupplier) Then
        mSource = mSource & "LocalToDB_Add"
        mDesc = "Error in LocalToDB"
        Err.Raise mNumber, mSource, mDesc
    End If

    mCurrentSupplier = lSupplier

    Call Item_AddLocal
    Call Item_ExitToView
    
    Exit Sub
    
Err_Item_Add:
    mNumber = C_ERRORRAISE + 1001
    Err.Raise mNumber, mSource, mDesc
    
End Sub

Private Function ReplaceHolders(ByVal aRequest As String) As String
    
    Dim lBuffer As String
    lBuffer = Replace(aRequest, "$lang$", SQLStr(mLanguage_Code), , , vbTextCompare)
    lBuffer = Replace(lBuffer, "$login$", SQLStr(mLoginName), , , vbTextCompare)
    lBuffer = Replace(lBuffer, "$u_code$", mUser_ID, , , vbTextCompare)
    lBuffer = Replace(lBuffer, "$now$", SQLDateTime(Now), , , vbTextCompare)
    ReplaceHolders = lBuffer
End Function

Private Function ReplaceHoldersFromSupplier(ByVal aRequest As String, ByRef aSupplier As TSupplier) As String
    
    Dim lRequest As String
    lRequest = ReplaceHolders(aRequest)
    lRequest = Replace(lRequest, "$sp_code$", aSupplier.SP_Code, , , vbTextCompare)
    
    lRequest = Replace(lRequest, "$SP_Name$", SQLStr(aSupplier.Name), , , vbTextCompare)
    lRequest = Replace(lRequest, "$SP_Addr1$", SQLStr(aSupplier.Addr1), , , vbTextCompare)
    lRequest = Replace(lRequest, "$SP_Addr2$", SQLStr(aSupplier.Addr2), , , vbTextCompare)
    lRequest = Replace(lRequest, "$SP_Addr3$", SQLStr(aSupplier.Addr3), , , vbTextCompare)
    
    lRequest = Replace(lRequest, "$SP_Town$", SQLStr(aSupplier.Town), , , vbTextCompare)
    lRequest = Replace(lRequest, "$SP_Zip$", SQLStr(aSupplier.Zip), , , vbTextCompare)
    lRequest = Replace(lRequest, "$SP_Country$", SQLStr(aSupplier.Country), , , vbTextCompare)
    lRequest = Replace(lRequest, "$SP_Phone$", SQLStr(aSupplier.Phone), , , vbTextCompare)
    lRequest = Replace(lRequest, "$SP_Fax$", SQLStr(aSupplier.Fax), , , vbTextCompare)
    lRequest = Replace(lRequest, "$SP_RIB$", SQLStr(aSupplier.RIB), , , vbTextCompare)
    
    lRequest = Replace(lRequest, "$cp_code$", IIf(aSupplier.CP_Code <> 0, aSupplier.CP_Code, "null"), , , vbTextCompare)
    lRequest = Replace(lRequest, "$pt_code$", IIf(aSupplier.PT_Code <> 0, aSupplier.PT_Code, "null"), , , vbTextCompare)
    
    ReplaceHoldersFromSupplier = lRequest
End Function

Private Function ReplaceHoldersFromSupplierContact(ByVal aRequest As String, ByRef aLineContact As TSupplierContact) As String

    Dim lRequest As String
    
    lRequest = ReplaceHolders(aRequest)
    lRequest = Replace(lRequest, "$SP_Code$", aLineContact.SP_Code, , , vbTextCompare)
    lRequest = Replace(lRequest, "$SPC_Code$", aLineContact.SPC_Code, , , vbTextCompare)
    lRequest = Replace(lRequest, "$SPC_Name$", SQLStr(aLineContact.Name), , , vbTextCompare)
    lRequest = Replace(lRequest, "$SPC_First_Name$", SQLStr(aLineContact.First_Name), , , vbTextCompare)
    lRequest = Replace(lRequest, "$SPC_Phone$", SQLStr(aLineContact.Phone), , , vbTextCompare)
    lRequest = Replace(lRequest, "$SPC_Fax$", SQLStr(aLineContact.Fax), , , vbTextCompare)
    
    ReplaceHoldersFromSupplierContact = lRequest
End Function

    
Private Function LocalToDB_Add(ByRef aSupplier As TSupplier) As Boolean
    
   
    Const DB_SUP_REQUEST As String = "exec IV_Suppliers_Ins $sp_code$, $sp_name$, $sp_addr1$, $sp_addr2$, $sp_addr3$, $sp_zip$, $sp_town$, $sp_fax$, $sp_phone$, $sp_country$, $cp_code$, $sp_rib$, $pt_code$, $now$, $u_code$"
    Const DB_CON_REQUEST As String = "exec IV_Suppliers_Contacts_Ins $spc_code$, $sp_code$, $spc_name$, $spc_first_name$, $spc_phone$, $spc_fax$, $now$, $u_code$"
    
On Error GoTo Err_LocalToDB_Add
    
    Dim lRequest As String, lLineRequest As Variant, lPORequest As String, lTranOpenned As Boolean
    
    mNumber = C_ERRORRAISE + 1000
    mSource = SCREEN_NAME & "/LocalToDB_Add: "
    
    lPORequest = ReplaceHoldersFromSupplier(DB_SUP_REQUEST, aSupplier)
    
    Dim lIdx As Long, lCount As Long, lBuffer As TSupplierContact
    
    'If Not aSupplier.Contacts Is Nothing Then
    lCount = UBound(aSupplier.Contacts)
    
    If lCount > -1 Then
        ReDim lLineRequest(lCount)
        For lIdx = 0 To lCount
            lBuffer = aSupplier.Contacts(lIdx) ' @$¤! VB who don't know how to manage array of user type !
            
            If Not GetNextKey("IV_Suppliers_Contacts", lBuffer.SPC_Code) Then
              mSource = mSource & "GetNextKey"
              mDesc = "Unable to get a new key"
              Err.Raise mNumber, mSource, mDesc
            End If
    
            lRequest = ReplaceHoldersFromSupplierContact(DB_CON_REQUEST, lBuffer)
            lLineRequest(lIdx) = lRequest
        Next
    Else
        ReDim lLineRequest(-1 To -1)
    End If
    
    If Not mDb.ExecuteSQL("BEGIN TRAN") Then
        mSource = mSource & "BEGIN TRAN"
        Err.Raise mNumber, mSource, "BEGIN TRAN failed"
    End If
    lTranOpenned = True
    
    If Not mDb.ExecuteSQL(lPORequest) Then
        mSource = mSource & lPORequest
        mDesc = "error in adding po"
        
        Err.Raise mNumber, mSource, mDesc
    End If
    For lIdx = 0 To lCount
        If Not mDb.ExecuteSQL(lLineRequest(lIdx)) Then
            mSource = mSource & lLineRequest(lIdx)
            mDesc = "error in adding a line"
            
            Err.Raise mNumber, mSource, mDesc
        End If
    Next
    
    If Not mDb.ExecuteSQL("COMMIT TRAN") Then
        mSource = mSource & "COMMIT TRAN"
        Err.Raise mNumber, mSource, "COMMIT TRAN failed"
    Else
    lTranOpenned = False
    End If
    
    LocalToDB_Add = True
    Exit Function
    
Err_LocalToDB_Add:
    If lTranOpenned Then
        If Not mDb.ExecuteSQL("ROLLBACK TRAN") Then
            UploadSQLError mDb, mDbErr, SCREEN_NAME & "/LocalToDB_Add : ROLLBACK TRAN"
            mDb.disconnect
            mDbErr.disconnect
            End
        Else
            UploadSQLError mDb, mDbErr, mSource
        End If
    Else
        UploadSQLError mDb, mDbErr, mSource
    End If
    Err.Raise mNumber, mSource, mDesc
End Function

Private Function ConvertDateToSQL(ByVal aDate As Date) As String
    Dim lStr As String
    lStr = Year(aDate) & "-" & Month(aDate) & "-" & Day(aDate)
    ConvertDateToSQL = lStr
End Function


Private Sub grList_ItemSelected()
    Screen.MousePointer = vbHourglass
    Call Item_Load(grList.CurrentKey(0))
    Screen.MousePointer = 0
End Sub

Private Sub Item_Load(ByVal aSP_Code As Long)
    
    mCurrentSupplier = DBToLocal(aSP_Code)
    fraItem.Visible = False
    Call LocalToForm(mCurrentSupplier)
    Call Item_ViewInit
    fraItem.Visible = True
End Sub

Private Function DBToLocal(ByVal aSP_Code As Long) As TSupplier

    Const DB_SUP_REQUEST As String = "exec IV_Suppliers_Sel $SP_Code$"
    Const DB_SUP_CONTACT_REQUEST As String = "IV_Suppliers_Contacts_grd $SP_Code$"

    Dim lRequest As String
    lRequest = Replace(DB_SUP_REQUEST, "$SP_Code$", aSP_Code, , , vbTextCompare)
    
    Dim lData As Long
    lData = mDb.OpenSQL(lRequest)
    
    Dim lSupplier As TSupplier
    
    lSupplier.SP_Code = mDb.GetFields(lData, "SP_Code")
    lSupplier.Name = mDb.GetFields(lData, "SP_Name")
    lSupplier.Addr1 = mDb.GetFields(lData, "SP_Adr1")
    lSupplier.Addr2 = mDb.GetFields(lData, "SP_Adr2")
    lSupplier.Addr3 = mDb.GetFields(lData, "SP_Adr3")
    lSupplier.Country = mDb.GetFields(lData, "SP_Country")
    lSupplier.Fax = mDb.GetFields(lData, "SP_Fax")
    lSupplier.Phone = mDb.GetFields(lData, "SP_Phone")
    lSupplier.Town = mDb.GetFields(lData, "SP_Town")
    lSupplier.Zip = mDb.GetFields(lData, "SP_Zip")
    lSupplier.RIB = mDb.GetFields(lData, "SP_RIB")
    lSupplier.CP_Code = mDb.GetFields(lData, "CP_Code")
    lSupplier.PT_Code = mDb.GetFields(lData, "PT_Code")
    
    mDb.Close (lData)
    
    lRequest = Replace(DB_SUP_CONTACT_REQUEST, "$SP_Code$", aSP_Code, , , vbTextCompare)
    lData = mDb.OpenSQL(lRequest)
    
    If mDb.RowCount(lData) > 0 Then
        Dim lIdx As Long, lCount As Long
        lCount = mDb.RowCount(lData) - 1
        ReDim lSupplier.Contacts(lCount)
        
        For lIdx = 0 To lCount
            lSupplier.Contacts(lIdx).SP_Code = mDb.GetFields(lData, "SP_Code")
            lSupplier.Contacts(lIdx).SPC_Code = mDb.GetFields(lData, "SPC_Code")
            lSupplier.Contacts(lIdx).Name = mDb.GetFields(lData, "SPC_Name")
            lSupplier.Contacts(lIdx).First_Name = mDb.GetFields(lData, "SPC_First_Name")
            lSupplier.Contacts(lIdx).Fax = mDb.GetFields(lData, "SPC_Fax")
            lSupplier.Contacts(lIdx).Phone = mDb.GetFields(lData, "SPC_Phone")
            mDb.Next (lData)
        Next
    Else
        ReDim lSupplier.Contacts(-1 To -1)
    End If
    mDb.Close (lData)
    
    DBToLocal = lSupplier
End Function

Private Sub LocalToForm(ByRef aSupplier As TSupplier)
    
    Call ClearForm(UserControl.Controls, fraItem)
    
    With aSupplier
        txt_SP_Name.Text = .Name
        txt_SP_Addr1.Text = .Addr1
        txt_SP_Addr2.Text = .Addr2
        txt_SP_Addr3.Text = .Addr3
        
        txt_SP_ZIP.Text = .Zip
        txt_SP_Town.Text = .Town
        txt_SP_Country.Text = .Country
        txt_SP_Fax.Text = .Fax
        txt_SP_Phone.Text = .Phone
        txt_SP_RIB.Text = .RIB
        
        If cbo_PaiementTerms.Count = 0 Then cbo_PaiementTerms.Load
        Call cbo_PaiementTerms.SearchItem(.CP_Code)
        
        If cbo_PaiementType.Count = 0 Then cbo_PaiementType.Load
        Call cbo_PaiementType.SearchItem(.PT_Code)
        
On Error GoTo SupHasNoContacts
        Dim lIdx As Long, lCount As Long
        lCount = UBound(.Contacts)
        grContactLines.Visible = False
        For lIdx = 0 To lCount
            If Not grContactLines.AddLine(Array(.Contacts(lIdx).SPC_Code, _
                                              .Contacts(lIdx).SP_Code, _
                                              .Contacts(lIdx).Name, _
                                              .Contacts(lIdx).First_Name, _
                                              .Contacts(lIdx).Phone, _
                                              .Contacts(lIdx).Fax)) Then
              'debug.print "grContactLines.AddLine failed in LocalToForm"
            End If
        Next
SupHasNoContacts:
        grContactLines.Visible = True
    End With
End Sub

Private Sub GotoPreviousItem()
    If Not grList.PreviousItem Then
        Call SendMessage(927, "#No more previous item", mLanguage_Code)
    End If
End Sub

Private Sub GotoNextItem()
    If Not grList.NextItem Then
        Call SendMessage(928, "#No more next item", mLanguage_Code)
    End If
End Sub


' TODO : Error management !!!!!!
' Give the nextkey of an DB table
' NOTICE : MUSTN'T BE CALLED INTO A ACID TRANSACTION BECAUSE DISPLAY ERROR MESSAGE !
Private Function GetNextKey(ByVal as_TableName, ByRef al_Key As Long, Optional ByVal al_TryCount As Integer = 5) As Boolean

    On Error GoTo onError
    
    
    Dim ls_Request As String

    ls_Request = "SELECT Table_Key" & vbCrLf & _
                 "FROM SYS_TablesKeys" & vbCrLf & _
                 "WHERE Table_Name = '" & as_TableName & "'"

    ' STEP 1 - Read the current key
    Dim lc_Cursor As Long, ll_CurrentKey As Long, ll_NewKey As Long
    
      
    lc_Cursor = mDb.OpenSQL(ls_Request)
    If mDb.RowCount(lc_Cursor) = 0 Then
        'Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mDb.LastErrorCode & " : " & mDb.LastErrorMessage & ", " & vbCrLf & "Error in GetNextKey, #1", C_ERR_DB_FAULT_MSG
    End If

    ' STEP 2 - Calculate the new
    ll_CurrentKey = mDb.GetFields(lc_Cursor, 0)
    mDb.Close (lc_Cursor)
    ll_NewKey = ll_CurrentKey + 1
    
    
    ' STEP 3 - Try to register the new key
    ls_Request = "UPDATE SYS_TablesKeys" & vbCrLf & _
                 "SET Table_Key = " & ll_NewKey & vbCrLf & _
                 "WHERE Table_Name = '" & as_TableName & "' " & _
                 "AND Table_Key = " & ll_CurrentKey & vbCrLf

    If Not mDb.ExecuteSQL(ls_Request) Then
      'Err.Raise C_ERR_OFFSET + C_ERR_DB_FAULT, mDb.LastErrorCode & " : " & mDb.LastErrorMessage & ", " & vbCrLf & "Error in GetNextKey, #2", C_ERR_DB_FAULT_MSG
    End If

    If mDb.SQLRowsAffected = 1 Then
        ' That's all folks !
        al_Key = ll_NewKey
        GetNextKey = True
    Else
        ' No luck, try again !
        If al_TryCount = 0 Then ' Too much tries, server should busy...
            GetNextKey = False
        Else
            GetNextKey = GetNextKey(as_TableName, al_Key, al_TryCount - 1)
        End If
    End If

    Exit Function

onError:
    mDb.Close (lc_Cursor)
    GetNextKey = False
'    If Err.Number > C_ERR_OFFSET Then
       ' Call SendMessage(Err.Number - C_ERR_OFFSET, Err.Description, Err.Source, vbCritical)
    'Else
        'Call SendMessage(C_ERR_UNKNOWN, C_ERR_UNKNOWN_MSG, Err.Number & " : " & Err.Description, vbCritical)
    'End If

End Function


Private Sub RefreshList()

  Call grList.Refresh
End Sub


Private Function Item_ContactLine_Check() As Boolean
    
    If Trim(txt_SPC_Name.Text) = "" Then
        Call SendFieldErrMsg(966, lbl_SPC_Name.Caption, txt_SPC_Name)
        Exit Function
    End If
    
    If Trim(txt_SPC_First_Name.Text) = "" Then
        Call SendFieldErrMsg(966, lbl_SPC_First_Name.Caption, txt_SPC_First_Name)
        Exit Function
    End If
    
    Item_ContactLine_Check = True
End Function


Private Sub Item_LCAddCurrentContactLine()
    
    ' Check if price and qty are numeric
    If Not Item_ContactLine_Check Then Exit Sub
    
    If Not grContactLines.AddLine(Array(0, 0, txt_SPC_Name.Text, txt_SPC_First_Name.Text, txt_SPC_Phone.Text, txt_SPC_Fax.Text)) Then
        'debug.print "unable to add a new line"
    End If
    Call ClearForm(UserControl.Controls, fraItemContact)
    txt_SPC_Name.SetFocus
End Sub

Private Sub Item_LCUpdateCurrentContactLine()
    
    ' Check if price and qty are numeric
    If Not Item_ContactLine_Check Then Exit Sub
    
    If grContactLines.SelectedCount <> 1 Then Exit Sub
    
    grContactLines.SelectedLine(0, "SPC_Name") = txt_SPC_Name.Text
    grContactLines.SelectedLine(0, "SPC_First_Name") = txt_SPC_First_Name.Text
    grContactLines.SelectedLine(0, "SPC_Phone") = txt_SPC_Phone.Text
    grContactLines.SelectedLine(0, "SPC_Fax") = txt_SPC_Fax.Text
    
    Call ClearForm(UserControl.Controls, fraItemContact)
    txt_SPC_Name.SetFocus
End Sub

Private Sub Item_LCClearContactLines()
    
    If MsgBox(MsgText(1009, mLanguage_Code, "#Attention, voulez vous vraiment tout supprimer ?"), vbYesNo) = vbYes Then
        grContactLines.ClearGrid
    End If
End Sub

Private Sub Item_LCDeleteSelContactLines()
    Dim lIdx As Long, lCount As Long
    lCount = grContactLines.SelectedCount - 1
    If lCount < 0 Then Exit Sub
    
    If MsgBox(MsgText(1010, mLanguage_Code, "#Attention, voulez vous vraiment supprimer toutes les données sélectionnées ?"), vbYesNo) = vbYes Then
        Dim lKeys As Variant
        lKeys = grContactLines.MultiSelectedKey
        For lIdx = 0 To lCount
            grContactLines.DeleteLine (lKeys(lIdx))
        Next
        grContactLines.DeselectRow
    End If
End Sub

Private Sub txt_SPC_Name_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Call Item_LCAddCurrentContactLine
    End If
End Sub

Private Sub txt_SPC_First_Name_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Call Item_LCAddCurrentContactLine
    End If
End Sub

Private Sub txt_SPC_Phone_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Call Item_LCAddCurrentContactLine
    End If
End Sub

Private Sub txt_SPC_Fax_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Call Item_LCAddCurrentContactLine
    End If
End Sub


Private Sub grContactLines_ItemSelected()
    txt_SPC_Name.Text = grContactLines.SelectedLine(0, "SPC_Name")
    txt_SPC_First_Name.Text = grContactLines.SelectedLine(0, "SPC_First_Name")
    txt_SPC_Phone.Text = grContactLines.SelectedLine(0, "SPC_Phone")
    txt_SPC_Fax.Text = grContactLines.SelectedLine(0, "SPC_Fax")
End Sub


Public Function Item_Check() As Boolean

    If Trim(txt_SP_Name.Text) = "" Then
        Call SendFieldErrMsg(966, lbl_SP_Name.Caption, txt_SP_Name)
        Exit Function
    End If
    
    If Trim(txt_SP_Addr1.Text) = "" Then
        Call SendFieldErrMsg(966, lbl_SP_Addr1.Caption, txt_SP_Addr1)
        Exit Function
    End If

    If Trim(txt_SP_Town.Text) = "" Then
        Call SendFieldErrMsg(966, lbl_SP_Town.Caption, txt_SP_Town)
        Exit Function
    End If

    If Trim(txt_SP_ZIP.Text) = "" Then
        Call SendFieldErrMsg(966, lbl_SP_Zip.Caption, txt_SP_ZIP)
        Exit Function
    End If

    If Trim(txt_SP_Country.Text) = "" Then
        Call SendFieldErrMsg(966, lbl_SP_Country.Caption, txt_SP_Country)
        Exit Function
    End If

    Item_Check = True
End Function


Private Sub Item_AddLocal()
    
    Call grList.Refresh
    If Not grList.SearchKey(True, Array(mCurrentSupplier.SP_Code)) Then
        ' ERROR
        'debug.print "unable to find the item"
    End If

End Sub

Private Sub List_ItemsDelete()
   
    Dim lIdx As Long, lCount As Long
    Dim lSP_Code As Long, lKeys As Variant, lAllKeys As Variant
    
    lCount = grList.SelectedCount - 1
    
    If lCount < 0 Then Exit Sub
    
    If MsgBox(MsgText(1010, mLanguage_Code, "#Attention, voulez vous vraiment supprimer toutes les données sélectionnées ?"), vbYesNo) <> vbYes Then Exit Sub
    
    lAllKeys = grList.MultiSelectedKey
    For lIdx = 0 To lCount
        lKeys = lAllKeys(lIdx)
        lSP_Code = lKeys(0)
        If Item_DbDelete(lSP_Code) Then
            Call Item_LocalDelete(lSP_Code)
        Else
            Call MsgBox(MsgText(1011, mLanguage_Code, "#Une erreur s''est produite, l''item suivant ne peut être effacé : ") & grList.SelectedLine(lIdx, "PO_Code"))
        End If
    Next

End Sub

Private Function Item_Delete()

    If MsgBox(MsgText(1015, mLanguage_Code, "Voulez-vous supprimer ce fornisseur ?"), vbYesNo) <> vbYes Then Exit Function
    If Not Item_DbDelete(mCurrentSupplier.SP_Code) Then Exit Function
    Item_LocalDelete (mCurrentSupplier.SP_Code)
    Call Item_ExitToGrid
End Function

Private Function Item_DbDelete(ByVal aSP_Code As Long) As Boolean

    Const DB_REQUEST As String = "exec IV_Suppliers_Del $sp_code$, $now$, $u_code$"
    Dim lRequest As String
    
    lRequest = ReplaceHolders(DB_REQUEST)
    lRequest = Replace(lRequest, "$sp_code$", aSP_Code, , , vbTextCompare)

    If Not mDb.ExecuteSQL(lRequest) Then
        'debug.print "Error during delete"
        Exit Function
    End If

    If mDb.SQLRowsAffected = 0 Then
        'debug.print "item has changed"
        Exit Function
    End If
    
    Item_DbDelete = True

End Function

Private Function Item_LocalDelete(ByVal aSP_Code As Long) As Boolean
    Item_LocalDelete = grList.DeleteLine(aSP_Code)
End Function

Private Sub Item_ViewInit()
    
    fraItem.Visible = False
    SetMode (emView)
    
    Call EnableFrame(UserControl.Controls, fraItem, False)
    Call EnableFrame(UserControl.Controls, fraItemContact, False)

    tcItem.DisplayFace (TB_ITEM_VIEW)

    tcLines.Visible = False
    fraItemContact.Visible = False
    fraItem.ZOrder
    fraItem.Visible = True
    fraList.Visible = False
End Sub

Private Sub Item_DeleteInit()
    
    SetMode (emDelete)
    
    Call EnableFrame(UserControl.Controls, fraItem, False)
    Call EnableFrame(UserControl.Controls, fraItemContact, False)
    
    tcItem.DisplayFace (TB_ITEM_DELETE)
    tcLines.Visible = False
    fraItemContact.Visible = False
    fraItem.ZOrder
    fraItem.Visible = True
    fraList.Visible = False
End Sub

Private Sub Item_ExitToView()
    
  If mb_ItemScreenOnly Then
    Call Item_Quit
  Else
    Call Item_ViewInit
  End If
End Sub

Private Sub List_ItemUpdate()
   
    If grList.SelectedCount <> 1 Then Exit Sub
    
    mCurrentSupplier = DBToLocal(grList.SelectedKey(0)(0))
    Call LocalToForm(mCurrentSupplier)
    Call Item_UpdateInit

End Sub

Private Sub Item_UpdateInit()
    
    SetMode (emUpdate)
    
    Call EnableFrame(UserControl.Controls, fraItem, True)
   
    tcItem.DisplayFace (TB_ITEM_UPDATE)
    
    tcLines.DisplayFace (TB_LC_LINE_ADD)
    tcLines.Visible = True
    fraItemContact.Visible = True
    
    fraItem.ZOrder
    fraItem.Visible = True
    fraList.Visible = False
End Sub

Private Sub Item_UpdateReinit()
    Call LocalToForm(mCurrentSupplier)
End Sub


Private Sub Item_Update()
    
On Error GoTo Err_Item_Update

    If Not Item_Check Then Exit Sub
    
    Dim lSupplier As TSupplier
    
    lSupplier.SP_Code = mCurrentSupplier.SP_Code
    
    If Not FormToLocal(lSupplier) Then
        mSource = mSource & "FormToLocal"
        mDesc = "Error in Update"
        Err.Raise mNumber, mSource, mDesc
    End If
    
    ' MAJ db
    If Not Item_DBUpdate(lSupplier, mCurrentSupplier.Contacts) Then
        Err.Raise mNumber, mSource, mDesc
    End If
    
    ' MAJ local
    Item_LocalUpdate
    
    If mOldMode = emList Then
        Call Item_ExitToGrid
    Else
        mCurrentSupplier = lSupplier
        'Call LocalToForm(mCurrentOrder)
        Call Item_ExitToView
    End If
    
    Exit Sub
    
Err_Item_Update:
    mNumber = C_ERRORRAISE + 1002
    Err.Raise mNumber, mSource, mDesc
End Sub

Private Function Item_DBUpdate(ByRef aSupplier As TSupplier, ByRef aOldItems() As TSupplierContact) As Boolean

On Error GoTo Err_Item_DBUpdate

    Const DB_SUP_REQUEST As String = "exec IV_Suppliers_upd $sp_code$, $sp_name$, $sp_addr1$, $sp_addr2$, $sp_addr3$, $sp_zip$, $sp_town$, $sp_fax$, $sp_phone$, $sp_country$, $cp_code$, $sp_rib$, $pt_code$, $now$, $u_code$"
    Const DB_CON_ADD_REQUEST As String = "exec IV_Suppliers_Contacts_ins $spc_code$, $sp_code$, $spc_name$, $spc_first_name$, $spc_phone$, $spc_fax$, $now$, $u_code$"
    Const DB_CON_UPD_REQUEST As String = "exec IV_Suppliers_Contacts_upd $spc_code$, $sp_code$, $spc_name$, $spc_first_name$, $spc_phone$, $spc_fax$, $now$, $u_code$"
    Const DB_CON_DEL_REQUEST As String = "exec IV_Suppliers_Contacts_del $spc_code$, $sp_code$, $now$, $u_code$"
    
    Dim lRequest As String, lPOLDelRequest As Variant, lPOLAddRequest As Variant, lTranOpenned As Boolean
    
    mNumber = C_ERRORRAISE + 1000
    mSource = SCREEN_NAME & "Item_DBUpdate: "
    
    lRequest = ReplaceHoldersFromSupplier(DB_SUP_REQUEST, aSupplier)
    
    Dim lIdx As Long, lCount As Long, lFound As Boolean
    Dim lNewIdx As Long, lNewCount As Long
    
    lNewCount = UBound(aSupplier.Contacts)
    lCount = UBound(aOldItems)
    If lCount > -1 Then
        ReDim lPOLDelRequest(lCount)
    Else
        ReDim lPOLDelRequest(-1 To -1)
    End If
    
    If lNewCount > -1 Then
        ReDim lPOLAddRequest(lNewCount)
        ReDim lPOLUpdRequest(lNewCount)
    Else
        ReDim lPOLAddRequest(-1 To -1)
        ReDim lPOLUpdRequest(-1 To -1)
    End If
    
    ' Delete unused lines
    For lIdx = 0 To lCount
        lFound = False
        For lNewIdx = 0 To lNewCount
            If aSupplier.Contacts(lNewIdx).SPC_Code = aOldItems(lIdx).SPC_Code Then
                lFound = True
                Exit For
            End If
        Next
        If Not lFound Then
            ' TO DELETE !
            lPOLDelRequest(lIdx) = ReplaceHoldersFromSupplierContact(DB_CON_DEL_REQUEST, aOldItems(lIdx))
        Else
            lPOLDelRequest(lIdx) = ""
        End If
    Next
    
    ' Add new lines
    For lNewIdx = 0 To lNewCount
        If aSupplier.Contacts(lNewIdx).SPC_Code = 0 Then
            If Not GetNextKey("IV_Suppliers_Contacts", aSupplier.Contacts(lNewIdx).SPC_Code) Then
              mSource = mSource & "GetNextKey"
              mDesc = "Unable to get a new key"
              Err.Raise mNumber, mSource, mDesc
            End If
            lPOLAddRequest(lNewIdx) = ReplaceHoldersFromSupplierContact(DB_CON_ADD_REQUEST, aSupplier.Contacts(lNewIdx))
        Else
            lPOLAddRequest(lNewIdx) = ""
        End If
    Next
    
    'update edited lines
    For lNewIdx = 0 To lNewCount
        lPOLUpdRequest(lNewIdx) = ""
        For lIdx = 0 To lCount
            If aSupplier.Contacts(lNewIdx).SPC_Code = aOldItems(lIdx).SPC_Code Then
              If (StrComp(aSupplier.Contacts(lNewIdx).Name, aOldItems(lIdx).Name, vbBinaryCompare) <> 0) Or _
                 (StrComp(aSupplier.Contacts(lNewIdx).First_Name, aOldItems(lIdx).First_Name, vbBinaryCompare) <> 0) Or _
                 (StrComp(aSupplier.Contacts(lNewIdx).Phone, aOldItems(lIdx).Phone, vbBinaryCompare) <> 0) Or _
                 (StrComp(aSupplier.Contacts(lNewIdx).Fax, aOldItems(lIdx).Fax, vbBinaryCompare) <> 0) Then
                lPOLUpdRequest(lNewIdx) = ReplaceHoldersFromSupplierContact(DB_CON_UPD_REQUEST, aSupplier.Contacts(lNewIdx))
              End If
              Exit For
            End If
        Next
    Next
    
    'BEGIN TRAN
    If Not mDb.ExecuteSQL("BEGIN TRAN") Then
        mSource = mSource & "BEGIN TRAN"
        mDesc = "BEGIN TRAN failed"""

        Err.Raise mNumber, mSource, mDesc
    End If
    lTranOpenned = True
    
    ' Execute the request
    If Not mDb.ExecuteSQL(lRequest) Then
        mSource = mSource & lRequest
        mDesc = "error in updating po"
        
        Err.Raise mNumber, mSource, mDesc
    End If
    
    If mDb.SQLRowsAffected = 0 Then
        mSource = mSource & lRequest
        mDesc = "No row updated in po"
        
        Err.Raise mNumber, mSource, mDesc
    End If
    
    For lIdx = 0 To lCount
        If lPOLDelRequest(lIdx) <> "" Then
            If Not mDb.ExecuteSQL(lPOLDelRequest(lIdx)) Then
                mSource = mSource & lPOLDelRequest(lIdx)
                mDesc = "ERROR while deleting line"
        
                Err.Raise mNumber, mSource, mDesc
            End If
            If mDb.SQLRowsAffected = 0 Then
                mSource = mSource & lPOLDelRequest(lIdx)
                mDesc = "No item to update"
        
                Err.Raise mNumber, mSource, mDesc
            End If
        End If
    Next
    
    For lNewIdx = 0 To lNewCount
        If lPOLAddRequest(lNewIdx) <> "" Then
            If Not mDb.ExecuteSQL(lPOLAddRequest(lNewIdx)) Then
                mSource = mSource & lPOLAddRequest(lNewIdx)
                mDesc = "Error in add line : "
        
                Err.Raise mNumber, mSource, mDesc
            End If
        End If
        
        If lPOLUpdRequest(lNewIdx) <> "" Then
            If Not mDb.ExecuteSQL(lPOLUpdRequest(lNewIdx)) Then
                mSource = mSource & lPOLUpdRequest(lNewIdx)
                mDesc = "Error in upd line : "
        
                Err.Raise mNumber, mSource, mDesc
            End If
        End If
    Next
    
    If Not mDb.ExecuteSQL("COMMIT TRAN") Then
        mSource = mSource & "COMMIT TRAN"
        mDesc = "COMMIT TRAN failed"
        
        Err.Raise mNumber, mSource, mDesc
    Else
    lTranOpenned = False
    End If
    
    
    Item_DBUpdate = True
    Exit Function

Err_Item_DBUpdate:
    If lTranOpenned Then
        If Not mDb.ExecuteSQL("ROLLBACK TRAN") Then
            UploadSQLError mDb, mDbErr, SCREEN_NAME & "/Item_DBUpdate: ROLLBACK TRAN"
            mDb.disconnect
            mDbErr.disconnect
            End
        Else
            UploadSQLError mDb, mDbErr, mSource
        End If
    Else
        UploadSQLError mDb, mDbErr, mSource
    End If
    
    Err.Raise mNumber, mSource, mDesc
    
End Function


Private Sub SetMode(ByVal aMode As eMode)
    mOldMode = mMode
    mMode = aMode
End Sub

Private Function Item_UpdateExit()
    If mOldMode = emList Then
        Call Item_ExitToGrid
    Else
        Call Item_ExitToView
    End If
    
End Function

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

    Dim lIdx As Long, lCount As Long, lLabels As Long
    Dim lControl As Control
    
    lLabels = mDb.OpenSQL("exec Screen_Csts '" & as_ScreenName & "','" & as_Language & "'")
    lCount = aControls.Count - 1
    
    For lIdx = 0 To lCount
        Set lControl = aControls.Item(lIdx)
            Select Case UCase(TypeName(lControl))
                Case "LABEL", "FRAME", "COMMANDBUTTON", "OPTIONBUTTON"
                    If lControl.Tag <> "" Then
                        If mDb.Find(lLabels, "FIELD_NAME", lControl.Tag, , 1) >= 0 Then
                            lControl.Caption = mDb.GetFields(lLabels, "LOCAL_TEXT")
                        End If
                    End If
                Case "FRAME", "MSFLEXGRID", "TOOLBARCONTROL", "TEXTBOX", "ARMGRID", "COMMANDBUTTON", "ARMCHECKVIEW", "ARMCOMBOBOX", "A_CALOCX", "OPTIONBUTTON", "ARMTREEVIEW", "LISTBOX", "PICTUREBOX"
                    ' Do nothing !
                Case Else
                    'debug.print "LoadLabels " & UCase(TypeName(lControl))
            End Select
        Set lControl = Nothing
    Next
    
    mDb.Close (lLabels)
            
End Sub

Sub SendMessage(aID As Long, aDefault As String, aLang As String)
Dim lMessage As String

lMessage = MsgText(aID, aLang, aDefault)
    
MsgBox lMessage

End Sub

Function MsgText(aID As Long, aLang As String, ByVal aDefault As String) As String

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

    MsgText = ""
    
    Dim lRequest As String
    lRequest = Replace(DB_REQ, "$id$", aID)
    lRequest = Replace(lRequest, "$lang$", aLang)
    
    Dim lData As Long
    lData = mDb.OpenSQL(lRequest)
    
    Dim lBuffer As String
    lBuffer = mDb.GetFields(lData, "message_text")
    mDb.Close (lData)
    If lBuffer = "" Then lBuffer = aDefault
    
    MsgText = lBuffer
    
End Function



Public Sub UploadSQLError(ByRef ao_Armdb As Object, ByRef ao_ArmdbErr As Object, ByVal as_Procedure As String)
Dim ls_Req As String, lStr As String, lNumber As Long, lDesc As String

Const C_ERR_FATAL_MSG As String = "A fatal error occured, the application will be terminated. Please report error to IT support team" & vbCrLf & "Error : "
Const C_ERR_REPORT As String = "Please, report this to IT application support"


lNumber = Err.Number
lDesc = Err.Description

On Error GoTo onError

If ao_Armdb.LastErrorCode = 0 Then
    If lNumber <> 0 Then
        'error runtime
        as_Procedure = "VB runtime : " & as_Procedure
        ls_Req = "EXEC Error_Log_Insert '" & App.EXEName & "', '" & App.Major & "." & App.Minor & "." & App.Revision & "', '" _
            & Replace(as_Procedure, "'", "''", , , vbTextCompare) & "', '" & lNumber & "','" & lDesc & "'"
        If Not ao_ArmdbErr.ExecuteSQL(ls_Req) Then
            'debug.print "Impossible to insert in Error log  "
        End If
    Else
        'debug.print "Call to UploadSQLError not relevant : " & as_Procedure
        Exit Sub
    End If
Else
    'In case of armsyscom failure
    If IsEmpty(ao_Armdb.SQLErrorCodes) Then Err.Raise C_ERRORRAISE, "UploadSQLError", "Fatal error in armsyscom : SQlErrorCodes is empty although LastErrorCode = " & ao_Armdb.LastErrorCode
    If IsEmpty(ao_Armdb.SQLErrorMessages) Then Err.Raise C_ERRORRAISE, "UploadSQLError", "Fatal error in armsyscom : SQLErrorMessages is empty although LastErrorCode = " & ao_Armdb.LastErrorCode
    
    
    Dim lErrMsg As Variant, lErrCode As Variant
    Dim lIdx As Long, lCount As Long, lCount2 As Long
        
    lStr = "An error occured : " & as_Procedure & vbCrLf
        
    '  On contourne le bug à l'aide de variables locales, le bug empêche d'accéder au élément du variant mais pas au variant lui même
    lErrCode = ao_Armdb.SQLErrorCodes
    lErrMsg = ao_Armdb.SQLErrorMessages
        
    lCount = UBound(lErrCode)
    lCount2 = UBound(lErrMsg)
         
    'If not it may cause a runtime error (index out of bound)
    If lCount = lCount2 Then
        For lIdx = 0 To lCount
            lStr = lStr & "Err : " & lErrCode(lIdx) & ", " & lErrMsg(lIdx)
        Next
    Else
            lStr = lStr & "Errs : " & Join(lErrCode, ", ") & vbCrLf & "Msg : " & Join(lErrMsg, vbCrLf) & vbCrLf & C_ERR_REPORT
    End If
        
    ls_Req = "EXEC Error_Log_Insert '" & App.EXEName & "', '" & App.Major & "." & App.Minor & "." & App.Revision & "', '" _
        & Replace(as_Procedure, "'", "''", , , vbTextCompare) & "', 'UploadSQLError','" & Replace(lStr, "'", "''", , , vbTextCompare) & "'"
    If Not ao_ArmdbErr.ExecuteSQL(ls_Req) Then
        'debug.print "Impossible to insert in Error log  "
    End If
End If
    
Exit Sub

onError:
    ao_Armdb.disconnect
    MsgBox C_ERR_FATAL_MSG & lNumber & ", " & lDesc, vbCritical
        
    End
End Sub


Private Sub SendFieldErrMsg(ByVal aMsgID As Long, ByVal aCaption As String, ByRef AField As Object)

    Dim lBuffer As String
    Dim lMsgID As Long
    lMsgID = aMsgID ' @!#'@@ of byref argument !
    lBuffer = MsgText(lMsgID, mLanguage_Code, "This data is not entered correctly")
    lBuffer = Replace(lBuffer, "$field$", aCaption)
    
    AField.SetFocus
    Call MsgBox(lBuffer, vbOKOnly + vbCritical)

End Sub


Private Function Item_LocalUpdate() As Boolean
    
    grList.Refresh
    If Not grList.SearchKey(True, Array(mCurrentSupplier.SP_Code)) Then
        ' ERROR
        'debug.print "unable to find the item"
    End If
    Item_LocalUpdate = True
End Function

Private Function SQLDbl(ad_Value As Double) As String
  SQLDbl = Str(ad_Value)
End Function

Private Function SQLDateTime(ad_Date As Date) As String
  If ad_Date = 0 Then
    SQLDateTime = "Null"
  Else
    SQLDateTime = "{ ts '" & Format(ad_Date, "yyyy-mm-dd hh:mm:ss") & "'}"
  End If
End Function

Private Function SQLStr(ByVal as_Value As String) As String

  SQLStr = "'" & Replace(as_Value, "'", "''") & "'"
End Function




