VERSION 5.00
Begin VB.Form Colour_mtnc 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   6660
   ClientLeft      =   285
   ClientTop       =   390
   ClientWidth     =   9045
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   6660
   ScaleWidth      =   9045
   ShowInTaskbar   =   0   'False
   Begin VB.Frame Frm_Bas 
      Height          =   972
      Left            =   0
      TabIndex        =   26
      Top             =   5640
      Width           =   9012
      Begin VB.CommandButton spp_save 
         Default         =   -1  'True
         Height          =   612
         Left            =   7560
         Style           =   1  'Graphical
         TabIndex        =   7
         Top             =   240
         Width           =   612
      End
      Begin VB.CommandButton ssp_quit 
         Height          =   612
         Left            =   8280
         Style           =   1  'Graphical
         TabIndex        =   8
         Top             =   240
         Width           =   612
      End
      Begin VB.CommandButton spp_media 
         Height          =   612
         Left            =   6660
         Style           =   1  'Graphical
         TabIndex        =   29
         Top             =   240
         Visible         =   0   'False
         Width           =   612
      End
      Begin VB.CommandButton SSC_dropped 
         Height          =   276
         Left            =   3000
         Style           =   1  'Graphical
         TabIndex        =   6
         Top             =   540
         Width           =   252
      End
      Begin VB.TextBox txt_dropped 
         ForeColor       =   &H00FF0000&
         Height          =   288
         Left            =   1800
         TabIndex        =   5
         Top             =   540
         Width           =   1212
      End
      Begin VB.CheckBox chk_Int 
         Caption         =   "Check1"
         Height          =   252
         Left            =   1800
         TabIndex        =   4
         Top             =   240
         Width           =   252
      End
      Begin VB.Label lbl_Int 
         Caption         =   "Internet flag"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   252
         Left            =   120
         TabIndex        =   28
         Top             =   240
         Width           =   1452
      End
      Begin VB.Label lbl_Drop 
         Caption         =   "Drop date"
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   252
         Left            =   120
         TabIndex        =   27
         Top             =   540
         Width           =   1452
      End
   End
   Begin VB.Frame frm_Vdv 
      Height          =   3732
      Left            =   0
      TabIndex        =   18
      Top             =   1920
      Width           =   9012
      Begin VB.PictureBox pic_Out 
         AutoSize        =   -1  'True
         Height          =   408
         Left            =   4260
         ScaleHeight     =   345
         ScaleWidth      =   345
         TabIndex        =   22
         TabStop         =   0   'False
         Top             =   2340
         Width           =   408
      End
      Begin VB.PictureBox pic_In 
         AutoSize        =   -1  'True
         Height          =   408
         Left            =   4260
         ScaleHeight     =   345
         ScaleWidth      =   345
         TabIndex        =   21
         TabStop         =   0   'False
         Top             =   1620
         Width           =   408
      End
      Begin VB.ListBox lst_ToDelete 
         Height          =   645
         Left            =   3780
         Sorted          =   -1  'True
         TabIndex        =   20
         Top             =   2820
         Visible         =   0   'False
         Width           =   1524
      End
      Begin VB.ListBox lst_ToInsert 
         Height          =   645
         Left            =   3720
         Sorted          =   -1  'True
         TabIndex        =   19
         Top             =   480
         Visible         =   0   'False
         Width           =   1524
      End
      Begin VB.ListBox lst_Selected 
         Appearance      =   0  'Flat
         Height          =   2565
         ItemData        =   "COLOR.frx":0000
         Left            =   4860
         List            =   "COLOR.frx":0007
         TabIndex        =   30
         Top             =   840
         Width           =   4095
      End
      Begin VB.ListBox lst_NotSelected 
         Appearance      =   0  'Flat
         Height          =   2565
         ItemData        =   "COLOR.frx":0019
         Left            =   120
         List            =   "COLOR.frx":0020
         TabIndex        =   31
         Top             =   840
         Width           =   4095
      End
      Begin VB.Label lbl_Selected 
         Alignment       =   2  'Center
         Caption         =   "Selected"
         Height          =   252
         Left            =   4560
         TabIndex        =   25
         Top             =   360
         Width           =   3012
      End
      Begin VB.Label lbl_Recommended 
         Alignment       =   2  'Center
         Height          =   252
         Left            =   420
         TabIndex        =   24
         Top             =   120
         Width           =   8172
      End
      Begin VB.Label lbl_NotSelected 
         Alignment       =   2  'Center
         Caption         =   "Not selected"
         Height          =   252
         Left            =   360
         TabIndex        =   23
         Top             =   360
         Width           =   3012
      End
   End
   Begin VB.TextBox txt_Std1 
      Height          =   285
      Left            =   180
      MaxLength       =   15
      TabIndex        =   1
      Top             =   1500
      Visible         =   0   'False
      Width           =   1455
   End
   Begin VB.TextBox txt_Desc 
      Height          =   285
      Left            =   180
      MaxLength       =   40
      TabIndex        =   0
      Top             =   840
      Width           =   4575
   End
   Begin VB.TextBox txt_Std2 
      Height          =   285
      Left            =   1860
      MaxLength       =   15
      TabIndex        =   2
      Top             =   1500
      Visible         =   0   'False
      Width           =   1455
   End
   Begin VB.TextBox txt_Std3 
      Height          =   285
      Left            =   3540
      MaxLength       =   15
      TabIndex        =   3
      Top             =   1500
      Visible         =   0   'False
      Width           =   1455
   End
   Begin VB.TextBox txt_Std4 
      Height          =   285
      Left            =   180
      MaxLength       =   15
      TabIndex        =   9
      Top             =   2160
      Visible         =   0   'False
      Width           =   1455
   End
   Begin VB.TextBox txt_Std5 
      Height          =   285
      Left            =   1860
      MaxLength       =   15
      TabIndex        =   10
      Top             =   2160
      Visible         =   0   'False
      Width           =   1455
   End
   Begin VB.Label lbl_Desc 
      Alignment       =   2  'Center
      Caption         =   "Description"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   180
      TabIndex        =   17
      Top             =   540
      Width           =   4572
   End
   Begin VB.Label lbl_Std1 
      Alignment       =   2  'Center
      Caption         =   "Standard1"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   180
      TabIndex        =   16
      Top             =   1200
      Visible         =   0   'False
      Width           =   1452
   End
   Begin VB.Label lbl_Std2 
      Alignment       =   2  'Center
      Caption         =   "Standard2"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   1860
      TabIndex        =   15
      Top             =   1200
      Visible         =   0   'False
      Width           =   1452
   End
   Begin VB.Label lbl_Std3 
      Alignment       =   2  'Center
      Caption         =   "Standard3"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   3540
      TabIndex        =   14
      Top             =   1200
      Visible         =   0   'False
      Width           =   1452
   End
   Begin VB.Label lbl_Std4 
      Alignment       =   2  'Center
      Caption         =   "Standard4"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   180
      TabIndex        =   13
      Top             =   1860
      Visible         =   0   'False
      Width           =   1452
   End
   Begin VB.Label lbl_Std5 
      Alignment       =   2  'Center
      Caption         =   "Standard5"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   1860
      TabIndex        =   12
      Top             =   1860
      Visible         =   0   'False
      Width           =   1452
   End
   Begin VB.Label lbl_Category 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   120
      TabIndex        =   11
      Top             =   120
      Width           =   4932
   End
