VERSION 5.00
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form C_MemoCombo 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   4005
   ClientLeft      =   975
   ClientTop       =   2235
   ClientWidth     =   7860
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4005
   ScaleWidth      =   7860
   Begin VB.CommandButton spp_save 
      Height          =   615
      Left            =   6420
      Style           =   1  'Graphical
      TabIndex        =   7
      Top             =   3300
      Width           =   615
   End
   Begin VB.CommandButton ssp_quit 
      Height          =   615
      Left            =   7140
      Style           =   1  'Graphical
      TabIndex        =   8
      Top             =   3300
      Width           =   615
   End
   Begin VB.PictureBox Pic_Dropped 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      Enabled         =   0   'False
      ForeColor       =   &H80000008&
      Height          =   315
      Left            =   2880
      ScaleHeight     =   315
      ScaleWidth      =   255
      TabIndex        =   6
      Top             =   3600
      Width           =   255
   End
   Begin VB.TextBox txt_dropped 
      Enabled         =   0   'False
      ForeColor       =   &H00FF0000&
      Height          =   315
      Left            =   1680
      Locked          =   -1  'True
      TabIndex        =   5
      Top             =   3600
      Width           =   1212
   End
   Begin VB.CheckBox chk_Int 
      Caption         =   "Check1"
      Enabled         =   0   'False
      Height          =   252
      Left            =   1680
      TabIndex        =   4
      Top             =   3240
      Width           =   252
   End
   Begin VB.TextBox txt_Definition 
      Enabled         =   0   'False
      Height          =   1755
      Left            =   60
      MultiLine       =   -1  'True
      TabIndex        =   3
      Top             =   1380
      Width           =   7695
   End
   Begin VB.TextBox txt_Item 
      Enabled         =   0   'False
      Height          =   288
      Left            =   1320
      MaxLength       =   80
      TabIndex        =   0
      Top             =   120
      Width           =   6435
   End
   Begin MSForms.ComboBox Cbo_Combo2 
      Height          =   315
      Left            =   5340
      TabIndex        =   2
      Top             =   660
      Visible         =   0   'False
      Width           =   2415
      VariousPropertyBits=   679479321
      DisplayStyle    =   7
      Size            =   "4260;556"
      MatchEntry      =   1
      ShowDropButtonWhen=   2
      FontEffects     =   1073750016
      FontHeight      =   165
      FontCharSet     =   0
      FontPitchAndFamily=   2
   End
   Begin MSForms.ComboBox cbo_Combo1 
      Height          =   315
      Left            =   1380
      TabIndex        =   1
      Top             =   660
      Visible         =   0   'False
      Width           =   2415
      VariousPropertyBits=   679479323
      DisplayStyle    =   7
      Size            =   "4260;556"
      MatchEntry      =   1
      ShowDropButtonWhen=   2
      FontHeight      =   165
      FontCharSet     =   0
      FontPitchAndFamily=   2
   End
   Begin VB.Label lbl_Combo2 
      Caption         =   "lbl_Combo2"
      Enabled         =   0   'False
      Height          =   255
      Left            =   3960
      TabIndex        =   14
      Top             =   720
      Visible         =   0   'False
      Width           =   1395
   End
   Begin VB.Label lbl_Int 
      Caption         =   "Internet flag"
      Enabled         =   0   'False
      Height          =   255
      Left            =   120
      TabIndex        =   13
      Top             =   3240
      Width           =   1455
   End
   Begin VB.Label lbl_Drop 
      Caption         =   "Drop date"
      Enabled         =   0   'False
      Height          =   255
      Left            =   120
      TabIndex        =   12
      Top             =   3600
      Width           =   1455
   End
   Begin VB.Label lbl_Definition 
      Caption         =   "lbl_Definition"
      Enabled         =   0   'False
      Height          =   255
      Left            =   60
      TabIndex        =   11
      Top             =   1080
      Width           =   1755
   End
   Begin VB.Label lbl_Item 
      Caption         =   "lbl_Item"
      Enabled         =   0   'False
      Height          =   255
      Left            =   60
      TabIndex        =   10
      Top             =   120
      Width           =   1275
   End
   Begin VB.Label lbl_Combo1 
      Caption         =   "lbl_Combo1"
      Enabled         =   0   'False
      Height          =   255
      Left            =   60
      TabIndex        =   9
      Top             =   720
      Visible         =   0   'False
      Width           =   1275
   End
