VERSION 5.00
Begin VB.Form ProdDim_mtnc 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   2805
   ClientLeft      =   1905
   ClientTop       =   2745
   ClientWidth     =   5445
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   2805
   ScaleWidth      =   5445
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton spp_save 
      Default         =   -1  'True
      Height          =   612
      Left            =   4020
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   2100
      Width           =   612
   End
   Begin VB.CommandButton ssp_quit 
      Height          =   612
      Left            =   4680
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   2100
      Width           =   612
   End
   Begin VB.CommandButton SSC_dropped 
      Height          =   276
      Left            =   2880
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   2400
      Width           =   252
   End
   Begin VB.ComboBox cbo_UnitCode 
      Height          =   288
      Left            =   3900
      Style           =   2  'Dropdown List
      TabIndex        =   16
      TabStop         =   0   'False
      Top             =   1620
      Visible         =   0   'False
      Width           =   312
   End
   Begin VB.ComboBox cbo_SystemCode 
      Height          =   288
      Left            =   1620
      Style           =   2  'Dropdown List
      TabIndex        =   13
      TabStop         =   0   'False
      Top             =   1620
      Visible         =   0   'False
      Width           =   312
   End
   Begin VB.ComboBox cbo_HeightCode 
      Height          =   288
      Left            =   3900
      Style           =   2  'Dropdown List
      TabIndex        =   10
      TabStop         =   0   'False
      Top             =   840
      Visible         =   0   'False
      Width           =   312
   End
   Begin VB.ComboBox cbo_ModuleCode 
      Height          =   288
      Left            =   1620
      Style           =   2  'Dropdown List
      TabIndex        =   9
      TabStop         =   0   'False
      Top             =   840
      Visible         =   0   'False
      Width           =   312
   End
   Begin VB.CheckBox chk_Int 
      Caption         =   "Check1"
      Height          =   252
      Left            =   1680
      TabIndex        =   1
      Top             =   2040
      Width           =   252
   End
   Begin VB.TextBox txt_dropped 
      ForeColor       =   &H00FF0000&
      Height          =   288
      Left            =   1680
      Locked          =   -1  'True
      TabIndex        =   6
      TabStop         =   0   'False
      Top             =   2400
      Width           =   1212
   End
   Begin VB.ComboBox cbo_Module 
      Height          =   288
      Left            =   120
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   840
      Width           =   2052
   End
   Begin VB.ComboBox cbo_Height 
      Height          =   288
      Left            =   2400
      Style           =   2  'Dropdown List
      TabIndex        =   11
      Top             =   840
      Width           =   2052
   End
   Begin VB.ComboBox cbo_System 
      Height          =   288
      Left            =   120
      Style           =   2  'Dropdown List
      TabIndex        =   14
      Top             =   1620
      Width           =   2052
   End
   Begin VB.ComboBox cbo_Unit 
      Height          =   288
      Left            =   2400
      Style           =   2  'Dropdown List
      TabIndex        =   17
      Top             =   1620
      Width           =   2052
   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        =   19
      Top             =   120
      Width           =   4572
   End
   Begin VB.Label lbl_Unit 
      Alignment       =   2  'Center
      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            =   2400
      TabIndex        =   18
      Top             =   1320
      Width           =   2052
   End
   Begin VB.Label lbl_System 
      Alignment       =   2  'Center
      Caption         =   "Measurement system"
      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        =   15
      Top             =   1320
      Width           =   2052
   End
   Begin VB.Label lbl_Height 
      Alignment       =   2  'Center
      Caption         =   "Height"
      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            =   2400
      TabIndex        =   12
      Top             =   540
      Width           =   2052
   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        =   8
      Top             =   2400
      Width           =   1452
   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        =   7
      Top             =   2040
      Width           =   1452
   End
   Begin VB.Label lbl_Module 
      Alignment       =   2  'Center
      Caption         =   "Module"
      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             =   540
      Width           =   2052
   End
End
Attribute VB_Name = "ProdDim_mtnc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim mb_ModuleNotLoaded As Boolean
Dim mb_HeightNotLoaded As Boolean
Dim mb_SystemNotLoaded As Boolean
Dim mb_UnitNotLoaded As Boolean


