VERSION 5.00
Begin VB.Form File_ext_mtnc 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   4695
   ClientLeft      =   2340
   ClientTop       =   1980
   ClientWidth     =   4290
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4695
   ScaleWidth      =   4290
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton spp_save 
      Default         =   -1  'True
      Height          =   612
      Left            =   2940
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   4020
      Width           =   612
   End
   Begin VB.CommandButton ssp_quit 
      Height          =   612
      Left            =   3600
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   4020
      Width           =   612
   End
   Begin VB.ComboBox cbo_MTCode 
      Height          =   288
      Left            =   3420
      Style           =   2  'Dropdown List
      TabIndex        =   20
      Top             =   1080
      Visible         =   0   'False
      Width           =   396
   End
   Begin VB.CheckBox chk_Def 
      Caption         =   "Check1"
      Height          =   252
      Left            =   2160
      TabIndex        =   16
      Top             =   1500
      Width           =   252
   End
   Begin VB.ComboBox cbo_DefinitionCode 
      Height          =   288
      Left            =   3420
      Style           =   2  'Dropdown List
      TabIndex        =   15
      Top             =   1920
      Visible         =   0   'False
      Width           =   396
   End
   Begin VB.ComboBox cbo_QualityCode 
      Height          =   288
      Left            =   3420
      Style           =   2  'Dropdown List
      TabIndex        =   13
      Top             =   3600
      Visible         =   0   'False
      Width           =   396
   End
   Begin VB.TextBox txt_Width 
      Enabled         =   0   'False
      Height          =   288
      Left            =   2160
      TabIndex        =   12
      Top             =   2760
      Width           =   1872
   End
   Begin VB.TextBox txt_Height 
      Enabled         =   0   'False
      Height          =   288
      Left            =   2160
      TabIndex        =   11
      Top             =   2340
      Width           =   1872
   End
   Begin VB.CheckBox chk_Quality 
      Caption         =   "Check1"
      Height          =   252
      Left            =   2160
      TabIndex        =   6
      Top             =   3180
      Width           =   252
   End
   Begin VB.CheckBox chk_Preview 
      Caption         =   "Check1"
      Height          =   252
      Left            =   2160
      TabIndex        =   4
      Top             =   660
      Width           =   252
   End
   Begin VB.TextBox txt_Descr 
      Height          =   285
      Left            =   2160
      MaxLength       =   3
      TabIndex        =   0
      Top             =   240
      Width           =   1815
   End
   Begin VB.ComboBox cbo_Quality 
      Enabled         =   0   'False
      Height          =   288
      Left            =   2160
      Style           =   2  'Dropdown List
      TabIndex        =   14
      Top             =   3600
      Width           =   1872
   End
   Begin VB.ComboBox cbo_MT 
      Height          =   288
      Left            =   2160
      Style           =   2  'Dropdown List
      TabIndex        =   21
      Top             =   1080
      Width           =   1872
   End
   Begin VB.ComboBox cbo_Definition 
      Enabled         =   0   'False
      Height          =   288
      Left            =   2160
      Style           =   2  'Dropdown List
      TabIndex        =   17
      Top             =   1920
      Width           =   1872
   End
   Begin VB.Label lbl_DefaultMT 
      Caption         =   "Default media type"
      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            =   240
      TabIndex        =   22
      Top             =   1080
      Width           =   1812
   End
   Begin VB.Label lbl_Def 
      Caption         =   "Has definition"
      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            =   240
      TabIndex        =   19
      Top             =   1500
      Width           =   1812
   End
   Begin VB.Label lbl_DefaultDef 
      Caption         =   "Default definition"
      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            =   240
      TabIndex        =   18
      Top             =   1920
      Width           =   1812
   End
   Begin VB.Label lbl_DefaultQS 
      Caption         =   "Default quality"
      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            =   240
      TabIndex        =   10
      Top             =   3600
      Width           =   1812
   End
   Begin VB.Label lbl_Width 
      Caption         =   "Default width"
      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            =   240
      TabIndex        =   9
      Top             =   2760
      Width           =   1812
   End
   Begin VB.Label lbl_Height 
      Caption         =   "Default 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            =   240
      TabIndex        =   8
      Top             =   2340
      Width           =   1812
   End
   Begin VB.Label lbl_Quality 
      Caption         =   "Has quality"
      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            =   240
      TabIndex        =   7
      Top             =   3180
      Width           =   1812
   End
   Begin VB.Label lbl_Preview 
      Caption         =   "Has preview"
      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            =   240
      TabIndex        =   5
      Top             =   660
      Width           =   1812
   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            =   240
      TabIndex        =   3
      Top             =   240
      Width           =   1812
   End
