VERSION 5.00
Begin VB.Form C_monodesc_mtnc 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   2700
   ClientLeft      =   645
   ClientTop       =   2670
   ClientWidth     =   5730
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   2700
   ScaleWidth      =   5730
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton spp_save 
      Default         =   -1  'True
      Height          =   612
      Left            =   4080
      Style           =   1  'Graphical
      TabIndex        =   10
      Top             =   1800
      Width           =   612
   End
   Begin VB.CommandButton SSC_dropped 
      Height          =   276
      Left            =   2880
      Style           =   1  'Graphical
      TabIndex        =   6
      Top             =   1800
      Width           =   252
   End
   Begin VB.CommandButton ssp_quit 
      Height          =   612
      Left            =   4800
      Style           =   1  'Graphical
      TabIndex        =   9
      Top             =   1800
      Width           =   612
   End
   Begin VB.Frame frm_option 
      Height          =   855
      Left            =   120
      TabIndex        =   12
      Top             =   0
      Visible         =   0   'False
      Width           =   5295
      Begin VB.OptionButton opt_integer 
         Height          =   255
         Left            =   1560
         TabIndex        =   14
         Top             =   540
         Width           =   315
      End
      Begin VB.OptionButton opt_string 
         Height          =   255
         Left            =   1560
         TabIndex        =   13
         Top             =   180
         Value           =   -1  'True
         Width           =   315
      End
      Begin VB.Label lbl_ChkText 
         Caption         =   "Text"
         Height          =   255
         Left            =   60
         TabIndex        =   16
         Top             =   180
         Width           =   1455
      End
      Begin VB.Label lbl_ChkNumeric 
         Caption         =   "Numeric"
         Height          =   255
         Left            =   60
         TabIndex        =   15
         Top             =   540
         Width           =   1455
      End
   End
   Begin VB.TextBox txt_record 
      Height          =   285
      Left            =   1680
      MaxLength       =   4
      TabIndex        =   0
      Top             =   480
      Width           =   1095
   End
   Begin VB.TextBox Txt_record2 
      Height          =   285
      Left            =   1680
      MaxLength       =   80
      TabIndex        =   1
      Top             =   960
      Width           =   3735
   End
   Begin VB.CheckBox chk_Int 
      Caption         =   "Check1"
      Height          =   252
      Left            =   1680
      TabIndex        =   2
      Top             =   1440
      Width           =   252
   End
   Begin VB.TextBox txt_dropped 
      ForeColor       =   &H00FF0000&
      Height          =   288
      Left            =   1680
      Locked          =   -1  'True
      TabIndex        =   3
      Top             =   1800
      Width           =   1212
   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           =   3852
   End
   Begin VB.Label Lbl_code 
      Caption         =   "Code"
      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        =   8
      Top             =   480
      Width           =   1092
   End
   Begin VB.Label Lbl_descr 
      Caption         =   "Description"
      Height          =   252
      Left            =   120
      TabIndex        =   7
      Top             =   960
      Width           =   1452
   End
   Begin VB.Label lbl_Drop 
      Caption         =   "Drop date"
      Height          =   252
      Left            =   120
      TabIndex        =   5
      Top             =   1800
      Width           =   1452
   End
   Begin VB.Label lbl_Int 
      Caption         =   "Internet flag"
      Height          =   252
      Left            =   120
      TabIndex        =   4
      Top             =   1440
      Width           =   1452
   End
End
Attribute VB_Name = "C_monodesc_mtnc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'the type of value for condition type
Dim mi_valuetype As Integer

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)

txt_record.MaxLength = gi_CodeSize
mtnc_monodesc_cst
' set default value for the group of radio buttons
mi_valuetype = 1
If gs_Action <> "Add" Then
    Select Case gs_TableName
        Case "Base_Item"
            txt_record.Enabled = KO
            txt_record = gs_TableCode
            gs_Action = "Add"
        Case "Test_Typ_Condition"
           mi_valuetype = CInt(gs_TableCode6)
            If mi_valuetype = 1 Then
                opt_string.value = OK
                opt_integer.value = KO
            Else
                opt_string.value = KO
                opt_integer.value = OK
            End If
            txt_record.Enabled = KO
            txt_record = gs_TableCode
            Txt_record2 = gs_TableCode3
            If gs_TableCode4 = "X" Then
                chk_Int.value = 1
            End If
            txt_dropped = gs_TableCode5
        Case Else
            txt_record.Enabled = KO
            txt_record = gs_TableCode
            If gs_TableName = "Currencies" Then
                Txt_record2 = gs_TableCode2
            Else
                Txt_record2 = gs_TableCode3
            End If
            If gs_TableCode4 = "X" Then
                chk_Int.value = 1
            End If
            txt_dropped = gs_TableCode5