End
Attribute VB_Name = "Colour_mtnc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const NB_STD = 2
Dim ms_Code As String

Dim ms_OldMediaCode As String
Dim mi_OldMediaIc As Integer
Private Function MediaCodeExist(ByVal as_desc As String) As String
Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer

On Error GoTo suite

ms_OldMediaCode = ""
mi_OldMediaIc = 0

ls_Req = "EXEC Int_Media_Ass_dtl '" & as_desc & ", 'E'"

If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
    li_Status = SQL_SUCCESS
Else
    li_Status = SQL_ERROR
End If
Do While li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO
    li_Status = SQLFetch(ll_Statement)
    If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
        ms_OldMediaCode = ODBCData(ll_Statement, 1)
        mi_OldMediaIc = CInt(ODBCData(ll_Statement, 2))
    End If
Loop
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)

Exit Function
suite:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError
End Function



Private Function GetDescSelected() As String
Dim li_Lenght As Integer
Dim li_Pos As Integer
Dim ls_HBMdesc As String
Dim ls_CGdesc As String
Dim ls_CCdesc As String
Dim ls_CLdesc As String
Dim ls_VATdesc As String
Dim ls_RestList As String

ls_RestList = lst_Selected
li_Lenght = Len(ls_RestList)
li_Pos = InStr(1, ls_RestList, "/")
ls_CGdesc = Mid(ls_RestList, 1, li_Pos - 1)
ls_RestList = Mid(ls_RestList, li_Pos + 1, li_Lenght - li_Pos)
li_Lenght = Len(ls_RestList)
li_Pos = InStr(1, ls_RestList, "/")
ls_HBMdesc = Mid(ls_RestList, 1, li_Pos - 1)
ls_RestList = Mid(ls_RestList, li_Pos + 1, li_Lenght - li_Pos)
li_Lenght = Len(ls_RestList)
li_Pos = InStr(1, ls_RestList, "/")
ls_CCdesc = Mid(ls_RestList, 1, li_Pos - 1)
ls_RestList = Mid(ls_RestList, li_Pos + 1, li_Lenght - li_Pos)
li_Lenght = Len(ls_RestList)
li_Pos = InStr(1, ls_RestList, "/")
ls_CLdesc = Mid(ls_RestList, 1, li_Pos - 1)
ls_VATdesc = Mid(ls_RestList, li_Pos + 1, li_Lenght - li_Pos)

