VERSION 5.00
Begin VB.UserControl armIVPO 
   ClientHeight    =   12540
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   15165
   LockControls    =   -1  'True
   ScaleHeight     =   12540
   ScaleWidth      =   15165
   Begin VB.Frame fraItem 
      Height          =   10695
      Left            =   3600
      TabIndex        =   0
      Tag             =   "fraItem"
      Top             =   840
      Visible         =   0   'False
      Width           =   10815
      Begin VB.Frame fraItemInfo 
         Height          =   1215
         Left            =   135
         TabIndex        =   73
         Tag             =   "fraItemInfo"
         Top             =   6120
         Width           =   10575
         Begin VB.TextBox txt_Comment 
            Height          =   945
            Left            =   1800
            MaxLength       =   500
            MultiLine       =   -1  'True
            TabIndex        =   29
            Tag             =   "txt_Comment"
            Top             =   170
            Width           =   8655
         End
         Begin VB.Label lbl_Comment 
            Caption         =   "#Commentaire"
            Height          =   255
            Left            =   120
            TabIndex        =   74
            Tag             =   "lbl_Comment"
            Top             =   170
            Width           =   1575
         End
      End
      Begin VB.TextBox txt_Spare5 
         Height          =   375
         Left            =   9600
         TabIndex        =   66
         Tag             =   "txt_Spare5"
         Text            =   "Spare5"
         Top             =   240
         Visible         =   0   'False
         Width           =   735
      End
      Begin VB.TextBox txt_Spare4 
         Height          =   375
         Left            =   8880
         TabIndex        =   65
         Tag             =   "txt_Spare4"
         Text            =   "Spare4"
         Top             =   240
         Visible         =   0   'False
         Width           =   735
      End
      Begin VB.TextBox txt_Spare3 
         Height          =   375
         Left            =   8040
         TabIndex        =   64
         Tag             =   "txt_Spare3"
         Text            =   "Spare3"
         Top             =   240
         Visible         =   0   'False
         Width           =   735
      End
      Begin VB.TextBox txt_Spare1 
         Height          =   285
         Left            =   6360
         TabIndex        =   63
         Tag             =   "txt_Spare1"
         Text            =   "Spare1"
         Top             =   240
         Visible         =   0   'False
         Width           =   735
      End
      Begin VB.TextBox txt_Spare2 
         Height          =   285
         Left            =   7200
         TabIndex        =   62
         Tag             =   "txt_Spare2"
         Text            =   "Spare2"
         Top             =   240
         Visible         =   0   'False
         Width           =   735
      End
      Begin Project1.ToolbarControl tcItem 
         Height          =   690
         Left            =   120
         TabIndex        =   59
         Top             =   120
         Width           =   6090
         _ExtentX        =   10742
         _ExtentY        =   1217
      End
      Begin VB.Frame fraItemOrder 
         Height          =   2775
         Left            =   120
         TabIndex        =   47
         Tag             =   "fraItemOrder"
         Top             =   7320
         Width           =   10575
         Begin Project1.ToolbarControl tcLines 
            Height          =   2415
            Left            =   9720
            TabIndex        =   61
            Top             =   240
            Width           =   690
            _ExtentX        =   1217
            _ExtentY        =   4260
         End
         Begin Project1.ArmGrid grOrderLines 
            Height          =   1575
            Left            =   120
            TabIndex        =   37
            Top             =   240
            Width           =   9495
            _ExtentX        =   16748
            _ExtentY        =   2778
         End
         Begin VB.Frame fraItemOrderLine 
            Height          =   855
            Left            =   120
            TabIndex        =   48
            Tag             =   "fraItemOrderLine"
            Top             =   1800
            Width           =   9495
            Begin VB.TextBox txt_TotalPrice 
               Height          =   375
               Left            =   6240
               Locked          =   -1  'True
               TabIndex        =   34
               Tag             =   "txt_TotalPrice"
               Top             =   360
               Width           =   975
            End
            Begin VB.TextBox txt_Quantity 
               Height          =   375
               Left            =   5160
               TabIndex        =   33
               Tag             =   "txt_Quantity"
               Top             =   360
               Width           =   975
            End
            Begin VB.TextBox txt_UnitPrice 
               Height          =   375
               Left            =   3840
               TabIndex        =   32
               Tag             =   "txt_UnitPrice"
               Top             =   360
               Width           =   1215
            End
            Begin VB.TextBox txt_Reference 
               Height          =   375
               Left            =   2040
               MaxLength       =   50
               TabIndex        =   31
               Tag             =   "txt_Reference"
               Top             =   360
               Width           =   1695
            End
            Begin VB.TextBox txt_Order 
               Height          =   375
               Left            =   120
               MaxLength       =   50
               TabIndex        =   30
               Tag             =   "txt_Order"
               Top             =   360
               Width           =   1815
            End
            Begin VB.Label lbl_TotalPrice 
               Caption         =   "#Prix total"
               Height          =   255
               Left            =   6240
               TabIndex        =   53
               Tag             =   "lbl_TotalPrice"
               Top             =   120
               Width           =   975
            End
            Begin VB.Label lbl_Quantity 
               Caption         =   "#Quantité"
               Height          =   255
               Left            =   5160
               TabIndex        =   52
               Tag             =   "lbl_Quantity"
               Top             =   120
               Width           =   855
            End
            Begin VB.Label lbl_UnitPrice 
               Caption         =   "#Prix unitaire"
               Height          =   255
               Left            =   3840
               TabIndex        =   51
               Tag             =   "lbl_UnitPrice"
               Top             =   120
               Width           =   1335
            End
            Begin VB.Label lbl_Reference 
               Caption         =   "#Référence"
               Height          =   255
               Left            =   2040
               TabIndex        =   50
               Tag             =   "bl_Reference"
               Top             =   120
               Width           =   975
            End
            Begin VB.Label lbl_Order 
               Caption         =   "#Commande"
               Height          =   255
               Left            =   120
               TabIndex        =   49
               Tag             =   "lbl_Order"
               Top             =   120
               Width           =   975
            End
         End
         Begin VB.PictureBox pctUpDown 
            Appearance      =   0  'Flat
            AutoSize        =   -1  'True
            BackColor       =   &H80000005&
            BorderStyle     =   0  'None
            FillColor       =   &H8000000F&
            ForeColor       =   &H80000008&
            Height          =   240
            Left            =   0
            MousePointer    =   7  'Size N S
            ScaleHeight     =   16
            ScaleMode       =   3  'Pixel
            ScaleWidth      =   16
            TabIndex        =   81
            Top             =   110
            Width           =   240
         End
      End
      Begin Project1.A_calocx cal_DeliveryDate 
         Height          =   375
         Left            =   8100
         TabIndex        =   15
         Tag             =   "cal_DeliveryDate"
         Top             =   1635
         Width           =   1815
         _ExtentX        =   3201
         _ExtentY        =   661
      End
      Begin Project1.A_calocx cal_OrderDate 
         Height          =   375
         Left            =   5520
         TabIndex        =   10
         Tag             =   "cal_OrderDate"
         Top             =   1010
         Width           =   1815
         _ExtentX        =   3201
         _ExtentY        =   661
      End
      Begin VB.Frame fraSupplier 
         Height          =   2130
         Left            =   120
         TabIndex        =   39
         Tag             =   "fraSupplier"
         Top             =   3960
         Width           =   10575
         Begin VB.CommandButton cmd_NewSupplier 
            Caption         =   "..."
            Height          =   320
            Left            =   4680
            TabIndex        =   82
            Top             =   240
            Width           =   255
         End
         Begin Project1.ArmCombobox cbo_PaiementType 
            Height          =   345
            Left            =   7440
            TabIndex        =   79
            Tag             =   "cbo_PaiementType"
            Top             =   1200
            Width           =   3015
            _ExtentX        =   5318
            _ExtentY        =   609
         End
         Begin Project1.ArmCombobox cbo_Currency 
            Height          =   345
            Left            =   7440
            TabIndex        =   25
            Tag             =   "cbo_Currency"
            Top             =   720
            Width           =   3015
            _ExtentX        =   5318
            _ExtentY        =   609
         End
         Begin Project1.ArmCombobox cbo_Paiement 
            Height          =   345
            Left            =   7440
            TabIndex        =   24
            Tag             =   "cbo_Paiement"
            Top             =   240
            Width           =   3015
            _ExtentX        =   5318
            _ExtentY        =   609
         End
         Begin Project1.ArmCombobox cbo_SupplierContact 
            Height          =   345
            Left            =   1920
            TabIndex        =   26
            Top             =   1680
            Width           =   3015
            _ExtentX        =   5318
            _ExtentY        =   609
         End
         Begin Project1.ArmCombobox cbo_Supplier 
            Height          =   345
            Left            =   1680
            TabIndex        =   22
            Tag             =   "cbo_Supplier"
            Top             =   240
            Width           =   3015
            _ExtentX        =   5318
            _ExtentY        =   609
         End
         Begin VB.TextBox txt_InfoSupplier 
            BackColor       =   &H80000018&
            Height          =   975
            Left            =   120
            MultiLine       =   -1  'True
            ScrollBars      =   2  'Vertical
            TabIndex        =   60
            Tag             =   "txt_InfoSupplier"
            Top             =   600
            Width           =   4815
         End
         Begin VB.Label lbl_PaiementType 
            Caption         =   "#Moyen de paiement"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   240
            Left            =   5040
            TabIndex        =   78
            Tag             =   "lbl_PaiementType"
            Top             =   1320
            Width           =   2280
         End
         Begin VB.Label lbl_Currency 
            Caption         =   "#Monnaie"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   5040
            TabIndex        =   72
            Tag             =   "lbl_Currency"
            Top             =   840
            Width           =   1935
         End
         Begin VB.Label lbl_TermsOfPayment 
            Caption         =   "#Conditions de règlement"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   5040
            TabIndex        =   42
            Tag             =   "lbl_TermsOfPayment"
            Top             =   360
            Width           =   2295
         End
         Begin VB.Label lbl_SupplierContact 
            Caption         =   "#Contact fournisseur"
            Height          =   255
            Left            =   150
            TabIndex        =   41
            Tag             =   "lbl_SupplierContact"
            Top             =   1785
            Width           =   1755
         End
         Begin VB.Label lbl_Supplier 
            Caption         =   "#Fournisseur"
            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        =   40
            Tag             =   "lbl_Supplier"
            Top             =   360
            Width           =   1575
         End
      End
      Begin VB.Frame fraItemUserInfo 
         Height          =   2520
         Left            =   120
         TabIndex        =   21
         Tag             =   "fraItemUserInfo"
         Top             =   1450
         Width           =   5535
         Begin Project1.ArmCombobox cbo_PO_RaisedFor 
            Height          =   345
            Left            =   2520
            TabIndex        =   83
            Top             =   1560
            Width           =   2895
            _ExtentX        =   5106
            _ExtentY        =   609
         End
         Begin VB.TextBox txt_Fax 
            Height          =   375
            Left            =   2520
            TabIndex        =   14
            Tag             =   "txt_Fax"
            Top             =   1080
            Width           =   2895
         End
         Begin VB.TextBox txt_Phone 
            Height          =   375
            Left            =   2520
            TabIndex        =   13
            Tag             =   "txt_Phone"
            Top             =   600
            Width           =   2895
         End
         Begin VB.TextBox txt_OrderBy 
            Height          =   375
            Left            =   2520
            TabIndex        =   12
            Tag             =   "txt_OrderBy"
            Top             =   170
            Width           =   2895
         End
         Begin Project1.ArmCombobox cbo_CostCenter 
            Height          =   345
            Left            =   2520
            TabIndex        =   77
            Tag             =   "cbo_CostCenter"
            Top             =   2040
            Width           =   2895
            _ExtentX        =   5106
            _ExtentY        =   609
         End
         Begin VB.Label lbl_PO_RaisedFor 
            Caption         =   "#Commandé pour"
            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        =   84
            Tag             =   "lbl_PO_RaisedFor"
            Top             =   1680
            Width           =   2295
         End
         Begin VB.Label lbl_CostCenter 
            Caption         =   "#Imputation comptable"
            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        =   35
            Tag             =   "lbl_CostCenter"
            Top             =   2160
            Width           =   2295
         End
         Begin VB.Label lbl_Fax 
            Caption         =   "#Fax"
            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        =   28
            Tag             =   "lbl_Fax"
            Top             =   1320
            Width           =   2295
         End
         Begin VB.Label lbl_Phone 
            Caption         =   "#Telephone"
            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        =   27
            Tag             =   "lbl_Phone"
            Top             =   840
            Width           =   2295
         End
         Begin VB.Label lbl_OrderBy 
            Caption         =   "#Commandé par"
            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        =   23
            Tag             =   "lbl_OrderBy"
            Top             =   360
            Width           =   2295
         End
      End
      Begin VB.Frame fraItemNumber 
         Height          =   615
         Left            =   120
         TabIndex        =   36
         Tag             =   "fraItemNumber"
         Top             =   840
         Width           =   10575
         Begin Project1.ArmCombobox cbo_Status 
            Height          =   345
            Left            =   8280
            TabIndex        =   11
            Tag             =   "cbo_Status"
            Top             =   170
            Width           =   2175
            _ExtentX        =   3836
            _ExtentY        =   609
         End
         Begin VB.TextBox txt_OrderNumber 
            Height          =   375
            Left            =   1440
            TabIndex        =   9
            Tag             =   "txt_OrderNumber"
            Top             =   170
            Width           =   1815
         End
         Begin VB.Label lbl_Status 
            Caption         =   "#Status"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   7440
            TabIndex        =   75
            Tag             =   "lbl_Status"
            Top             =   290
            Width           =   855
         End
         Begin VB.Label lbl_OrderDate 
            Caption         =   "#Date de commande"
            BeginProperty Font 
               Name            =   "Arial"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   3360
            TabIndex        =   46
            Tag             =   "lbl_OrderDate"
            Top             =   290
            Width           =   1935
         End
         Begin VB.Label lbl_OrderNumber 
            Caption         =   "#Numéro"
            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        =   38
            Tag             =   "lbl_OrderNumber"
            Top             =   290
            Width           =   855
         End
      End
      Begin VB.Frame fraItemDelivery 
         Height          =   2535
         Left            =   5835
         TabIndex        =   43
         Tag             =   "fraItemDelivery"
         Top             =   1440
         Width           =   4860
         Begin VB.ListBox lst_DAPreselect 
            Height          =   1035
            Left            =   120
            TabIndex        =   16
            Tag             =   "lst_DAPreselect"
            Top             =   1305
            Width           =   2055
         End
         Begin VB.TextBox txt_DAAddr4 
            Height          =   375
            Left            =   2265
            MaxLength       =   50
            TabIndex        =   20
            Tag             =   "txt_DAAddr4"
            Top             =   1950
            Width           =   2415
         End
         Begin VB.TextBox txt_DAAddr3 
            Height          =   375
            Left            =   2265
            MaxLength       =   50
            TabIndex        =   19
            Tag             =   "txt_DAAddr3"
            Top             =   1500
            Width           =   2415
         End
         Begin VB.TextBox txt_DAAddr2 
            Height          =   375
            Left            =   2265
            MaxLength       =   50
            TabIndex        =   18
            Tag             =   "txt_DAAddr2"
            Top             =   1080
            Width           =   2415
         End
         Begin VB.TextBox txt_DAAddr1 
            Height          =   375
            Left            =   2265
            MaxLength       =   50
            TabIndex        =   17
            Tag             =   "txt_DAAddr1"
            Top             =   660
            Width           =   2415
         End
         Begin VB.Label lbl_DAPreselect 
            Caption         =   "#Preselection"
            Height          =   255
            Left            =   90
            TabIndex        =   76
            Tag             =   "lbl_DAPreselect"
            Top             =   1080
            Width           =   1335
         End
         Begin VB.Label lbl_DeliveryDate 
            Caption         =   "#Date de livraison"
            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        =   45
            Tag             =   "lbl_DeliveryDate"
            Top             =   285
            Width           =   1575
         End
         Begin VB.Label lbl_DeliveryAddress 
            Caption         =   "#Adresse de livraison"
            BeginProperty Font 
               Name            =   "MS Sans Serif"
               Size            =   8.25
               Charset         =   0
               Weight          =   700
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   255
            Left            =   75
            TabIndex        =   44
            Tag             =   "lbl_DeliveryAddress"
            Top             =   720
            Width           =   2175
         End
      End
      Begin VB.Label lbl_Spare5 
         Caption         =   "#Spare 5"
         Height          =   255
         Left            =   9360
         TabIndex        =   71
         Tag             =   "lbl_Spare5"
         Top             =   600
         Visible         =   0   'False
         Width           =   975
      End
      Begin VB.Label lbl_Spare4 
         Caption         =   "#Spare 4"
         Height          =   255
         Left            =   8880
         TabIndex        =   70
         Tag             =   "lbl_Spare4"
         Top             =   480
         Visible         =   0   'False
         Width           =   975
      End
      Begin VB.Label lbl_Spare3 
         Caption         =   "#Spare 3"
         Height          =   255
         Left            =   8280
         TabIndex        =   69
         Tag             =   "lbl_Spare3"
         Top             =   600
         Visible         =   0   'False
         Width           =   975
      End
      Begin VB.Label lbl_Spare2 
         Caption         =   "#Spare 2"
         Height          =   255
         Left            =   7320
         TabIndex        =   68
         Tag             =   "lbl_Spare2"
         Top             =   480
         Visible         =   0   'False
         Width           =   975
      End
      Begin VB.Label lbl_Spare1 
         Caption         =   "#Spare 1"
         Height          =   255
         Left            =   6360
         TabIndex        =   67
         Tag             =   "lbl_Spare1"
         Top             =   600
         Visible         =   0   'False
         Width           =   975
      End
   End
   Begin VB.Frame fraTV 
      Height          =   10215
      Left            =   120
      TabIndex        =   54
      Tag             =   "fraTV"
      Top             =   120
      Visible         =   0   'False
      Width           =   3975
      Begin Project1.A_calocx calfiltersMax 
         Height          =   375
         Left            =   2040
         TabIndex        =   4
         Top             =   1680
         Width           =   1815
         _ExtentX        =   3201
         _ExtentY        =   661
      End
      Begin Project1.A_calocx calFiltersMin 
         Height          =   375
         Left            =   120
         TabIndex        =   3
         Top             =   1680
         Width           =   1815
         _ExtentX        =   3201
         _ExtentY        =   661
      End
      Begin VB.CommandButton cmd_TVReLoad 
         Height          =   735
         Left            =   120
         Style           =   1  'Graphical
         TabIndex        =   80
         Tag             =   "cmd_TVReLoad"
         Top             =   2760
         Width           =   735
      End
      Begin VB.Frame fraFiltersDate 
         Caption         =   "#Date range"
         Height          =   735
         Left            =   120
         TabIndex        =   56
         Tag             =   "fraFiltersDate"
         Top             =   360
         Width           =   3735
         Begin VB.OptionButton optFiltersDate 
            Caption         =   "#All"
            Height          =   375
            Index           =   0
            Left            =   120
            TabIndex        =   1
            Tag             =   "optFiltersDate_All"
            Top             =   240
            Value           =   -1  'True
            Width           =   1455
         End
         Begin VB.OptionButton optFiltersDate 
            Caption         =   "#Between"
            Height          =   375
            Index           =   1
            Left            =   1800
            TabIndex        =   57
            Tag             =   "optFiltersDate_Between"
            Top             =   240
            Width           =   1455
         End
      End
      Begin Project1.ArmTreeView tvPO 
         Height          =   7335
         Left            =   120
         TabIndex        =   6
         Top             =   2760
         Width           =   3735
         _ExtentX        =   6588
         _ExtentY        =   12938
      End
      Begin Project1.ArmCombobox cbo_FiltersDate 
         Height          =   345
         Left            =   120
         TabIndex        =   2
         Top             =   1200
         Width           =   3735
         _ExtentX        =   6588
         _ExtentY        =   609
      End
      Begin Project1.ArmCombobox cbo_Views 
         Height          =   345
         Left            =   120
         TabIndex        =   5
         Top             =   2400
         Width           =   3375
         _ExtentX        =   5953
         _ExtentY        =   609
      End
      Begin VB.Label lbl_Views 
         Caption         =   "#Views"
         Height          =   255
         Left            =   120
         TabIndex        =   58
         Tag             =   "lbl_Views"
         Top             =   2160
         Width           =   2055
      End
   End
   Begin VB.Frame fraList 
      Height          =   10215
      Left            =   4200
      TabIndex        =   55
      Tag             =   "fraList"
      Top             =   120
      Visible         =   0   'False
      Width           =   9615
      Begin Project1.ArmGrid grList 
         Height          =   9015
         Left            =   120
         TabIndex        =   8
         Top             =   1080
         Width           =   9375
         _ExtentX        =   16536
         _ExtentY        =   15901
      End
      Begin Project1.ToolbarControl tcList 
         Height          =   690
         Left            =   120
         TabIndex        =   7
         Top             =   240
         Width           =   4455
         _ExtentX        =   7858
         _ExtentY        =   1217
      End
   End
