VERSION 5.00
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form Categories_mtnc 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   2400
   ClientLeft      =   1800
   ClientTop       =   2550
   ClientWidth     =   5730
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   2400
   ScaleWidth      =   5730
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton spp_save 
      Default         =   -1  'True
      Height          =   615
      Left            =   4200
      Style           =   1  'Graphical
      TabIndex        =   6
      Top             =   1560
      Width           =   615
   End
   Begin VB.CommandButton ssp_quit 
      Height          =   615
      Left            =   4860
      Style           =   1  'Graphical
      TabIndex        =   7
      Top             =   1560
      Width           =   615
   End
   Begin VB.CommandButton SSC_dropped 
      Height          =   270
      Left            =   3120
      Style           =   1  'Graphical
      TabIndex        =   8
      Top             =   1920
      Width           =   255
   End
   Begin VB.TextBox Txt_descr 
      Height          =   285
      Left            =   1920
      MaxLength       =   40
      TabIndex        =   0
      Top             =   120
      Width           =   3135
   End
   Begin VB.TextBox txt_dropped 
      ForeColor       =   &H00FF0000&
      Height          =   288
      Left            =   1920
      Locked          =   -1  'True
      TabIndex        =   5
      Top             =   1920
      Width           =   1212
   End
   Begin VB.CheckBox chk_Int 
      Caption         =   "Check1"
      Height          =   252
      Left            =   1920
      TabIndex        =   4
      Top             =   1560
      Width           =   252
   End
   Begin MSForms.ComboBox cbo_UOM 
      Height          =   315
      Left            =   1920
      TabIndex        =   2
      Top             =   1080
      Width           =   1500
      VariousPropertyBits=   746604571
      DisplayStyle    =   3
      Size            =   "2646;556"
      MatchEntry      =   1
      ShowDropButtonWhen=   2
      FontHeight      =   165
      FontCharSet     =   0
      FontPitchAndFamily=   2
   End
   Begin MSForms.ComboBox cbo_super 
      Height          =   315
      Left            =   1920
      TabIndex        =   1
      Top             =   600
      Width           =   1500
      VariousPropertyBits=   746604571
      DisplayStyle    =   3
      Size            =   "2646;556"
      MatchEntry      =   1
      ShowDropButtonWhen=   2
      FontHeight      =   165
      FontCharSet     =   0
      FontPitchAndFamily=   2
   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        =   12
      Top             =   120
      Width           =   1812
   End
   Begin VB.Label Lbl_super 
      Caption         =   "Super 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             =   600
      Width           =   1812
   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            =   120
      TabIndex        =   10
      Top             =   1560
      Width           =   1455
   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            =   120
      TabIndex        =   9
      Top             =   1920
      Width           =   1455
   End
   Begin VB.Label lbl_UOM 
      Caption         =   "Unit of measure :"
      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             =   1080
      Width           =   1812
   End
End
Attribute VB_Name = "Categories_mtnc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Cbo_super_Click()
MouseOff
If cbo_super.ListIndex <> -1 And cbo_super.Visible = -1 Then
    If cbo_super.Column(2) = 1 Then
        SendMessage 70, "Inactive data.", gut_LangLogin.Code
    End If
End If
MouseOn
End Sub

Private Sub cbo_UOM_Click()
MouseOff
If cbo_UOM.ListIndex <> -1 And cbo_UOM.Visible = -1 Then
    If cbo_UOM.Column(2) = 1 Then
        SendMessage 70, "Inactive data.", gut_LangLogin.Code
    End If
End If
MouseOn
End Sub

Private Sub Form_Load()
Dim li_Count As Integer

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)

mtnc_Categories_cst

Select Case gs_Action
Case "Add"
    Select Case gs_TableName
        Case Else
            MCombo_Fill cbo_super, "EXEC Super_Categories_cbo '" & gut_LangWork.Code & "'", , OK
            MCombo_Fill cbo_UOM, "EXEC Unit_Of_Measure_cbo '" & gut_LangWork.Code & "'", , OK
    End Select