GetDescSelected = QuoteParam(ls_HBMdesc) & "', '" _
    & QuoteParam(ls_CCdesc) & "', '" _
    & QuoteParam(ls_CLdesc) & "', '" _
    & QuoteParam(ls_VATdesc) & "', " _
    & CInt(right(gs_TableCode, 3))

End Function


Private Sub pic_In_Click()

MouseOff
If lst_NotSelected.ListIndex <> -1 Then
    If Not RemoveItemLst(lst_ToDelete, lst_NotSelected.Text) Then
        lst_ToInsert.AddItem lst_NotSelected.Text
    End If
    lst_Selected.AddItem lst_NotSelected
    lst_NotSelected.RemoveItem lst_NotSelected.ListIndex
End If
MouseOn

End Sub

Private Sub pic_Out_Click()

MouseOff
If lst_Selected.ListIndex <> -1 Then
    If Not RemoveItemLst(lst_ToInsert, lst_Selected.Text) Then
        lst_ToDelete.AddItem lst_Selected.Text
    End If
    lst_NotSelected.AddItem lst_Selected
    lst_Selected.RemoveItem lst_Selected.ListIndex
End If
MouseOn

End Sub



Private Sub Form_Load()

Dim ls_Req As String

MouseOff

If gl_CodePage <> 1252 And gl_CodePage <> 0 Then ChangeCharset Me

' the pictures for the buttons
spp_save.Picture = LoadResPicture(RES_OK, 1)
ssp_quit.Picture = LoadResPicture(RES_QUIT, 1)
SSC_dropped.Picture = LoadResPicture(RES_DOWN2, vbResIcon)

' clear content of listbox
Call lst_NotSelected.Clear
Call lst_Selected.Clear