End
Attribute VB_Name = "armIVPO"
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"

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
Private Const PATH_DOWNLOAD As String = "IVPO"

Public Event quit()

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

Private WithEvents mIVPOSup As ArmIVPOSup
Attribute mIVPOSup.VB_VarHelpID = -1

Private mInitialized As Boolean
Private mLoginName As String
Private mLanguage_Code As String
Private mTempPath As String

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

Private mTreeViewInfos() As TTreeViewInfo
Private mEventFrozen As Boolean

Private Type TUserInfo
    isValid As Boolean
    FirstName As String
    LastName As String
    FullName As String
    Phone As String
    Fax As String
    Department As String
    D_Code As Long
    U_Code As Long
    CC_Code As String
    CC_Desc As String
    p_code As String
    P_Desc As String
End Type
Private mUserInfo As TUserInfo

Private Type TSupplierContact
    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

Private Type TOrderLine
    POL_Code As Long
    Description As String
    Reference As String
    Unit_Price As Double
    Quantity As Double
    Total_Price As Double
End Type

Private Type TPurchaseOrder
    PurchaseNumber As Long
    iConcurrency As Long
    Supplier As TSupplier
    Supplier_Contact As TSupplierContact
    Order_Date As Date
    LastUpdate_Date As Date
    UserInfo As TUserInfo
    
    CC_Code As String
    CC_Desc As String
       
    p_code As String
    P_Desc As String
       
    CP_Code As Long
    Paiement_Terms As String
    PO_Currency As String
    Currency_Desc As String
    ST_Code As String
    ST_Desc As String
    DeliveryDate As Date
    DA_Addr1 As String
    DA_Addr2 As String
    DA_Addr3 As String
    DA_Addr4 As String
    
    Items() As TOrderLine
    MaxPOLCode As Long
    
    Spare1 As String
    Spare2 As String
    Spare3 As String
    Spare4 As String
    Spare5 As String
    Template As Long
    PO_Comment As String
    PT_Code As Long
    PT_Desc As String
    
    RaisedFor As TUserInfo
End Type

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

Private mCurrentOrder As TPurchaseOrder
Private mLblPO As String
Private mTemplate As Long
Private mFullGrid As Boolean
Private mDeliveryAddr As Long
Private mRights As Long

Private Enum eStatus
    esNew = 1
    esApproved = 2
End Enum

Private Enum eMode
    emList = 0
    emView = 1
    emAdd = 2
    emUpdate = 3
    emDelete = 4
End Enum
Private mMode As eMode
Private mOldMode As eMode
Private mTVDisable As Boolean


Const RIGHTS_UPD As String = "UPD"
Const RIGHTS_VIEW As String = "VIEW"


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 Function Load_A_Com() As Boolean
    
    On Error GoTo onError
    
    Const CL_REQUEST_TB As String = "SELECT Toolbar_Info FROM Toolbars_Users WHERE User_Code=$user_id$"
    Const CL_REQUEST_DA As String = "exec IV_Ship_Address_lst"
    Const DB_GET_TEMPLATE = "exec  IVPO_GetTemplate"
    Const DB_GET_RIGHTS = "exec IV_GetUserRights $u_code$"
    
    Dim lIdx As Long, lCount As Long
    Dim ls_Toolbar_Info As String
    
    mMode = emList
    Set mIVPOSup = Nothing
    Call LoadLabels(UserControl.Controls, SCREEN_NAME, mLanguage_Code)
    
    mUserInfo = GetUserInfo(mLoginName)
    mRights = mDb.OpenSQL(Replace(DB_GET_RIGHTS, "$u_code$", mUserInfo.U_Code, , , vbTextCompare))
    If mDb.RowCount(mRights) = 0 Then
        Exit Function
    End If
    
    fraItem.Visible = False
    fraTV.Visible = False
    fraList.Visible = False
    
    calFiltersMin.Visible = False
    calfiltersMax.Visible = False
    cbo_FiltersDate.Visible = False
        
    Call InitCtrlSize
    
    Set cbo_FiltersDate.ArmDb = mDb
    cbo_FiltersDate.Load_A_Com
    cbo_FiltersDate.Request = "exec captv_date_cbo '" & SCREEN_NAME & "','" & mLanguage_Code & "'"
    cbo_FiltersDate.Load
    cbo_FiltersDate.SearchItem "1", 2, 0
   
    Set cbo_Supplier.ArmDb = mDb
    cbo_Supplier.FirstBlankItem = False
    cbo_Supplier.Load_A_Com
    cbo_Supplier.Request = "exec IV_Suppliers_Lst"
    
    Set cbo_SupplierContact.ArmDb = mDb
    cbo_SupplierContact.FirstBlankItem = True
    cbo_SupplierContact.Load_A_Com
    
    Set cbo_Paiement.ArmDb = mDb
    cbo_Paiement.FirstBlankItem = False
    cbo_Paiement.Load_A_Com
    cbo_Paiement.Request = "exec IV_Paiement_Terms_Lst"
    
    Set cbo_currency.ArmDb = mDb
    cbo_currency.FirstBlankItem = False
    cbo_currency.Load_A_Com
    cbo_currency.Request = "exec currencies_cbo '" & mLanguage_Code & "'"
    cbo_currency.Load
    
    Set cbo_Status.ArmDb = mDb
    cbo_Status.FirstBlankItem = False
    cbo_Status.Load_A_Com
    cbo_Status.Request = "exec IV_Status_Lst"
    cbo_Status.Load
    
    Set cbo_PaiementType.ArmDb = mDb
    cbo_PaiementType.FirstBlankItem = False
    cbo_PaiementType.Load_A_Com
    cbo_PaiementType.Request = "exec IV_Paiement_Type_Lst"
    
    Set cbo_CostCenter.ArmDb = mDb
    cbo_CostCenter.FirstBlankItem = False
    cbo_CostCenter.Load_A_Com
    cbo_CostCenter.Request = "exec IV_CostCenter_Lst"
    'cbo_CostCenter.Load
    
    Set cbo_PO_RaisedFor.ArmDb = mDb
    cbo_PO_RaisedFor.FirstBlankItem = False
    cbo_PO_RaisedFor.Load_A_Com
    cbo_PO_RaisedFor.Request = "exec IV_PO_RaisedFor_Lst " & mUserInfo.U_Code
    
    cal_OrderDate.Language = mLanguage_Code
    cal_DeliveryDate.Language = mLanguage_Code
    calfiltersMax.Language = mLanguage_Code
    calFiltersMin.Language = mLanguage_Code
    
    Set grOrderLines.ArmDb = mDb
    grOrderLines.Load_A_Com
    grOrderLines.AllowExcelExport = True
    grOrderLines.ExportTitles = True
    grOrderLines.MultiSelect = True
    grOrderLines.UnBound = True
    Dim lColumns As Variant
    ReDim lColumns(5)
    lColumns(0) = Join(Array("POL_CODE", 0, 1, "POL_CODE", "#POL_Code"), SEP)
    lColumns(1) = Join(Array("POL_DESC", 2500, 2, "POL_DESC", lbl_Order.Caption), SEP)
    lColumns(2) = Join(Array("POL_REF", 2500, 3, "POL_REF", lbl_Reference.Caption), SEP)
    lColumns(3) = Join(Array("POL_Unit_Price", 1200, 0, "POL_Unit_Price", lbl_UnitPrice.Caption, "Float"), SEP)
    lColumns(4) = Join(Array("POL_Qty", 1200, 0, "POL_Qty", Lbl_Quantity.Caption, "Float"), SEP)
    lColumns(5) = Join(Array("POL_Cost_Code", 1500, 0, "POL_Cost_Code", lbl_TotalPrice.Caption), SEP)
    If Not grOrderLines.SetColumns(lColumns) Then
        Call Unload_A_Com
        End
    End If
    
    Dim lData As Long, lLabels As Variant
    lData = mDb.OpenSQL("SELECT Field_Name, Local_Text FROM Screen_Constants WHERE Screen_Name = '" & SCREEN_NAME & "' AND Field_Name LIKE 'gr%'")
    lIdx = mDb.Find(lData, "Field_Name", "grList", , 1)
    lLabels = Split(mDb.GetFieldsAt(lData, lIdx, "Local_Text"), SEP)
    mDb.Close (lData)
    If UBound(lLabels) <> 10 Then
        lLabels = Array("#Numéro", "IConcurrency", "Z_Creation_User", "#Status", "#Date de livraison", "#Fournisseur", "#Status", "#Commandé le", "#Commandé pour", "#Imputation comptable", "#Commandé par")
    End If
    
    Set grList.ArmDb = mDb
    grList.Load_A_Com
    grList.AllowExcelExport = True
    grList.ExportTitles = True
    grList.MultiSelect = True
    ReDim lColumns(10)
    lColumns(0) = Join(Array("PO_CODE", 800, 1, "PO_CODE", lLabels(0)), SEP)
    lColumns(1) = Join(Array("IConcurrency", 0, 0, "IConcurrency", lLabels(1)), SEP)
    lColumns(2) = Join(Array("Z_Creation_User", 0, 0, "Z_Creation_User", lLabels(2)), SEP)
    lColumns(3) = Join(Array("ST_Code", 0, 0, "ST_Code", lLabels(3)), SEP)
    lColumns(4) = Join(Array("Delivery_date", 1300, 0, "Delivery_date", lLabels(4)), SEP)
    lColumns(5) = Join(Array("SP_name", 2500, 0, "SP_name", lLabels(5)), SEP)
    lColumns(6) = Join(Array("ST_Desc", 1800, 0, "ST_Desc", lLabels(6)), SEP)
    lColumns(7) = Join(Array("Order_Date", 1000, 0, "Order_Date", lLabels(7)), SEP)
    lColumns(8) = Join(Array("RaisedFor", 2000, 0, "RaisedFor", lLabels(8)), SEP)
    lColumns(9) = Join(Array("CC_Desc", 2000, 0, "CC_Desc", lLabels(9)), SEP)
    lColumns(10) = Join(Array("CreatorName", 2000, 0, "CreatorName", lLabels(10)), SEP)
    
    If Not grList.SetColumns(lColumns) Then
        Call Unload_A_Com
        End
    End If
    
    mLblPO = "PO n° $number$"
    
    Set tvPO.ArmDb = mDb
    tvPO.Language = mLanguage_Code
    tvPO.AllowCheckboxes = True
    tvPO.UseImages = False
    tvPO.Load_A_Com
    
    ' Initializing the view combo
    Set cbo_Views.ArmDb = mDb
    Call cbo_Views.Load_A_Com
    Call cbo_Views.Clear
    cbo_Views.FirstBlankItem = False
    cbo_Views.Request = "exec TreeView_View_t_lst '" & SCREEN_NAME & "'," & "'" & mLanguage_Code & "'"
    cbo_Views.Load
    If cbo_Views.Count = 0 Then
        Exit Function
    End If
    
    lCount = cbo_Views.Count - 1
    ReDim mTreeViewInfos(lCount)
    For lIdx = 0 To lCount
        mTreeViewInfos(lIdx).Loaded = False
        mTreeViewInfos(lIdx).TreeViewCode = cbo_Views.ComboItems(lIdx + 1).Key
    Next
    cbo_Views.SearchItem "X", "TV_Default", 0
    
    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, "008")
    Call tcList.DisplayFace("0")
    tcList.ButtonVisible("A") = CanAdd()
    
    Call tcItem.Load_A_Com
    tcItem.Language = "E"
    Call tcItem.SetToolbarInfoStringParameters(ls_Toolbar_Info, "009")
    
    Call tcLines.Load_A_Com
    tcLines.Language = "E"
    Call tcLines.SetToolbarInfoStringParameters(ls_Toolbar_Info, "010")
    
    lData = mDb.OpenSQL(DB_GET_TEMPLATE)
    mTemplate = mDb.GetFields(lData, "FC_CODE")
    mDb.Close (lData)
    If mTemplate = 0 Then
        Exit Function
    End If
    
    If mTempPath = "" Then mTempPath = App.Path & "\"
    
    mDeliveryAddr = mDb.OpenSQL(CL_REQUEST_DA)
    lCount = mDb.RowCount(mDeliveryAddr) - 1
    For lIdx = 0 To lCount
        lst_DAPreselect.AddItem (mDb.GetFields(mDeliveryAddr, "AL_Desc"))
        lst_DAPreselect.ItemData(lIdx) = mDb.GetFields(mDeliveryAddr, "AL_Code")
        mDb.Next (mDeliveryAddr)
    Next
    
    txt_OrderNumber.BackColor = CL_COLOR_DISABLED
    txt_TotalPrice.BackColor = CL_COLOR_DISABLED
    
    Set mDbErr = mDb
    
    cmd_TVReLoad.Visible = False
    cmd_TVReLoad.Picture = LoadResPicture(61, vbResIcon)
    fraTV.Visible = True
    fraList.Visible = True
    
    mInitialized = True
    Load_A_Com = True
    
    Exit Function
    