Case "Update"
    Select Case gs_TableName
    Case "PFG_Category", "APFG_Category"
            Lbl_super.Enabled = OK
            cbo_super.Enabled = OK
            lbl_UOM.Visible = KO
            cbo_UOM.Visible = KO
            lbl_Int.Visible = KO
            lbl_Drop.Visible = KO
            chk_Int.Visible = KO
            txt_dropped.Visible = KO
            SSC_dropped.Visible = KO
            Txt_descr.Text = gs_TableCode6
            Txt_descr.Enabled = KO
            MCombo_AddItemCode cbo_super, "", "(None)", True
            MCombo_Fill cbo_super, "EXEC DGrid_Group_cbo '" & gut_LangWork.Code & "'", , OK
            MCombo_CodeSelect(cbo_super) = gs_TableCode11
    Case Else
        MCombo_Fill cbo_super, "EXEC Super_Categories_cbo '" & gut_LangWork.Code & "'", , OK
        MCombo_Fill cbo_UOM, "EXEC Unit_Of_Measure_cbo '" & gut_LangWork.Code & "'", , OK
        MCombo_CodeSelect(cbo_super) = gs_TableCode4
        MCombo_CodeSelect(cbo_UOM) = gs_TableCode6
        Txt_descr = gs_TableCode3
        If gs_TableCode8 = "X" Then
            chk_Int.value = 1
        End If
        txt_dropped = gs_TableCode9
    End Select
Case "Delete"
    Select Case gs_TableName
    Case Else
        Txt_descr.Enabled = KO
        cbo_super.Enabled = KO
        cbo_UOM.Enabled = KO
        chk_Int.Enabled = KO
        txt_dropped.Enabled = KO
        SSC_dropped.Visible = KO
        Txt_descr = gs_TableCode3
        MCombo_AddItemCode cbo_super, "", gs_TableCode5
        cbo_super.ListIndex = 0
        MCombo_AddItemCode cbo_UOM, "", gs_TableCode7
        cbo_UOM.ListIndex = 0
        If gs_TableCode8 = "X" Then
            chk_Int.value = 1
        End If
        txt_dropped = gs_TableCode9
    End Select
Case "MoreInfo"
    Select Case gs_TableName
    Case "ProductsFamilies_Group"
        Txt_descr.Enabled = KO
        chk_Int.Enabled = KO
        txt_dropped.Enabled = KO
        SSC_dropped.Visible = KO
        Txt_descr = gs_TableCode7
        MCombo_AddItemCode cbo_super, "", gs_TableCode6
        cbo_super.ListIndex = 0
        MCombo_AddItemCode cbo_UOM, "", gs_TableCode10
        cbo_UOM.ListIndex = 0
        cbo_super.Enabled = KO
        cbo_UOM.Enabled = KO
        If gs_TableCode9 = "X" Then
            chk_Int.value = 1
        End If
        txt_dropped = gs_TableCode8
    Case "AccProductsFamilies_Group"
        Txt_descr.Enabled = KO
        chk_Int.Enabled = KO
        txt_dropped.Enabled = KO
        SSC_dropped.Visible = KO
        Txt_descr = gs_TableCode7
        MCombo_AddItemCode cbo_super, "", gs_TableCode6
        cbo_super.ListIndex = 0
        MCombo_AddItemCode cbo_UOM, "", gs_TableCode10
        cbo_UOM.ListIndex = 0
        cbo_super.Enabled = KO
        cbo_UOM.Enabled = KO
        If gs_TableCode9 = "X" Then
            chk_Int.value = 1
        End If
        txt_dropped = gs_TableCode8
    End Select
End Select
MouseOn
Exit Sub

suite:
StdError
End Sub

Private Sub spp_save_Click()

On Error GoTo suite

MouseOff
gb_Return = OK
Select Case gs_Action
Case "Add":
    If Add_Table Then
        Txt_descr = ""
        cbo_super.ListIndex = -1
        cbo_UOM.ListIndex = -1
        Txt_descr.SetFocus
        txt_dropped = ""
        chk_Int.value = 0
        Select Case gs_TableName
            Case Else
                If gl_NbLineDisplay < 2 Then
                    C_main.FillGrid
                End If
        End Select
    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

Exit Sub

suite:
StdError
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
Dim ls_DGG_Code As String
Dim ls_InternetGroup As String

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

Upd_Table = KO