' the pictures for the arrows
pic_In.Picture = LoadResPicture(RES_RIGHT, 1)
pic_Out.Picture = LoadResPicture(RES_LEFT, 1)
GetConstants
If NB_STD > 0 Then
    lbl_Std1.Visible = OK
    txt_Std1.Visible = OK
    If NB_STD > 1 Then
        lbl_Std2.Visible = OK
        txt_Std2.Visible = OK
        If NB_STD > 2 Then
            lbl_Std3.Visible = OK
            txt_Std3.Visible = OK
            If NB_STD > 3 Then
                lbl_Std4.Visible = OK
                txt_Std4.Visible = OK
                If NB_STD > 4 Then
                    lbl_Std5.Visible = OK
                    txt_Std5.Visible = OK
                End If
            End If
        End If
    End If
End If
If gs_Action = "Add" Then
    ls_Req = "EXEC " & gut_Param.Str1 & "_Link_cbo " _
        & " 0, 0, '" & gut_LangWork.Code & "'"
    FillLstSingle ls_Req, lst_NotSelected
Else
    txt_Desc = gs_TableCode2
    txt_Std1 = gs_TableCode3
    txt_Std2 = gs_TableCode4
    txt_Std3 = gs_TableCode5
    txt_Std4 = gs_TableCode6
    txt_Std5 = gs_TableCode7
    ls_Req = "EXEC " & gut_Param.Str1 & "_Link_cbo " _
        & right(gs_TableCode, 3) & ", 0, '" & gut_LangWork.Code & "'"
    FillLstSingle ls_Req, lst_NotSelected
    ls_Req = "EXEC " & gut_Param.Str1 & "_Link_cbo2 " _
        & right(gs_TableCode, 3) & ", 0, '" & gut_LangWork.Code & "'"
    FillLstSingle ls_Req, lst_Selected
    If gs_TableCode9 = "X" Then
        chk_Int.value = 1
    End If
    txt_dropped = gs_TableCode10
    spp_media.Picture = LoadResPicture(RES_MEDIA, 1)
    spp_media.Visible = OK
    If gs_Action <> "Update" Then
        pic_In.Visible = KO
        pic_Out.Visible = KO
        txt_Desc.Enabled = KO
        txt_Std1.Enabled = KO
        txt_Std2.Enabled = KO
        txt_Std3.Enabled = KO
        txt_Std4.Enabled = KO
        txt_Std5.Enabled = KO
        chk_Int.Enabled = KO
        txt_dropped.Enabled = KO
        SSC_dropped.Visible = KO
        If gs_Action = "MoreInfo" Then
            spp_save.Visible = KO
        End If
    End If
End If
MouseOn
Exit Sub

suite:
StdError
End Sub

Private Sub spp_media_Click()
Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ls_Desc As String
Dim lb_insert As Boolean

MouseOff
If lst_Selected.ListIndex <> -1 Then
    ls_Desc = GetDescSelected
    gut_Param2.Str1 = "Maintenance"
    gut_Param2.Str2 = "EXEC Media_Product_Classif_cnt "
    gut_Param2.Str2 = gut_Param2.Str2 & "'" & gs_CGCode & "', '', '', '', '', '', '', '', '', '" & gs_TableCode & "'"
    gut_Param2.Str3 = "EXEC Media_t_lst '" & gut_LangWork.Code & "', "
    gut_Param2.Str3 = gut_Param2.Str3 & "'" & gs_CGCode & "', '', '', '', '', '', '', '', '', '" & gs_TableCode & "'"
    gut_Param2.Str4 = gs_GridColumn(1)
    gut_Param2.Str5 = gs_TableCode2

    MediaCodeExist ls_Desc

    gs_MediaCode = ms_OldMediaCode
    
    C_media.ms_Desc = ls_Desc
    C_media.mi_OldMediaIc = mi_OldMediaIc
    
    C_media.show 1

    If gs_MediaCode <> "" And gs_MediaCode <> ms_OldMediaCode Then
        If ms_OldMediaCode = "" Then
            ls_Req = "EXEC Int_Media_Ass_ins '" & ls_Desc & ", '" & gs_MediaCode & "', 'E'"
            lb_insert = OK
        Else
            ls_Req = "EXEC Int_Media_Ass_upd '" & ls_Desc & ", '" & gs_MediaCode & "', 'E', " & mi_OldMediaIc
            lb_insert = KO
        End If

        If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
           ' Ok
        Else
            If lb_insert Then
                    SendMessage 4, "Insert Failed: an another user have changed the information.", gut_LangLogin.Code
                Else
                    SendMessage 2, "Update Failed: an another user have changed the information.", gut_LangLogin.Code
            End If
        End If
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    End If
Else
    MsgBox "Select a Line !!"