onError:
    MsgBox "Error : " & Err.Number & ", " & Err.Description
    Load_A_Com = False
    
End Function

Public Function Unload_A_Com() As Boolean
    
    mDb.Close (mDeliveryAddr)
    mDb.Close (mRights)
    
    tcList.Unload_A_Com
    tcItem.Unload_A_Com
    tcLines.Unload_A_Com
    
    grList.Unload_A_Com
    grOrderLines.Unload_A_Com
    
    tvPO.Unload_A_Com
        
    cbo_FiltersDate.Unload_A_Com
    cbo_Views.Unload_A_Com
    
    cbo_Supplier.Unload_A_Com
    cbo_SupplierContact.Unload_A_Com
    cbo_Paiement.Unload_A_Com
    cbo_currency.Unload_A_Com
    cbo_Status.Unload_A_Com
    cbo_CostCenter.Unload_A_Com
    cbo_PaiementType.Unload_A_Com
    
    If mDb.CursorCount <> 0 Then
    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 Language_Code(ByVal aLanguage_Code As String)
    mLanguage_Code = aLanguage_Code
End Property

Public Property Let TempPath(ByVal aPath As String)
    mTempPath = aPath
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", "ARMCHECKVIEW"
                Case "COMMANDBUTTON", "ARMCOMBOBOX", "A_CALOCX", "OPTIONBUTTON", "ARMTREEVIEW", "LISTBOX", "PICTUREBOX"
                    lControl.Enabled = aEnabled
                Case Else
                    lControl.Enabled = aEnabled
            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", "COMMANDBUTTON"
                Case "ARMGRID"
                    lControl.ClearGrid
                Case "LISTBOX"
                    lControl.ListIndex = -1
                Case Else
            End Select
        End If
        
        Set lControl = Nothing
    Next

End Sub

Private Sub LoadUserInfo(ByRef aUserInfo As TUserInfo)
    
    txt_OrderBy.Text = aUserInfo.FirstName & " " & aUserInfo.LastName
    Txt_phone.Text = aUserInfo.Phone
    Txt_fax.Text = aUserInfo.Fax

    'Fill default Cost center for login's department
    If mMode = emAdd Then
        mEventFrozen = True
        
        If Not cbo_PO_RaisedFor.SearchItem(aUserInfo.U_Code, 0, , True) Then
            ' The combo is not loaded, we have to had the item manually
            Call cbo_PO_RaisedFor.AddItem(Array(aUserInfo.U_Code, aUserInfo.LastName & " " & aUserInfo.FirstName, aUserInfo.CC_Code, aUserInfo.CC_Desc), True)
        End If
        
        If Not cbo_PO_RaisedFor.SelectedItem Is Nothing Then
            If Not cbo_CostCenter.SearchItem(cbo_PO_RaisedFor.SelectedItem.GetData(2), 0, , True) Then
                ' The combo is not loaded, we have to had the item manually
                Call cbo_CostCenter.AddItem(Array(cbo_PO_RaisedFor.SelectedItem.GetData(2), cbo_PO_RaisedFor.SelectedItem.GetData(3) & " - " & cbo_PO_RaisedFor.SelectedItem.GetData(2), cbo_PO_RaisedFor.SelectedItem.GetData(3)), True)
            End If
        End If
        
        mEventFrozen = False
    End If

End Sub

Private Sub cbo_FiltersDate_ComboItemSelected()
    Call OnFilterChange
End Sub



Private Sub cbo_Supplier_ComboItemSelected()
    If Not cbo_Supplier.SelectedItem Is Nothing Then
        Call Item_LoadSupplierInfo(cbo_Supplier.SelectedItem.Key)
    End If
End Sub

Private Sub Item_LoadSupplierInfo(ByVal aSP_Code As Long)
    
    Const C_DB_REQUEST_CONTACT As String = "exec IV_Suppliers_Contacts_Lst $SP_Code$"
    Const C_DB_REQUEST_INFO As String = "exec IV_Suppliers_sel $SP_Code$"
    
    If mMode = eMode.emView Then Exit Sub
    
    ' Init the contact
    cbo_SupplierContact.Clear
    cbo_SupplierContact.Request = Replace(C_DB_REQUEST_CONTACT, "$SP_Code$", aSP_Code)
    cbo_SupplierContact.Enabled = True
    
    ' Get informations about the supplier
    Dim lData As Long
    lData = mDb.OpenSQL(Replace(C_DB_REQUEST_INFO, "$SP_Code$", aSP_Code))
    
    txt_InfoSupplier.Text = mDb.GetFields(lData, "SP_Adr1") & vbCrLf & mDb.GetFields(lData, "SP_Adr2") & vbCrLf & mDb.GetFields(lData, "SP_Adr3") & vbCrLf & _
                            mDb.GetFields(lData, "SP_Zip") & vbTab & mDb.GetFields(lData, "SP_Town") & vbCrLf & mDb.GetFields(lData, "SP_Country") & vbCrLf & _
                            mDb.GetFields(lData, "SP_Phone") & vbCrLf & mDb.GetFields(lData, "SP_Fax")
    txt_InfoSupplier.SelStart = 0
    
    Dim lCP_Code As Long, lCP_Desc As String
    lCP_Code = mDb.GetFields(lData, "CP_Code")
    lCP_Desc = mDb.GetFields(lData, "CP_Desc")
    
    cbo_Paiement.Enabled = True
    If lCP_Code <> 0 Then
        If Not cbo_Paiement.SearchItem(lCP_Code, "CP_CODE", , True) Then
            ' The combo is not loaded, we have to had the item manually
            Call cbo_Paiement.AddItem(Array(lCP_Code, lCP_Desc), True)
        End If
    End If
    
    cbo_PaiementType.Enabled = True
    Dim lPT_Code As Long, lPT_Desc As String
    lPT_Code = mDb.GetFields(lData, "PT_Code")
    lPT_Desc = mDb.GetFields(lData, "PT_Desc")
    If lPT_Code <> 0 Then
        If Not cbo_PaiementType.SearchItem(lPT_Code, "PT_Code", , True) Then
            Call cbo_PaiementType.AddItem(Array(lPT_Code, lPT_Desc), True)
        End If
    End If
    
    mDb.Close (lData)

End Sub

Private Sub cmd_TVReLoad_Click()
    'TODO
    Call LoadTreeView(tvPO, GetTreeViewInfo(mTreeViewInfos, SCREEN_NAME, cbo_Views.SelectedItem.Key), grList)
    cmd_TVReLoad.Visible = False
    tvPO.Visible = True
    
End Sub


Private Sub grList_CustomFormatRow(ByVal al_row As Long)
  
  If grList.Data(al_row, "ST_Code") = esApproved Then
    Call grList.BoldLine(al_row)
  End If
End Sub

Private Sub grList_SelChange()
    Call RefreshTCList
End Sub


Private Sub RefreshTCList()
    Dim lCanUpdate As Boolean
    lCanUpdate = CanUpdate(grList.SelectedLine(0, "Z_Creation_User"), grList.SelectedLine(0, "ST_Code"))
    tcList.Redraw = False
    tcList.ButtonVisible("B") = lCanUpdate
    tcList.ButtonVisible("G") = CanExport(grList.SelectedLine(0, "Z_Creation_User"), grList.SelectedLine(0, "ST_Code"))
    tcList.ButtonVisible("C") = lCanUpdate
    tcList.Redraw = True
End Sub


Private Sub optFiltersDate_Click(Index As Integer)
    Screen.MousePointer = vbHourglass
    Call SelectDateFilters(Index)
    Screen.MousePointer = 0
End Sub





Private Sub pctUpDown_DblClick()
    
    If Not mFullGrid Then
        Call fraItemOrder.Move(120, fraItemNumber.Top, fraItemOrder.Width, fraItem.Height - fraItemNumber.Top - 90)
        fraItemOrder.Zorder
    Else
        Call fraItemOrder.Move(120, 7320, fraItemOrder.Width, 2775)
    End If
    grOrderLines.Height = fraItemOrder.Height - 480 - fraItemOrderLine.Height
    fraItemOrderLine.Top = grOrderLines.Top + grOrderLines.Height + 120
    
    grOrderLines.Zorder
    mFullGrid = Not mFullGrid

End Sub

Private Sub txt_Quantity_Change()
On Error GoTo ErrorHandler

    txt_TotalPrice.Text = CDbl(txt_UnitPrice.Text) * CDbl(txt_Quantity.Text)
    Exit Sub
ErrorHandler:
    
End Sub

Private Sub txt_Quantity_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Call Item_LCAddCurrentOrderLine
    End If
End Sub



Private Sub txt_UnitPrice_Change()
On Error GoTo ErrorHandler

    txt_TotalPrice.Text = CDbl(txt_UnitPrice.Text) * CDbl(txt_Quantity.Text)
    Exit Sub
ErrorHandler:
    
End Sub


