VERSION 5.00
Begin VB.Form PossibleList_Mtnc 
   Caption         =   "Possible area"
   ClientHeight    =   5010
   ClientLeft      =   435
   ClientTop       =   1620
   ClientWidth     =   7875
   ControlBox      =   0   'False
   LinkTopic       =   "Form4"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   5010
   ScaleWidth      =   7875
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton spp_save 
      Height          =   612
      Left            =   6300
      Style           =   1  'Graphical
      TabIndex        =   2
      Top             =   4320
      Width           =   612
   End
   Begin VB.CommandButton ssp_quit 
      Height          =   612
      Left            =   6960
      Style           =   1  'Graphical
      TabIndex        =   3
      Top             =   4320
      Width           =   612
   End
   Begin VB.ListBox lst_ToDelete 
      Height          =   645
      Left            =   3180
      Sorted          =   -1  'True
      TabIndex        =   12
      Top             =   3600
      Visible         =   0   'False
      Width           =   1524
   End
   Begin VB.ListBox lst_ToInsert 
      Height          =   645
      Left            =   3180
      Sorted          =   -1  'True
      TabIndex        =   11
      Top             =   1260
      Visible         =   0   'False
      Width           =   1524
   End
   Begin VB.PictureBox pic_Out 
      AutoSize        =   -1  'True
      Height          =   408
      Left            =   3720
      ScaleHeight     =   345
      ScaleWidth      =   345
      TabIndex        =   7
      Top             =   3120
      Width           =   408
   End
   Begin VB.PictureBox pic_In 
      AutoSize        =   -1  'True
      Height          =   408
      Left            =   3720
      ScaleHeight     =   345
      ScaleWidth      =   345
      TabIndex        =   6
      Top             =   2400
      Width           =   408
   End
   Begin VB.ListBox lst_Selected 
      Height          =   2595
      ItemData        =   "Posslist.frx":0000
      Left            =   4500
      List            =   "Posslist.frx":0002
      TabIndex        =   5
      Top             =   1440
      Width           =   3012
   End
   Begin VB.ListBox lst_NotSelected 
      Height          =   2595
      ItemData        =   "Posslist.frx":0004
      Left            =   300
      List            =   "Posslist.frx":0006
      TabIndex        =   4
      Top             =   1440
      Width           =   3012
   End
   Begin VB.TextBox txt_Title 
      Height          =   312
      Left            =   2340
      TabIndex        =   1
      Top             =   420
      Width           =   3012
   End
   Begin VB.Label lbl_Classif 
      Alignment       =   2  'Center
      Caption         =   "Area classification within market segmentation"
      Height          =   252
      Left            =   1680
      TabIndex        =   10
      Top             =   900
      Width           =   4392
   End
   Begin VB.Label lbl_Selected 
      Alignment       =   2  'Center
      Caption         =   "Selected"
      Height          =   252
      Left            =   4500
      TabIndex        =   9
      Top             =   1140
      Width           =   3012
   End
   Begin VB.Label lbl_NotSelected 
      Alignment       =   2  'Center
      Caption         =   "Not selected"
      Height          =   252
      Left            =   300
      TabIndex        =   8
      Top             =   1140
      Width           =   3012
   End
   Begin VB.Label lbl_Title 
      Alignment       =   2  'Center
      Caption         =   "Title"
      Height          =   252
      Left            =   2340
      TabIndex        =   0
      Top             =   120
      Width           =   3012
   End
End
Attribute VB_Name = "PossibleList_Mtnc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim ms_Code As String
Private Function AddTable() As Boolean
Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_lngrows As Long
Dim ls_Mks As String
Dim ls_Ra As String
Dim i  As Integer

On Error GoTo suite

AddTable = KO

If ms_Code = "" Then
    Exit Function