End If
MouseOn

End Sub

Private Sub spp_save_Click()

Dim ls_Line As String
Dim ls_IntFlag As String
Dim ls_Req As String

On Error GoTo suite

MouseOff
gb_Return = OK
Select Case gs_Action
Case "Add"
    If Control Then
        If BeginTran(gl_Environment, gl_Database) Then
            If AddRow Then
                If AddLink Then
                    If CommitTran(gl_Environment, gl_Database) Then
                    ' add the line in Cmain
                        If chk_Int.value = 1 Then
                            ls_IntFlag = "X"
                        End If
                        ls_Line = ms_Code & Chr(9) & txt_Desc & Chr(9) & txt_Std1 & Chr(9) & txt_Std2 & Chr(9) & txt_Std3 & Chr(9) & txt_Std4 & Chr(9) & txt_Std5 & Chr(9) & 1 & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped
                        C_main.Grid.AddItem ls_Line
                        C_main.Grid.Row = C_main.Grid.Rows - 1
                        ' reinit fields for an another entry
                        txt_Desc = ""
                        txt_Std1 = ""
                        txt_Std2 = ""
                        txt_Std3 = ""
                        txt_Std4 = ""
                        txt_Std5 = ""
                        txt_dropped = ""
                        chk_Int.value = 0
                        lst_NotSelected.Clear
                        lst_Selected.Clear
                        ls_Req = "EXEC Value_Link_cbo " & " 0, 14, 17, 0, '" & gut_LangWork.Code & "'"
                        FillLstSingle ls_Req, lst_NotSelected
                        txt_Desc.SetFocus
                        If gl_NbLineDisplay <= 2 Then
                            C_main.FillGrid
                        End If
                    Else ' commit trans
                        RollbackTran gl_Environment, gl_Database
                        SendMessage 4, "Insert failed", gut_LangLogin.Code
                     End If
                Else ' AddLink
                    RollbackTran gl_Environment, gl_Database
                    SendMessage 4, "Insert failed", gut_LangLogin.Code
                 End If
            Else ' AddRow
                RollbackTran gl_Environment, gl_Database
                SendMessage 4, "Insert failed", gut_LangLogin.Code
            End If
        Else ' BeginTrans
            SendMessage 4, "Insert failed", gut_LangLogin.Code
        End If
    End If ' control
Case "Update"
    If Control Then
        If BeginTran(gl_Environment, gl_Database) Then
            If UpdateRow Then
                If DeleteLink Then
                    If AddLink Then
                        If CommitTran(gl_Environment, gl_Database) Then
                            ' update the line in Cmain
                            If chk_Int.value = 1 Then
                                ls_IntFlag = "X"
                            End If
                            C_main.Grid.RemoveItem C_main.Grid.Row
                            ls_Line = gs_TableCode & Chr(9) & txt_Desc & Chr(9) & txt_Std1 & Chr(9) & txt_Std2 & Chr(9) & txt_Std3 & Chr(9) & txt_Std4 & Chr(9) & txt_Std5 & Chr(9) & CInt(gs_TableCode8) + 1 & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped
                            C_main.Grid.AddItem ls_Line, C_main.Grid.Row
                            If gs_TableName = "Colours" Then gs_TableCode = txt_Desc
                            Unload Me
                        Else ' CommitTran
                            RollbackTran gl_Environment, gl_Database
                            SendMessage 3, "Update failed", gut_LangLogin.Code
                        End If
                    Else ' AddTable
                        RollbackTran gl_Environment, gl_Database
                        SendMessage 3, "Update failed", gut_LangLogin.Code
                    End If
                Else ' DeleteLink
                    RollbackTran gl_Environment, gl_Database
                    SendMessage 3, "Update failed", gut_LangLogin.Code
                End If
            Else ' UpdateRow
                RollbackTran gl_Environment, gl_Database
                SendMessage 3, "Update failed", gut_LangLogin.Code
            End If
        Else ' BeginTran
            SendMessage 3, "Update failed", gut_LangLogin.Code
        End If
    End If ' Control
