VERSION 5.00
Begin VB.Form C_categdesc_mtnc 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   2670
   ClientLeft      =   1695
   ClientTop       =   2340
   ClientWidth     =   5730
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   2670
   ScaleWidth      =   5730
   ShowInTaskbar   =   0   'False
   Begin VB.TextBox txt_SortOrder 
      Height          =   288
      Left            =   3240
      MaxLength       =   4
      TabIndex        =   16
      Top             =   1500
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.CommandButton spp_save 
      Default         =   -1  'True
      Height          =   612
      Left            =   4260
      Style           =   1  'Graphical
      TabIndex        =   9
      Top             =   1920
      Width           =   612
   End
   Begin VB.CommandButton SSC_dropped 
      Height          =   276
      Left            =   2880
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   1860
      Width           =   252
   End
   Begin VB.CommandButton ssp_quit 
      Height          =   612
      Left            =   4920
      Style           =   1  'Graphical
      TabIndex        =   8
      Top             =   1920
      Width           =   612
   End
   Begin VB.ComboBox Cbo_IntGroupeCode 
      Height          =   315
      Left            =   3120
      TabIndex        =   14
      Text            =   "Combo1"
      Top             =   2280
      Visible         =   0   'False
      Width           =   390
   End
   Begin VB.ComboBox Cbo_IntGroup 
      Height          =   315
      Left            =   1680
      Style           =   2  'Dropdown List
      TabIndex        =   13
      Top             =   2280
      Visible         =   0   'False
      Width           =   2415
   End
   Begin VB.TextBox Txt_InternetName 
      Height          =   285
      Left            =   1680
      TabIndex        =   10
      Top             =   600
      Visible         =   0   'False
      Width           =   3855
   End
   Begin VB.TextBox txt_Descr 
      Height          =   288
      Left            =   1680
      MaxLength       =   80
      TabIndex        =   0
      Top             =   1020
      Width           =   3852
   End
   Begin VB.TextBox txt_dropped 
      ForeColor       =   &H00FF0000&
      Height          =   288
      Left            =   1680
      Locked          =   -1  'True
      TabIndex        =   2
      Top             =   1860
      Width           =   1212
   End
   Begin VB.CheckBox chk_Int 
      Height          =   252
      Left            =   1680
      TabIndex        =   1
      Top             =   1500
      Width           =   252
   End
   Begin VB.Label lbl_SortOrder 
      Caption         =   "Sort order"
      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            =   2200
      TabIndex        =   15
      Top             =   1500
      Visible         =   0   'False
      Width           =   975
   End
   Begin VB.Label Lbl_InternetGroup 
      Caption         =   "Internet Group"
      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            =   120
      TabIndex        =   12
      Top             =   2280
      Visible         =   0   'False
      Width           =   1455
   End
   Begin VB.Label Lbl_InternetName 
      Caption         =   "Internet name"
      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            =   120
      TabIndex        =   11
      Top             =   600
      Visible         =   0   'False
      Width           =   1455
   End
   Begin VB.Label lbl_Descr 
      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            =   120
      TabIndex        =   7
      Top             =   1020
      Width           =   1392
   End
   Begin VB.Label lbl_Category 
      Caption         =   "For 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          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   240
      Width           =   5400
   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        =   5
      Top             =   1500
      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        =   4
      Top             =   1860
      Width           =   1452
   End
End
Attribute VB_Name = "C_categdesc_mtnc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'what is new
'2.7.1 Product height controled to 4 figures and 2 decimals (JN)

Private Sub Form_Load()

On Error GoTo suite

MouseOff

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

spp_save.Picture = LoadResPicture(RES_OK, 1)
ssp_quit.Picture = LoadResPicture(RES_QUIT, 1)
SSC_dropped.Picture = LoadResPicture(RES_DOWN2, vbResIcon)

GetConstants
Select Case gs_TableName
Case "Products_Families"
    If gs_MenuChoice = "Ceilings" Then
        Txt_InternetName.Visible = OK
        Lbl_InternetName.Visible = OK
        txt_Descr.Top = 600
        lbl_Descr.Top = 600
        Txt_InternetName.Top = 1020
        Lbl_InternetName.Top = 1020
        Lbl_InternetGroup.Top = 1400
        Lbl_InternetGroup.Visible = OK
        Cbo_IntGroup.Top = 1400
        Cbo_IntGroup.Visible = OK
        lbl_Int.Top = 1860
        chk_Int.Top = 1860
        lbl_Drop.Top = 2200
        txt_dropped.Top = 2200
        SSC_dropped.Top = 2200
    End If