Private Sub cbo_Height_DropDown()

Dim ls_Height As String

MouseOff
If mb_HeightNotLoaded Then
    mb_HeightNotLoaded = KO
    If cbo_Height.ListIndex <> -1 Then
        ls_Height = cbo_HeightCode.List(cbo_Height.ListIndex)
    Else
        ls_Height = ""
    End If
    cbo_HeightCode.Clear
    cbo_Height.Clear
    FillCbo "Product_Height", cbo_HeightCode, cbo_Height
    If ls_Height <> "" Then
        cbo_Height.ListIndex = ComboFindItem(cbo_HeightCode, ls_Height)
    End If
End If
MouseOn

End Sub
Private Sub cbo_Module_DropDown()

Dim ls_Module As String

MouseOff
If mb_ModuleNotLoaded Then
    mb_ModuleNotLoaded = KO
    If cbo_Module.ListIndex <> -1 Then
        ls_Module = cbo_ModuleCode.List(cbo_Module.ListIndex)
    Else
        ls_Module = ""
    End If
    cbo_ModuleCode.Clear
    cbo_Module.Clear
    FillCbo "Product_Module", cbo_ModuleCode, cbo_Module
    If ls_Module <> "" Then
        cbo_Module.ListIndex = ComboFindItem(cbo_ModuleCode, ls_Module)
    End If
End If
MouseOn

End Sub

Private Sub cbo_System_DropDown()

Dim ls_System As String

MouseOff
If mb_SystemNotLoaded Then
    mb_SystemNotLoaded = KO
    If cbo_System.ListIndex <> -1 Then
        ls_System = cbo_SystemCode.List(cbo_System.ListIndex)
    Else
        ls_System = ""
    End If
    cbo_SystemCode.Clear
    cbo_System.Clear
    FillCbo "Measurement_System", cbo_SystemCode, cbo_System
    If ls_System <> "" Then
        cbo_System.ListIndex = ComboFindItem(cbo_SystemCode, ls_System)
    End If
End If
MouseOn

End Sub

Private Sub cbo_Unit_DropDown()

Dim ls_Unit As String

MouseOff
If mb_UnitNotLoaded Then
    mb_UnitNotLoaded = KO
    If cbo_Unit.ListIndex <> -1 Then
        ls_Unit = cbo_UnitCode.List(cbo_Unit.ListIndex)
    Else
        ls_Unit = ""
    End If
    cbo_UnitCode.Clear
    cbo_Unit.Clear
    FillCbo "Unit_Of_Measure", cbo_UnitCode, cbo_Unit
    If ls_Unit <> "" Then
        cbo_Unit.ListIndex = ComboFindItem(cbo_UnitCode, ls_Unit)
    End If
End If
MouseOn

End Sub
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)

Getcsts
Select Case gs_Action
Case "Add"
    mb_ModuleNotLoaded = OK
    mb_HeightNotLoaded = OK
    mb_SystemNotLoaded = OK
    mb_UnitNotLoaded = OK
Case Else
    cbo_Module.Enabled = KO
    cbo_ModuleCode.AddItem gs_TableCode3
    cbo_Module.AddItem gs_TableCode4
    cbo_Module.ListIndex = 0
    cbo_Height.Enabled = KO
    cbo_HeightCode.AddItem gs_TableCode5
    cbo_Height.AddItem gs_TableCode6
    cbo_Height.ListIndex = 0
    cbo_System.Enabled = KO
    cbo_SystemCode.AddItem gs_TableCode7
    cbo_System.AddItem gs_TableCode8
    cbo_System.ListIndex = 0
    cbo_Unit.Enabled = KO
    cbo_UnitCode.AddItem gs_TableCode9
    cbo_Unit.AddItem gs_TableCode10
    cbo_Unit.ListIndex = 0
    If gs_TableCode11 = "X" Then
        chk_Int.value = 1
    End If
    txt_dropped = gs_TableCode12
    If gs_Action = "Delete" Then
        chk_Int.Enabled = KO
        SSC_dropped.Visible = KO
    End If
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 AddRow Then
        cbo_Module.ListIndex = -1
        cbo_Height.ListIndex = -1
        cbo_System.ListIndex = -1
        cbo_Unit.ListIndex = -1
        chk_Int.value = 0
        txt_dropped = ""
        If gl_NbLineDisplay < 2 Then
            C_main.FillGrid
        End If
        cbo_Module.SetFocus
      End If