'            If gs_TableCode6 = "1" Then
'                opt_string.Value = OK
'            ElseIf gs_TableCode6 = "2" Then
'                opt_integer.Value = OK
'            End If
    End Select

    Select Case gs_Action
    Case "Update"
        frm_option.Enabled = KO
    Case "Delete"
        'all fields are disabled
        Txt_record2.Enabled = KO
        txt_dropped.Enabled = KO
        SSC_dropped.Visible = KO
        chk_Int.Enabled = KO
        frm_option.Enabled = KO
    Case "MoreInfo"
        'all fields are disabled and you can just click on the exit button
        Txt_record2.Enabled = KO
        txt_dropped.Enabled = KO
        SSC_dropped.Visible = KO
        spp_save.Enabled = KO
        spp_save.Visible = KO
        chk_Int.Enabled = KO
        frm_option.Enabled = KO
    End Select
End If

' depends on the type of data we hide some useless fields
Select Case gs_TableName
    Case "Currencies"
        lbl_Int.Visible = KO
        lbl_Drop.Visible = KO
        txt_dropped.Visible = KO
        SSC_dropped.Visible = KO
        chk_Int.Visible = KO
    Case "Test_Typ_Option"
        txt_record.Visible = KO
        Lbl_code.Visible = KO
    Case "Test_Typ_Condition"
        txt_record.Visible = KO
        Lbl_code.Visible = KO
        frm_option.Visible = OK
    Case "Quot_LoseReason"
        txt_record.Visible = KO
        Lbl_code.Visible = KO

'        mi_valuetype = 1
           'start change
        Select Case gs_Action
        Case "Add"
            opt_string.Enabled = OK
            opt_integer.Enabled = OK
        Case "Update"
            opt_string.Enabled = KO
            opt_integer.Enabled = KO
        Case "Delete"
            opt_string.Enabled = KO
            opt_integer.Enabled = KO
        Case "MoreInfo"
            opt_string.Enabled = KO
            opt_integer.Enabled = KO
        End Select
        'end change
End Select
MouseOn
Exit Sub

suite:
StdError
End Sub

Private Sub opt_integer_Click()

If opt_integer.value = OK Then
    mi_valuetype = 2
Else
    mi_valuetype = 1
End If

End Sub


Private Sub opt_string_Click()

If opt_string.value = OK Then
    mi_valuetype = 1
Else
    mi_valuetype = 2
End If

End Sub


Private Sub spp_save_Click()

MouseOff
gb_Return = OK
Select Case gs_Action
Case "Add"
    If Add_Table Then
        If gs_TableName <> "Base_Item" And gs_TableName <> "Test_Typ_Option" And gs_TableName <> "Test_Typ_Condition" And gs_TableName <> "Quot_LoseReason" Then
            txt_record = ""
            Txt_record2 = ""
            chk_Int.value = 0
            txt_dropped = ""
            txt_record.SetFocus
            If gl_NbLineDisplay < 2 Then
                C_main.FillGrid
            End If
        Else
            gs_TableCode = Txt_record2
            Unload Me
        End If
    End If
Case "Update"
    If Upd_Table Then
        Unload Me
        Exit Sub
    End If
Case "Delete"
    If Dlt_Table Then
        Unload Me
        Exit Sub
    End If
Case "MoreInfo"
    Unload Me
    Exit Sub
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 Upd_Table() 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