Case "Delete"
    If SendMessage(5, "Delete record ?", gut_LangLogin.Code, vbQuestion + vbYesNo, "Delete ") = vbYes Then
        If DeleteRow Then
            C_main.Grid.RemoveItem C_main.Grid.Row
        Else
            SendMessage 6, "Delete failed", gut_LangLogin.Code
        End If
    End If
    Unload Me
End Select
MouseOn
Exit Sub

suite:
Select Case Err
Case 30015
    C_main.FillGrid
Case Else
    StdError
End Select
MouseOn
End Sub
Private Sub SSC_dropped_Click()

On Error GoTo suite

MouseOff
gb_Return = KO
gs_Date = txt_dropped
Dates.show 1
If gb_Return Then
    txt_dropped = gs_Date
End If
MouseOn

Exit Sub

suite:
StdError
End Sub

Private Sub ssp_quit_Click()

MouseOff
Unload Me

End Sub
Private Function UpdateRow() As Boolean

Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_lngrows As Long
Dim ls_Line As String
Dim ls_IntFlag As String
Dim ls_DropFlag As String
Dim ls_DropDate As String

UpdateRow = KO

On Error GoTo suite

If chk_Int.value = 1 Then ls_IntFlag = "X"
If txt_dropped <> "" Then
    ls_DropFlag = "X"
    ls_DropDate = FormatD(txt_dropped, "mm/dd/yyyy")
End If
ls_Req = "EXEC Colours_upd '" _
    & QuoteParam(gs_TableCode) & "','" & QuoteParam(txt_Desc) & "','" _
    & QuoteParam(gs_CGCode) & "','" & QuoteParam(txt_Std1) & "','" _
    & QuoteParam(txt_Std2) & "','" & QuoteParam(txt_Std3) & "','" _
    & QuoteParam(txt_Std4) & "','" & QuoteParam(txt_Std5) & "'," _
    & gs_TableCode8 & ",'" _
    & ls_IntFlag & "','" _
    & ls_DropFlag & "','" _
    & ls_DropDate & "'"
If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
    li_Status = SQLRowCount(ll_Statement, ll_lngrows)
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    If ll_lngrows = 0 Then
        SendMessage 2, "Another user change the record", gut_LangLogin.Code
        C_main.FillGrid
    Else
        ms_Code = gs_TableCode
        UpdateRow = OK
    End If
Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    SendMessage 3, "Update failed", gut_LangLogin.Code
End If
Exit Function

suite:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError
End Function
Private Function AddLink() As Boolean

Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_lngrows As Long
Dim i  As Integer
Dim li_Lenght As Integer
Dim li_Pos As Integer
Dim ls_HBMdesc As String
Dim ls_CGdesc As String
Dim ls_CCdesc As String
Dim ls_CLdesc As String
Dim ls_VATdesc As String
Dim ls_RestList As String

AddLink = KO

On Error GoTo suite

