VERSION 5.00
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form C_Formulaire 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Media_ShortClassif"
   ClientHeight    =   3165
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5625
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3165
   ScaleWidth      =   5625
   StartUpPosition =   1  'CenterOwner
   Begin VB.TextBox txt_TextField 
      Height          =   315
      Index           =   4
      Left            =   1560
      Locked          =   -1  'True
      TabIndex        =   16
      TabStop         =   0   'False
      Top             =   1440
      Visible         =   0   'False
      Width           =   2715
   End
   Begin VB.TextBox txt_TextField 
      Height          =   315
      Index           =   2
      Left            =   1560
      Locked          =   -1  'True
      TabIndex        =   11
      TabStop         =   0   'False
      Top             =   720
      Visible         =   0   'False
      Width           =   2715
   End
   Begin VB.TextBox txt_TextField 
      Height          =   315
      Index           =   1
      Left            =   1560
      Locked          =   -1  'True
      TabIndex        =   10
      TabStop         =   0   'False
      Top             =   360
      Visible         =   0   'False
      Width           =   2715
   End
   Begin VB.Frame frm_Bas 
      Height          =   972
      Left            =   0
      TabIndex        =   2
      Top             =   2160
      Width           =   5595
      Begin VB.CommandButton spp_save 
         Default         =   -1  'True
         Height          =   615
         Left            =   4080
         Style           =   1  'Graphical
         TabIndex        =   5
         Top             =   240
         Width           =   615
      End
      Begin VB.CommandButton ssp_quit 
         Height          =   615
         Left            =   4800
         Style           =   1  'Graphical
         TabIndex        =   4
         Top             =   240
         Width           =   615
      End
      Begin VB.CheckBox chk_Int 
         Height          =   252
         Left            =   1620
         TabIndex        =   3
         Top             =   240
         Width           =   252
      End
      Begin Project1.CDate d_DropDate 
         Height          =   315
         Left            =   1620
         TabIndex        =   6
         Top             =   540
         Width           =   1395
         _ExtentX        =   2461
         _ExtentY        =   556
      End
      Begin VB.Label lbl_Int 
         Caption         =   "Internet flag"
         Height          =   252
         Left            =   120
         TabIndex        =   8
         Top             =   240
         Width           =   1572
      End
      Begin VB.Label lbl_Drop 
         Caption         =   "Drop date"
         Height          =   252
         Left            =   120
         TabIndex        =   7
         Top             =   540
         Width           =   1572
      End
   End
   Begin VB.TextBox txt_TextField 
      Height          =   315
      Index           =   0
      Left            =   1560
      Locked          =   -1  'True
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   0
      Visible         =   0   'False
      Width           =   2715
   End
   Begin VB.TextBox txt_TextField 
      Height          =   315
      Index           =   3
      Left            =   1560
      Locked          =   -1  'True
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   1080
      Visible         =   0   'False
      Width           =   2715
   End
   Begin Project1.CDate d_DateField 
      Height          =   315
      Index           =   0
      Left            =   1560
      TabIndex        =   22
      Top             =   0
      Visible         =   0   'False
      Width           =   1395
      _ExtentX        =   2461
      _ExtentY        =   556
   End
   Begin Project1.CDate d_DateField 
      Height          =   315
      Index           =   1
      Left            =   1560
      TabIndex        =   23
      Top             =   360
      Visible         =   0   'False
      Width           =   1395
      _ExtentX        =   2461
      _ExtentY        =   556
   End
   Begin Project1.CDate d_DateField 
      Height          =   315
      Index           =   2
      Left            =   1560
      TabIndex        =   24
      Top             =   720
      Visible         =   0   'False
      Width           =   1395
      _ExtentX        =   2461
      _ExtentY        =   556
   End
   Begin Project1.CDate d_DateField 
      Height          =   315
      Index           =   3
      Left            =   1560
      TabIndex        =   25
      Top             =   1080
      Visible         =   0   'False
      Width           =   1395
      _ExtentX        =   2461
      _ExtentY        =   556
   End
   Begin Project1.CDate d_DateField 
      Height          =   315
      Index           =   4
      Left            =   1560
      TabIndex        =   26
      Top             =   1440
      Visible         =   0   'False
      Width           =   1395
      _ExtentX        =   2461
      _ExtentY        =   556
   End
   Begin VB.Label lbl_Field 
      Caption         =   "lbl_Field"
      Height          =   255
      Index           =   4
      Left            =   0
      TabIndex        =   21
      Top             =   1500
      Visible         =   0   'False
      Width           =   1575
   End
   Begin VB.Label lbl_Field 
      Caption         =   "lbl_Field"
      Height          =   255
      Index           =   3
      Left            =   0
      TabIndex        =   20
      Top             =   1140
      Visible         =   0   'False
      Width           =   1575
   End
   Begin VB.Label lbl_Field 
      Caption         =   "lbl_Field"
      Height          =   255
      Index           =   2
      Left            =   0
      TabIndex        =   19
      Top             =   780
      Visible         =   0   'False
      Width           =   1575
   End
   Begin VB.Label lbl_Field 
      Caption         =   "lbl_Field"
      Height          =   255
      Index           =   1
      Left            =   0
      TabIndex        =   18
      Top             =   420
      Visible         =   0   'False
      Width           =   1575
   End
   Begin MSForms.ComboBox cbo_Combo 
      Height          =   315
      Index           =   4
      Left            =   1560
      TabIndex        =   17
      Top             =   1440
      Visible         =   0   'False
      Width           =   2715
      VariousPropertyBits=   679495707
      DisplayStyle    =   7
      Size            =   "4789;556"
      MatchEntry      =   1
      ShowDropButtonWhen=   2
      FontHeight      =   165
      FontCharSet     =   0
      FontPitchAndFamily=   2
   End
   Begin MSForms.ComboBox cbo_Combo 
      Height          =   315
      Index           =   3
      Left            =   1560
      TabIndex        =   15
      Top             =   1080
      Visible         =   0   'False
      Width           =   2715
      VariousPropertyBits=   679495707
      DisplayStyle    =   7
      Size            =   "4789;556"
      MatchEntry      =   1
      ShowDropButtonWhen=   2
      FontHeight      =   165
      FontCharSet     =   0
      FontPitchAndFamily=   2
   End
   Begin MSForms.ComboBox cbo_Combo 
      Height          =   315
      Index           =   2
      Left            =   1560
      TabIndex        =   14
      Top             =   720
      Visible         =   0   'False
      Width           =   2715
      VariousPropertyBits=   679495707
      DisplayStyle    =   7
      Size            =   "4789;556"
      MatchEntry      =   1
      ShowDropButtonWhen=   2
      FontHeight      =   165
      FontCharSet     =   0
      FontPitchAndFamily=   2
   End
   Begin MSForms.ComboBox cbo_Combo 
      Height          =   315
      Index           =   1
      Left            =   1560
      TabIndex        =   13
      Top             =   360
      Visible         =   0   'False
      Width           =   2715
      VariousPropertyBits=   679495707
      DisplayStyle    =   7
      Size            =   "4789;556"
      MatchEntry      =   1
      ShowDropButtonWhen=   2
      FontHeight      =   165
      FontCharSet     =   0
      FontPitchAndFamily=   2
   End
   Begin MSForms.ComboBox cbo_Combo 
      Height          =   315
      Index           =   0
      Left            =   1560
      TabIndex        =   12
      Top             =   0
      Visible         =   0   'False
      Width           =   2715
      VariousPropertyBits=   679495707
      DisplayStyle    =   7
      Size            =   "4789;556"
      MatchEntry      =   1
      ShowDropButtonWhen=   2
      FontHeight      =   165
      FontCharSet     =   0
      FontPitchAndFamily=   2
   End
   Begin VB.Label lbl_Field 
      Caption         =   "lbl_Field"
      Height          =   255
      Index           =   0
      Left            =   0
      TabIndex        =   9
      Top             =   60
      Visible         =   0   'False
      Width           =   1575
   End