' Remarks : Not all fields are filled from  the FORM
Private Function FormToLocal(ByRef aOrder As TPurchaseOrder) As Boolean
    
    aOrder.DeliveryDate = cal_DeliveryDate.date_dt
    aOrder.CP_Code = cbo_Paiement.SelectedItem.Key
    aOrder.DA_Addr1 = txt_DAAddr1.Text
    aOrder.DA_Addr2 = txt_DAAddr2.Text
    aOrder.DA_Addr3 = txt_DAAddr3.Text
    aOrder.DA_Addr4 = txt_DAAddr4.Text
    
    Dim lIdx As Long, lCount As Long, lBuffer As Variant
    lCount = grOrderLines.Rows - 1
    ReDim aOrder.Items(lCount)
    For lIdx = 0 To lCount
        aOrder.Items(lIdx).Description = grOrderLines.Data(lIdx, "POL_DESC")
        aOrder.Items(lIdx).POL_Code = grOrderLines.Data(lIdx, "POL_CODE")
        aOrder.Items(lIdx).Quantity = grOrderLines.Data(lIdx, "POL_Qty")
        aOrder.Items(lIdx).Reference = grOrderLines.Data(lIdx, "POL_REF")
        aOrder.Items(lIdx).Total_Price = grOrderLines.Data(lIdx, "POL_Cost_Code")
        aOrder.Items(lIdx).Unit_Price = grOrderLines.Data(lIdx, "POL_Unit_Price")
    Next
    
    aOrder.PO_Comment = txt_Comment.Text
    aOrder.Order_Date = cal_OrderDate.date_courte
    aOrder.Paiement_Terms = cbo_Paiement.SelectedItem.DisplayText
    aOrder.PT_Code = cbo_PaiementType.SelectedItem.Key
    aOrder.PT_Desc = cbo_PaiementType.SelectedItem.DisplayText
    aOrder.ST_Code = cbo_Status.SelectedItem.Key
    aOrder.ST_Desc = cbo_Status.SelectedItem.DisplayText
    aOrder.PO_Currency = cbo_currency.SelectedItem.Key
    aOrder.Currency_Desc = cbo_currency.SelectedItem.DisplayText
    
    aOrder.CC_Code = cbo_CostCenter.SelectedItem.Key
    aOrder.CC_Desc = cbo_CostCenter.SelectedItem.GetData(2)
    
    aOrder.Spare1 = txt_spare1.Text
    aOrder.Spare2 = txt_spare2.Text
    aOrder.Spare3 = txt_spare3.Text
    aOrder.Spare4 = txt_spare4.Text
    aOrder.Spare5 = txt_Spare5.Text
    
    aOrder.Supplier.SP_Code = cbo_Supplier.SelectedItem.Key
    lBuffer = Split(txt_InfoSupplier.Text, vbCrLf, , vbTextCompare)
    aOrder.Supplier.Addr1 = lBuffer(0)
    aOrder.Supplier.Addr2 = lBuffer(1)
    aOrder.Supplier.Addr3 = lBuffer(2)
    aOrder.Supplier.Country = lBuffer(4)
    aOrder.Supplier.Phone = lBuffer(5)
    aOrder.Supplier.Fax = lBuffer(6)
    lBuffer = Split(lBuffer(3), vbTab, , vbTextCompare)
    aOrder.Supplier.Zip = lBuffer(0)
    aOrder.Supplier.Town = lBuffer(1)
    aOrder.Supplier.Name = cbo_Supplier.SelectedItem.DisplayText

    
    aOrder.RaisedFor.U_Code = cbo_PO_RaisedFor.SelectedItem.Key
    aOrder.RaisedFor.CC_Code = cbo_PO_RaisedFor.SelectedItem.GetData(2)
    aOrder.RaisedFor.CC_Desc = cbo_PO_RaisedFor.SelectedItem.GetData(3)
    aOrder.RaisedFor.FullName = cbo_PO_RaisedFor.SelectedItem.DisplayText
    
    If Not cbo_SupplierContact.SelectedItem Is Nothing Then
        aOrder.Supplier_Contact.SPC_Code = cbo_SupplierContact.SelectedItem.Key
        aOrder.Supplier_Contact.First_Name = cbo_SupplierContact.SelectedItem.GetData(2)
        aOrder.Supplier_Contact.Name = cbo_SupplierContact.SelectedItem.GetData(3)
    Else
        aOrder.Supplier_Contact.SPC_Code = 0
    End If
    
    
    FormToLocal = True

End Function



#If LIVE Then
Private Sub LocalToExcel_1(ByRef aSheet As Object, ByRef aPurchaseOrder As TPurchaseOrder)
#Else
Private Sub LocalToExcel_1(ByRef aSheet As Object, ByRef aPurchaseOrder As TPurchaseOrder)
#End If

    With aPurchaseOrder
    
        ' Purchase Order information
        ' TODO
        Dim lBuffer As String
        lBuffer = Replace(mLblPO, "$department$", .UserInfo.Department, , , vbTextCompare)
        'lBuffer = Replace(lBuffer, "$year$", Year(.Order_Date), , , vbTextCompare)
        lBuffer = Replace(lBuffer, "$number$", .PurchaseNumber, , , vbTextCompare)
        aSheet.cells(5, 3) = lBuffer
        
        ' User information
        aSheet.cells(6, 2) = .UserInfo.LastName & " " & aPurchaseOrder.UserInfo.FirstName
        aSheet.cells(7, 2) = "'" & .UserInfo.Phone
        aSheet.cells(8, 2) = "'" & .UserInfo.Fax
        aSheet.cells(9, 2) = aPurchaseOrder.RaisedFor.FullName '.LastName & " " & aPurchaseOrder.RaisedFor.FirstName
        aSheet.cells(10, 2) = .CC_Desc & " - " & .CC_Code ' .UserInfo.CostCenter
    
        ' Supplier information
        aSheet.cells(13, 2) = .Supplier.Name
        aSheet.cells(14, 2) = .Supplier.Addr1
        aSheet.cells(15, 2) = .Supplier.Addr2
        aSheet.cells(16, 2) = .Supplier.Addr3
        aSheet.cells(17, 2) = .Supplier.Zip & " " & .Supplier.Town & "   " & .Supplier.Country
        
        aSheet.cells(18, 3) = .Supplier_Contact.Name & " " & .Supplier_Contact.First_Name
        
        If .PT_Code <> 2 Then
            aSheet.cells(19, 2) = ""
        End If
        
        aSheet.Range("B22").Font.Strikethrough = .CP_Code <> 1
        aSheet.Range("C22").Font.Strikethrough = .CP_Code <> 2
        aSheet.Range("D22").Font.Strikethrough = .CP_Code <> 3
        aSheet.Range("E22").Font.Strikethrough = .CP_Code <> 4
        
        aSheet.Range("B23").Font.Strikethrough = .PT_Code <> 1
        aSheet.Range("C23").Font.Strikethrough = .PT_Code <> 2
        aSheet.Range("D23").Font.Strikethrough = .PT_Code <> 3
        
        aSheet.cells(24, 2) = .DA_Addr1
        aSheet.cells(25, 2) = .DA_Addr2
        aSheet.cells(26, 2) = .DA_Addr3
        aSheet.cells(27, 2) = .DA_Addr4
        aSheet.cells(41, 2) = Format(.LastUpdate_Date, "DD/MM/YYYY")
        
        ' Delivery
        If .DeliveryDate <> 0 Then
            aSheet.cells(28, 2) = Format(.DeliveryDate, "DD/MM/YYYY")
        End If
        
        Dim lIdx As Long, lCount As Long, lHeight As Long
        If UBound(.Items) > 2 Then
            aSheet.Range("A31", "E31").Copy
            lCount = UBound(.Items)
            For lIdx = 2 To lCount - 1
                Call aSheet.Range("A32", "E32").Insert
                'aSheet.Range("A32", "E32").RowHeight = aSheet.Range("A30", "E30").RowHeight
            Next
        End If
        Dim lTotal As Double
        lTotal = 0
        lCount = UBound(.Items)
        For lIdx = 0 To lCount
            aSheet.cells(30 + lIdx, 1) = .Items(lIdx).Description
            aSheet.cells(30 + lIdx, 2) = .Items(lIdx).Reference
            aSheet.cells(30 + lIdx, 3) = .Items(lIdx).Unit_Price
            aSheet.cells(30 + lIdx, 4) = .Items(lIdx).Quantity
            aSheet.cells(30 + lIdx, 5) = .Items(lIdx).Total_Price
            lTotal = lTotal + .Items(lIdx).Total_Price
        Next
        Dim lNextRowIdx As Long
        lNextRowIdx = IIf(lIdx <= 2, 34, 31 + lIdx)
        aSheet.cells(lNextRowIdx, 2) = aSheet.cells(lNextRowIdx, 2) & " " & .Currency_Desc
        aSheet.Range("A" & lNextRowIdx - 1, "E" & lNextRowIdx - 1).RowHeight = 0
        aSheet.cells(lNextRowIdx, 5) = lTotal
        
        aSheet.cells(lNextRowIdx + 1, 2) = .PO_Comment
       
            
        ' Check the page break
        If aSheet.HPageBreaks.Count <> 0 Then
            If (aSheet.HPageBreaks(aSheet.HPageBreaks.Count).Location.Row > lNextRowIdx) And (aSheet.HPageBreaks(aSheet.HPageBreaks.Count).Location.Row < (lNextRowIdx + 11)) Then
                Call aSheet.HPageBreaks.Add(aSheet.cells(lNextRowIdx, 1))
            End If
        End If
        
        'Check the vertical page break
        If aSheet.VPageBreaks.Count <> 0 Then
            aSheet.Application.ActiveWindow.View = 2     ' xlPageBreakPreview = 2
            Call aSheet.VPageBreaks(aSheet.VPageBreaks.Count).DragOff(-4161, 1) ' xlToRight = -4161
        End If
        
    End With
    
End Sub



Private Sub SelectDateFilters(ByVal aIndex As Long)
    ' Show/Hide the range
    Dim lShow As Boolean
    lShow = (aIndex = 1)
    calFiltersMin.Visible = lShow
    calfiltersMax.Visible = lShow
    cbo_FiltersDate.Visible = lShow
    
    If Not lShow Then
        calFiltersMin.reinit_cal
        calfiltersMax.reinit_cal
        cbo_FiltersDate.SearchItem "1", 2, 0
    End If
    
    Call OnFilterChange
End Sub


Private Sub OnFilterChange()

    ' Treeview don't need to be clear because all things are displayed in the treeview
    
    
    Dim lFilters As String
    If optFiltersDate(0).Value Then
        lFilters = optFiltersDate(0).Caption
    End If
    If optFiltersDate(1).Value Then
        If Not cbo_FiltersDate.SelectedItem Is Nothing Then
            lFilters = cbo_FiltersDate.SelectedItem.DisplayText & " " & optFiltersDate(1).Caption & " " & IIf(calFiltersMin.date_courte <> "", calFiltersMin.date_courte, "-") & " && " & IIf(calfiltersMax.date_courte <> "", calfiltersMax.date_courte, "-")
        Else
            lFilters = "-"
        End If
    End If
    grList.Title = lFilters
    
    If Not mInitialized Then Exit Sub
    
    tvPO.Visible = False
    tvPO.Clear
    cmd_TVReLoad.Visible = True
        
    grList.Requests = ""
    grList.ClearGrid
    
    ' Clear the treeview sel
    'Set tvPO.SelectedItem = Nothing
    
End Sub

Private Sub calFiltersMin_datechangee()
    Screen.MousePointer = vbHourglass
    If calFiltersMin.date_courte <> "" And calfiltersMax.date_courte <> "" Then
        If CDate(calFiltersMin.date_courte) > CDate(calfiltersMax.date_courte) Then
            calFiltersMin.SetFocus
            calFiltersMin.reinit_cal
            Call SendMessage(968, "Start date cannot be greater than End date", mLanguage_Code)
        End If
   End If
   Call OnFilterChange
    
    Screen.MousePointer = 0
End Sub

Private Sub calFiltersMax_datechangee()
    Screen.MousePointer = vbHourglass
    If calfiltersMax.date_courte <> "" And calFiltersMin.date_courte <> "" Then
        If CDate(calfiltersMax.date_courte) < CDate(calFiltersMin.date_courte) Then
            calfiltersMax.SetFocus
            calfiltersMax.reinit_cal
            Call SendMessage(969, "End date cannot be less than Start date", mLanguage_Code)
        End If
    End If
    Call OnFilterChange
    Screen.MousePointer = 0
End Sub


Private Sub cbo_Views_ComboItemSelected()
    If Not cbo_Views.SelectedItem Is Nothing Then
        Call LoadTreeView(tvPO, GetTreeViewInfo(mTreeViewInfos, SCREEN_NAME, cbo_Views.SelectedItem.Key), grList)
    End If
End Sub


Private Function GetTreeViewInfo(ByRef aTVInfos() As TTreeViewInfo, ByVal AScreenName As String, ByVal aTVCode As String) As TTreeViewInfo
    
    Dim lIdx As Long, lCount As Long
    Dim lTreeView As TTreeViewInfo, lFound As Boolean
    
    ' Search in the array
    lCount = UBound(aTVInfos)
    lFound = False
    For lIdx = 0 To lCount
        If aTVInfos(lIdx).TreeViewCode = aTVCode Then
            aTVInfos(lIdx).Loaded = False
            If Not aTVInfos(lIdx).Loaded Then
                aTVInfos(lIdx) = GetTreeViewInfoFromDB(AScreenName, aTVCode)
            End If
            lTreeView = aTVInfos(lIdx)
            lFound = True
            Exit For
        End If
    Next
    
    If Not lFound Then
        'ERROR
    End If
    
    GetTreeViewInfo = lTreeView
    
End Function



Private Function LoadTreeView(ByRef aTV As ArmTreeView, ByRef aTreeViewInfo As TTreeViewInfo, Optional ByRef aGrid As ArmGrid = Nothing) As Boolean
    
    'aTV.Visible = True

    aTV.Clear
    ' Clearing the associated grid
    If Not aGrid Is Nothing Then
        aGrid.Requests = ""
        Call aGrid.ClearGrid
    End If

    aTV.Levels = aTreeViewInfo.Levels
    aTV.StartDemandLevel = 1
    aTV.SelectedImages = aTreeViewInfo.SelectedImages
    aTV.Images = aTreeViewInfo.Images
    aTV.NodeRequests = ApplyTVFilters(aTreeViewInfo.NodeRequest)
    aTV.GridRequests = aTreeViewInfo.GridRequest
    aTV.FindRequests = ApplyTVFilters(aTreeViewInfo.FindRequest)
    aTV.CountRequests = aTreeViewInfo.CountRequest
    
    If Not aTV.LoadTree(LoadTypeChildsDemand) Then
        'ERROR
        LoadTreeView = False
    End If
    
    'aTV.Visible = True
    
End Function