If Control Then
    Select Case gs_TableName
        Case Else
            ls_Req = "EXEC Categories_upd '" _
              & QuoteParam(gs_TableCode) & "', '" _
                & QuoteParam(Txt_descr) & "', '" _
                & QuoteParam(MCombo_GetCode(cbo_super)) & "', '" _
                & QuoteParam(MCombo_GetCode(cbo_UOM)) & "', " _
                & 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
            Select Case gs_TableName
                Case Else
                    ls_Line = gs_TableCode & Chr(9) & CInt(gs_TableCode2) + 1 & Chr(9) & Txt_descr & Chr(9) & MCombo_GetCode(cbo_super) & Chr(9) & cbo_super & Chr(9) & MCombo_GetCode(cbo_UOM) & Chr(9) & cbo_UOM & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped
            End Select
            C_main.Grid.AddItem ls_Line, C_main.Grid.Row
            C_main.Grid.RemoveItem C_main.Grid.Row + 1
        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 "ProductsFamilies_Group"
        Case Else
            ls_Req = "EXEC Categories_ins '" _
                & QuoteParam(Txt_descr) & "', '" _
                & QuoteParam(MCombo_GetCode(cbo_super)) & "','" _
                & QuoteParam(MCombo_GetCode(cbo_UOM)) & "','" _
                & 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
            ls_Line = ls_Code & Chr(9) & 1 & Chr(9) & Txt_descr & Chr(9) & MCombo_GetCode(cbo_super) & Chr(9) & cbo_super & Chr(9) & MCombo_GetCode(cbo_UOM) & Chr(9) & cbo_UOM & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped
            C_main.Grid.AddItem ls_Line
            C_main.Grid.Row = C_main.Grid.Rows - 1
            li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
            If gs_TableName = "ProductsFamilies_Group" Or gs_TableName = "AccProductsFamilies_Group" Then
                'dans le cas des products families, mise a jour des listes
                Lbl_super.Enabled = OK
                cbo_super.Enabled = OK
                lbl_UOM.Enabled = KO
                cbo_UOM.Enabled = KO
                cbo_UOM.Clear
            End If
        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
Dim lb_DeleteYesOrNo As Boolean 'will the delete valid ?

On Error GoTo suite

Dlt_Table = KO

lb_DeleteYesOrNo = False 'false = no; true = yes

Select Case gs_TableName
    Case Else
        If SendMessage(5, "Delete category ?", gut_LangLogin.Code, vbQuestion + vbYesNo, "Delete ") = vbYes Then
            lb_DeleteYesOrNo = True
        End If
End Select

MouseOn
If lb_DeleteYesOrNo = True Then
    MouseOff
    Select Case gs_TableName
    Case Else
        ls_Req = "EXEC Categories_del '" _
      & 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_Categories_cst()

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

On Error GoTo suite

Select Case gs_TableName
    Case "PFG_Category"
        ls_Req = "EXEC Screen_Csts m_PFG_Category, '" & gut_LangLogin.Code & "'"
    Case Else
        ls_Req = "EXEC Screen_Csts mtnc_Categories, '" & gut_LangLogin.Code & "'"
End Select
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_descr": lbl_descr.Caption = ls_Text
        Case "lbl_super": Lbl_super = ls_Text
        Case "lbl_uom": lbl_UOM = ls_Text
        Case "lbl_int": lbl_Int = ls_Text
        Case "lbl_drop": lbl_Drop = 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_PFG_Desc(ByVal as_pf_code As String) As Boolean
Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim lb_return As Boolean

lb_return = True

On Error GoTo suite

ls_Req = "EXEC ProductsFamilies_Group_t_lst2 '" & as_pf_code & "','" & Txt_descr & "','" & 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
        lb_return = False
    End If
Loop
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)

Control_PFG_Desc = lb_return
Exit Function

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

Private Function Control()

Control = KO
Select Case gs_TableName
Case Else
    If cbo_super.ListIndex = -1 Then
        cbo_super.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        Exit Function
    End If
    If cbo_UOM.ListIndex = -1 Then
        cbo_UOM.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 Len(Txt_descr) < 4 Then
        Txt_descr.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        Exit Function
    End If
End Select
Control = OK

End Function