For i = 0 To lst_ToInsert.ListCount - 1
    ls_RestList = lst_ToInsert.List(i)
    li_Lenght = Len(ls_RestList)
    li_Pos = InStr(1, ls_RestList, "/")
    ls_CGdesc = Mid(ls_RestList, 1, li_Pos - 1)
    ls_RestList = Mid(ls_RestList, li_Pos + 1, li_Lenght - li_Pos)
    li_Lenght = Len(ls_RestList)
    li_Pos = InStr(1, ls_RestList, "/")
    ls_HBMdesc = Mid(ls_RestList, 1, li_Pos - 1)
    ls_RestList = Mid(ls_RestList, li_Pos + 1, li_Lenght - li_Pos)
    li_Lenght = Len(ls_RestList)
    li_Pos = InStr(1, ls_RestList, "/")
    ls_CCdesc = Mid(ls_RestList, 1, li_Pos - 1)
    ls_RestList = Mid(ls_RestList, li_Pos + 1, li_Lenght - li_Pos)
    li_Lenght = Len(ls_RestList)
    li_Pos = InStr(1, ls_RestList, "/")
    ls_CLdesc = Mid(ls_RestList, 1, li_Pos - 1)
    ls_VATdesc = Mid(ls_RestList, li_Pos + 1, li_Lenght - li_Pos)
    ls_Req = "EXEC " & gut_Param.Str1 & "_Link_ins " _
        & " 0, " & right(ms_Code, 3) & ", '" _
        & gut_LangWork.Code & "', '" _
        & QuoteParam(ls_HBMdesc) & "', '" _
        & QuoteParam(ls_CGdesc) & "', '" _
        & QuoteParam(ls_CCdesc) & "', '" _
        & QuoteParam(ls_CLdesc) & "', '" _
        & QuoteParam(ls_VATdesc) & "'"
    If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
        li_Status = SQLRowCount(ll_Statement, ll_lngrows)
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        If ll_lngrows = 0 Then
            Exit Function
        End If
    Else
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        Exit Function
    End If
Next i
AddLink = OK
Exit Function

suite:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError
End Function
Private Function AddRow() As Boolean

Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_lngrows As Long
Dim ls_IntFlag As String
Dim ls_DropFlag As String
Dim ls_DropDate As String

AddRow = KO

On Error GoTo suite

If chk_Int.value = 1 Then ls_IntFlag = "X"
If txt_dropped <> "" Then
    ls_DropFlag = "X"
    ls_DropDate = FormatD(txt_dropped, "mm/dd/yyyy")
End If
ls_Req = "EXEC Colours_ins '" & QuoteParam(txt_Desc) & "','" _
      & gs_CGCode & "','" _
      & QuoteParam(txt_Std1) & "','" _
      & QuoteParam(txt_Std2) & "','" _
      & QuoteParam(txt_Std3) & "','" _
      & QuoteParam(txt_Std4) & "','" _
      & QuoteParam(txt_Std5) & "','" _
      & ls_IntFlag & "','" _
      & ls_DropFlag & "','" _
      & ls_DropDate & "'"
If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
    li_Status = SQLRowCount(ll_Statement, ll_lngrows)
    If ll_lngrows = 0 Then
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        SendMessage 4, "Insert failed", gut_LangLogin.Code
        C_main.FillGrid
    Else
        li_Status = SQLFetch(ll_Statement)
        If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
            ms_Code = ODBCData(ll_Statement, 1)
            AddRow = OK
        End If
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    End If
Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    SendMessage 4, "Insert failed", gut_LangLogin.Code
End If
Exit Function

suite:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError
End Function
Private Function DeleteLink() As Boolean

Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_lngrows As Long
Dim i  As Integer
Dim li_Lenght As Integer
Dim li_Pos As Integer
Dim ls_HBMdesc As String
Dim ls_CGdesc As String
Dim ls_CCdesc As String
Dim ls_CLdesc As String
Dim ls_VATdesc As String
Dim ls_RestList As String

DeleteLink = KO

On Error GoTo suite

