VERSION 5.00
Begin VB.Form Perforation_Design 
   Caption         =   "Form1"
   ClientHeight    =   4560
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5925
   LinkTopic       =   "Form1"
   ScaleHeight     =   4560
   ScaleWidth      =   5925
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox txt_openArea 
      Height          =   288
      Left            =   1680
      MaxLength       =   200
      TabIndex        =   36
      Top             =   2880
      Width           =   1020
   End
   Begin VB.TextBox txt_dimm3 
      Height          =   288
      Left            =   1680
      MaxLength       =   200
      TabIndex        =   32
      Top             =   2130
      Width           =   1410
   End
   Begin VB.TextBox txt_dimm4 
      Height          =   288
      Left            =   1680
      MaxLength       =   200
      TabIndex        =   31
      Top             =   2505
      Width           =   1410
   End
   Begin VB.ComboBox cbo_UOM3_Code 
      Height          =   315
      Left            =   4995
      TabIndex        =   28
      Text            =   "Combo1"
      Top             =   2115
      Visible         =   0   'False
      Width           =   390
   End
   Begin VB.ComboBox cbo_UOM4_Code 
      Height          =   315
      Left            =   5010
      TabIndex        =   27
      Text            =   "Combo1"
      Top             =   2490
      Visible         =   0   'False
      Width           =   390
   End
   Begin VB.TextBox txt_design 
      Height          =   288
      Left            =   1680
      MaxLength       =   200
      TabIndex        =   2
      Top             =   525
      Width           =   4095
   End
   Begin VB.ComboBox cbo_UOM2_Code 
      Height          =   315
      Left            =   5010
      TabIndex        =   25
      Text            =   "Combo1"
      Top             =   1740
      Visible         =   0   'False
      Width           =   390
   End
   Begin VB.ComboBox cbo_UOM1_Code 
      Height          =   315
      Left            =   4995
      TabIndex        =   24
      Text            =   "Combo1"
      Top             =   1365
      Visible         =   0   'False
      Width           =   390
   End
   Begin VB.ComboBox cbo_UOM2_desc 
      Height          =   315
      Left            =   3360
      Style           =   2  'Dropdown List
      TabIndex        =   7
      Top             =   1740
      Width           =   2415
   End
   Begin VB.ComboBox cbo_UOM1_desc 
      Height          =   315
      Left            =   3360
      Style           =   2  'Dropdown List
      TabIndex        =   5
      Top             =   1365
      Width           =   2415
   End
   Begin VB.TextBox txt_dimm2 
      Height          =   288
      Left            =   1680
      MaxLength       =   200
      TabIndex        =   6
      Top             =   1755
      Width           =   1410
   End
   Begin VB.TextBox txt_dimm1 
      Height          =   288
      Left            =   1680
      MaxLength       =   200
      TabIndex        =   4
      Top             =   1380
      Width           =   1410
   End
   Begin VB.ComboBox cbo_PRFSH_Id 
      Height          =   315
      Left            =   4170
      TabIndex        =   21
      Text            =   "Combo1"
      Top             =   3300
      Visible         =   0   'False
      Width           =   390
   End
   Begin VB.TextBox txt_language 
      Height          =   288
      Left            =   2595
      Locked          =   -1  'True
      MaxLength       =   80
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   90
      Width           =   1545
   End
   Begin VB.TextBox txt_ID 
      Height          =   288
      Left            =   1680
      Locked          =   -1  'True
      MaxLength       =   80
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   90
      Width           =   720
   End
   Begin VB.CheckBox chk_Int 
      Height          =   252
      Left            =   1770
      TabIndex        =   9
      Top             =   3825
      Width           =   252
   End
   Begin VB.TextBox txt_dropped 
      ForeColor       =   &H00FF0000&
      Height          =   288
      Left            =   1770
      Locked          =   -1  'True
      TabIndex        =   11
      Top             =   4185
      Width           =   1212
   End
   Begin VB.TextBox txt_Descr 
      Height          =   288
      Left            =   1680
      MaxLength       =   200
      TabIndex        =   3
      Top             =   975
      Width           =   4095
   End
   Begin VB.CommandButton ssp_quit 
      Height          =   612
      Left            =   5235
      Style           =   1  'Graphical
      TabIndex        =   15
      Top             =   3870
      Width           =   612
   End
   Begin VB.CommandButton SSC_dropped 
      Height          =   276
      Left            =   3015
      Style           =   1  'Graphical
      TabIndex        =   12
      Top             =   4200
      Width           =   252
   End
   Begin VB.CommandButton spp_save 
      Default         =   -1  'True
      Height          =   612
      Left            =   4575
      Style           =   1  'Graphical
      TabIndex        =   13
      Top             =   3870
      Width           =   612
   End
   Begin VB.TextBox txt_SortOrder 
      Height          =   288
      Left            =   3330
      MaxLength       =   4
      TabIndex        =   10
      Top             =   3825
      Width           =   855
   End
   Begin VB.ComboBox cbo_PRFSH_Desc 
      Height          =   315
      Left            =   2460
      Style           =   2  'Dropdown List
      TabIndex        =   8
      Top             =   3300
      Width           =   3360
   End
   Begin VB.ComboBox cbo_UOM4_desc 
      Height          =   315
      Left            =   3360
      Style           =   2  'Dropdown List
      TabIndex        =   29
      Top             =   2490
      Width           =   2415
   End
   Begin VB.ComboBox cbo_UOM3_desc 
      Height          =   315
      Left            =   3360
      Style           =   2  'Dropdown List
      TabIndex        =   30
      Top             =   2115
      Width           =   2415
   End
   Begin VB.Label lbl_OpenArea 
      Caption         =   "#Open Area"
      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        =   35
      Top             =   2897
      Width           =   1590
   End
   Begin VB.Label lbl_dimm3 
      Caption         =   "#Dimmension 3"
      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        =   34
      Top             =   2147
      Width           =   1590
   End
   Begin VB.Label lbl_dimm4 
      Caption         =   "#Dimmension 4"
      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        =   33
      Top             =   2520
      Width           =   1590
   End
   Begin VB.Label lbl_design 
      Caption         =   "#Design"
      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        =   26
      Top             =   555
      Width           =   1590
   End
   Begin VB.Label lbl_dimm2 
      Caption         =   "#Dimmension 2"
      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        =   23
      Top             =   1772
      Width           =   1590
   End
   Begin VB.Label lbl_dimm1 
      Caption         =   "#Dimmension 1"
      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        =   22
      Top             =   1397
      Width           =   1590
   End
   Begin VB.Label lbl_perforationShape 
      Caption         =   "#Perforation Shape"
      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        =   20
      Top             =   3345
      Width           =   2220
   End
   Begin VB.Label lbl_key 
      Caption         =   "#Key"
      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        =   19
      Top             =   150
      Width           =   1590
   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          =   255
      Left            =   75
      TabIndex        =   18
      Top             =   4185
      Width           =   1590
   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          =   255
      Left            =   75
      TabIndex        =   17
      Top             =   3825
      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          =   255
      Left            =   75
      TabIndex        =   16
      Top             =   975
      Width           =   1590
   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            =   2295
      TabIndex        =   14
      Top             =   3825
      Width           =   975
   End