End
Attribute VB_Name = "C_Formulaire"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Public Enum TAction ' Must be passed in a general module
    vbAdd = 1
    vbUpdate = 2
    vbDelete = 3
    vbMoreInfo = 4
End Enum

' Improvements :
'   - Change the way to define field. IT wiil better if it was a unlimited collection
'   - The form must resize himself according to the type and the number of field displayed
'

' letter between () : E means that a variable that can be set to a value, S means that a variable can be get
Public s_ScreenConstantsReq As String   ' (E) SQL Command to get label traduction
Public s_Req As String                  ' (E) Template SQL Command to add/update or delete information
Public b_FromCMain As Boolean           ' (E) Must be true if the calling screen is the CMain (it's for localy updating the grid)
Public b_CloseAfterAdd As Boolean       ' (E) Must be True if you want the window not be closed when  user click on the green check (it's for massive data inserting)
Public s_ReturnLine As String           ' (E) Template line for the CMain grid
Public e_Action As TAction              ' (E) Inform the screen on what action must be done (Add,Update,Delete or moreinfo)
Public s_ID As String                   ' (E) ID of the information to change
Public i_FieldCount As Integer          ' (E) Number of fields that must be used
'Public s_LanguageCode As String
Public i_Concurency As Integer          ' (E) i_Concurency of information to change
Public Field1 As New CFieldData          ' (E) Parameter of the field 1
Public Field2 As New CFieldData          ' (E) Parameter of the field 2
Public Field3 As New CFieldData          ' (E) Parameter of the field 3
Public Field4 As New CFieldData          ' (E) Parameter of the field 4
Public Field5 As New CFieldData          ' (E) Parameter of the field 5
Public b_chkInt As Boolean
Public s_DropDate As String