End
Attribute VB_Name = "File_ext_mtnc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub chk_Def_Click()
MouseOff
If chk_Def.value Then
    cbo_Definition.Enabled = OK
    txt_Height.Enabled = OK
    txt_Width.Enabled = OK
Else
    cbo_Definition.Enabled = KO
    txt_Height.Enabled = KO
    txt_Width.Enabled = KO
End If
MouseOn
End Sub


Private Sub chk_Quality_Click()
MouseOff
If chk_Quality.value Then
    cbo_Quality.Enabled = OK
Else
    cbo_Quality.Enabled = KO
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)

File_Ext_cst
FillCbo "Definition", cbo_DefinitionCode, cbo_Definition
FillCbo "Media_Quality_On_Screen", cbo_QualityCode, cbo_Quality
FillCbo "Media_Type", cbo_MTCode, cbo_MT

If gs_Action <> "Add" Then
    txt_Descr = gs_TableCode2
    If gs_TableCode3 = "X" Then chk_Def.value = 1
    If gs_TableCode4 = "X" Then chk_Preview.value = 1
    If gs_TableCode5 = "X" Then chk_Quality.value = 1
    txt_Height = gs_TableCode7
    txt_Width = gs_TableCode8
    cbo_Definition.ListIndex = ComboFindItem(cbo_DefinitionCode, gs_TableCode9)
    cbo_Quality.ListIndex = ComboFindItem(cbo_QualityCode, gs_TableCode11)
    cbo_MT.ListIndex = ComboFindItem(cbo_MTCode, gs_TableCode13)
    If gs_Action = "Delete" Then
        txt_Descr.Enabled = KO
        chk_Def.Enabled = KO
        chk_Preview.Enabled = KO
        chk_Quality.Enabled = KO
        txt_Height.Enabled = KO
        txt_Width.Enabled = KO
        cbo_Definition.Enabled = KO
        cbo_Quality.Enabled = KO
        cbo_MT.Enabled = KO
    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":
    If Add_Table Then
        txt_Descr = ""
        chk_Def.value = 0
        chk_Preview.value = 0
        chk_Quality.value = 0
        txt_Height = ""
        txt_Width = ""
        cbo_Quality.ListIndex = -1
        cbo_Definition.ListIndex = -1
        cbo_MT.ListIndex = -1
        txt_Descr.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 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_DefFlag As String
Dim ls_PreviewFlag As String
Dim ls_QualityFlag As String

Upd_Table = KO

On Error GoTo suite

