VERSION 5.00
Begin VB.Form C_compdesc_mtnc 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   2280
   ClientLeft      =   1965
   ClientTop       =   2475
   ClientWidth     =   5670
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   2280
   ScaleWidth      =   5670
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton ssp_quit 
      Height          =   612
      Left            =   4800
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   1440
      Width           =   612
   End
   Begin VB.CommandButton spp_save 
      Default         =   -1  'True
      Height          =   612
      Left            =   4080
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   1440
      Width           =   612
   End
   Begin VB.TextBox txt_Comp 
      Height          =   288
      Left            =   1920
      MaxLength       =   4
      TabIndex        =   0
      Top             =   720
      Width           =   3612
   End
   Begin VB.Label Lbl_code 
      Caption         =   "Country company"
      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        =   3
      Top             =   720
      Width           =   1812
   End
End
Attribute VB_Name = "C_compdesc_mtnc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public mb_CompetitiveDB As Boolean
Private ml_NextID As Long
Private ml_UCode As Long

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)

txt_Comp.MaxLength = gi_CodeSize
mtnc_monodesc_cst
If gs_Action <> "Add" Then
    If gs_TableName = "DC_UOM" Or gs_TableName = "DC_Equipement" Then
        txt_Comp = gs_TableCode
    Else
        txt_Comp = gs_TableCode3
    End If
    If gs_Action = "Delete" Then
            txt_Comp.Enabled = KO
    End If
End If

'Competitive DB
If mb_CompetitiveDB Then
    ml_UCode = prg.U_Code
    If ml_UCode = 0 Then
        SendMessage 2101, "Failure while getting your ID login, can you contact IT support please.", gut_LangLogin.Code
    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":
    'Competitive DB Next ID
    If mb_CompetitiveDB Then
        ml_NextID = NextID(gs_TableName)
        If ml_NextID = 0 Then
            MouseOn
            Exit Sub
        End If
    End If
    
    If Add_Table Then
        txt_Comp = ""
        txt_Comp.SetFocus
        If gl_NbLineDisplay < 2 Then
            C_main.FillGrid
        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
End Select
MouseOn

End Sub



Private Sub ssp_quit_Click()
MouseOff
Unload Me
End Sub



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 mb_CompetitiveDB Then
        ls_Req = gs_ParamReqIns
        ls_Req = Replace(ls_Req, "$Key$", ml_NextID)
        ls_Req = Replace(ls_Req, "$Desc$", QuoteParam(txt_Comp))
        ls_Req = Replace(ls_Req, "$Creator$", ml_UCode)
    Else
            ls_Req = gs_ParamReqIns & " '" & QuoteParam(txt_Comp) & "'"
    End If

    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
            
            'Competitive DB
            If mb_CompetitiveDB Then lS_Code = ml_NextID

            If gs_TableName = "DC_UOM" Or gs_TableName = "DC_Equipement" Then
                ls_Line = txt_Comp & Chr(9) & 1
            Else
                ls_Line = lS_Code & Chr(9) & 1 & Chr(9) & txt_Comp
            End If
            C_main.Grid.AddItem ls_Line
            C_main.Grid.Row = C_main.Grid.Rows - 1
            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

Dlt_Table = KO

On Error GoTo suite

MouseOn
If SendMessage(5, "Delete record ?", gut_LangLogin.Code, vbQuestion + vbYesNo, "Delete ") = vbYes Then
    MouseOff
    If mb_CompetitiveDB Then
        ls_Req = gs_ParamReqDel
        ls_Req = Replace(ls_Req, "$Key$", gs_TableCode)
        ls_Req = Replace(ls_Req, "$Creator$", ml_UCode)
    Else
        ls_Req = gs_ParamReqDel & " " & gs_TableCode & ", " & gs_TableCode2
    End If
    
    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
            li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
            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), 30)
        Select Case LCase(ls_Field)
            Case "lbl_code": lbl_Code = ls_Text
            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
        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_Comp = "" Then
    txt_Comp.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
Control = OK

End Function

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 Control Then
    If mb_CompetitiveDB Then
        ls_Req = gs_ParamReqUpd
        ls_Req = Replace(ls_Req, "$Key$", gs_TableCode)
        ls_Req = Replace(ls_Req, "$Desc$", QuoteParam(txt_Comp))
        ls_Req = Replace(ls_Req, "$UID$", ml_UCode)
    Else
        ls_Req = gs_ParamReqUpd & " " & gs_TableCode & ", " & gs_TableCode2 & ", '" & QuoteParam(txt_Comp) & "'"
    End If
           
    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
            ls_Line = gs_TableCode & Chr(9) & CInt(gs_TableCode2) + 1 & Chr(9) & txt_Comp
            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

Public Property Let CompetitiveDB(ab_CompetitiveDB As Boolean)
    mb_CompetitiveDB = ab_CompetitiveDB
End Property