End
Attribute VB_Name = "C_MemoCombo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'------------------------------------------------------------------
' Name : C_MemoCombo
'
' Parameters :
'       gs_ParamReqCsts   Request for filling screen constants
'       gs_ParamReqDel    Request for deleting
'       gs_ParamReqIns    Request for deleting
'       gs_ParamReqUpd    Request for deleting
'       gs_param2req1     Request for filling combo1
'       gs_param2req2     Request for filling combo2
'       gs_param2req3     Request for getting memo
'       gut_Param.Str1    Number of combo to display ("0" "1" ou "2")
'       gut_Param.Str2    Combo1 mandatory ("OK" ou "KO")
'       gut_Param.Str3    Combo2 mandatory ("OK" ou "KO")
'       gut_Param.Str4    Display description ("OK" ou "KO")
'       gut_param.str5    Code
'       gut_param.str6    Description
'       gut_param.str7    Combo1 code
'       gut_param.str8    Combo1 desc
'       gut_param.str9    Combo2 code
'       gut_param.str10   Combo2 desc
'       gut_param.str11   Internet
'       gut_param.str12   Drop
'       gut_param.str13   iConcurrency
'       gut_param.str14   systeme code
'
' review : Nov/25/1999 by JC
'------------------------------------------------------------------

Dim ms_Code As String   ' The code got after an add or update
Dim ms_iConcurrency As String ' The iConcurrency got after an add or update

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)
    Pic_Dropped.Picture = LoadResPicture(RES_COMBOCOPYGRAY, 1)
 
    ' Fill screen constants
    '----------------------
    Getcsts
    ' Show combobox
    '--------------
    If CInt(gut_Param.Str1) >= 1 Then
        cbo_Combo1.Visible = OK
        lbl_Combo1.Visible = OK
    End If
    If CInt(gut_Param.Str1) >= 2 Then
        Cbo_Combo2.Visible = OK
        lbl_Combo2.Visible = OK
    End If
    'Hide description
    '-----------------
    If gut_Param.Str4 = "KO" Then
        txt_Item.Visible = KO
        lbl_Item.Visible = KO
    End If
    ' Fill the values
    '-----------------
    If gs_Action <> "Add" Then FillValues
    ' Enable the fields
    '------------------------------
    If gs_Action = "Add" Or gs_Action = "Update" Then
        FrameEnabled "C_MemoCombo", OK
        Pic_Dropped.Picture = LoadResPicture(RES_COMBOCOPY, 1)
    End If
    If gs_Action = "MoreInfo" Then spp_save.Visible = KO
    
    cbo_Combo1.Tag = UNLOADED
    Cbo_Combo2.Tag = UNLOADED
    MouseOn
    Exit Sub
suite:
    StdError
End Sub

Private Sub Getcsts()
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 = gs_ParamReqCsts & ",'" & 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_Combo1": lbl_Combo1 = ls_Text
            Case "lbl_Combo2": lbl_Combo2 = ls_Text
            Case "lbl_Item": lbl_Item = ls_Text
            Case "lbl_Definition": lbl_Definition = ls_Text
            Case "lbl_Int": lbl_InternetFlag = ls_Text
            Case "lbl_Drop": lbl_DropDate = 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 FillValues()
Dim ll_Statement As Long
Dim li_Status As Integer
    txt_Item = gut_Param.Str6
    If gut_Param.Str7 <> "" Then MCombo_AddItemCode cbo_Combo1, gut_Param.Str7, gut_Param.Str8
    If gut_Param.Str9 <> "" Then MCombo_AddItemCode Cbo_Combo2, gut_Param.Str9, gut_Param.Str10
    If gut_Param.Str11 = "X" Then chk_Int.value = 1
    txt_dropped = gut_Param.Str12
   
    On Error GoTo suite
    If SQLSubmit(gl_Environment, gl_Database, ll_Statement, gs_Param2Req3 & ",'E'") Then
        li_Status = SQL_SUCCESS
        li_Status = SQLFetch(ll_Statement)
        txt_Definition = ODBCMemoGet(ll_Statement, 1)
    Else
        li_Status = SQL_ERROR
    End If
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    Exit Sub
suite:
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError
    
End Sub

Private Sub Pic_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 spp_save_Click()
'------------------------------------------------
' Write the informations to DB if everythings OK
'------------------------------------------------
    MouseOff
    If gs_Action <> "Delete" Then
        If Control <> OK Then
            MouseOn
            Exit Sub
        End If
    End If
    CreateRequest
    MouseOn
    Unload Me