Private Function GetTreeViewInfoFromDB(ByVal AScreenName As String, ByVal aTVCode As String) As TTreeViewInfo

    Dim lTreeView As TTreeViewInfo
    Dim lRequest As String
    Dim lCurs As Long, lIdx As Long, lCount As Long
    
    ' Get the data from the DB
    lRequest = "EXEC Treeview_Parameters_lst '" & AScreenName & "', '" & aTVCode & "'"
    lCurs = mDb.OpenSQL(lRequest)
    
    lCount = mDb.RowCount(lCurs) - 1
    
    If lCount = -1 Then
    End If
    
    ReDim lTreeView.NodeRequest(lCount)
    ReDim lTreeView.GridRequest(lCount)
    ReDim lTreeView.ExcelRequest(lCount)
    ReDim lTreeView.FindRequest(lCount)
    ReDim lTreeView.CountRequest(lCount)
    ReDim lTreeView.Images(lCount)
    ReDim lTreeView.SelectedImages(lCount)
    
    Dim lLevel As Long
    For lIdx = 0 To lCount
        lLevel = mDb.GetFields(lCurs, "TV_Level")
        lTreeView.NodeRequest(lLevel) = ReplaceHolders(mDb.GetFields(lCurs, "TV_NodeRequest"))
        lTreeView.GridRequest(lLevel) = ReplaceHolders(mDb.GetFields(lCurs, "TV_GridRequest"))
        lTreeView.ExcelRequest(lLevel) = ReplaceHolders(mDb.GetFields(lCurs, "TV_ExcelRequest"))
        lTreeView.FindRequest(lLevel) = ReplaceHolders(mDb.GetFields(lCurs, "TV_FindRequest"))
        lTreeView.CountRequest(lLevel) = ReplaceHolders(mDb.GetFields(lCurs, "TV_CountRequest"))
        lTreeView.Images(lLevel) = mDb.GetFields(lCurs, "TV_Images")
        lTreeView.SelectedImages(lLevel) = mDb.GetFields(lCurs, "TV_SelectedImages")
        mDb.Next (lCurs)
    Next
    
    lTreeView.TreeViewCode = aTVCode
    lTreeView.Levels = lCount + 1
    lTreeView.Loaded = True
    GetTreeViewInfoFromDB = lTreeView
    
    mDb.Close (lCurs)
    
End Function


Private Function ReplaceHolders(ByVal aRequest As String) As String
    Dim lBuffer As String
    lBuffer = Replace(aRequest, "$lang$", mLanguage_Code, , , vbTextCompare)
    lBuffer = Replace(lBuffer, "$login$", mLoginName, , , vbTextCompare)
    lBuffer = Replace(lBuffer, "$u_code$", mUserInfo.U_Code, , , vbTextCompare)
    ReplaceHolders = lBuffer
    
End Function

Private Function GetUserInfo(ByVal aLogin As String) As TUserInfo
    
    Const DB_REQUEST As String = "IVPO_GetUserInfo $param1$"

    Dim aUserInfo As TUserInfo

    Dim lRequest As String
    
    lRequest = Replace(DB_REQUEST, "$param1$", aLogin)
    
    
    Dim lData As Long
    lData = mDb.OpenSQL(lRequest)
    
    If mDb.RowCount(lData) = 0 Then
    End If
    
    aUserInfo.U_Code = mDb.GetFields(lData, "U_Code")
    aUserInfo.CC_Code = mDb.GetFields(lData, "CC_Code")
    aUserInfo.CC_Desc = mDb.GetFields(lData, "CC_Desc")
    aUserInfo.p_code = mDb.GetFields(lData, "P_Code")
    aUserInfo.P_Desc = mDb.GetFields(lData, "P_Desc")
    aUserInfo.Department = mDb.GetFields(lData, "Department")
    aUserInfo.Fax = mDb.GetFields(lData, "Fax")
    aUserInfo.Phone = mDb.GetFields(lData, "Phone")
    aUserInfo.LastName = mDb.GetFields(lData, "Name")
    aUserInfo.FirstName = mDb.GetFields(lData, "FirstName")
    aUserInfo.FullName = aUserInfo.LastName & " " & aUserInfo.FirstName
    aUserInfo.D_Code = mDb.GetFields(lData, "D_Code")
    aUserInfo.isValid = True
    aUserInfo.isValid = True

    mDb.Close (lData)
    GetUserInfo = aUserInfo

End Function

Private Sub Item_AddClear()
    Call ClearForm(UserControl.Controls, fraItem)
    Call LoadUserInfo(mUserInfo)
    txt_OrderNumber.Text = ""
    cbo_SupplierContact.Enabled = False
    cal_OrderDate.date_courte = Date
    cbo_Paiement.Enabled = False
    
    lst_DAPreselect.Selected(0) = True
    lst_DAPreselect_DblClick
End Sub

Private Sub InitCtrlSize()

    Const HSPACE As Long = 120
    Const VSPACE As Long = 120
    Call fraTV.Move(HSPACE, VSPACE, 3975, UserControl.Height - (VSPACE * 2))
    tvPO.Height = fraTV.Height - tvPO.Top - VSPACE
    
    Dim lBuffer As Long
    lBuffer = fraTV.Left + fraTV.Width + 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 tvPO_NodeClick(ByVal Node As MSComctlLib.Node)

    If mTVDisable Then Exit Sub

    Screen.MousePointer = vbHourglass
    ' Clear the grids
    grList.Requests = ""
    Call grList.ClearGrid


    If tvPO.Checkboxes Then
        Screen.MousePointer = 0
        Exit Sub
    End If

    ' If the selected node is on the last level, we have to load the grids
    If tvPO.NodeInfo(Node).ml_Level = tvPO.Levels - 1 Then
        grList.Requests = ApplyTVFilters(tvPO.SelectedNodeRequest)
        If grList.Execute = False Then
            'ERROR
        End If
    End If

    Screen.MousePointer = 0


End Sub


Private Sub tvPO_CheckboxesChange(Checkboxes As Boolean)
    Call OnFilterChange
End Sub


Private Function ApplyTVFilters(ByVal aRequest As Variant) As Variant
    
    Dim lRequests As Variant
    If IsArray(aRequest) Then
        ReDim lRequests(UBound(aRequest))
        Dim lIdx As Long, lCount As Long
        lCount = UBound(lRequests)
        For lIdx = 0 To lCount
            lRequests(lIdx) = ReplaceTVFiltersHolders(aRequest(lIdx))
        Next
    Else
        ReDim lRequests(0)
        lRequests(0) = ReplaceTVFiltersHolders(aRequest)
    End If

    ApplyTVFilters = lRequests
End Function


Private Function ReplaceTVFiltersHolders(ByVal aRequest As String) As String

    ' For date, there is three params
    Dim lRequest As String
    Dim lDateType As String, lDateMin As String, lDateMax As String

    If optFiltersDate(0).Value Then
        lDateType = 0
        lDateMin = "null"
        lDateMax = "null"
    End If
    
    If optFiltersDate(1).Value Then
        lDateType = cbo_FiltersDate.SelectedItem.GetData(0)
        lDateMin = IIf(calFiltersMin.date_us <> "", "'" & calFiltersMin.date_us & "'", "null")
        lDateMax = IIf(calfiltersMax.date_us <> "", "'" & calfiltersMax.date_us & "'", "null")
    End If

    lRequest = Replace(aRequest, "$datetype$", lDateType, , , vbTextCompare)
    lRequest = Replace(lRequest, "$datemin$", lDateMin, , , vbTextCompare)
    lRequest = Replace(lRequest, "$datemax$", lDateMax, , , vbTextCompare)

    ReplaceTVFiltersHolders = lRequest

End Function


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 "G"    ' Export the selected items to excels
            Call List_ExportToExcel
        
        Case "F"    ' Refresh the current list
            Call RefreshList
        
        Case "L"    ' Load the current treeview
            Call LoadCurrentTVSelection
            
        Case "B"    ' Update the selected item
            Call List_ItemUpdate
        
        Case "C"    ' Delete the selected items
            Call List_ItemsDelete
        Case "R"
            Call ShowSuppliersScreen(False)
            
        Case "T"    ' Exit from application
            RaiseEvent quit
    End Select

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

Private Sub ShowSuppliersScreen(ab_ItemScreenOnly As Boolean)

    If mIVPOSup Is Nothing Then
      Set mIVPOSup = UserControl.Controls.Add("Project1.ArmIVPOSup", "ivPOSup")
      mIVPOSup.Visible = False
      Call mIVPOSup.Move(0, 0, Width, Height)
      
      Set mIVPOSup.Db = mDb
      mIVPOSup.ItemScreenOnly = ab_ItemScreenOnly
      mIVPOSup.Language_Code = mLanguage_Code
      mIVPOSup.LoginName = mLoginName
      mIVPOSup.User_ID = mUserInfo.U_Code
      
      If Not mIVPOSup.Load_A_Com Then
          End
      End If
    End If
    
    mIVPOSup.Zorder
    mIVPOSup.Visible = True
End Sub

Private Sub mIVPOSup_Quit(al_SP_Code As Long)

  If Not (mIVPOSup Is Nothing) Then
    Call mIVPOSup.Unload_A_Com
    Call UserControl.Controls.Remove("ivPOSup")
    Set mIVPOSup = Nothing
    
    Call cbo_Supplier.Load
    
    If al_SP_Code <> 0 Then
      Call cbo_Supplier.SearchItem(al_SP_Code)
    End If
  End If
End Sub

Private Sub cmd_NewSupplier_Click()

  Call ShowSuppliersScreen(True)
  Call mIVPOSup.Item_AddInit
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 "G"    ' Export to excel
            Call Item_ExportToExcel
        
        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 1001, "Impossible to create this purchase order.", mLanguage_Code
    Case 1002
        SendMessage 1002, "Impossible to update this purchase order.", mLanguage_Code
    Case Else
        MsgBox "unexpected error : " & Err.Number & "," & Err.Description
    End Select

End Sub

Private Sub Item_AddInit()
    
    Call SetMode(emAdd)
        
    Call fraItem.Move(fraItem.Left, fraItem.Top, 12735, fraItem.Height)
    mFullGrid = False
    
    Call EnableFrame(UserControl.Controls, fraItem, True)
    Call EnableFrame(UserControl.Controls, fraItemUserInfo, False)
    Call EnableFrame(UserControl.Controls, fraTV, False)
    Call Item_AddClear
    
    txt_OrderNumber.Locked = True
    txt_InfoSupplier.Locked = True
    txt_TotalPrice.Locked = True
    
    Call cbo_Status.SearchItem(1, 0, , True)
    cbo_Status.Enabled = False
    cbo_PaiementType.Enabled = False
    cbo_CostCenter.Enabled = True
    cbo_PO_RaisedFor.Enabled = True
    
    tcItem.DisplayFace (TB_ITEM_ADD)
    tcLines.DisplayFace (TB_LC_LINE_ADD)
    tcLines.Visible = True
    
    fraItemOrderLine.Visible = True
    lst_DAPreselect.Visible = True
    lbl_DAPreselect.Visible = True
    
    txt_OrderNumber.BackColor = CL_COLOR_DISABLED
    txt_TotalPrice.BackColor = CL_COLOR_DISABLED

    Call cbo_currency.SearchItem("EUR", 0, , True)
                
    fraItem.Zorder
    fraItem.Visible = True
    fraList.Visible = False
    
End Sub

Private Sub Item_ExitToGrid()
    SetMode (emList)
    fraItem.Visible = False
    fraList.Visible = True
    Call EnableFrame(UserControl.Controls, fraTV, True)
    Call EnableFrame(UserControl.Controls, fraList, True)
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_LCAddCurrentOrderLine
        Case "C"    ' Delete the selected lines
            Call Item_LCDeleteSelOrderLines
        Case "I"    ' Clear the grid
            Call Item_LCClearOrderLines
    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 lOrder As TPurchaseOrder
    
    mSource = SCREEN_NAME & "/Item_Add: "
    
    If Not GetNextKey("IV_PO", lOrder.PurchaseNumber) Then
        mSource = mSource & "GetNextKey"
        mDesc = "Unable to get a new key"
        Err.Raise mNumber, mSource, mDesc
    End If
    
    lOrder.Template = mTemplate
    lOrder.UserInfo = mUserInfo
    
    If Not FormToLocal(lOrder) Then
        mSource = mSource & "FormToLocal"
        mDesc = "Error in Add"
        Err.Raise mNumber, mSource, mDesc
    End If
    
    'LocalTODB
    If Not LocalToDB_Add(lOrder) Then
        mSource = mSource & "LocalToDB_Add"
        mDesc = "Error in LocalToDB"
        Err.Raise mNumber, mSource, mDesc
    End If

    mCurrentOrder = lOrder
    mCurrentOrder.iConcurrency = 1

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


Private Function ReplaceHoldersFromLCPOL(ByVal aRequest As String, ByRef aLineOrder As TOrderLine) As String

    Dim lRequest As String
    
    lRequest = aRequest
    lRequest = Replace(lRequest, "$pol_code$", aLineOrder.POL_Code, , , vbTextCompare)
    lRequest = Replace(lRequest, "$pol_desc$", Replace(aLineOrder.Description, "'", "''", , , vbTextCompare), , , vbTextCompare)
    lRequest = Replace(lRequest, "$pol_ref$", Replace(aLineOrder.Reference, "'", "''", , , vbTextCompare), , , vbTextCompare)
    lRequest = Replace(lRequest, "$pol_unit_price$", SqlDbl(aLineOrder.Unit_Price), , , vbTextCompare)
    lRequest = Replace(lRequest, "$pol_qty$", SqlDbl(aLineOrder.Quantity), , , vbTextCompare)
    
    ReplaceHoldersFromLCPOL = lRequest
    
End Function

    
Private Function LocalToDB_Add(ByRef aOrder As TPurchaseOrder) As Boolean
    
    ' TODO : Manage transaction
    
    Const DB_PO_REQUEST As String = "exec IV_PO_Ins $po_code$, $z_user$, $sp_code$, $spc_code$, $cp_code$, $order_date$, $delivery_date$, '$po_currency$', $st_code$, $fc_code$, '$po_sp1$', '$po_sp2$', '$po_sp3$', '$po_sp4$', '$po_sp5$', '$po_comment$', '$da_addr1$', '$da_addr2$', '$da_addr3$', '$da_addr4$', $pt_code$, '$cc_code$', $raisedfor$"
    Const DB_POL_REQUEST As String = "exec IV_POL_Ins $po_code$, $z_user$, $pol_code$, '$pol_desc$', '$pol_ref$', $pol_unit_price$, $pol_qty$"
    