Upd_Table = 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
If Control Then
    Select Case gs_TableName
        Case "Priv_Labels"
            ls_Req = gs_ParamReqUpd & " '" _
                & QuoteParam(txt_record) & "', '" _
                & QuoteParam(Txt_record2) & "', '" _
                & QuoteParam(gs_CGCode) & "', " _
                & gs_TableCode2 & ", '" _
                & ls_IntFlag & "','" _
                & ls_DropFlag & "','" _
                & ls_DropDate & "'"
        Case "Currencies"
            ls_Req = gs_ParamReqUpd & " '" _
                & QuoteParam(txt_record) & "', '" _
                & QuoteParam(Txt_record2) & "', " _
                & gs_TableCode3
        Case "Test_Typ_Option"
            ls_Req = gs_ParamReqUpd & " " _
                & gs_TableCode & ", '" _
                & QuoteParam(Txt_record2) & "','" _
                & ls_IntFlag & "','" _
                & ls_DropFlag & "','" _
                & ls_DropDate & "', " _
                & gs_TableCode2
        Case "Test_Typ_Condition"
            ls_Req = gs_ParamReqUpd & " " _
                & gs_TableCode & ", '" _
                & QuoteParam(Txt_record2) & "','" _
                & ls_IntFlag & "','" _
                & ls_DropFlag & "','" _
                & ls_DropDate & "', " _
                & gs_TableCode2
        Case "Quot_LoseReason"
            ls_Req = gs_ParamReqUpd & " " _
                & gs_TableCode & ", '" _
                & QuoteParam(Txt_record2) & "'," _
                & gs_TableCode2 & ",'" _
                & ls_IntFlag & "','" _
                & ls_DropFlag & "','" _
                & ls_DropDate & "'"
        Case Else
            ls_Req = gs_ParamReqUpd & " '" _
                & QuoteParam(txt_record) & "', '" _
                & QuoteParam(Txt_record2) & "', " _
                & 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
            Upd_Table = OK
            C_main.Grid.RemoveItem C_main.Grid.Row
            Select Case gs_TableName
            Case "Currencies"
                ls_Line = txt_record & Chr(9) & Txt_record2 & Chr(9) & CInt(gs_TableCode3) + 1
            Case "Test_Typ_Option"
                ls_Line = gs_TableCode & Chr(9) & CInt(gs_TableCode2 + 1) & Chr(9) & Txt_record2 & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped
            Case "Test_Typ_Condition"
                ls_Line = gs_TableCode & Chr(9) & CInt(gs_TableCode2 + 1) & Chr(9) & Txt_record2 & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped & Chr(9) & mi_valuetype
            Case Else
                ls_Line = txt_record & Chr(9) & CInt(gs_TableCode2) + 1 & Chr(9) & Txt_record2 & 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 Add_Table() As Boolean
Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_lngrows As Long
Dim ls_Code As String
Dim ls_Line As String
Dim ls_IntFlag As String
Dim ls_DropFlag As String
Dim ls_DropDate As String

On Error GoTo suite