'P593
        lbl_SortOrder.Top = lbl_Int.Top
        txt_SortOrder.Top = lbl_Int.Top
        lbl_SortOrder.Left = lbl_Int.Left + 2200
        lbl_SortOrder.Visible = True
        txt_SortOrder.Visible = True
        txt_SortOrder.Enabled = True
Case "Perforation_Shape", "Component_Type", "Form"
        lbl_SortOrder.Top = lbl_Int.Top
        txt_SortOrder.Top = lbl_Int.Top
        lbl_SortOrder.Left = lbl_Int.Left + 2200
        lbl_SortOrder.Visible = True
        txt_SortOrder.Visible = True
        txt_SortOrder.Enabled = True
Case "Product_Height"
    txt_Descr.MaxLength = 7             ' JN 21.06.2013 Change width of field to accept 9999.99
Case "Estimate_Slot"
    txt_Descr.MaxLength = 30
Case "Estimate_Length"
    txt_Descr.MaxLength = 30
Case "DGrid_MainRunner"
    lbl_Category.Visible = KO
Case "DGrid_CrossTee"
    lbl_Category.Visible = KO
Case "DGrid_Interface"
    lbl_Category.Visible = KO
Case "DGrid_Group"
    lbl_Category.Visible = KO
Case "Ceiling_InternetGroup"
    lbl_Category.Visible = KO
End Select


If gs_Action <> "Add" Then
    If gs_TableName = "Product_Height" Then
        txt_Descr.Enabled = KO
    End If
    txt_Descr = gs_TableCode3
    If gs_TableCode4 = "X" Then
        chk_Int.value = 1
    End If
'P593
    If gs_TableName = "Products_Families" And gs_TableCode5 = "X" Then
            chk_Int.value = 1
    End If
    Txt_InternetName = gs_TableCode4
    
    Select Case gs_TableName
    Case "Products_Families"
        txt_SortOrder.Text = gs_TableCode9
    Case "Shapes", "Perforation_Shape", "Component_Type", "Form"
        txt_dropped = gs_TableCode5
        txt_SortOrder.Text = gs_TableCode6
    Case Else
        txt_dropped = gs_TableCode6
    End Select
    
    If gs_Action = "Delete" Or gs_Action = "MoreInfo" Then
        txt_Descr.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
        Txt_InternetName.Enabled = KO
        Cbo_IntGroup.Enabled = KO
        txt_SortOrder.Enabled = False
    End If
Else
    txt_SortOrder.Text = "0"
End If
If gs_TableName = "Products_Families" And gs_MenuChoice <> "Grids" Then
    'remplir la combo des ceiling groups
    Cbo_IntGroup.Clear
    Cbo_IntGroupeCode.Clear
    FillCbo "EXEC Ceiling_InternetGroup_cbo '" & gut_LangWork.Code & "'", Cbo_IntGroupeCode, Cbo_IntGroup
    If gs_Action <> "Add" Then
        Cbo_IntGroup.ListIndex = ComboFindItem(Cbo_IntGroup, gs_TableCode8)
    End If
End If

MouseOn
Exit Sub

suite:
StdError
End Sub

Private Sub spp_save_Click()

MouseOff
gb_Return = OK
Select Case gs_Action
Case "Add"
    If AddRow Then
        txt_Descr = ""
        txt_Descr.SetFocus
        chk_Int.value = 0
        txt_dropped = ""
        Txt_InternetName = ""
        Cbo_IntGroup.ListIndex = -1
        txt_SortOrder = ""
        If gl_NbLineDisplay < 2 Then
            C_main.FillGrid
        End If
    End If
Case "Update"
    If UpdateRow Then
        Unload Me
        Exit Sub
    End If
Case "Delete"
    If DeleteRow Then
        Unload Me
        Exit Sub
    End If
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
Dim ls_internetname As String
Dim ls_InternetGroup As String

UpdateRow = KO

On Error GoTo suite