End Sub

Private Sub ssp_quit_Click()
    MouseOff
    Unload Me
End Sub

Private Sub LoadCombo(ls_Req As String, cbo_Combo As msforms.ComboBox, BlankLine As Boolean)
'-------------------------------------------------------------
' Drop down a combo and load it if necessary with ls_req
'-------------------------------------------------------------
Dim ls_Code
    If cbo_Combo.Tag <> Loaded Then
        MouseOff
        ls_Code = MCombo_GetCode(cbo_Combo)
        cbo_Combo.Clear
        If BlankLine = OK Then MCombo_AddItemCode cbo_Combo, "None", ""
        MCombo_Fill cbo_Combo, ls_Req
        MCombo_CodeSelect(cbo_Combo) = ls_Code
        cbo_Combo.Tag = Loaded
        MouseOn
    End If
End Sub

Private Sub cbo_Combo1_DropButtonClick()
    LoadCombo gs_Param2Req1 & " '" & gut_LangLogin.Code & "'", cbo_Combo1, Not (gut_Param.Str2 = "OK")
End Sub
Private Sub cbo_Combo2_DropButtonClick()
    LoadCombo gs_Param2Req2 & " '" & gut_LangLogin.Code & "'", Cbo_Combo2, Not (gut_Param.Str3 = "OK")
End Sub

Private Sub FrameEnabled(ms_Frame As String, mb_Enabled As Boolean)
Dim ls_Count As Integer
    For ls_Count = 0 To Me.Count - 1
        If Me.Controls(ls_Count).Container.Name = ms_Frame Then Me.Controls(ls_Count).Enabled = mb_Enabled
    Next
End Sub

Private Function Control() As Boolean
Dim lo_Component As Object
'------------------------------------------------------------------------
' Test the validity of all frames (mandatory values and numeric vbalues)
'------------------------------------------------------------------------

' Test if mandatory fields are OK
'----------------------------------
    Set lo_Component = Nothing
    If txt_Definition = "" Then Set lo_Component = txt_Definition
    If gut_Param.Str3 = "OK" And (MCombo_GetCode(Cbo_Combo2) = "None" Or Cbo_Combo2.ListIndex = -1) Then Set lo_Component = Cbo_Combo2
    If gut_Param.Str2 = "OK" And (MCombo_GetCode(cbo_Combo1) = "None" Or cbo_Combo1.ListIndex = -1) Then Set lo_Component = cbo_Combo1
    If gut_Param.Str4 = "OK" And txt_Item = "" Then Set lo_Component = txt_Item
    If TypeName(lo_Component) <> "Nothing" Then
        lo_Component.SetFocus
        SendMessage 8, "Value must be filled in", gut_LangLogin.Code
        Control = KO
        Exit Function
    End If
    Control = OK
End Function

Private Sub CreateRequest()
'-----------------------------------------------------------------------------------
' select, construct and execute the request for updating, adding or deleting a line
'-----------------------------------------------------------------------------------
Dim ls_Req As String
Dim lb_cancel As Boolean
On Error GoTo suite

    lb_cancel = KO
    
    ' Select and construct the request
    '---------------------------------
    Select Case gs_Action
        ' ADDING
        Case "Add":    ls_Req = gs_ParamReqIns & Parameter()
        'UPDATING
        Case "Update": ls_Req = gs_ParamReqUpd & Parameter() & "," & gut_Param.Str13
        ' DELETING
        Case "Delete": MouseOn
                       If SendMessage(5, "Delete record ?", gut_LangLogin.Code, vbQuestion + vbYesNo, "Delete ") = vbYes Then
                            MouseOff
                            ls_Req = gs_ParamReqDel
                        Else
                            lb_cancel = OK
                        End If
    End Select
    If lb_cancel = KO Then
        ' Execute the request
        '---------------------
        li_Status = ExecuteRequest(ls_Req)
        If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
            ' Update the parent grid with the new values
            '---------------------------------------------
            RefreshGrid
        End If
    End If
    Exit Sub
suite:
    StdError
End Sub