For i = 0 To lst_ToDelete.ListCount - 1
    ls_RestList = lst_ToDelete.List(i)
    li_Lenght = Len(ls_RestList)
    li_Pos = InStr(1, ls_RestList, "/")
    ls_CGdesc = Mid(ls_RestList, 1, li_Pos - 1)
    ls_RestList = Mid(ls_RestList, li_Pos + 1, li_Lenght - li_Pos)
    li_Lenght = Len(ls_RestList)
    li_Pos = InStr(1, ls_RestList, "/")
    ls_HBMdesc = Mid(ls_RestList, 1, li_Pos - 1)
    ls_RestList = Mid(ls_RestList, li_Pos + 1, li_Lenght - li_Pos)
    li_Lenght = Len(ls_RestList)
    li_Pos = InStr(1, ls_RestList, "/")
    ls_CCdesc = Mid(ls_RestList, 1, li_Pos - 1)
    ls_RestList = Mid(ls_RestList, li_Pos + 1, li_Lenght - li_Pos)
    li_Lenght = Len(ls_RestList)
    li_Pos = InStr(1, ls_RestList, "/")
    ls_CLdesc = Mid(ls_RestList, 1, li_Pos - 1)
    ls_VATdesc = Mid(ls_RestList, li_Pos + 1, li_Lenght - li_Pos)
    ls_Req = "EXEC " & gut_Param.Str1 & "_Link_del " _
        & " 0, " & right(ms_Code, 3) & ", '" _
        & gut_LangWork.Code & "', '" _
        & QuoteParam(ls_HBMdesc) & "', '" _
        & QuoteParam(ls_CGdesc) & "', '" _
        & QuoteParam(ls_CCdesc) & "', '" _
        & QuoteParam(ls_CLdesc) & "', '" _
        & QuoteParam(ls_VATdesc) & "'"
    If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
        li_Status = SQLRowCount(ll_Statement, ll_lngrows)
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        If ll_lngrows = 0 Then
            Exit Function
        End If
    Else
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        Exit Function
    End If
Next i
DeleteLink = OK
Exit Function

suite:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError
End Function
Private Function DeleteRow() As Boolean

Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_lngrows As Long

DeleteRow = KO

On Error GoTo suite

ls_Req = "EXEC Colours_del '" _
  & QuoteParam(gs_TableCode) & "', " _
  & gs_TableCode8
If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
    li_Status = SQLRowCount(ll_Statement, ll_lngrows)
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    If ll_lngrows = 0 Then
        SendMessage 7, "Delete failed : concurrency problem ?", gut_LangLogin.Code
        C_main.FillGrid
    Else
        DeleteRow = OK
    End If
Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    SendMessage 6, "Delete failed", gut_LangLogin.Code
End If
Exit Function

suite:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError
End Function
Private Sub GetConstants()

Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ls_Field As String, ls_Text As String

On Error GoTo suite

ls_Req = "EXEC Screen_Csts mtnc_Colours, '" & gut_LangLogin.Code & "'"

If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
    li_Status = SQL_SUCCESS
Else
    li_Status = SQL_ERROR
End If
Do While li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO
    li_Status = SQLFetch(ll_Statement)
    If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
        ls_Field = ODBCData(ll_Statement, 1)
        ls_Text = left(ODBCData(ll_Statement, 2), 30)
        Select Case ls_Field
            Case "title": Caption = ls_Text
            Case "titleA": If gs_Action = "Add" Then Caption = Caption & " - " & ls_Text
            Case "titleU": If gs_Action = "Update" Then Caption = Caption & " - " & ls_Text
            Case "titleD": If gs_Action = "Delete" Then Caption = Caption & " - " & ls_Text
            Case "lbl_Category": lbl_Category = ls_Text
            Case "lbl_Desc": lbl_Desc = ls_Text
            Case "lbl_Std1": lbl_Std1 = ls_Text
            Case "lbl_Std2": lbl_Std2 = ls_Text
            Case "lbl_Std3": lbl_Std3 = ls_Text
            Case "lbl_Std4": lbl_Std4 = ls_Text
            Case "lbl_Std5": lbl_Std5 = ls_Text
            Case "lbl_int": lbl_Int = ls_Text
            Case "lbl_drop": lbl_Drop = ls_Text
            Case "lbl_inout": lbl_Recommended = ls_Text
        End Select
    End If
Loop
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
lbl_Category = lbl_Category & " " & gs_MenuChoice

Exit Sub

suite:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError
End Sub

Private Function Control() As Boolean

Control = KO
If txt_Desc.Text = "" Then
    txt_Desc.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
Control = OK

End Function
