VERSION 4.00
Begin VB.Form Viewer_mtnc 
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   2232
   ClientLeft      =   1908
   ClientTop       =   2448
   ClientWidth     =   6336
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   Height          =   2652
   Left            =   1860
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2232
   ScaleWidth      =   6336
   ShowInTaskbar   =   0   'False
   Top             =   2076
   Width           =   6432
   Begin VB.TextBox txt_Sp1 
      Height          =   285
      Left            =   180
      MaxLength       =   15
      TabIndex        =   2
      Top             =   1740
      Visible         =   0   'False
      Width           =   1455
   End
   Begin VB.TextBox txt_Desc 
      Height          =   285
      Left            =   180
      MaxLength       =   40
      TabIndex        =   0
      Top             =   420
      Width           =   4575
   End
   Begin VB.TextBox txt_Sp2 
      Height          =   285
      Left            =   1740
      MaxLength       =   15
      TabIndex        =   3
      Top             =   1740
      Visible         =   0   'False
      Width           =   1455
   End
   Begin VB.TextBox txt_Sp3 
      Height          =   285
      Left            =   3300
      MaxLength       =   15
      TabIndex        =   4
      Top             =   1740
      Visible         =   0   'False
      Width           =   1455
   End
   Begin VB.TextBox txt_Path 
      Height          =   285
      Left            =   180
      MaxLength       =   40
      TabIndex        =   1
      Top             =   1080
      Width           =   4575
   End
   Begin VB.CommandButton spp_save 
      Default         =   -1  'True
      Height          =   612
      Left            =   4920
      Style           =   1  'Graphical
      TabIndex        =   11
      Top             =   1440
      Width           =   612
   End
   Begin VB.CommandButton ssp_quit 
      Height          =   612
      Left            =   5580
      Style           =   1  'Graphical
      TabIndex        =   10
      Top             =   1440
      Width           =   612
   End
   Begin VB.Label lbl_Desc 
      Alignment       =   2  'Center
      Caption         =   "Description"
      BeginProperty Font 
         name            =   "MS Sans Serif"
         charset         =   1
         weight          =   700
         size            =   7.8
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   180
      TabIndex        =   9
      Top             =   120
      Width           =   4572
   End
   Begin VB.Label lbl_Sp1 
      Alignment       =   2  'Center
      Caption         =   "Spare1"
      BeginProperty Font 
         name            =   "MS Sans Serif"
         charset         =   1
         weight          =   700
         size            =   7.8
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   180
      TabIndex        =   8
      Top             =   1440
      Visible         =   0   'False
      Width           =   1452
   End
   Begin VB.Label lbl_Sp2 
      Alignment       =   2  'Center
      Caption         =   "Spare2"
      BeginProperty Font 
         name            =   "MS Sans Serif"
         charset         =   1
         weight          =   700
         size            =   7.8
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   1740
      TabIndex        =   7
      Top             =   1440
      Visible         =   0   'False
      Width           =   1452
   End
   Begin VB.Label lbl_Sp3 
      Alignment       =   2  'Center
      Caption         =   "Spare3"
      BeginProperty Font 
         name            =   "MS Sans Serif"
         charset         =   1
         weight          =   700
         size            =   7.8
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   3300
      TabIndex        =   6
      Top             =   1440
      Visible         =   0   'False
      Width           =   1452
   End
   Begin VB.Label lbl_Path 
      Alignment       =   2  'Center
      Caption         =   "Path"
      BeginProperty Font 
         name            =   "MS Sans Serif"
         charset         =   1
         weight          =   700
         size            =   7.8
         underline       =   0   'False
         italic          =   0   'False
         strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   180
      TabIndex        =   5
      Top             =   780
      Width           =   4572
   End
End
Attribute VB_Name = "Viewer_mtnc"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

Dim mi_Concurrency As Integer

Private Const NB_SPARE = 0


Private Sub Form_Load()

On Error GoTo suite

MouseOff

If gut_LangLogin.Code = "R" Then ChangeToCyrillic Me

spp_save.Picture = LoadResPicture(res_Ok, 1)
ssp_quit.Picture = LoadResPicture(res_Quit, 1)

If NB_SPARE > 0 Then
    lbl_Sp1.Visible = OK
    txt_Sp1.Visible = OK
    If NB_SPARE > 1 Then
        lbl_Sp2.Visible = OK
        txt_Sp2.Visible = OK
        If NB_SPARE > 2 Then
            lbl_Sp3.Visible = OK
            txt_Sp3.Visible = OK
        End If
    End If
End If
mtnc_Viewer_cst
If gs_Action <> "Add" Then
    Set_description
    If gs_Action = "Delete" Then
        txt_desc.Enabled = KO
        txt_Path.Enabled = KO
        txt_Sp1.Enabled = KO
        txt_Sp2.Enabled = KO
        txt_Sp3.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_desc = ""
        txt_Path = ""
        txt_Sp1 = ""
        txt_Sp2 = ""
        txt_Sp3 = ""
    End If
Case "Update":
    If upd_table Then
        Unload Me
    End If
Case "Delete":
    If dlt_table Then
        Unload Me
    End If
End Select
MouseOn