If Control Then
    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
    Select Case gs_TableName
    Case "Product_Height"
        ls_req = gs_ParamReqUpd & " '" _
            & QuoteParam(gs_TableCode) & "', '" _
            & ls_IntFlag & "', '" _
            & ls_DropFlag & "', '" _
            & ls_DropDate & "', " _
            & gs_TableCode2
    Case "Estimate_GridType"
        ls_req = gs_ParamReqUpd & " '" _
            & QuoteParam(gs_TableCode) & "', '" _
            & QuoteParam(txt_Descr) & "'," _
            & gs_TableCode2 & ", '" _
            & ls_IntFlag & "', '" _
            & ls_DropFlag & "', '" _
            & ls_DropDate & "'"
    Case "DGrid_MainRunner"
        ls_req = gs_ParamReqUpd & " " _
            & gs_TableCode & ", '" _
            & QuoteParam(txt_Descr) & "', '" _
            & ls_IntFlag & "', '" _
            & ls_DropFlag & "', '" _
            & ls_DropDate & "', " _
            & gs_TableCode2
    Case "DGrid_CrossTee"
        ls_req = gs_ParamReqUpd & " " _
            & gs_TableCode & ", '" _
            & QuoteParam(txt_Descr) & "', '" _
            & ls_IntFlag & "', '" _
            & ls_DropFlag & "', '" _
            & ls_DropDate & "', " _
            & gs_TableCode2
    Case "DGrid_Interface"
        ls_req = gs_ParamReqUpd & " " _
            & gs_TableCode & ", '" _
            & QuoteParam(txt_Descr) & "', '" _
            & ls_IntFlag & "', '" _
            & ls_DropFlag & "', '" _
            & ls_DropDate & "', " _
            & gs_TableCode2
    Case "DGrid_Group", "Ceiling_InternetGroup"
        ls_req = gs_ParamReqUpd & " " _
            & gs_TableCode & ", '" _
            & QuoteParam(txt_Descr) & "', '" _
            & ls_IntFlag & "', '" _
            & ls_DropFlag & "', '" _
            & ls_DropDate & "', " _
            & gs_TableCode2
    Case "Products_Families"
            If gs_MenuChoice = "Grids" Then
                ls_internetname = "NULL"
                ls_InternetGroup = "NULL"
            Else
                If Cbo_IntGroup.ListIndex = -1 Then
                    ls_InternetGroup = "NULL"
                Else
                    ls_InternetGroup = "'" & QuoteParam(Cbo_IntGroupeCode.List(Cbo_IntGroup.ListIndex)) & "'"
                End If
                If Txt_InternetName <> "" Then
                    ls_internetname = "'" & Txt_InternetName & "'"
                Else
                    ls_internetname = "NULL"
                End If
            End If
            ls_req = gs_ParamReqUpd & " '" _
            & QuoteParam(gs_TableCode) & "', '" _
            & QuoteParam(txt_Descr) & "', '" _
            & QuoteParam(gs_CGCode) & "', " _
            & gs_TableCode2 & ", '" _
            & ls_IntFlag & "', '" _
            & ls_DropFlag & "', '" _
            & ls_DropDate & "'," _
            & ls_internetname & "," _
            & ls_InternetGroup & "," & CInt(txt_SortOrder.Text)
    Case "Component_Type", "Perforation_Shape", "Form"
        ls_req = gs_ParamReqUpd & " '" _
            & QuoteParam(gs_TableCode) & "', '" _
            & QuoteParam(txt_Descr) & "', '" _
            & QuoteParam(gs_CGCode) & "', " _
            & gs_TableCode2 & ", '" _
            & ls_IntFlag & "', '" _
            & ls_DropFlag & "', '" _
            & ls_DropDate & "', " _
            & CInt(txt_SortOrder.Text)
    Case Else
        ls_req = gs_ParamReqUpd & " '" _
            & QuoteParam(gs_TableCode) & "', '" _
            & QuoteParam(txt_Descr) & "', '" _
            & QuoteParam(gs_CGCode) & "', " _
            & gs_TableCode2 & ", '" _
            & ls_IntFlag & "', '" _
            & ls_DropFlag & "', '" _
            & ls_DropDate & "'"
    End Select
    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
            UpdateRow = OK
            C_main.Grid.RemoveItem C_main.Grid.Row
            Select Case gs_TableName
            Case "Products_Families"
                If gs_MenuChoice = "Ceilings" Then
                    ls_Line = gs_TableCode & Chr(9) & CInt(gs_TableCode2) + 1 & Chr(9) & txt_Descr & Chr(9) & Txt_InternetName & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped & Chr(9) & QuoteParam(Cbo_IntGroupeCode.List(Cbo_IntGroup.ListIndex)) & Chr(9) & QuoteParam(Cbo_IntGroup.List(Cbo_IntGroup.ListIndex)) & Chr(9) & CInt(txt_SortOrder.Text) & Chr(9) & gs_TableCode10
                Else