On Error GoTo Err_LocalToDB_Add
    
    Dim lRequest As String, lLineRequest As Variant, lPORequest As String, lTranOpenned As Boolean
    lPORequest = ReplaceHoldersFromLCPO(DB_PO_REQUEST, aOrder)
    
    Dim lIdx As Long, lCount As Long, lBuffer As TOrderLine
    lCount = UBound(aOrder.Items)
    ReDim lLineRequest(lCount)
    For lIdx = 0 To lCount
        aOrder.Items(lIdx).POL_Code = lIdx + 1
        lBuffer = aOrder.Items(lIdx) ' @$¤! VB who don't know how to manage array of user type !
        lRequest = ReplaceHoldersFromLCPOL(DB_POL_REQUEST, lBuffer)
        lRequest = Replace(lRequest, "$po_code$", aOrder.PurchaseNumber, , , vbTextCompare)
        lRequest = Replace(lRequest, "$z_user$", aOrder.UserInfo.U_Code, , , vbTextCompare)
        lLineRequest(lIdx) = lRequest
    Next
    aOrder.MaxPOLCode = aOrder.Items(lCount).POL_Code
    
    mNumber = C_ERRORRAISE + 1000
    mSource = SCREEN_NAME & "/LocalToDB_Add :"
    
    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 ReplaceHoldersFromLCPO(ByVal aRequest As String, ByRef aOrder As TPurchaseOrder) As String
    
    Dim lRequest As String
    lRequest = aRequest
    lRequest = Replace(lRequest, "$po_code$", aOrder.PurchaseNumber, , , vbTextCompare)
    lRequest = Replace(lRequest, "$z_user$", aOrder.UserInfo.U_Code, , , vbTextCompare)
    
    lRequest = Replace(lRequest, "$sp_code$", aOrder.Supplier.SP_Code, , , vbTextCompare)
    lRequest = Replace(lRequest, "$spc_code$", IIf(aOrder.Supplier_Contact.SPC_Code <> 0, aOrder.Supplier_Contact.SPC_Code, "null"), , , vbTextCompare)
    lRequest = Replace(lRequest, "$cp_code$", aOrder.CP_Code, , , vbTextCompare)
    
    lRequest = Replace(lRequest, "$da_addr1$", Replace(aOrder.DA_Addr1, "'", "''", , , vbDatabaseCompare), , , vbTextCompare)
    lRequest = Replace(lRequest, "$da_addr2$", Replace(aOrder.DA_Addr2, "'", "''", , , vbDatabaseCompare), , , vbTextCompare)
    lRequest = Replace(lRequest, "$da_addr3$", Replace(aOrder.DA_Addr3, "'", "''", , , vbDatabaseCompare), , , vbTextCompare)
    lRequest = Replace(lRequest, "$da_addr4$", Replace(aOrder.DA_Addr4, "'", "''", , , vbDatabaseCompare), , , vbTextCompare)
    
    lRequest = Replace(lRequest, "$order_date$", ConvertDateToSQL(aOrder.Order_Date), , , vbTextCompare)
    lRequest = Replace(lRequest, "$delivery_date$", ConvertDateToSQL(aOrder.DeliveryDate), , , vbTextCompare)
    lRequest = Replace(lRequest, "$po_currency$", aOrder.PO_Currency, , , vbTextCompare)
    
    lRequest = Replace(lRequest, "$cc_code$", aOrder.CC_Code)
    
    lRequest = Replace(lRequest, "$st_code$", aOrder.ST_Code, , , vbTextCompare)
    lRequest = Replace(lRequest, "$fc_code$", aOrder.Template, , , vbTextCompare)
    lRequest = Replace(lRequest, "$po_sp1$", Replace(aOrder.Spare1, "'", "''", , , vbTextCompare), , , vbTextCompare)
    lRequest = Replace(lRequest, "$po_sp2$", Replace(aOrder.Spare2, "'", "''", , , vbTextCompare), , , vbTextCompare)
    lRequest = Replace(lRequest, "$po_sp3$", Replace(aOrder.Spare3, "'", "''", , , vbTextCompare), , , vbTextCompare)
    lRequest = Replace(lRequest, "$po_sp4$", Replace(aOrder.Spare4, "'", "''", , , vbTextCompare), , , vbTextCompare)
    lRequest = Replace(lRequest, "$po_sp5$", Replace(aOrder.Spare5, "'", "''", , , vbTextCompare), , , vbTextCompare)
    lRequest = Replace(lRequest, "$po_comment$", Replace(aOrder.PO_Comment, "'", "''", , , vbTextCompare), , , vbTextCompare)
    lRequest = Replace(lRequest, "$iconcurrency$", aOrder.iConcurrency, , , vbTextCompare)
    lRequest = Replace(lRequest, "$pt_code$", aOrder.PT_Code, , , vbTextCompare)
    lRequest = Replace(lRequest, "$raisedfor$", aOrder.RaisedFor.U_Code, , , vbTextCompare)
    
    ReplaceHoldersFromLCPO = lRequest
    
End Function


Private Function ConvertDateToSQL(ByVal aDate As Date) As String
    Dim lStr As String
    
    If aDate = 0 Then
      lStr = "NULL"
    Else
      lStr = "'" & Year(aDate) & "-" & Month(aDate) & "-" & Day(aDate) & "'"
    End If
    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 aPO_Code As Long)
    
    mCurrentOrder = DBToLocal(aPO_Code)
    fraItem.Visible = False
    Call LocalToForm(mCurrentOrder)
    Call Item_ViewInit
    fraItem.Visible = True

End Sub


Private Function DBToLocal(ByVal aPO_Code As Long) As TPurchaseOrder

    Const DB_PO_REQUEST As String = "IV_PO_Sel '$lang$', $po_code$"
    Const DB_POL_REQUEST As String = "IV_POL_Sel $po_code$"

    Dim lRequest As String
    lRequest = ReplaceHolders(DB_PO_REQUEST)
    lRequest = Replace(lRequest, "$po_code$", aPO_Code, , , vbTextCompare)
    
    Dim lData As Long
    lData = mDb.OpenSQL(lRequest)
    
    Dim lOrder As TPurchaseOrder
    lOrder.PurchaseNumber = aPO_Code
    
    lOrder.RaisedFor = GetUserInfo(mDb.GetFields(lData, "PO_RaisedFor"))
    
    lOrder.DeliveryDate = mDb.GetFields(lData, "Delivery_Date")
    lOrder.LastUpdate_Date = mDb.GetFields(lData, "Z_Last_Upd")
    
    
    lOrder.Order_Date = mDb.GetFields(lData, "Order_Date")
    lOrder.CP_Code = mDb.GetFields(lData, "CP_Code")
    lOrder.Paiement_Terms = mDb.GetFields(lData, "CP_Desc")
    lOrder.PT_Code = mDb.GetFields(lData, "PT_Code")
    lOrder.PT_Desc = mDb.GetFields(lData, "PT_Desc")
    
    lOrder.iConcurrency = mDb.GetFields(lData, "iConcurrency")
    
    lOrder.PO_Currency = mDb.GetFields(lData, "PO_Currency")
    lOrder.Currency_Desc = mDb.GetFields(lData, "CURR_Desc")
    
    lOrder.Spare1 = mDb.GetFields(lData, "SP1")
    lOrder.Spare2 = mDb.GetFields(lData, "SP2")
    lOrder.Spare3 = mDb.GetFields(lData, "SP3")
    lOrder.Spare4 = mDb.GetFields(lData, "SP4")
    lOrder.Spare5 = mDb.GetFields(lData, "SP5")
    lOrder.PO_Comment = mDb.GetFields(lData, "PO_Comment")
    
    lOrder.Template = mDb.GetFields(lData, "FC_Code")
    
    lOrder.ST_Code = mDb.GetFields(lData, "ST_Code")
    lOrder.ST_Desc = mDb.GetFields(lData, "ST_Desc")
    
    
    lOrder.CC_Code = mDb.GetFields(lData, "CC_Code")
    lOrder.CC_Desc = mDb.GetFields(lData, "CC_Desc")
    lOrder.p_code = mDb.GetFields(lData, "P_Code")
    lOrder.P_Desc = mDb.GetFields(lData, "P_Desc")
    
    lOrder.DA_Addr1 = mDb.GetFields(lData, "DA_Addr1")
    lOrder.DA_Addr2 = mDb.GetFields(lData, "DA_Addr2")
    lOrder.DA_Addr3 = mDb.GetFields(lData, "DA_Addr3")
    lOrder.DA_Addr4 = mDb.GetFields(lData, "DA_Addr4")
    
    lOrder.Supplier.Addr1 = mDb.GetFields(lData, "SP_Adr1")
    lOrder.Supplier.Addr2 = mDb.GetFields(lData, "SP_Adr2")
    lOrder.Supplier.Addr3 = mDb.GetFields(lData, "SP_Adr3")
    lOrder.Supplier.Country = mDb.GetFields(lData, "SP_Country")
    lOrder.Supplier.Fax = mDb.GetFields(lData, "SP_Fax")
    lOrder.Supplier.Name = mDb.GetFields(lData, "SP_Name")
    lOrder.Supplier.Phone = mDb.GetFields(lData, "SP_Phone")
    lOrder.Supplier.SP_Code = mDb.GetFields(lData, "SP_Code")
    lOrder.Supplier.Town = mDb.GetFields(lData, "SP_Town")
    lOrder.Supplier.Zip = mDb.GetFields(lData, "SP_Zip")
    lOrder.Supplier.RIB = mDb.GetFields(lData, "SP_RIB")
    
    lOrder.Supplier_Contact.Fax = mDb.GetFields(lData, "SPC_Fax")
    lOrder.Supplier_Contact.First_Name = mDb.GetFields(lData, "SPC_First_Name")
    lOrder.Supplier_Contact.Name = mDb.GetFields(lData, "SPC_Name")
    lOrder.Supplier_Contact.Phone = mDb.GetFields(lData, "SPC_Phone")
    lOrder.Supplier_Contact.SPC_Code = mDb.GetFields(lData, "SPC_Code")
    
    'lOrder.UserInfo.CostCenter = mDb.GetFields(lData, "UICostCenter")
    lOrder.UserInfo.Department = mDb.GetFields(lData, "UIDepartment")
    lOrder.UserInfo.Fax = mDb.GetFields(lData, "UIFax")
    lOrder.UserInfo.FirstName = mDb.GetFields(lData, "UIFirstName")
    lOrder.UserInfo.LastName = mDb.GetFields(lData, "UIName")
    lOrder.UserInfo.Phone = mDb.GetFields(lData, "UIPhone")
    lOrder.UserInfo.U_Code = mDb.GetFields(lData, "U_Code")
    
    mDb.Close (lData)
    
    lRequest = Replace(DB_POL_REQUEST, "$po_code$", aPO_Code, , , vbTextCompare)
    lData = mDb.OpenSQL(lRequest)
    
    lOrder.MaxPOLCode = 0
    If mDb.RowCount(lData) > 0 Then
        Dim lIdx As Long, lCount As Long
        lCount = mDb.RowCount(lData) - 1
        ReDim lOrder.Items(lCount)
        For lIdx = 0 To lCount
            lOrder.Items(lIdx).Description = mDb.GetFields(lData, "POL_Desc")
            
            lOrder.Items(lIdx).POL_Code = mDb.GetFields(lData, "POL_Code")
            If lOrder.Items(lIdx).POL_Code > lOrder.MaxPOLCode Then
                lOrder.MaxPOLCode = lOrder.Items(lIdx).POL_Code
            End If
            lOrder.Items(lIdx).Quantity = mDb.GetFields(lData, "POL_Qty")
            lOrder.Items(lIdx).Reference = mDb.GetFields(lData, "POL_Ref")
            lOrder.Items(lIdx).Unit_Price = mDb.GetFields(lData, "POL_Unit_Price")
            lOrder.Items(lIdx).Total_Price = lOrder.Items(lIdx).Unit_Price * lOrder.Items(lIdx).Quantity
            mDb.Next (lData)
        Next
    End If
    mDb.Close (lData)
    
    DBToLocal = lOrder

End Function

Private Sub LocalToForm(ByRef aOrder As TPurchaseOrder)
    
    mEventFrozen = True
    
    Call ClearForm(UserControl.Controls, fraItem)
    
    With aOrder
        txt_OrderNumber.Text = .PurchaseNumber
        
        Call cal_OrderDate.reinit_cal
        If .Order_Date <> 0 Then cal_OrderDate.date_courte = .Order_Date
        
        'When add : cost_center retrieved from gen_department otherwise from iv_po
        Call LoadUserInfo(.UserInfo)
        
        If Not cbo_PO_RaisedFor.SearchItem(aOrder.RaisedFor.U_Code, 0, , True) Then
            Call cbo_PO_RaisedFor.AddItem(Array(aOrder.RaisedFor.U_Code, aOrder.RaisedFor.LastName & " " & aOrder.RaisedFor.FirstName, aOrder.RaisedFor.CC_Code, aOrder.RaisedFor.CC_Desc), True)
        End If
        
        If aOrder.CC_Code <> 0 Then
            If Not cbo_CostCenter.SearchItem(aOrder.CC_Code, 0, , True) Then
                Call cbo_CostCenter.AddItem(Array(aOrder.CC_Code, aOrder.CC_Desc & " - " & aOrder.CC_Code, aOrder.CC_Desc), True)
            End If
        End If
    
        cal_DeliveryDate.reinit_cal
        If .DeliveryDate <> 0 Then cal_DeliveryDate.date_courte = .DeliveryDate
    
        ' TODO : Delivery Address
        txt_DAAddr1.Text = .DA_Addr1
        txt_DAAddr2.Text = .DA_Addr2
        txt_DAAddr3.Text = .DA_Addr3
        txt_DAAddr4.Text = .DA_Addr4
        
        txt_spare1.Text = .Spare1
        txt_spare2.Text = .Spare2
        txt_spare3.Text = .Spare3
        txt_spare4.Text = .Spare4
        txt_Spare5.Text = .Spare5
        txt_Comment.Text = .PO_Comment
        
        With .Supplier
            If Not cbo_Supplier.SearchItem(.SP_Code, 0, , True) Then
                Call cbo_Supplier.AddItem(Array(.SP_Code, .Name, aOrder.CP_Code, aOrder.Paiement_Terms), True)
            End If
            txt_InfoSupplier.Text = .Addr1 & vbCrLf & .Addr2 & vbCrLf & .Addr3 & vbCrLf & .Zip & vbTab & .Town & vbCrLf & .Country & vbCrLf & .Phone & vbCrLf & .Fax
            txt_InfoSupplier.SelStart = 0
            
        End With
        If Not cbo_Paiement.SearchItem(.CP_Code, 0, , True) Then
            Call cbo_Paiement.AddItem(Array(.CP_Code, .Paiement_Terms), True)
        End If
    
        If Not cbo_PaiementType.SearchItem(.PT_Code, 0, , True) Then
            Call cbo_PaiementType.AddItem(Array(.PT_Code, .PT_Desc), True)
        End If
    
        If Not cbo_Status.SearchItem(.ST_Code, 0, , True) Then
            Call cbo_Status.AddItem(Array(.ST_Code, .ST_Desc), True)
        End If
        
    
        With .Supplier_Contact
            If .SPC_Code <> 0 Then
                If Not cbo_SupplierContact.SearchItem(.SPC_Code, 0, , True) Then
                    Call cbo_SupplierContact.AddItem(Array(.SPC_Code, .Name & " " & .First_Name), True)
                End If
            End If
        End With
    
        Call cbo_currency.SearchItem(.PO_Currency, 0, , True)
    
        Dim lIdx As Long, lCount As Long
        lCount = UBound(.Items)
        grOrderLines.Visible = False
        For lIdx = 0 To lCount
            Call grOrderLines.AddLine(Array(.Items(lIdx).POL_Code, .Items(lIdx).Description, .Items(lIdx).Reference, .Items(lIdx).Unit_Price, .Items(lIdx).Quantity, .Items(lIdx).Total_Price))
        Next
        'grOrderLines.LastLine
        grOrderLines.FirstLine
        grOrderLines.Visible = True
        
    End With
    
    mEventFrozen = False
    