End Sub
Private Sub ssp_quit_Click()
MouseOff
Unload Me
End Sub

Public Function Set_description() As String
C_main.Grid.Col = 1
txt_desc = C_main.Grid.Text
C_main.Grid.Col = 2
txt_Path = C_main.Grid.Text
C_main.Grid.Col = 3
mi_Concurrency = C_main.Grid.Text
End Function
Public 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

upd_table = KO

On Error GoTo suite

If Control Then
    ls_Req = "EXEC media_Viewer_upd '" _
        & gs_TableCode & "', '" _
        & QuoteParam(txt_desc) & "', '" _
        & QuoteParam(txt_Path) & "', " _
        & mi_Concurrency
    If SQLSubmit(gl_DataBase, ll_Statement, ls_Req) Then
        li_Status = SQLRowCount(ll_Statement, ll_Lngrows)
        li_Status = SQLFreeStmt(ll_Statement, SQL_DROP)
        If ll_Lngrows = 0 Then
            SendMessage 2, "Another user change the record"
            C_main.FillGrid
        Else
            upd_table = OK
            C_main.Grid.RemoveItem C_main.Grid.Row
            ls_Line = gs_TableCode & Chr(9) & txt_desc & Chr(9) & txt_Path & Chr(9) & CInt(gs_TableCode4) + 1
            C_main.Grid.AddItem ls_Line, C_main.Grid.Row
        End If
    Else
        li_Status = SQLFreeStmt(ll_Statement, SQL_DROP)
        SendMessage 3, "Update failed"
    End If
End If
Exit Function

suite:
MouseOn
Select Case Err:
Case 30015:
    C_main.FillGrid
    Exit Function
Case Else:
    li_Status = SQLFreeStmt(ll_Statement, SQL_DROP)
    StdError
End Select
End Function
Public 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

add_table = KO

On Error GoTo suite

If Control Then
    ls_Req = "EXEC media_Viewer_ins '" _
        & QuoteParam(txt_desc) & "', '" _
        & QuoteParam(txt_Path) & "'"
        
    If SQLSubmit(gl_DataBase, ll_Statement, ls_Req) Then
        li_Status = SQLRowCount(ll_Statement, ll_Lngrows)
        li_Status = SQLFreeStmt(ll_Statement, SQL_DROP)
        If ll_Lngrows = 0 Then
            SendMessage 4, "Insert failed"
        Else
            add_table = OK
        End If
        C_main.FillGrid
    Else
        li_Status = SQLFreeStmt(ll_Statement, SQL_DROP)
        SendMessage 4, "Insert failed"
    End If
End If
Exit Function

suite:
li_Status = SQLFreeStmt(ll_Statement, SQL_DROP)
StdError
End Function
Public 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

gs_Message = MsgText(5)
If gs_Message = "" Then
    gs_Message = "Delete the record ?"
End If
MouseOn
If MsgBox(gs_Message, vbQuestion + vbYesNo, "Delete ") = vbYes Then
    MouseOff
    C_main.pic_delete.Visible = KO
    C_main.pic_fire.Visible = OK
    ls_Req = "EXEC media_Viewer_del '" & gs_TableCode & "', " & mi_Concurrency
    If SQLSubmit(gl_DataBase, ll_Statement, ls_Req) Then
        li_Status = SQLRowCount(ll_Statement, ll_Lngrows)
        li_Status = SQLFreeStmt(ll_Statement, SQL_DROP)
        If ll_Lngrows = 0 Then
            SendMessage 7, "Delete failed : concurrency problem ?"
            C_main.FillGrid
        Else
            dlt_table = OK
            C_main.Grid.RemoveItem C_main.Grid.Row
        End If
    Else
        li_Status = SQLFreeStmt(ll_Statement, SQL_DROP)
        SendMessage 6, "Delete failed"
    End If
End If
MouseOff
Exit Function

suite:
MouseOn
Select Case Err:
Case 30015:
    C_main.FillGrid
    Exit Function
Case Else:
    li_Status = SQLFreeStmt(ll_Statement, SQL_DROP)
    StdError
End Select
End Function
Private Sub mtnc_Viewer_cst()

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

On Error GoTo suite

ls_Req = "EXEC screen_csts mtnc_Viewer, '" & gut_LangWork.Code & "'"
If SQLSubmit(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_desc = ls_Text
        Case "lbl_Path": lbl_Path = ls_Text
        Case "lbl_Sp1": lbl_Sp1 = ls_Text
        Case "lbl_Sp2": lbl_Sp2 = ls_Text
        Case "lbl_Sp3": lbl_Sp3 = ls_Text
        End Select
    End If
Loop
li_Status = SQLFreeStmt(ll_Statement, SQL_DROP)

Exit Sub

suite:
li_Status = SQLFreeStmt(ll_Statement, SQL_DROP)
StdError
End Sub

Public Function Control() As Boolean

Control = KO
If txt_desc.Text = "" Then
    txt_desc.SetFocus
    SendMessage 8, "Value must be filled in"
    Exit Function
End If
If txt_Path.Text = "" Then
    txt_Path.SetFocus
    SendMessage 8, "Value must be filled in"
    Exit Function
End If
Control = OK

End Function