End
Attribute VB_Name = "Perforation_Design"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'what is new
'3.0.0 Screen introduced (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

    If gs_Action <> "Add" Then
        txt_ID.Text = gs_TableCode
        
        txt_design.Text = gs_TableCode3
        txt_Descr = gs_TableCode4
        If gs_TableCode15 = "X" Then
            chk_Int.Value = 1
        End If
        txt_openArea = gs_TableCode5
        txt_dropped = gs_TableCode16
        txt_SortOrder = gs_TableCode6
        txt_dimm1 = gs_TableCode7
        txt_dimm2 = gs_TableCode9
        txt_dimm3 = gs_TableCode11
        txt_dimm4 = gs_TableCode13
        
        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
            txt_dimm1.Enabled = KO
            txt_dimm2.Enabled = KO
            txt_dimm3.Enabled = KO
            txt_dimm4.Enabled = KO
            txt_openArea.Enabled = KO
            cbo_PRFSH_Desc.Enabled = KO
            cbo_UOM1_desc.Enabled = KO
            cbo_UOM2_desc.Enabled = KO
            cbo_UOM3_desc.Enabled = KO
            cbo_UOM4_desc.Enabled = KO
            If gs_Action = "MoreInfo" Then
                spp_save.Visible = KO
            End If
            txt_SortOrder.Enabled = False
        End If
    Else
        txt_ID.Text = "New"
    End If
    txt_language.Text = gut_LangWork.Desc
    
    

    cbo_PRFSH_Id.Clear
    cbo_PRFSH_Desc.Clear
    FillCbo "EXEC Perforation_Shape_cbo '" & gs_CGCode & "','" & gut_LangWork.Code & "'", cbo_PRFSH_Id, cbo_PRFSH_Desc
    
    cbo_UOM1_Code.Clear
    cbo_UOM1_desc.Clear
    FillCbo "Unit_Of_Measure", cbo_UOM1_Code, cbo_UOM1_desc

    cbo_UOM2_Code.Clear
    cbo_UOM2_desc.Clear
    FillCbo "Unit_Of_Measure", cbo_UOM2_Code, cbo_UOM2_desc
    
    cbo_UOM3_Code.Clear
    cbo_UOM3_desc.Clear
    FillCbo "Unit_Of_Measure", cbo_UOM3_Code, cbo_UOM3_desc
    
    cbo_UOM4_Code.Clear
    cbo_UOM4_desc.Clear
    FillCbo "Unit_Of_Measure", cbo_UOM4_Code, cbo_UOM4_desc
    
    If gs_Action <> "Add" Then
        cbo_PRFSH_Desc.ListIndex = ComboFindItem(cbo_PRFSH_Id, gs_TableCode17)
        cbo_UOM1_desc.ListIndex = ComboFindItem(cbo_UOM1_Code, gs_TableCode8)
        cbo_UOM2_desc.ListIndex = ComboFindItem(cbo_UOM2_Code, gs_TableCode10)
        cbo_UOM3_desc.ListIndex = ComboFindItem(cbo_UOM3_Code, gs_TableCode12)
        cbo_UOM4_desc.ListIndex = ComboFindItem(cbo_UOM4_Code, gs_TableCode14)
    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_ID = "NEW"
        txt_Descr = ""
        txt_design.Text = ""
        txt_dimm1.Text = ""
        txt_dimm2.Text = ""
        cbo_UOM1_desc.ListIndex = -1
        cbo_UOM2_desc.ListIndex = -1
        cbo_UOM3_desc.ListIndex = -1
        cbo_UOM4_desc.ListIndex = -1
        cbo_PRFSH_Desc.ListIndex = -1
        txt_Descr.SetFocus
        chk_Int.Value = 0
        txt_dropped = ""
        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
    
    Dim ls_UOM1_Code As String
    Dim ls_UOM2_Code As String
    Dim ls_UOM3_Code As String
    Dim ls_UOM4_Code As String
    
    If cbo_UOM1_desc.ListIndex = -1 Or txt_dimm1.Text = "" Then
        ls_UOM1_Code = "NULL"
    Else
        ls_UOM1_Code = "'" & cbo_UOM1_Code.List(cbo_UOM1_desc.ListIndex) & "'"
    End If
    
    If cbo_UOM2_desc.ListIndex = -1 Or txt_dimm2.Text = "" Then
        ls_UOM2_Code = "NULL"
    Else
        ls_UOM2_Code = "'" & cbo_UOM2_Code.List(cbo_UOM2_desc.ListIndex) & "'"
    End If

    If cbo_UOM3_desc.ListIndex = -1 Or txt_dimm3.Text = "" Then
        ls_UOM3_Code = "NULL"
    Else
        ls_UOM3_Code = "'" & cbo_UOM3_Code.List(cbo_UOM3_desc.ListIndex) & "'"
    End If

    If cbo_UOM4_desc.ListIndex = -1 Or txt_dimm4.Text = "" Then
        ls_UOM4_Code = "NULL"
    Else
        ls_UOM4_Code = "'" & cbo_UOM4_Code.List(cbo_UOM4_desc.ListIndex) & "'"
    End If

    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) & ", '" _
        & cbo_PRFSH_Id.List(cbo_PRFSH_Desc.ListIndex) & "', " _
        & SQLNum(txt_dimm1.Text) & ", " _
        & ls_UOM1_Code & ", " _
        & SQLNum(txt_dimm2.Text) & ", " _
        & ls_UOM2_Code & ", " _
        & SQLNum(txt_dimm3.Text) & ", " _
        & ls_UOM3_Code & ", " _
        & SQLNum(txt_dimm4.Text) & ", " _
        & ls_UOM4_Code & ", " _
        & SQLNum(txt_openArea.Text) & ", '" _
        & QuoteParam(txt_design) & "'"

    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
            
            ls_Line = gs_TableCode & Chr(9) & CInt(gs_TableCode2) + 1 & Chr(9) & txt_design.Text & Chr(9) & txt_Descr & Chr(9) & txt_openArea.Text & Chr(9) & CInt(txt_SortOrder.Text) & Chr(9) & txt_dimm1.Text & Chr(9) & IIf(ls_UOM1_Code = "NULL", "", cbo_UOM1_Code.List(cbo_UOM1_desc.ListIndex)) & Chr(9) & txt_dimm2.Text & Chr(9) & IIf(ls_UOM2_Code = "NULL", "", cbo_UOM2_Code.List(cbo_UOM2_desc.ListIndex)) & Chr(9) & txt_dimm3.Text & Chr(9) & IIf(ls_UOM3_Code = "NULL", "", cbo_UOM3_Code.List(cbo_UOM3_desc.ListIndex)) & Chr(9) & txt_dimm4.Text & Chr(9) & IIf(ls_UOM4_Code = "NULL", "", cbo_UOM4_Code.List(cbo_UOM4_desc.ListIndex)) & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped & Chr(9) & cbo_PRFSH_Id.List(cbo_PRFSH_Desc.ListIndex)
            
            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
    
    Dim ls_UOM1_Code As String
    Dim ls_UOM2_Code As String
    Dim ls_UOM3_Code As String
    Dim ls_UOM4_Code As String
    
    If cbo_UOM1_desc.ListIndex = -1 Or txt_dimm1.Text = "" Then
        ls_UOM1_Code = "NULL"
    Else
        ls_UOM1_Code = "'" & cbo_UOM1_Code.List(cbo_UOM1_desc.ListIndex) & "'"
    End If
    
    If cbo_UOM2_desc.ListIndex = -1 Or txt_dimm2.Text = "" Then
        ls_UOM2_Code = "NULL"
    Else
        ls_UOM2_Code = "'" & cbo_UOM2_Code.List(cbo_UOM2_desc.ListIndex) & "'"
    End If
    
    If cbo_UOM3_desc.ListIndex = -1 Or txt_dimm3.Text = "" Then
        ls_UOM3_Code = "NULL"
    Else
        ls_UOM3_Code = "'" & cbo_UOM3_Code.List(cbo_UOM3_desc.ListIndex) & "'"
    End If
    
    If cbo_UOM4_desc.ListIndex = -1 Or txt_dimm4.Text = "" Then
        ls_UOM4_Code = "NULL"
    Else
        ls_UOM4_Code = "'" & cbo_UOM4_Code.List(cbo_UOM4_desc.ListIndex) & "'"
    End If
    
    
    ls_req = gs_ParamReqIns & " '" _
        & QuoteParam(txt_Descr) & "', '" _
        & QuoteParam(gs_CGCode) & "', '" _
        & ls_IntFlag & "', '" _
        & ls_DropFlag & "', '" _
        & ls_DropDate & "', " _
        & CInt(txt_SortOrder.Text) & ", '" _
        & cbo_PRFSH_Id.List(cbo_PRFSH_Desc.ListIndex) & "', " _
        & SQLNum(txt_dimm1.Text) & ", " _
        & ls_UOM1_Code & ", " _
        & SQLNum(txt_dimm2.Text) & ", " _
        & ls_UOM2_Code & ", " _
        & SQLNum(txt_dimm3.Text) & ", " _
        & ls_UOM3_Code & ", " _
        & SQLNum(txt_dimm4.Text) & ", " _
        & ls_UOM4_Code & ", " _
        & SQLNum(txt_openArea.Text) & ", '" _
        & QuoteParam(txt_design) & "'"
    
    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_Descr": lbl_Descr = ls_Text
            Case "lbl_int": lbl_Int = ls_Text
            Case "lbl_drop": lbl_Drop = ls_Text
            Case "lbl_SortOrder": lbl_SortOrder.Caption = ls_Text
            Case "lbl_dimm1": lbl_dimm1.Caption = ls_Text
            Case "lbl_dimm2": lbl_dimm2.Caption = ls_Text
            Case "lbl_dimm3": lbl_dimm3.Caption = ls_Text
            Case "lbl_dimm4": lbl_dimm4.Caption = ls_Text
            Case "lbl_OpenArea": lbl_OpenArea.Caption = ls_Text
            Case "lbl_perforationShape": lbl_perforationShape.Caption = ls_Text
            Case "lbl_key": lbl_key.Caption = ls_Text
            Case "lbl_design": lbl_design.Caption = ls_Text
        End Select
    End If