End If
For i = 0 To lst_ToInsert.ListCount - 1
    ls_Mks = left(lst_ToInsert.List(i), InStr(1, lst_ToInsert.List(i), "\", 1) - 1)
    ls_Ra = right(lst_ToInsert.List(i), Len(lst_ToInsert.List(i)) - Len(ls_Mks) - 1)
    ls_Req = "EXEC possible_area_list_ins '" _
        & ms_Code & "', '" _
        & gut_LangWork.Code & "', '" _
        & QuoteParam(ls_Mks) & "', '" _
        & QuoteParam(ls_Ra) & "'"
    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
            Exit Function
        End If
    Else
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        SendMessage 4, "Insert failed", gut_LangLogin.Code
        Exit Function
    End If
Next i
AddTable = OK
Exit Function

suite:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError
End Function
Private Function AddTitle() As Boolean
Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_lngrows As Long

On Error GoTo suite

AddTitle = KO

ls_Req = "EXEC Possible_Area_Comb_ins '" _
    & QuoteParam(txt_Title) & "'"

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
        ms_Code = ODBCData(ll_Statement, 1)
        AddTitle = OK
    End If
Loop
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
Exit Function

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

Private Function UpdTitle() As Boolean
Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_lngrows As Long

On Error GoTo suite

UpdTitle = KO

ls_Req = "EXEC Possible_Area_Comb_upd '" _
    & QuoteParam(gs_TableCode) & "', '" _
    & QuoteParam(txt_Title) & "'," _
    & gs_TableCode2
If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
    li_Status = SQL_SUCCESS
    UpdTitle = OK
Else
    li_Status = SQL_ERROR
End If
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
Exit Function

suite:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError
End Function
Private Sub GetScCsts()
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

ls_Req = "EXEC Screen_Csts 'mtnc_poss_area', '" & 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 = ODBCData(ll_Statement, 2)
        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_title": lbl_Title = ls_Text
            Case "lbl_classif": lbl_Classif = ls_Text
            Case "lbl_select": lbl_Selected = ls_Text
            Case "lbl_notselect": lbl_NotSelected = 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 Sub Form_Load()
Dim ls_Req As String

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)
pic_In.Picture = LoadResPicture(RES_RIGHT, 1)
pic_Out.Picture = LoadResPicture(RES_LEFT, 1)
GetScCsts
Select Case gs_Action
    Case "Add":
        lst_NotSelected.Clear
        lst_Selected.Clear
        ls_Req = "EXEC Recommended_Comb_cbo '" & gut_LangWork.Code & "'"
        FillLstSingle ls_Req, lst_NotSelected
    Case "Delete":
        C_main.Grid.Col = 2
        txt_Title = C_main.Grid.Text
        txt_Title.Enabled = KO
        lst_NotSelected.Clear
        lst_Selected.Clear
        ls_Req = "EXEC Recommended_Comb_cbo2 '" & gs_TableCode & "','" & gut_LangWork.Code & "'"
        FillLstSingle ls_Req, lst_NotSelected
        ls_Req = "EXEC Recommended_Comb_cbo3 '" & gs_TableCode & "','" & gut_LangWork.Code & "'"
        FillLstSingle ls_Req, lst_Selected
        pic_In.Visible = KO
        pic_Out.Visible = KO
    Case "Update":
        C_main.Grid.Col = 2
        txt_Title = C_main.Grid.Text
        lst_NotSelected.Clear
        lst_Selected.Clear
        ls_Req = "EXEC Recommended_Comb_cbo2 '" & gs_TableCode & "','" & gut_LangWork.Code & "'"
        FillLstSingle ls_Req, lst_NotSelected
        ls_Req = "EXEC Recommended_Comb_cbo3 '" & gs_TableCode & "','" & gut_LangWork.Code & "'"
        FillLstSingle ls_Req, lst_Selected
    Case "MoreInfo":
        C_main.Grid.Col = 2
        txt_Title = C_main.Grid.Text
        txt_Title.Enabled = KO
        lst_NotSelected.Clear
        lst_Selected.Clear
        ls_Req = "EXEC Recommended_Comb_cbo2 '" & gs_TableCode & "','" & gut_LangWork.Code & "'"
        FillLstSingle ls_Req, lst_NotSelected
        ls_Req = "EXEC Recommended_Comb_cbo3 '" & gs_TableCode & "','" & gut_LangWork.Code & "'"
        FillLstSingle ls_Req, lst_Selected
        pic_In.Visible = KO
        pic_Out.Visible = KO
        spp_save.Visible = KO
End Select
MouseOn

End Sub


Private Sub pic_In_Click()
If lst_NotSelected.ListIndex <> -1 Then
    If Not RemoveItemLst(lst_ToDelete, lst_NotSelected.Text) Then
        lst_ToInsert.AddItem lst_NotSelected.Text
    End If
    lst_Selected.AddItem lst_NotSelected
    lst_NotSelected.RemoveItem lst_NotSelected.ListIndex
End If
End Sub

Private Sub pic_Out_Click()
If lst_Selected.ListIndex <> -1 Then
    If Not RemoveItemLst(lst_ToInsert, lst_Selected.Text) Then
        lst_ToDelete.AddItem lst_Selected.Text
    End If
    lst_NotSelected.AddItem lst_Selected
    lst_Selected.RemoveItem lst_Selected.ListIndex
End If
End Sub


Private Sub spp_save_Click()
Dim ls_Line As String

MouseOff
Select Case gs_Action
    Case "Add":
        If Control Then
            If BeginTran(gl_Environment, gl_Database) Then
                If AddTitle Then
                    If AddTable Then
                        If CommitTran(gl_Environment, gl_Database) Then
                            ls_Line = ms_Code & Chr(9) & 1 & Chr(9) & txt_Title
                            C_main.Grid.AddItem ls_Line
                            C_main.Grid.Row = C_main.Grid.Rows - 1
                            gb_Return = OK
                            Unload Me
                        Else
                            RollbackTran gl_Environment, gl_Database
                            SendMessage 4, "Insert failed", gut_LangLogin.Code
                        End If
                    Else
                        RollbackTran gl_Environment, gl_Database
                        SendMessage 4, "Insert failed", gut_LangLogin.Code
                    End If
                Else
                    RollbackTran gl_Environment, gl_Database
                    SendMessage 4, "Insert failed", gut_LangLogin.Code
                End If
            Else
                SendMessage 4, "Insert failed", gut_LangLogin.Code
            End If
        End If
    Case "Delete":
        If BeginTran(gl_Environment, gl_Database) Then
            If DltTable2 Then
                If CommitTran(gl_Environment, gl_Database) Then
                    C_main.Grid.RemoveItem C_main.Grid.Row
                    gb_Return = OK
                    Unload Me
                Else
                    RollbackTran gl_Environment, gl_Database
                    SendMessage 6, "Delete failed", gut_LangLogin.Code
                End If
            Else
                RollbackTran gl_Environment, gl_Database
                SendMessage 6, "Delete failed", gut_LangLogin.Code
            End If
        Else
            SendMessage 6, "Delete failed", gut_LangLogin.Code
        End If
    Case "Update":
        If Control Then
            If BeginTran(gl_Environment, gl_Database) Then
                ms_Code = gs_TableCode
                If UpdTitle Then
                    If AddTable Then
                        If DltTable Then
                            If CommitTran(gl_Environment, gl_Database) Then
                                C_main.Grid.RemoveItem C_main.Grid.Row
                                ls_Line = ms_Code & Chr(9) & CInt(gs_TableCode2) + 1 & Chr(9) & txt_Title
                                C_main.Grid.AddItem ls_Line
                                C_main.Grid.Row = C_main.Grid.Rows - 1
                                gb_Return = OK
                                Unload Me
                            Else
                                RollbackTran gl_Environment, gl_Database
                                SendMessage 3, "Update failed", gut_LangLogin.Code
                            End If
                        Else
                            RollbackTran gl_Environment, gl_Database
                            SendMessage 3, "Update failed", gut_LangLogin.Code
                        End If
                    Else
                        RollbackTran gl_Environment, gl_Database
                        SendMessage 3, "Update failed", gut_LangLogin.Code
                    End If
                Else
                    RollbackTran gl_Environment, gl_Database
                    SendMessage 3, "Update failed", gut_LangLogin.Code
                End If
            Else
                SendMessage 3, "Update failed", gut_LangLogin.Code
            End If
        End If
End Select
MouseOn
End Sub
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
Dim ls_Mks As String
Dim ls_Ra As String
Dim i  As Integer

On Error GoTo suite

DltTable = KO
For i = 0 To lst_ToDelete.ListCount - 1
    ls_Mks = left(lst_ToDelete.List(i), InStr(1, lst_ToDelete.List(i), "\", 1) - 1)
    ls_Ra = right(lst_ToDelete.List(i), Len(lst_ToDelete.List(i)) - Len(ls_Mks) - 1)
    ls_Req = "EXEC possible_area_list_del '" _
        & ms_Code & "', '" _
        & gut_LangWork.Code & "', '" _
        & QuoteParam(ls_Mks) & "', '" _
        & QuoteParam(ls_Ra) & "'"
    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
            Exit Function
        End If
    Else
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        SendMessage 6, "Delete failed", gut_LangLogin.Code
        Exit Function
    End If
Next i
DltTable = OK
Exit Function

suite:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError
End Function
Private Function DltTable2() As Boolean
Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_lngrows As Long

On Error GoTo suite

DltTable2 = KO
ls_Req = "EXEC Possible_Area_Comb_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
        Exit Function
    End If
Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    SendMessage 6, "Delete failed", gut_LangLogin.Code
    Exit Function
End If
DltTable2 = OK
Exit Function

suite:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError
End Function
Private Function Control() As Boolean
Control = KO
If txt_Title = "" Then
    txt_Title.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
If lst_Selected.ListCount = 0 Then
    lst_Selected.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
Control = OK
End Function
Private Sub ssp_quit_Click()
Unload Me
End Sub