Add_Table = KO

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 "Priv_Labels"
            ls_Req = gs_ParamReqIns & " '" _
                & UCase(QuoteParam(txt_record)) & "', '" _
                & QuoteParam(Txt_record2) & "', '" _
                & QuoteParam(gs_CGCode) & "', '" _
                & ls_IntFlag & "','" _
                & ls_DropFlag & "','" _
                & ls_DropDate & "'"
        Case "Currencies"
            ls_Req = gs_ParamReqIns & " '" _
                & UCase(QuoteParam(txt_record)) & "', '" _
                & QuoteParam(Txt_record2) & "'"
        Case "Test_Typ_Option"
            ls_Req = gs_ParamReqIns & " '" _
                & QuoteParam(Txt_record2) & "', '" _
                & ls_IntFlag & "','" _
                & ls_DropFlag & "','" _
                & ls_DropDate & "'"
        Case "Test_Typ_Condition"
            ls_Req = gs_ParamReqIns & " " _
                & mi_valuetype & ", '" _
                & QuoteParam(Txt_record2) & "', '" _
                & ls_IntFlag & "','" _
                & ls_DropFlag & "','" _
                & ls_DropDate & "'"
        Case "Quot_LoseReason"
            ls_Req = gs_ParamReqIns _
                & QuoteParam(Txt_record2) & "', '" _
                & ls_IntFlag & "','" _
                & ls_DropFlag & "','" _
                & ls_DropDate & "'"
        Case Else
            ls_Req = gs_ParamReqIns & " '" _
                & UCase(QuoteParam(txt_record)) & "', '" _
                & QuoteParam(Txt_record2) & "', '" _
                & 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)
        If ll_lngrows = 0 Then
            li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
            SendMessage 4, "Insert failed", gut_LangLogin.Code
            C_main.FillGrid
        Else
            Add_Table = OK
            ' Find the code
            li_Status = SQLFetch(ll_Statement)
            If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
                ls_Code = ODBCData(ll_Statement, 1)
            End If
            Select Case gs_TableName
            Case "Currencies"
                ls_Line = UCase(txt_record) & Chr(9) & Txt_record2 & Chr(9) & 1
                C_main.Grid.AddItem ls_Line
                C_main.Grid.Row = C_main.Grid.Rows - 1
            Case "Base_Item"
            Case "Test_Typ_Option"
                If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
                    ls_Line = ls_Code & Chr(9) & 1 & Chr(9) & Txt_record2 & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped
                    C_main.Grid.AddItem ls_Line
                    C_main.Grid.Row = C_main.Grid.Rows - 1
                Else
                    C_main.FillGrid
                End If
            Case "Test_Typ_Condition"
                If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
                    ls_Line = ls_Code & Chr(9) & 1 & Chr(9) & Txt_record2 & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped & Chr(9) & mi_valuetype
                    C_main.Grid.AddItem ls_Line
                    C_main.Grid.Row = C_main.Grid.Rows - 1
                Else
                    C_main.FillGrid
                End If
            Case "Quot_LoseReason"
                ls_Line = ls_Code & Chr(9) & 1 & Chr(9) & Txt_record2 & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped
                C_main.Grid.AddItem ls_Line
                C_main.Grid.Row = C_main.Grid.Rows - 1
            Case Else
                ls_Line = UCase(txt_record) & Chr(9) & 1 & Chr(9) & Txt_record2 & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped
                C_main.Grid.AddItem ls_Line
                C_main.Grid.Row = C_main.Grid.Rows - 1
            End Select
            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
End If
Exit Function

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

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

On Error GoTo suite

Dlt_Table = KO

MouseOn
If SendMessage(5, "Delete record ?", gut_LangLogin.Code, vbQuestion + vbYesNo, "Delete ") = vbYes Then
    MouseOff
    Select Case gs_TableName
    Case "Currencies"
        ls_Req = gs_ParamReqDel & " '" _
            & QuoteParam(gs_TableCode) & "', " _
            & gs_TableCode3
    Case "Test_Typ_Option"
        ls_Req = gs_ParamReqDel & " " & _
            gs_TableCode & ", " _
            & gs_TableCode2
    Case "Test_Typ_Condition"
        ls_Req = gs_ParamReqDel & " " & _
            gs_TableCode & ", " _
            & gs_TableCode2
    Case "Quot_LoseReason"
        ls_Req = gs_ParamReqDel & " " & _
            gs_TableCode & ", " _
            & gs_TableCode2
    Case Else
        ls_Req = gs_ParamReqDel & " '" _
            & QuoteParam(gs_TableCode) & "', " _
            & gs_TableCode2
    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 7, "Delete failed : concurrency problem ?", gut_LangLogin.Code
            C_main.FillGrid
        Else
            Dlt_Table = 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 mtnc_monodesc_cst()

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), 40)
        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 "titleI": If gs_Action = "MoreInfo" Then Caption = Caption & " - " & ls_Text
            Case "lbl_Category":
                lbl_Category = ls_Text & " " & gs_MenuChoice
            Case "lbl_code": Lbl_code = ls_Text
            Case "lbl_descr": Lbl_descr = ls_Text
            Case "lbl_int": lbl_Int = ls_Text
            Case "lbl_drop": lbl_Drop = ls_Text
            Case "opt_string": lbl_ChkText.Caption = ls_Text
            Case "opt_integer": lbl_ChkNumeric.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

Control = KO
If txt_record = "" And gs_TableName <> "Test_Typ_Option" And gs_TableName <> "Test_Typ_Condition" And gs_TableName <> "Quot_LoseReason" Then
    txt_record.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
If Txt_record2.Text = "" Then
    Txt_record2.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
If Len(Txt_record2) < 4 Then
    Txt_record2.SetFocus
    SendMessage 11, "Value must be more than 3 characters long", gut_LangLogin.Code
    Exit Function
End If
Control = OK

End Function