Public mb_NoInternet As Boolean
Public ml_Width2 As Long
Public mb_NextID As Boolean
Public mb_LoginID As Boolean

Private ma_Field(5) As CFieldData       ' We use an array in intern to factorize the code
Private ml_NextID As Long
Private ml_UCode As Long

' task 409 JN begin
Private mo_medMan As MediaManager

Public Property Set MediaManager(ByRef ao_medMan As MediaManager)
    Set mo_medMan = ao_medMan
End Property
' task 409 end

Private Sub cbo_Combo_Click(Index As Integer)
Dim li_Count As Integer
For li_Count = 1 To i_FieldCount
    If ma_Field(li_Count).s_FieldDepend = "Field" & CStr(Index + 1) Then
        Select Case ma_Field(li_Count).e_Type
        Case vbTextField
            txt_TextField(li_Count - 1).Locked = KO
        Case vbComboBox
            cbo_Combo(li_Count - 1).Locked = KO
'        Case vbDateField
'
'        Case vbLargeTextField
'
        End Select
    End If
Next
End Sub

Private Sub cbo_Combo_DropButtonClick(Index As Integer)
Dim ls_Req As String
Dim lv_ActualCode
    
    If cbo_Combo(Index).Tag = UNLOADED Then
        MouseOff
    
        lv_ActualCode = MCombo_GetCode(cbo_Combo(Index))
        cbo_Combo(Index).Clear
    
        'Add a free element to free the combo choice
        MCombo_AddItemCode cbo_Combo(Index), 0, ""
            
        ls_Req = ma_Field(Index + 1).s_FillReq
        MCombo_Fill cbo_Combo(Index), ls_Req
            
        MCombo_CodeSelect(cbo_Combo(Index)) = lv_ActualCode
        
        cbo_Combo(Index).Tag = Loaded
        
        MouseOn
    End If
End Sub

Private Sub Form_Load()
Dim li_Count As Integer
On Error GoTo suite

MouseOff
' the pictures for the buttons
spp_save.Picture = LoadResPicture(RES_OK, 1)
ssp_quit.Picture = LoadResPicture(RES_QUIT, 1)

Set ma_Field(1) = Field1
Set ma_Field(2) = Field2
Set ma_Field(3) = Field3
Set ma_Field(4) = Field4
Set ma_Field(5) = Field5