Loop
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
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_design.Text = "" Then
        txt_design.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        Exit Function
    End If
    
    If txt_Descr.Text = "" Then
        txt_Descr.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        Exit Function
    End If
    
    If txt_dimm1.Text <> "" Then
        ls_Texte = Formatage(txt_dimm1, 2)
        If Not ChkNumeric(ls_Texte, 2) Then
            txt_dimm1.SetFocus
            Exit Function
        End If
        txt_dimm1 = ls_Texte
    End If

    If txt_dimm2.Text <> "" Then
        ls_Texte = Formatage(txt_dimm2, 2)
        If Not ChkNumeric(ls_Texte, 2) Then
            txt_dimm2.SetFocus
            Exit Function
        End If
        txt_dimm2 = ls_Texte
    End If

    If txt_dimm3.Text <> "" Then
        ls_Texte = Formatage(txt_dimm3, 2)
        If Not ChkNumeric(ls_Texte, 2) Then
            txt_dimm3.SetFocus
            Exit Function
        End If
        txt_dimm3 = ls_Texte
    End If

    If txt_dimm4.Text <> "" Then
        ls_Texte = Formatage(txt_dimm4, 2)
        If Not ChkNumeric(ls_Texte, 2) Then
            txt_dimm4.SetFocus
            Exit Function
        End If
        txt_dimm4 = ls_Texte
    End If

    ls_Texte = Formatage(txt_openArea, 2)
    If Not ChkNumeric(ls_Texte, 2) Then
        txt_openArea.SetFocus
        Exit Function
    End If
    txt_openArea = ls_Texte
    
    If ls_Texte < 0 Or ls_Texte > 100 Then
        ReDim lv_MsgReplaceInfo(2, 1)
        lv_MsgReplaceInfo(0, 0) = "$LabelCaption$"
        lv_MsgReplaceInfo(0, 1) = lbl_OpenArea.Caption
        lv_MsgReplaceInfo(1, 0) = "$Min$"
        lv_MsgReplaceInfo(1, 1) = Formatage("0", 2)
        lv_MsgReplaceInfo(2, 0) = "$Max$"
        lv_MsgReplaceInfo(2, 1) = Formatage("100", 2)
        
        txt_openArea.SetFocus
        Call MsgBox(MsgTextA(2132, gut_LangLogin.Code, "#The field $LabelCaption$ must be a number between $Min$ and $Max$.", lv_MsgReplaceInfo), vbOKOnly)
        Exit Function
    End If


    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
    
    If txt_dimm1.Text <> "" And cbo_UOM1_desc.ListIndex = -1 Then
        cbo_UOM1_desc.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        Exit Function
    End If
    
    If txt_dimm2.Text <> "" And cbo_UOM2_desc.ListIndex = -1 Then
        cbo_UOM2_desc.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        Exit Function
    End If
    
    If txt_dimm3.Text <> "" And cbo_UOM3_desc.ListIndex = -1 Then
        cbo_UOM3_desc.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        Exit Function
    End If
    
    If txt_dimm4.Text <> "" And cbo_UOM4_desc.ListIndex = -1 Then
        cbo_UOM4_desc.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        Exit Function
    End If
    
    If cbo_PRFSH_Desc.ListIndex = -1 Then
        cbo_PRFSH_Desc.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        Exit Function
    End If


Control = OK

End Function

Private Function SQLNum(ByVal as_str As String) As String
    If as_str = "" Then
        SQLNum = "NULL"
    Else
        SQLNum = Replace(as_str, ",", ".")
    End If
End Function

Private Function MsgTextA(ByVal aID As Long, ByVal aLang As String, ByVal aDefault As String, Optional ByVal aInfo As Variant) As String
On Error GoTo errhandler

    MsgTextA = ""
    
    Dim lBuffer As String
    Dim li_ID As Integer
    li_ID = aID
    lBuffer = MsgText(li_ID, aLang)
    
    If lBuffer = "" Then lBuffer = aDefault
    
    Dim li_idx As Integer
    If Not IsMissing(aInfo) Then
        For li_idx = 0 To UBound(aInfo)
            lBuffer = Replace(lBuffer, aInfo(li_idx, 0), aInfo(li_idx, 1), , , vbTextCompare)
        Next li_idx
    End If
    
    
    MsgTextA = lBuffer
    Exit Function
errhandler:
    MsgTextA = aDefault
End Function