End Sub

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

Private Sub GotoNextItem()
    If Not grList.NextItem Then
        Call SendMessage(928, "#No more next item", mLanguage_Code)
    Else
        RefreshTCList
    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 LoadCurrentTVSelection()
    If tvPO.Checkboxes = True Then
        grList.Requests = ApplyTVFilters(tvPO.CheckedNodesRequests)
    Else
        grList.Requests = ApplyTVFilters(tvPO.SelectedNodeRequest)
    End If
    If grList.Execute = False Then
        'Error
    End If
End Sub


Private Sub RefreshList()
    tvPO.Refresh
    If tvPO.Checkboxes = True Or grList.Row > 0 Then
        Call LoadCurrentTVSelection
    End If
End Sub

' TODO Manage error
Private Sub List_ExportToExcel()

    Dim lIdx As Long, lCount As Long, lOrder As TPurchaseOrder, lKey As Variant
    
    lCount = grList.SelectedCount - 1
    If lCount < 0 Then Exit Sub
    
    For lIdx = 0 To lCount
        lKey = grList.MultiSelectedKey(lIdx)
        lOrder = DBToLocal(lKey(0))
            
            If Item_ForApproved(lOrder) Then
            
                If InStr(1, cbo_Views.SelectedItem.GetData(2), cbo_Status.Tag, vbTextCompare) <= 0 Then
                    grList.SelectedLine(lIdx, "ST_Desc") = cbo_Status.GetItemData(2, 1)  ' Get the description
                    grList.SelectedLine(lIdx, "ST_Code") = 2
                    grList.SelectedLine(lIdx, "IConcurrency") = lOrder.iConcurrency
                Else
                    grList.DeleteLine (lKey)
                End If
            Else
            End If
        
        If Not LocalToExcel(lOrder) Then
            MsgBox "Excel Problem"
        End If
        
    Next

End Sub


Private Function Item_OrderLine_Check() As Boolean
    
    If txt_Order.Text = "" Then
        Call SendFieldErrMsg(966, lbl_Order.Caption, txt_Order)
        txt_Order.SelStart = 0
        txt_Order.SelLength = Len(txt_Order.Text)
        Exit Function
    End If
    
    If txt_Reference.Text = "" Then
        Call SendFieldErrMsg(966, lbl_Reference.Caption, txt_Reference)
        txt_Reference.SelStart = 0
        txt_Reference.SelLength = Len(txt_Reference.Text)
        Exit Function
    End If
    
    If Not isNumeric(txt_UnitPrice.Text) Then
        Call SendFieldErrMsg(1005, lbl_UnitPrice.Caption, txt_UnitPrice)
        txt_UnitPrice.SelStart = 0
        txt_UnitPrice.SelLength = Len(txt_UnitPrice.Text)
        Exit Function
    End If
    
    If Not isNumeric(txt_Quantity.Text) Then
        Call SendFieldErrMsg(1005, Lbl_Quantity.Caption, txt_Quantity)
        txt_Quantity.SelStart = 0
        txt_Quantity.SelLength = Len(txt_Quantity.Text)
        Exit Function
    End If
    
    Item_OrderLine_Check = True
    
End Function


Private Sub Item_LCAddCurrentOrderLine()
    
    ' Check if price and qty are numeric
    If Not Item_OrderLine_Check Then Exit Sub
    
    ' TODO : check the validity of the line
    If grOrderLines.SearchKey(True, Array(0, txt_Order.Text, txt_Reference.Text)) Then
        Exit Sub
    End If
    
    If Not grOrderLines.AddLine(Array(0, txt_Order.Text, txt_Reference.Text, txt_UnitPrice.Text, txt_Quantity.Text, txt_TotalPrice.Text)) Then
    End If
    Call ClearForm(UserControl.Controls, fraItemOrderLine)
    txt_Order.SetFocus
    
End Sub

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

Private Sub Item_LCDeleteSelOrderLines()
    Dim lIdx As Long, lCount As Long
    lCount = grOrderLines.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 = grOrderLines.MultiSelectedKey
        For lIdx = 0 To lCount
            grOrderLines.DeleteLine (lKeys(lIdx))
        Next
        grOrderLines.DeselectRow
    End If
End Sub

Private Sub txt_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Call Item_LCAddCurrentOrderLine
    End If
End Sub

Private Sub txt_Order_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Call Item_LCAddCurrentOrderLine
    End If
End Sub

Private Sub txt_Reference_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Call Item_LCAddCurrentOrderLine
    End If
End Sub

Private Sub txt_UnitPrice_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Call Item_LCAddCurrentOrderLine
    End If
End Sub




Private Sub grOrderLines_ItemSelected()
    txt_Order.Text = grOrderLines.SelectedLine(0, "POL_DESC")
    txt_Reference.Text = grOrderLines.SelectedLine(0, "POL_REF")
    txt_UnitPrice.Text = grOrderLines.SelectedLine(0, "POL_Unit_Price")
    txt_Quantity.Text = grOrderLines.SelectedLine(0, "POL_Qty")
End Sub


Public Function Item_Check() As Boolean

    If cal_OrderDate.date_courte = "" Then
        Call SendFieldErrMsg(966, lbl_OrderDate.Caption, cal_OrderDate)
        Exit Function
    End If
    
    If cal_DeliveryDate.date_courte <> "" Then
    If CDate(cal_OrderDate.date_courte) > CDate(cal_DeliveryDate.date_courte) Then
        cal_DeliveryDate.SetFocus
        cal_DeliveryDate.reinit_cal
        SendMessage 1003, "Delivery date must be greater than order date.", mLanguage_Code
        Exit Function
    End If
    End If
    
    If txt_DAAddr1.Text = "" Then
        Call SendFieldErrMsg(966, Lbl_DeliveryAddress.Caption, txt_DAAddr1)
        Exit Function
    End If
    
    If cbo_Supplier.SelectedItem Is Nothing Then
        Call SendFieldErrMsg(966, lbl_Supplier.Caption, cbo_Supplier)
        Exit Function
    End If
    
    
    If cbo_PO_RaisedFor.SelectedItem Is Nothing Then
        Call SendFieldErrMsg(966, lbl_PO_RaisedFor.Caption, cbo_PO_RaisedFor)
        Exit Function
    End If
    
    If cbo_Paiement.SelectedItem Is Nothing Then
        Call SendFieldErrMsg(966, lbl_TermsOfPayment.Caption, cbo_Paiement)
        Exit Function
    End If
    
    If cbo_currency.SelectedItem Is Nothing Then
        Call SendFieldErrMsg(966, Lbl_Currency.Caption, cbo_currency)
        Exit Function
    End If
    
    If cbo_Status.SelectedItem Is Nothing Then
        Call SendFieldErrMsg(966, lbl_Status.Caption, cbo_Status)
        Exit Function
    End If
    
    If cbo_PaiementType.SelectedItem Is Nothing Then
        Call SendFieldErrMsg(966, lbl_PaiementType.Caption, cbo_PaiementType)
        Exit Function
    End If
    
    
    If grOrderLines.Rows = 0 Then
        SendMessage 1004, "At least one item is needed.", mLanguage_Code
        txt_Order.SetFocus
        Exit Function
    End If
    
    If cbo_CostCenter.SelectedItem Is Nothing Then
        Call SendFieldErrMsg(966, lbl_CostCenter.Caption, cbo_CostCenter)
        Exit Function
    End If
    
    Item_Check = True
    
End Function


Private Sub Item_AddLocal()
    
    txt_OrderNumber.Text = mCurrentOrder.PurchaseNumber
    
    Dim lPath As String
    lPath = GetCurrentPath(UserControl.Controls, fraItem, cbo_Views.SelectedItem.GetData(2))
    
    
    If FindInTreeView(tvPO, lPath) Then
       ' FOR NEXT TIME Item has been created, we can here write a network optimisation if we know what to put in the grid
        grList.Requests = ApplyTVFilters(tvPO.SelectedNodeRequest)
    Else
         grList.Requests = ApplyTVFilters(tvPO.SelectedNodeRequest)
    End If
    
    If Not grList.SearchKey(True, Array(mCurrentOrder.PurchaseNumber)) Then
        ' ERROR
    End If
    Call RefreshTCList

End Sub

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

    On Error GoTo onError:
    mTVDisable = True

    Dim lValues As Variant
    lValues = Split(aPath, SEP & SEP)

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

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

    mTVDisable = False
    Exit Function
onError:
    mTVDisable = False
End Function

Private Function GetCurrentPath(ByRef aControls As Variant, ByRef aContainer As Object, ByVal aPattern As String) As String

    Dim lPattern() As String
    lPattern = Split(aPattern, SEP)

    Dim lPath() As String
    lPath = lPattern

    Dim lIdxPattern As Long, lCountPattern As Long, lIdxPath As Long
    Dim lIdx As Long, lCount As Long, lIdxLbl As Long
    Dim lControl As Control

    lCountPattern = UBound(lPattern)
    lCount = aControls.Count - 1
    For lIdx = 0 To lCount
        Set lControl = aControls.Item(lIdx)
        If HasContainer(lControl, aContainer) Then
            lIdxPath = -1
            For lIdxPattern = 0 To lCountPattern
                If StrComp(lControl.Tag, lPattern(lIdxPattern), vbTextCompare) = 0 Then
                    Select Case UCase(TypeName(lControl))
                        Case "TEXTBOX"
                            lPath(lIdxPattern) = lControl.Text & SEP & lControl.Text
                        Case "ARMCOMBOBOX"
                            lPath(lIdxPattern) = lControl.SelectedItem.Key & SEP & lControl.SelectedItem.DisplayText
                        Case Else
                    End Select
                Exit For
                End If
            Next
        End If
        Set lControl = Nothing
    Next

    Dim lBuffer As String
    lBuffer = Join(lPath, SEP & SEP)
    lBuffer = Replace(lBuffer, "u_code", mCurrentOrder.UserInfo.U_Code & SEP & Trim(mCurrentOrder.UserInfo.LastName & " " & mCurrentOrder.UserInfo.FirstName), , , vbTextCompare)
    GetCurrentPath = lBuffer

End Function




Private Function LocalToExcel(ByRef aOrder As TPurchaseOrder) As Boolean
    
    Const DB_REQUEST As String = "select fc_file from iv_po_zip where fc_code = $fc_code$"
    Const REQ_UPD_STATUS As String = "exec IV_PO_Upd2 $po_code$, $st_code$, $z_user$, $iconcurrency$"
    
    ' TODO : Manage error
    Dim lTemplateFileName As String
    Dim lRequest As String
    lTemplateFileName = mTempPath & aOrder.Template & "_ivpotemplate.xls"
    
    #If LIVE Then
        Dim lFso As Object
        Set lFso = CreateObject("Scripting.FileSystemObject")
    #Else
        Dim lFso As FileSystemObject
        Set lFso = New FileSystemObject
    #End If
    
    If Not lFso.FileExists(lTemplateFileName) Then
        lRequest = Replace(DB_REQUEST, "$fc_code$", aOrder.Template, , , vbTextCompare)
        Call mDb.BlobToFileSQL(lRequest, lTemplateFileName)
    End If
    
    #If LIVE Then
        Dim lExcelApp As Object, lExcelWorkbook As Object, lExcelSheet As Object
        Set lExcelApp = CreateObject("Excel.Application")
    #Else
        Dim lExcelApp As Object, lExcelWorkbook As Object, lExcelSheet As Object
        Set lExcelApp = CreateObject("Excel.Application")
        lExcelApp.ScreenUpdating = True
        lExcelApp.Visible = True
    #End If
    
    Set lExcelWorkbook = lExcelApp.Workbooks.Open(lTemplateFileName)
    Set lExcelSheet = lExcelWorkbook.ActiveSheet
    
    Select Case aOrder.Template
        Case 1
            Call LocalToExcel_1(lExcelSheet, aOrder)
    End Select
    
    #If LIVE Then
        lExcelWorkbook.PrintOut
        lExcelWorkbook.Close (False)
        Call lExcelApp.quit
    #End If
    
    Set lExcelSheet = Nothing
    Set lExcelWorkbook = Nothing
    Set lExcelApp = Nothing
    Set lFso = Nothing
    
    LocalToExcel = True
    
End Function



Private Sub lst_DAPreselect_DblClick()
    If lst_DAPreselect.SelCount = 0 Then Exit Sub
    Call mDb.Find(mDeliveryAddr, "AL_Code", lst_DAPreselect.ItemData(lst_DAPreselect.ListIndex), , 1)
    txt_DAAddr1.Text = mDb.GetFields(mDeliveryAddr, "AL_Ligne1")
    txt_DAAddr2.Text = mDb.GetFields(mDeliveryAddr, "AL_Ligne2")
    txt_DAAddr3.Text = mDb.GetFields(mDeliveryAddr, "AL_Ligne3")
    txt_DAAddr4.Text = mDb.GetFields(mDeliveryAddr, "AL_Ligne4")
End Sub

Private Sub List_ItemsDelete()
   
    Dim lIdx As Long, lCount As Long
    Dim lPO_Code As Long, liConc As Long, lU_Code As Long, lST_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)
        lPO_Code = lKeys(0)
        liConc = grList.SelectedLine(lIdx, "iConcurrency")
        lU_Code = grList.SelectedLine(lIdx, "Z_Creation_User")
        lST_Code = grList.SelectedLine(lIdx, "ST_Code")
        If CanUpdate(lU_Code, lST_Code) Then
            If Item_DbDelete(lPO_Code, liConc) Then
                Call Item_LocalDelete(lPO_Code)
            Else
                MsgBox MsgText(1011, mLanguage_Code, "#Une erreur s''est produite, l''item suivant ne peut être effacé : ") & grList.SelectedLine(lIdx, "PO_Code")
            End If
        Else
            MsgBox MsgText(1012, mLanguage_Code, "#Vous n''avez pas les droits suffisants pour effacer cette donnée : ") & grList.SelectedLine(lIdx, "PO_Code")
        End If
    Next

End Sub

Private Function Item_Delete()

    If MsgBox(MsgText(1013, mLanguage_Code, "Voulez-vous supprimer ce bon de commande ?"), vbYesNo) <> vbYes Then Exit Function
    If Not Item_DbDelete(mCurrentOrder.PurchaseNumber, mCurrentOrder.iConcurrency) Then Exit Function
    Item_LocalDelete (mCurrentOrder.PurchaseNumber)
    Call Item_ExitToGrid
End Function