'P593
'                    ls_Line = gs_TableCode & Chr(9) & CInt(gs_TableCode2) + 1 & Chr(9) & txt_Descr & Chr(9) & Txt_InternetName & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped & Chr(9) & CInt(txt_SortOrder.Text)
                    ls_Line = gs_TableCode & Chr(9) & CInt(gs_TableCode2) + 1 & Chr(9) & txt_Descr & Chr(9) & Txt_InternetName & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped & Chr(9) & QuoteParam(Cbo_IntGroupeCode.List(Cbo_IntGroup.ListIndex)) & Chr(9) & QuoteParam(Cbo_IntGroup.List(Cbo_IntGroup.ListIndex)) & Chr(9) & CInt(txt_SortOrder.Text) & Chr(9) & gs_TableCode10
                End If
            Case "Component_Type", "Perforation_Shape", "Form"
                ls_Line = gs_TableCode & Chr(9) & CInt(gs_TableCode2) + 1 & Chr(9) & txt_Descr & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped & Chr(9) & txt_SortOrder.Text
            Case Else
                ls_Line = gs_TableCode & Chr(9) & CInt(gs_TableCode2) + 1 & Chr(9) & txt_Descr & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped
            End Select
            C_main.Grid.AddItem ls_Line, C_main.Grid.Row
        End If
    Else
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        SendMessage 3, "Update failed", gut_LangLogin.Code
    End If
End If
Exit Function

suite:
Select Case Err
Case 30015
    C_main.FillGrid
Case Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Select
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_Line As String
Dim ls_IntFlag As String
Dim ls_DropFlag As String
Dim ls_DropDate As String
Dim ls_internetname As String 'only for products families
Dim ls_InternetGroup As String 'only for products families

AddRow = KO

On Error GoTo suite

If Control Then
    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
    Select Case gs_TableName
        Case "Product_Height"
            ls_req = gs_ParamReqIns & " '" _
                & QuoteParam(gs_CGCode) & "', " _
                & QuoteParam(txt_Descr) & ", '" _
                & ls_IntFlag & "', '" _
                & ls_DropFlag & "', '" _
                & ls_DropDate & "'"
        Case "DGrid_MainRunner"
            ls_req = gs_ParamReqIns & " '" _
                & QuoteParam(txt_Descr) & "', '" _
                & ls_IntFlag & "', '" _
                & ls_DropFlag & "', '" _
                & ls_DropDate & "'"
        Case "DGrid_CrossTee"
            ls_req = gs_ParamReqIns & " '" _
                & QuoteParam(txt_Descr) & "', '" _
                & ls_IntFlag & "', '" _
                & ls_DropFlag & "', '" _
                & ls_DropDate & "'"
        Case "DGrid_Interface"
            ls_req = gs_ParamReqIns & " '" _
                & QuoteParam(txt_Descr) & "', '" _
                & ls_IntFlag & "', '" _
                & ls_DropFlag & "', '" _
                & ls_DropDate & "'"
        Case "DGrid_Group", "Ceiling_InternetGroup"
            ls_req = gs_ParamReqIns & " '" _
                & QuoteParam(txt_Descr) & "', '" _
                & ls_IntFlag & "', '" _
                & ls_DropFlag & "', '" _
                & ls_DropDate & "'"
        Case "Products_Families"
            If Cbo_IntGroup.ListIndex = -1 Or gs_MenuChoice = "Grids" Then
                ls_internetname = "NULL"
                ls_InternetGroup = "NULL"
            Else
                ls_internetname = "'" & Txt_InternetName & "'"
                If Cbo_IntGroup.ListIndex = -1 Then
                    ls_InternetGroup = "NULL"
                Else
                    ls_InternetGroup = "'" & QuoteParam(Cbo_IntGroupeCode.List(Cbo_IntGroup.ListIndex)) & "'"
                End If
            End If
            ls_req = gs_ParamReqIns & " '" _
                & QuoteParam(txt_Descr) & "', '" _
                & QuoteParam(gs_CGCode) & "', '" _
                & ls_IntFlag & "', '" _
                & ls_DropFlag & "', '" _
                & ls_DropDate & "'," _
                & ls_internetname & "," _
                & ls_InternetGroup & "," & CInt(txt_SortOrder.Text)
        Case "Component_Type", "Perforation_Shape", "Form"
            ls_req = gs_ParamReqIns & " '" _
                & QuoteParam(txt_Descr) & "', '" _
                & QuoteParam(gs_CGCode) & "', '" _
                & ls_IntFlag & "', '" _
                & ls_DropFlag & "', '" _
                & ls_DropDate & "', " _
                & CInt(txt_SortOrder.Text)
        Case Else
            ls_req = gs_ParamReqIns & " '" _
                & QuoteParam(txt_Descr) & "', '" _
                & QuoteParam(gs_CGCode) & "', '" _
                & ls_IntFlag & "', '" _
                & ls_DropFlag & "', '" _
                & ls_DropDate & "'"
    End Select
    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 4, "Insert failed", gut_LangLogin.Code
        Else
            AddRow = OK
        End If
        C_main.FillGrid
    Else
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        SendMessage 4, "Insert failed", gut_LangLogin.Code
    End If