For li_Count = 1 To i_FieldCount
    ' Initialize Field after Field
    With ma_Field(li_Count)
        lbl_field(li_Count - 1).Visible = OK
        Select Case .e_Type
        Case vbTextField
            '
             Select Case e_Action
             Case vbAdd
                If .s_FieldDepend = "" Then
                    txt_TextField(li_Count - 1).Locked = .b_Locked
                Else
                    txt_TextField(li_Count - 1).Locked = OK
                End If
             Case vbUpdate
                If .s_FieldDepend = "" Then
                    txt_TextField(li_Count - 1).Locked = .b_Locked
                Else
                    txt_TextField(li_Count - 1).Locked = OK
                End If
             Case vbDelete
                txt_TextField(li_Count - 1).Locked = OK
             Case vbMoreInfo
                txt_TextField(li_Count - 1).Locked = OK
             End Select
             txt_TextField(li_Count - 1).Visible = OK
             txt_TextField(li_Count - 1).Text = .s_InitialValue
             
        Case vbComboBox
            cbo_Combo(li_Count - 1).Tag = UNLOADED
            If .s_InitialCode <> "" Then
                MCombo_AddItemCode cbo_Combo(li_Count - 1), .s_InitialCode, .s_InitialValue
            End If
            Select Case e_Action
             Case vbAdd
                cbo_Combo(li_Count - 1).Enabled = Not (.b_Locked)
             Case vbUpdate
                cbo_Combo(li_Count - 1).Enabled = Not (.b_Locked)
             Case vbDelete
                cbo_Combo(li_Count - 1).Enabled = KO
             Case vbMoreInfo
                cbo_Combo(li_Count - 1).Enabled = KO
            End Select
            cbo_Combo(li_Count - 1).Visible = OK
            
        Case vbDateField
            'Date Field Are not tested
            If .s_InitialCode <> "" Then
                d_DateField(li_Count - 1).SetDate = .s_InitialCode
            End If
            Select Case e_Action
             Case vbAdd
                d_DateField(li_Count - 1).Enabled = Not (.b_Locked)
             Case vbUpdate
                d_DateField(li_Count - 1).Enabled = Not (.b_Locked)
             Case vbDelete
                d_DateField(li_Count - 1).Enabled = KO
             Case vbMoreInfo
                d_DateField(li_Count - 1).Enabled = KO
            End Select
        Case vbLargeTextField
            'Not finished
        End Select
    End With
Next

'Initialize the drop flag and the drop date
If mb_NoInternet Then
    lbl_Int.Visible = False
    chk_Int.Visible = False
    lbl_Drop.Visible = False
    d_DropDate.Visible = False
Else
If e_Action <> vbAdd Then
    If b_chkInt Then
        chk_Int.value = 1
    Else
        chk_Int.value = 0
    End If
    d_DropDate.SetDate = s_DropDate
End If

If e_Action = vbAdd Or e_Action = vbUpdate Then
    chk_Int.Enabled = OK
    d_DropDate.Enabled = OK
Else
    chk_Int.Enabled = KO
    d_DropDate.Enabled = KO
End If

If e_Action = vbMoreInfo Then
    spp_save.Visible = KO
    End If
End If

'Itinialize width 07/05
If ml_Width2 > 0 Then
    Me.Width = Me.Width + ml_Width2
    ssp_quit.Left = ssp_quit.Left + ml_Width2
    spp_save.Left = spp_save.Left + ml_Width2
    Frm_Bas.Width = Frm_Bas.Width + ml_Width2
    txt_TextField(1).Width = txt_TextField(1).Width + ml_Width2
End If

'get user login code
If mb_LoginID 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

'Get translated constants
Getcsts
MouseOn
Exit Sub

suite:
StdError
End Sub


Private Sub Getcsts()

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

On Error GoTo suite

If SQLSubmit(gl_Environment, gl_Database, ll_Statement, s_ScreenConstantsReq) 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 e_Action = vbAdd Then Caption = Caption & " - " & ls_Text
        Case "titleU": If e_Action = vbUpdate Then Caption = Caption & " - " & ls_Text
        Case "titleD": If e_Action = vbDelete Then Caption = Caption & " - " & ls_Text
        Case "titleI": If e_Action = vbMoreInfo Then Caption = Caption & " - " & ls_Text
        Case "lbl_Field1": lbl_field(0) = ls_Text
        Case "lbl_Field2": lbl_field(1) = ls_Text
        Case "lbl_Field3": lbl_field(2) = ls_Text
        Case "lbl_Field4": lbl_field(3) = ls_Text
        Case "lbl_Field5": lbl_field(4) = 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 SetToValueForVB(ByVal ls_TemplateReq As String) As String