Private Function Item_DbDelete(ByVal aPO_Code As Long, ByVal aiConcurrency As Long) As Boolean

    Const DB_REQUEST As String = "exec IV_PO_Del $po_code$, $iconcurrency$"
    Dim lRequest As String
    
    lRequest = Replace(DB_REQUEST, "$po_code$", aPO_Code, , , vbTextCompare)
    lRequest = Replace(lRequest, "$iconcurrency$", aiConcurrency, , , vbTextCompare)

    If Not mDb.ExecuteSQL(lRequest) Then
        Exit Function
    End If

    If mDb.SQLRowsAffected = 0 Then
        Exit Function
    End If
    
    Item_DbDelete = True

End Function

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


Private Sub Item_ViewInit()
    
    fraItem.Visible = False
    
    SetMode (emView)
    ' Init Cpt
    mFullGrid = False
    Call fraItem.Move(fraItem.Left, fraItem.Top, 12735, fraItem.Height)
    
    Call EnableFrame(UserControl.Controls, fraItem, False)
    Call EnableFrame(UserControl.Controls, fraItemUserInfo, False)
    Call EnableFrame(UserControl.Controls, fraTV, False)
    
    lst_DAPreselect.Visible = False
    lbl_DAPreselect.Visible = False

    tcItem.DisplayFace (TB_ITEM_VIEW)
    Dim lCanUpdate As Boolean
    lCanUpdate = CanUpdate(mCurrentOrder.UserInfo.U_Code, mCurrentOrder.ST_Code)
    tcItem.Redraw = False
    tcItem.ButtonVisible("B") = lCanUpdate
    tcItem.ButtonVisible("C") = lCanUpdate
    tcItem.ButtonVisible("G") = CanExport(mCurrentOrder.UserInfo.U_Code, mCurrentOrder.ST_Code)
    tcItem.Redraw = True
    pctUpDown.Enabled = True

    tcLines.Visible = False
    fraItemOrderLine.Visible = False
    fraItem.Zorder
    fraItem.Visible = True
    fraList.Visible = False
End Sub

Private Sub Item_DeleteInit()
    
    SetMode (emDelete)
    
    mFullGrid = False
    Call fraItem.Move(fraItem.Left, fraItem.Top, 12735, fraItem.Height)
    
    Call EnableFrame(UserControl.Controls, fraItem, False)
    Call EnableFrame(UserControl.Controls, fraItemUserInfo, False)
    Call EnableFrame(UserControl.Controls, fraTV, False)
    
    lst_DAPreselect.Visible = False
    lbl_DAPreselect.Visible = False

    tcItem.DisplayFace (TB_ITEM_DELETE)
    pctUpDown.Enabled = True
    tcLines.Visible = False
    fraItemOrderLine.Visible = False
    fraItem.Zorder
    fraItem.Visible = True
    fraList.Visible = False

End Sub

Private Sub Item_ExitToView()
    'Call LocalToForm(mCurrentOrder)
    Call Item_ViewInit
End Sub

Private Sub List_ItemUpdate()
   
    If grList.SelectedCount <> 1 Then Exit Sub
    
    If Not (CanUpdate(grList.SelectedLine(0, "Z_Creation_User"), grList.SelectedLine(0, "ST_Code"))) Then
        Call MsgBox(MsgText(1014, mLanguage_Code, "VBous n''avez pas les droits suffisants pour modifier cette donnée"))
        Exit Sub
    End If
    
    mCurrentOrder = DBToLocal(grList.SelectedKey(0)(0))
    Call LocalToForm(mCurrentOrder)
    Call Item_UpdateInit

End Sub

Private Sub Item_UpdateInit()
    
    SetMode (emUpdate)
    mFullGrid = False
    Call fraItem.Move(fraItem.Left, fraItem.Top, 12735, fraItem.Height)
    
    Call EnableFrame(UserControl.Controls, fraItem, True)
    Call EnableFrame(UserControl.Controls, fraItemUserInfo, False)
    Call EnableFrame(UserControl.Controls, fraTV, False)
   
    txt_OrderNumber.Locked = True
    txt_InfoSupplier.Locked = True
    txt_TotalPrice.Locked = True
    cbo_Status.Enabled = False
    cbo_CostCenter.Enabled = True
    cbo_PO_RaisedFor.Enabled = True

    
    txt_OrderNumber.BackColor = CL_COLOR_DISABLED
    txt_TotalPrice.BackColor = CL_COLOR_DISABLED

    tcItem.DisplayFace (TB_ITEM_UPDATE)
    
    Dim lCanUpdate As Boolean
    lCanUpdate = CanUpdate(mCurrentOrder.UserInfo.U_Code, mCurrentOrder.ST_Code)
    
    tcLines.DisplayFace (TB_LC_LINE_ADD)
    tcLines.Visible = lCanUpdate
    fraItemOrderLine.Visible = lCanUpdate
    
    lst_DAPreselect.Visible = True
    lbl_DAPreselect.Visible = True
        
    fraItem.Zorder
    fraItem.Visible = True
    fraList.Visible = False

End Sub

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


Private Sub Item_Update()
    
On Error GoTo Err_Item_Update

    If Not Item_Check Then Exit Sub
    
    Dim lOrder As TPurchaseOrder
    
    If Not FormToLocal(lOrder) Then
        mSource = mSource & "FormToLocal"
        mDesc = "Error in Update"
        Err.Raise mNumber, mSource, mDesc
    End If

    lOrder.PurchaseNumber = mCurrentOrder.PurchaseNumber
    lOrder.iConcurrency = mCurrentOrder.iConcurrency
    lOrder.Template = mCurrentOrder.Template
    lOrder.MaxPOLCode = mCurrentOrder.MaxPOLCode
    
    'for updating st_code to 'Pour approbation' when print
    lOrder.ST_Code = mCurrentOrder.ST_Code
    
    ' MAJ db
    If Not Item_DBUpdate(lOrder, mCurrentOrder.Items) Then
        Err.Raise mNumber, mSource, mDesc
    End If
    
    lOrder.UserInfo = mCurrentOrder.UserInfo
    lOrder.iConcurrency = lOrder.iConcurrency + 1
    
    ' MAJ local
    Item_LocalUpdate
    
    If mOldMode = emList Then
        Call Item_ExitToGrid
    Else
        mCurrentOrder = lOrder
        '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 aOrder As TPurchaseOrder, ByRef aOldItems() As TOrderLine) As Boolean

On Error GoTo Err_Item_DBUpdate

    Const DB_PO_REQUEST As String = "exec IV_PO_Upd $po_code$, $z_user$, $sp_code$, $spc_code$, $cp_code$, $order_date$, $delivery_date$, '$po_currency$', $st_code$, $fc_code$, '$po_sp1$', '$po_sp2$', '$po_sp3$', '$po_sp4$', '$po_sp5$', '$po_comment$', '$da_addr1$', '$da_addr2$', '$da_addr3$', '$da_addr4$', $iconcurrency$, $pt_code$, '$cc_code$', $raisedfor$"
    Const DB_POL_ADD_REQUEST As String = "exec IV_POL_Ins $po_code$, $z_user$, $pol_code$, '$pol_desc$', '$pol_ref$', $pol_unit_price$, $pol_qty$"
    Const DB_POL_DEL_REQUEST As String = "exec IV_POL_Del $po_code$, $pol_code$"
    
    Dim lRequest As String, lPOLDelRequest As Variant, lPOLAddRequest As Variant, lTranOpenned As Boolean
    lRequest = ReplaceHoldersFromLCPO(DB_PO_REQUEST, aOrder)
    
    Dim lIdx As Long, lCount As Long, lFound As Boolean
    Dim lNewIdx As Long, lNewCount As Long
    
    lNewCount = UBound(aOrder.Items)
    lCount = UBound(aOldItems)
    ReDim lPOLDelRequest(lCount)
    ReDim lPOLAddRequest(lNewCount)
    
    ' Delete unused lines
    For lIdx = 0 To lCount
        lFound = False
        For lNewIdx = 0 To lNewCount
            If aOrder.Items(lNewIdx).POL_Code = aOldItems(lIdx).POL_Code Then
                lFound = True
                Exit For
            End If
        Next
        If Not lFound Then
            ' TO DELETE !
            lPOLDelRequest(lIdx) = ReplaceHoldersFromLCPOL(DB_POL_DEL_REQUEST, aOldItems(lIdx))
            lPOLDelRequest(lIdx) = Replace(lPOLDelRequest(lIdx), "$po_code$", aOrder.PurchaseNumber, , , vbTextCompare)
        Else
            lPOLDelRequest(lIdx) = ""
        End If
    Next
    
    ' Add new lines
    Dim lNewKey As Long
    lNewKey = aOrder.MaxPOLCode + 1
    For lNewIdx = 0 To lNewCount
        If aOrder.Items(lNewIdx).POL_Code = 0 Then
            aOrder.Items(lNewIdx).POL_Code = lNewKey
            lPOLAddRequest(lNewIdx) = ReplaceHoldersFromLCPOL(DB_POL_ADD_REQUEST, aOrder.Items(lNewIdx))
            lPOLAddRequest(lNewIdx) = Replace(lPOLAddRequest(lNewIdx), "$po_code$", aOrder.PurchaseNumber, , , vbTextCompare)
            lPOLAddRequest(lNewIdx) = Replace(lPOLAddRequest(lNewIdx), "$z_user$", aOrder.UserInfo.U_Code, , , vbTextCompare)
            lNewKey = lNewKey + 1
        Else
            lPOLAddRequest(lNewIdx) = ""
        End If
    Next
    
    'BEGIN TRAN
    
    mNumber = C_ERRORRAISE + 1000
    mSource = SCREEN_NAME & "Item_DBUpdate: "
    
    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
    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 LocalToForm(mCurrentOrder)
        Call Item_ExitToView
    End If
    
End Function

Private Function CanUpdate(ByVal aU_Code As Long, ByVal aST_Code As Long) As Boolean
    If aST_Code = eStatus.esApproved Then Exit Function
    If mDb.Find(mRights, Array("U_Code_Authorized", "U_Rights"), Array(aU_Code, RIGHTS_UPD), , 1) < 0 Then Exit Function
    CanUpdate = True
End Function

Private Function CanExport(ByVal aU_Code As Long, ByVal aST_Code As Long) As Boolean
    If mDb.Find(mRights, Array("U_Code_Authorized", "U_Rights"), Array(aU_Code, RIGHTS_UPD), , 1) < 0 Then Exit Function
    CanExport = True
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
            End Select
        Set lControl = Nothing
    Next
    
    mDb.Close (lLabels)
            
End Sub

Private Function CanAdd() As Boolean
    CanAdd = mDb.Find(mRights, "U_RIGHTS", RIGHTS_UPD, , 1) >= 0
End Function

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
        End If
    Else
        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
    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 field is not entered correctly : ")
    lBuffer = Replace(lBuffer, "$field$", aCaption)
    
    AField.SetFocus
    Call MsgBox(lBuffer, vbOKOnly + vbCritical)

End Sub


Private Function Item_LocalUpdate() As Boolean
    
    Dim lPath As String
    lPath = GetCurrentPath(UserControl.Controls, fraItem, cbo_Views.SelectedItem.GetData(2))
    If FindInTreeView(tvPO, lPath) Then
       ' FOR NEXT TIME Item has been created, we can here write a network optimisation if we know what to put in the grid
        grList.Requests = ApplyTVFilters(tvPO.SelectedNodeRequest)
    Else
         grList.Requests = ApplyTVFilters(tvPO.SelectedNodeRequest)
    End If
    
    If Not grList.SearchKey(True, Array(mCurrentOrder.PurchaseNumber)) Then
        ' ERROR
    End If
    Call RefreshTCList
    Item_LocalUpdate = True
End Function


'  ONLY FOR TEST
Private Sub Command1_Click()
    Call mDb.FileToBlobSQL("UPDATE IV_PO_Zip set FC_File = ? where fc_code = 1", App.Path & "\Download\template 1.xls")
End Sub


Private Function Item_ExportToExcel()

    If Item_ForApproved(mCurrentOrder) Then
        cbo_Status.SearchItem (2)
        If InStr(1, cbo_Views.SelectedItem.GetData(2), cbo_Status.Tag, vbTextCompare) < 0 Then
            grList.SelectedLine(0, "ST_Desc") = cbo_Status.GetItemData(2, 1)  ' Get the description
            grList.SelectedLine(0, "ST_Code") = 2
            tcItem.Redraw = False
            tcItem.ButtonVisible("B") = False
            tcItem.ButtonVisible("C") = False
            tcItem.Redraw = True
        Else
            Call Item_LocalUpdate
        End If
    End If
    Call LocalToExcel(mCurrentOrder)

End Function

Private Function Item_ForApproved(ByRef aOrder As TPurchaseOrder) As Boolean

    If aOrder.ST_Code = eStatus.esApproved Then Exit Function
    aOrder.ST_Code = eStatus.esApproved
    If Item_UpdStatus(aOrder) Then
        aOrder.iConcurrency = aOrder.iConcurrency + 1
    End If
    Item_ForApproved = True

End Function


Private Function Item_UpdStatus(ByRef aOrder As TPurchaseOrder) As Boolean

    Const DB_UPD_STATUS = "IV_PO_Upd_Status $po_code$, $z_user$, $iconcurrency$, $st_code$"
    Const DB_SEL_LASTUPD = "exec IV_PO_Sel_LastUpd $po_code$"

    Dim lRequest As String
    lRequest = ReplaceHoldersFromLCPO(DB_UPD_STATUS, aOrder)
    If Not mDb.ExecuteSQL(lRequest) Then
        'TODO : error
        Exit Function
    End If
    
    Dim ll_curs As Long
    lRequest = ReplaceHoldersFromLCPO(DB_SEL_LASTUPD, aOrder)
    ll_curs = mDb.OpenSQL(lRequest)
    If mDb.RowCount(ll_curs) = 0 Then
        mDb.Close (ll_curs)
        Exit Function
    End If
    aOrder.LastUpdate_Date = mDb.GetFields(ll_curs, "Z_Last_Upd")
    mDb.Close (ll_curs)
    
    Item_UpdStatus = 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

Private Sub cbo_PO_RaisedFor_ComboItemSelected()
    If mEventFrozen Then Exit Sub
    
    If Not cbo_CostCenter.SearchItem(cbo_PO_RaisedFor.SelectedItem.GetData(2), 0, , True) Then
        ' The combo is not loaded, we have to had the item manually
        Call cbo_CostCenter.AddItem(Array(cbo_PO_RaisedFor.SelectedItem.GetData(2), cbo_PO_RaisedFor.SelectedItem.GetData(3) & " - " & cbo_PO_RaisedFor.SelectedItem.GetData(2)), True)
    End If
    
End Sub