Public Function ExecuteRequest(ls_Req As String) As Integer
'----------------------------------------------------------
' Send the request ls_req to the server
'----------------------------------------------------------
Dim ll_Statement As Long
Dim li_Status As Integer
Dim ll_lngrows As Long
On Error GoTo suite
    If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
        li_Status = SQLRowCount(ll_Statement, ll_lngrows)
        If ll_lngrows = 0 Then
            SendMessage 2, "Another user change the record", gut_LangLogin.Code
            li_Status = SQL_ERROR
        Else
            li_Status = SQL_SUCCESS
            ' Get the code and the iConcurrency
            SQLFetch (ll_Statement)
            ms_Code = ODBCData(ll_Statement, 1)
            ms_iConcurrency = ODBCData(ll_Statement, 2)
        End If
    Else
        Select Case gs_Action
            Case "Update": SendMessage 3, "Update failed", gut_LangLogin.Code
            Case "Delete": SendMessage 6, "Delete failed", gut_LangLogin.Code
            Case "Add": SendMessage 4, "Insert failed", gut_LangLogin.Code
        End Select
        li_Status = SQL_ERROR
    End If
    ExecuteRequest = li_Status
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    Exit Function
suite:
    ExecuteRequest = li_Status
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    StdError
End Function

Private Function Parameter() As String
Dim ls_ParamString As String
    If gut_Param.Str4 = "OK" Then ls_ParamString = ",'" & QuoteParam(txt_Item.Text) & "'"
    If CInt(gut_Param.Str1) >= 1 Then
        If (MCombo_GetCode(cbo_Combo1) = "None" Or cbo_Combo1.ListIndex = -1) Then
            ls_ParamString = ls_ParamString & ",Null"
        Else
            ls_ParamString = ls_ParamString & ",'" & MCombo_GetCode(cbo_Combo1) & "'"
        End If
    End If
    If CInt(gut_Param.Str1) >= 2 Then
        If (MCombo_GetCode(Cbo_Combo2) = "None" Or Cbo_Combo2.ListIndex = -1) Then
            ls_ParamString = ls_ParamString & ",Null"
        Else
            ls_ParamString = ls_ParamString & ",'" & MCombo_GetCode(Cbo_Combo2) & "'"
        End If
    End If
    ls_ParamString = ls_ParamString & ",'" & QuoteParam(txt_Definition.Text) & "'"
    If chk_Int.value = 1 Then
        ls_ParamString = ls_ParamString & ",'X'"
    Else
        ls_ParamString = ls_ParamString & ",''"
    End If
    If txt_dropped = "" Then
        ls_ParamString = ls_ParamString & ",null"
    Else
        ls_ParamString = ls_ParamString & ",'" & FormatD(txt_dropped, "mm/dd/yyyy") & "'"
    End If
    Parameter = ls_ParamString
End Function

Public Sub RefreshGrid()
'--------------------------------------------
' Refresh the parent grid
'--------------------------------------------
Dim ls_Line As String
On Error GoTo suite:
    ls_Line = ms_Code
    ls_Line = ls_Line & Chr(9) & ms_iConcurrency
    If gut_Param.Str4 = "OK" Then ls_Line = ls_Line & Chr(9) & txt_Item
    ls_Line = ls_Line & Chr(9) & txt_Definition
    If CInt(gut_Param.Str1) >= 1 Then ls_Line = ls_Line & Chr(9) & MCombo_GetCode(cbo_Combo1) & Chr(9) & cbo_Combo1.value
    If CInt(gut_Param.Str1) >= 2 Then ls_Line = ls_Line & Chr(9) & MCombo_GetCode(Cbo_Combo2) & Chr(9) & Cbo_Combo2.value
    ls_Line = ls_Line & Chr(9) & gut_Param.Str14
    If chk_Int.value = 1 Then
        ls_Line = ls_Line & Chr(9) & "X"
    Else
        ls_Line = ls_Line & Chr(9) & ""
    End If
    ls_Line = ls_Line & Chr(9) & "" & Chr(9) & txt_dropped
              
                 
    Select Case gs_Action
        Case "Add":     C_main.Grid.AddItem ls_Line
                        C_main.Grid.Row = C_main.Grid.Rows - 1
                        If gl_NbLineDisplay < 2 Then C_main.FillGrid
                        gb_Return = OK
        Case "Update":  C_main.Grid.RemoveItem C_main.Grid.Row
                        C_main.Grid.AddItem ls_Line, C_main.Grid.Row
                        gb_Return = OK
        Case "Delete":  C_main.Grid.RemoveItem C_main.Grid.Row
                        gb_Return = OK
        Case Else:      gb_Return = KO
    End Select
    Exit Sub
suite:
    If Err = 30015 Then
        Quot_Line_View.FillGrid
    Else
        StdError
    End If
End Sub