'Replace Variable with their value for use with VB (see below)
' Replace Date by the French format
Dim ls_IntFlag As String
Dim ls_DropFlag As String
Dim ls_DropDate As String
Dim li_Count As Integer
Dim ls_Req As String
    ' date on screen are displayed in the french format
    If chk_Int.value = 1 Then ls_IntFlag = "X"
    
    If d_DropDate.isDateEntered Then
        ls_DropFlag = "X"
        ls_DropDate = d_DropDate.GetFrDate
    Else
        ls_DropFlag = ""
        ls_DropDate = ""
    End If
    
    ls_Req = SubstituteAlpha(ls_TemplateReq, "ID", s_ID)
    ls_Req = SubstituteAlpha(ls_Req, "iConc", CStr(i_Concurency))
    For li_Count = 1 To i_FieldCount
        Select Case ma_Field(li_Count).e_Type
        Case vbTextField
            ls_Req = SubstituteAlpha(ls_Req, "Field" & li_Count, txt_TextField(li_Count - 1).Text)
        Case vbComboBox
            ls_Req = SubstituteAlpha(ls_Req, "Field" & li_Count & ".Code", MCombo_GetCode(cbo_Combo(li_Count - 1)))
            ls_Req = SubstituteAlpha(ls_Req, "Field" & li_Count & ".Desc", cbo_Combo(li_Count - 1))
        End Select
    Next
    ls_Req = SubstituteAlpha(ls_Req, "chk_Int", ls_IntFlag)
    ls_Req = SubstituteAlpha(ls_Req, "DropFlag", ls_DropFlag)
    ls_Req = SubstituteAlpha(ls_Req, "DropDate", ls_DropDate)
    SetToValueForVB = ls_Req
End Function


Private Function SetToValueForDB(ByVal ls_TemplateReq As String) As String
'Replace Variable with their value for use with SQL Server7 (see below)
' Replace Date by the English format

Dim ls_IntFlag As String
Dim ls_DropFlag As String
Dim ls_DropDate As String
Dim li_Count As Integer
Dim ls_Req As String
    ' date on SQL Server are managed in the english format
    If chk_Int.value = 1 Then ls_IntFlag = "X"
    
    If d_DropDate.isDateEntered Then
        ls_DropFlag = "X"
        ls_DropDate = d_DropDate.GetUSDate
    Else
        ls_DropFlag = ""
        ls_DropDate = ""
    End If
    
    ls_Req = SubstituteAlpha(ls_TemplateReq, "ID", s_ID)
    ls_Req = SubstituteAlpha(ls_Req, "iConc", CStr(i_Concurency))
    For li_Count = 1 To i_FieldCount
        Select Case ma_Field(li_Count).e_Type
        Case vbTextField
            ls_Req = SubstituteAlpha(ls_Req, "Field" & li_Count, QuoteParam(txt_TextField(li_Count - 1).Text))
        Case vbComboBox
            ls_Req = SubstituteAlpha(ls_Req, "Field" & li_Count & ".Code", MCombo_GetCode(cbo_Combo(li_Count - 1)))
            ls_Req = SubstituteAlpha(ls_Req, "Field" & li_Count & ".Desc", QuoteParam(cbo_Combo(li_Count - 1)))
        End Select
    Next
    ls_Req = SubstituteAlpha(ls_Req, "chk_Int", ls_IntFlag)
    ls_Req = SubstituteAlpha(ls_Req, "DropFlag", ls_DropFlag)
    ls_Req = SubstituteAlpha(ls_Req, "DropDate", ls_DropDate)
    SetToValueForDB = ls_Req
End Function

Private Function Control() As Boolean

Dim li_Count As Integer
Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer

Control = KO

If d_DropDate.isDateEntered Then
    If Not (d_DropDate.isDateValid) Then
        SendMessage 131, "Invalid Date.", gut_LangLogin.Code
        d_DropDate.SetFocus
        Exit Function
    End If