Case "Update"
    If UpdateRow Then
        Unload Me
    End If
Case "Delete"
    If DeleteRow Then
        Unload Me
    End If
End Select
MouseOn
Exit Sub

suite:
StdError
MouseOn
End Sub
Private Sub SSC_dropped_Click()

MouseOff
gb_Return = KO
gs_Date = txt_dropped
Dates.show 1
If gb_Return Then
    txt_dropped = gs_Date
End If
MouseOn

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

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
    ls_Req = "EXEC Product_Dimension_upd " _
     & gs_TableCode & ", '" _
     & ls_IntFlag & "', '" _
     & ls_DropFlag & "', '" _
     & ls_DropDate & "', " _
     & 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 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) & gs_TableCode3 & Chr(9) & gs_TableCode4 & Chr(9) & gs_TableCode5 & Chr(9) & gs_TableCode6 & Chr(9) & gs_TableCode7 & Chr(9) & gs_TableCode8 & Chr(9) & gs_TableCode9 & Chr(9) & gs_TableCode10 & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped
            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_ModuleCode As String
Dim ls_HeightCode As String
Dim ls_SystemCode As String
Dim ls_UnitCode As String
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

AddRow = KO

On Error GoTo suite

If Control Then
    ls_ModuleCode = cbo_ModuleCode.List(cbo_Module.ListIndex)
    ls_HeightCode = cbo_HeightCode.List(cbo_Height.ListIndex)
    ls_SystemCode = cbo_SystemCode.List(cbo_System.ListIndex)
    ls_UnitCode = cbo_UnitCode.List(cbo_Unit.ListIndex)
    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
    ls_Req = "EXEC Product_Dimension_ins '" _
        & gs_CGCode & "', '" _
        & cbo_Module & " * " & cbo_Height & " (" & LCase(cbo_UnitCode.List(cbo_Unit.ListIndex)) & ")', '" _
        & ls_ModuleCode & "', '" & ls_HeightCode & "', '" _
        & ls_SystemCode & "', '" & ls_UnitCode & "', '" _
        & ls_IntFlag & "', '" & ls_DropFlag & "', '" & ls_DropDate & "'"
    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
            li_Status = SQLFetch(ll_Statement)
            If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
                ls_Code = ODBCData(ll_Statement, 1)
                li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
                ls_Line = ls_Code & Chr(9) & "1" & Chr(9) & ls_ModuleCode & Chr(9) & cbo_Module & Chr(9) & ls_HeightCode & Chr(9) & cbo_Height & Chr(9) & ls_SystemCode & Chr(9) & cbo_System & Chr(9) & ls_UnitCode & Chr(9) & cbo_Unit & Chr(9) & ls_IntFlag & Chr(9) & txt_dropped
                C_main.Grid.AddItem ls_Line
                C_main.Grid.Row = C_main.Grid.Rows - 1
                AddRow = OK
            Else
                li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
                C_main.FillGrid
            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 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 = "EXEC Product_Dimension_del '" _
     & 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 Getcsts()

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

On Error GoTo suite

ls_Req = "EXEC Screen_Csts 'mtnc_prodmod', '" & 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
        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_Int": lbl_Int = ls_Text
        Case "lbl_Drop": lbl_Drop = ls_Text
        Case "lbl_Module": lbl_Module = ls_Text
        Case "lbl_Height": lbl_Height = ls_Text
        Case "lbl_System": lbl_System = ls_Text
        Case "lbl_Unit": lbl_Unit = 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

Control = KO
If cbo_Module.ListIndex = -1 Then
    cbo_Module.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
If cbo_Height.ListIndex = -1 Then
    cbo_Height.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
If cbo_System.ListIndex = -1 Then
    cbo_System.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
If cbo_Unit.ListIndex = -1 Then
    cbo_Unit.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
Control = OK

End Function