If Control Then
    If chk_Def.value = 1 Then ls_DefFlag = "X"
    If chk_Preview.value = 1 Then ls_PreviewFlag = "X"
    If chk_Quality.value = 1 Then ls_QualityFlag = "X"
    ls_Req = "EXEC Media_File_Ext_upd '" _
        & QuoteParam(gs_TableCode) & "', '" _
        & QuoteParam(txt_Descr) & "','" & ls_DefFlag & "', '" _
        & ls_PreviewFlag & "', '" & ls_QualityFlag & "', '" _
        & txt_Height & "', '" & txt_Width & "', '" _
        & cbo_DefinitionCode.List(cbo_Definition.ListIndex) & "', '" _
        & cbo_QualityCode.List(cbo_Quality.ListIndex) & "', '" _
        & cbo_MTCode.List(cbo_MT.ListIndex) & "', " _
        & gs_TableCode6
    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) & txt_Descr & Chr(9) & ls_DefFlag & Chr(9) & ls_PreviewFlag & Chr(9) & ls_QualityFlag & Chr(9) & CInt(gs_TableCode6) + 1 & Chr(9) & txt_Height & Chr(9) & txt_Width & Chr(9) & cbo_DefinitionCode.List(cbo_Definition.ListIndex) & Chr(9) & cbo_Definition & Chr(9) & cbo_QualityCode.List(cbo_Quality.ListIndex) & Chr(9) & cbo_Quality & Chr(9) & cbo_MTCode.List(cbo_MT.ListIndex) & Chr(9) & cbo_MT
            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_Line As String
Dim ls_DefFlag As String
Dim ls_PreviewFlag As String
Dim ls_QualityFlag As String

Add_Table = KO

On Error GoTo suite

If Control Then
    If chk_Def.value = 1 Then ls_DefFlag = "X"
    If chk_Preview.value = 1 Then ls_PreviewFlag = "X"
    If chk_Quality.value = 1 Then ls_QualityFlag = "X"
    ls_Req = "EXEC Media_File_Ext_ins '" _
        & QuoteParam(txt_Descr) & "','" _
        & ls_DefFlag & "','" & ls_PreviewFlag & "','" _
        & ls_QualityFlag & "','" & txt_Height & "','" & txt_Width & "','" _
        & cbo_DefinitionCode.List(cbo_Definition.ListIndex) & "','" _
        & cbo_QualityCode.List(cbo_Quality.ListIndex) & "','" _
        & cbo_MTCode.List(cbo_MT.ListIndex) & "'"
    
    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
            Add_Table = 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 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
    ls_Req = "EXEC Media_File_Ext_del '" _
        & QuoteParam(gs_TableCode) & "', " _
        & gs_TableCode6
    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 : conclairecy 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 File_Ext_cst()

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

On Error GoTo suite

ls_Req = "EXEC Screen_Csts 'mtnc_File_Ext','" & 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_Desc": lbl_Descr = ls_Text
            Case "lbl_def": lbl_Def = ls_Text
            Case "lbl_preview": lbl_Preview = ls_Text
            Case "lbl_quality": lbl_Quality = ls_Text
            Case "lbl_height": lbl_Height = ls_Text
            Case "lbl_width": lbl_Width = ls_Text
            Case "lbl_def_def": lbl_DefaultDef = ls_Text
            Case "lbl_def_mt": lbl_DefaultMT = ls_Text
            Case "lbl_def_qons": lbl_DefaultQS = 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_Descr.Text = "" Then
    txt_Descr.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
If cbo_MT = "" Then
    cbo_MT.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
If chk_Def.value Then
    If cbo_Definition = "" Then
        cbo_Definition.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        Exit Function
    End If
    If txt_Height = "" Then
        txt_Height.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        Exit Function
    End If
    If txt_Width = "" Then
        txt_Width.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        Exit Function
    End If
End If
If chk_Quality.value Then
    If cbo_Quality = "" Then
        cbo_Quality.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        Exit Function
    End If
End If
Control = OK

End Function

Private Sub txt_Height_LostFocus()

MouseOff
If Not ChkNumeric(Formatage(txt_Height, 0), 0) Then
    txt_Height.SetFocus
    MouseOn
    Exit Sub
Else
    txt_Height = Formatage(txt_Height, 0)
End If
MouseOn

End Sub


Private Sub txt_width_LostFocus()

MouseOff
If Not ChkNumeric(Formatage(txt_Width, 0), 0) Then
    txt_Width.SetFocus
    MouseOn
    Exit Sub
Else
    txt_Width = Formatage(txt_Width, 0)
End If
MouseOn

End Sub