End If

For li_Count = 1 To i_FieldCount
    With ma_Field(li_Count)
        Select Case .e_Type
        Case vbTextField
            If .b_Mandatory Then
                If txt_TextField(li_Count - 1).Text = "" Then
                    txt_TextField(li_Count - 1).SetFocus
                    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
                    Exit Function
                End If
            End If
        Case vbComboBox
            If .b_Mandatory Then
                If cbo_Combo(li_Count - 1).ListIndex = -1 Then
                    cbo_Combo(li_Count - 1).SetFocus
                    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
                    Exit Function
                End If
            End If
        Case vbDateField
            If .b_Mandatory Then
                If Not (d_DateField(li_Count - 1).isDateEntered) Then
                    d_DateField(li_Count - 1).SetFocus
                    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
                    Exit Function
                End If
            End If
        End Select
    End With
Next

For li_Count = 1 To i_FieldCount
    With ma_Field(li_Count)
        If .s_CheckExistance <> "" Then
        
            ls_Req = SetToValueForDB(.s_CheckExistance)
            
            If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
                li_Status = SQLFetch(ll_Statement)
                If Not (li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO) Then
                    Select Case .e_Type
                    Case vbTextField
                        txt_TextField(li_Count - 1).SetFocus
                        SendMessage 134, "Value doesn't exist", gut_LangLogin.Code
                        Exit Function
                    Case vbComboBox
                        cbo_Combo(li_Count - 1).SetFocus
                        SendMessage 134, "Value doesn't exist", gut_LangLogin.Code
                        Exit Function
                    End Select
                End If
            End If
            li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        End If
    End With
Next


Control = OK
Exit Function

Err_Control:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
End Function

Private Sub Reinit()
Dim li_Count As Integer

For li_Count = 1 To i_FieldCount
    With ma_Field(li_Count)
        lbl_field(li_Count - 1).Visible = OK
        Select Case .e_Type
        Case vbTextField
             Select Case e_Action
             Case vbAdd
                txt_TextField(li_Count - 1).Locked = .b_Locked
             Case vbUpdate
                txt_TextField(li_Count - 1).Locked = .b_Locked
             Case vbDelete
                txt_TextField(li_Count - 1).Locked = OK
             Case vbMoreInfo
                txt_TextField(li_Count - 1).Locked = OK
             End Select
             txt_TextField(li_Count - 1).Visible = OK
             txt_TextField(li_Count - 1).Text = .s_InitialValue
        Case vbComboBox
            cbo_Combo(li_Count - 1).Tag = UNLOADED
            If .s_InitialCode <> "" Then
                MCombo_AddItemCode cbo_Combo(li_Count - 1), .s_InitialCode, .s_InitialValue
            End If
            Select Case e_Action
             Case vbAdd
                cbo_Combo(li_Count - 1).Enabled = Not (.b_Locked)
             Case vbUpdate
                cbo_Combo(li_Count - 1).Enabled = Not (.b_Locked)
             Case vbDelete
                cbo_Combo(li_Count - 1).Enabled = KO
             Case vbMoreInfo
                cbo_Combo(li_Count - 1).Enabled = KO
            End Select
            cbo_Combo(li_Count - 1).Visible = OK
        End Select
    End With
Next

chk_Int.value = 0
d_DropDate.SetDate = ""

End Sub


Private Sub Form_Unload(Cancel As Integer)
Dim li_Count As Integer
            Set Field1 = Nothing
            Set Field2 = Nothing
            Set Field3 = Nothing
            Set Field4 = Nothing
            Set Field5 = Nothing
            
            For li_Count = 1 To i_FieldCount
                Set ma_Field(li_Count) = Nothing
            Next
    
    mb_LoginID = False
    mb_NextID = False
    mb_NoInternet = False
    ml_NextID = 0
    ml_Width2 = 0

End Sub