End If
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

MouseOn
If SendMessage(5, "Delete record ?", gut_LangLogin.Code, vbQuestion + vbYesNo, "Delete ") = vbYes Then
    MouseOff
    ls_req = gs_ParamReqDel & " '" _
      & QuoteParam(gs_TableCode) & "', " _
      & gs_TableCode2
    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
            C_main.Grid.RemoveItem C_main.Grid.Row
        End If
    Else
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        SendMessage 6, "Delete failed", gut_LangLogin.Code
    End If
End If
MouseOff
Exit Function

suite:
Select Case Err
Case 30015
    C_main.FillGrid
Case Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Select
End Function

Private Sub GetConstants()

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

On Error GoTo suite

If SQLSubmit(gl_Environment, gl_Database, ll_Statement, gs_ParamReqCsts) 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_Descr": lbl_Descr = ls_Text
            Case "lbl_int": lbl_Int = ls_Text
            Case "lbl_drop": lbl_Drop = ls_Text
            Case "lbl_InternetName": Lbl_InternetName = ls_Text
            Case "lbl_InternetGroup": Lbl_InternetGroup = ls_Text
            Case "lbl_SortOrder": lbl_SortOrder.Caption = 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

Dim ls_Texte As String

Control = KO
If txt_Descr.Text = "" Then
    txt_Descr.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
If gs_TableName = "Product_Height" Then
    ls_Texte = Formatage(txt_Descr, 2)
    If Not ChkNumeric(ls_Texte, 2) Then
        txt_Descr.SetFocus
        Exit Function
    End If
    txt_Descr = ls_Texte
    If StringToFloat(txt_Descr) > 9999.99 Then
        txt_Descr.SetFocus
        SendMessage 63, "4 figures and 2 decimals maximum", gut_LangLogin.Code      ' JN 21/06/2013 change to 4 figures and 2 decimals
        Exit Function
    End If
Else
    If Len(txt_Descr) < 4 And gs_TableName <> "Products_Families" Then
        txt_Descr.SetFocus
        SendMessage 11, "Value must be more than 3 characters long", gut_LangLogin.Code
        Exit Function
    End If
End If

Select Case gs_TableName
Case "Products_Families", "Component_Type", "Perforation_Shape", "Form"
'P593
    ls_Texte = Formatage(txt_SortOrder.Text, 0)
    If Not ChkNumeric(ls_Texte, 0) Then
        txt_SortOrder.SetFocus
        Exit Function
    End If
    txt_SortOrder.Text = ls_Texte
End Select
Control = OK

End Function