Private Sub spp_save_Click()
'Dim li_Count As Integer
MouseOff
gb_Return = OK
Select Case e_Action
Case vbAdd
    'Next Id
    If mb_NextID Then
        ml_NextID = NextID(gs_TableName)
        If ml_NextID = 0 Then
            MouseOn
            Exit Sub
        Else
            s_Req = Replace(s_Req, "$Key$", ml_NextID)
            s_Req = Replace(s_Req, "$UCode$", ml_UCode)
        End If
    End If

    
    If AddTable Then
        If b_CloseAfterAdd Then
            Unload Me
            Exit Sub
        Else
            Reinit
        End If
    End If
Case vbUpdate
    s_Req = Replace(s_Req, "$UCode$", ml_UCode)
    If UpdTable Then
        Unload Me
        Exit Sub
    End If
Case vbDelete
    If DltTable Then
        Unload Me
        Exit Sub
    End If
End Select
MouseOn

End Sub

Private Sub ssp_quit_Click()

MouseOff

Unload Me

End Sub


Private Function UpdTable() As Boolean
Dim li_Count As Integer
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_IntFlag As String
Dim ls_DropFlag As String
Dim ls_DropDate As String
Dim ls_ReturnLine As String

UpdTable = KO

On Error GoTo suite

If Control Then

    
    'ID
    ls_Req = SetToValueForDB(s_Req)
  
    
    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
            i_Concurency = i_Concurency + 1
            UpdTable = OK
            If b_FromCMain Then
                Call UpdItem
            End If
        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
    If b_FromCMain Then
        C_main.FillGrid
    End If
Case Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Select
End Function


Private Function AddTable() As Boolean

Dim li_Count As Integer
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_Code As String
Dim ls_IntFlag As String
Dim ls_DropFlag As String
Dim ls_DropDate As String
Dim ls_ReturnLine As String

AddTable = KO

On Error GoTo suite

If Control Then

    ls_Req = SetToValueForDB(s_Req)

    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
            AddTable = OK
            li_Status = SQLFetch(ll_Statement)
            If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
                s_ID = ODBCData(ll_Statement, 1)
                li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
                If b_FromCMain Then
                    Call AddItem
                End If
            Else
                li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
            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 DltTable() As Boolean

Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_lngrows As Long

DltTable = KO

On Error GoTo suite

MouseOn
If SendMessage(5, "Delete record ?", gut_LangLogin.Code, vbQuestion + vbYesNo, "Delete ") = vbYes Then
    MouseOff

    ls_Req = SetToValueForDB(s_Req)
    
    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
        Else
            DltTable = OK
            If b_FromCMain Then
                Call DelItem
            End If
        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
    If b_FromCMain Then
        C_main.FillGrid
    End If
Case Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Select
End Function

' **** set of new functions that will take care of caller ****
' task 409 JN begin
' for compatibility with previuos version, called after action failure to reinit iconcurrency and other fields
Private Sub FillGrid()
    If mo_medMan Is Nothing Then
        ' form is opened for Referenced product/project
        C_main.FillGrid
    Else
        ' if this form is opened for Media manager -> short code classification
        Call mo_medMan.Item_Short_FillGrid
    End If
End Sub
Private Sub AddItem()
    Dim ls_ReturnLine As String
    ls_ReturnLine = SetToValueForVB(s_ReturnLine)
    If mo_medMan Is Nothing Then
        C_main.Grid.AddItem ls_ReturnLine, C_main.Grid.Row
    Else
        Call mo_medMan.Item_Short_Add(Split(ls_ReturnLine, Chr(9)))
    End If
End Sub
Private Sub UpdItem()
    Dim ls_ReturnLine As String
    ls_ReturnLine = SetToValueForVB(s_ReturnLine)
    If mo_medMan Is Nothing Then
        C_main.Grid.RemoveItem C_main.Grid.Row
        C_main.Grid.AddItem ls_ReturnLine, C_main.Grid.Row
    Else
        Call mo_medMan.Item_Short_Upd(s_ID, Split(ls_ReturnLine, Chr(9)))
    End If
End Sub
Private Sub DelItem()
    If mo_medMan Is Nothing Then
        C_main.Grid.RemoveItem C_main.Grid.Row
    Else
        Call mo_medMan.Item_Short_Del(s_ID)
    End If
End Sub
' task 409 end

