VERSION 5.00
Object = "{0D452EE1-E08F-101A-852E-02608C4D0BB4}#2.0#0"; "FM20.DLL"
Begin VB.Form C_Memo 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   3825
   ClientLeft      =   975
   ClientTop       =   2235
   ClientWidth     =   7425
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3825
   ScaleWidth      =   7425
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton spp_save 
      Default         =   -1  'True
      Height          =   612
      Left            =   5940
      Style           =   1  'Graphical
      TabIndex        =   6
      Top             =   3120
      Width           =   612
   End
   Begin VB.CommandButton ssp_quit 
      Height          =   612
      Left            =   6720
      Style           =   1  'Graphical
      TabIndex        =   7
      Top             =   3120
      Width           =   612
   End
   Begin VB.PictureBox Pic_Dropped 
      Appearance      =   0  'Flat
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   345
      Left            =   2820
      ScaleHeight     =   345
      ScaleWidth      =   375
      TabIndex        =   5
      Top             =   3420
      Width           =   375
   End
   Begin VB.TextBox txt_dropped 
      ForeColor       =   &H00FF0000&
      Height          =   315
      Left            =   1680
      Locked          =   -1  'True
      TabIndex        =   4
      Top             =   3420
      Width           =   1212
   End
   Begin VB.CheckBox chk_Int 
      Caption         =   "Check1"
      Height          =   252
      Left            =   1680
      TabIndex        =   3
      Top             =   3060
      Width           =   252
   End
   Begin VB.TextBox txt_Definition 
      Height          =   1452
      Left            =   60
      MultiLine       =   -1  'True
      TabIndex        =   2
      Top             =   1440
      Width           =   7272
   End
   Begin VB.TextBox txt_Item 
      Height          =   288
      Left            =   1320
      MaxLength       =   80
      TabIndex        =   1
      Top             =   600
      Width           =   5952
   End
   Begin MSForms.ComboBox cbo_Topic 
      Height          =   315
      Left            =   1320
      TabIndex        =   0
      Top             =   180
      Width           =   2955
      VariousPropertyBits=   679479323
      DisplayStyle    =   7
      Size            =   "5212;556"
      MatchEntry      =   1
      ShowDropButtonWhen=   2
      FontHeight      =   165
      FontCharSet     =   0
      FontPitchAndFamily=   2
   End
   Begin VB.Label lbl_Int 
      Caption         =   "Internet flag"
      Height          =   252
      Left            =   120
      TabIndex        =   12
      Top             =   3060
      Width           =   1452
   End
   Begin VB.Label lbl_Drop 
      Caption         =   "Drop date"
      Height          =   252
      Left            =   120
      TabIndex        =   11
      Top             =   3420
      Width           =   1452
   End
   Begin VB.Label lbl_Definition 
      Caption         =   "lbl_Definition"
      Height          =   252
      Left            =   60
      TabIndex        =   10
      Top             =   1140
      Width           =   1752
   End
   Begin VB.Label lbl_Item 
      Caption         =   "lbl_Item"
      Height          =   252
      Left            =   60
      TabIndex        =   9
      Top             =   600
      Width           =   1272
   End
   Begin VB.Label lbl_Topic 
      Caption         =   "lbl_Topic"
      Height          =   252
      Left            =   60
      TabIndex        =   8
      Top             =   180
      Width           =   1272
   End
End
Attribute VB_Name = "C_Memo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Function SetDescription()
Dim ls_Req As String
Dim ll_Statement As Long
Dim li_Status As Integer

On Error GoTo suite

Select Case gs_TableName
    Case "Quot_Comment"
        ls_Req = "EXEC Quot_Comment_sel " & gs_TableCode & ", '" & gut_LangWork.Code & "'"
    Case Else
        ls_Req = "EXEC Glossary_sel '" & gs_TableCode & "', '" & gs_TableCode3 & "', '" & gut_LangWork.Code & "'"
End Select
If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
    li_Status = SQLFetch(ll_Statement)
    If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
        Select Case gs_TableName
            Case "Quot_Comment"
                txt_Item = ODBCData(ll_Statement, 1)
                If ODBCData(ll_Statement, 2) = "X" Then
                    chk_Int.value = 1
                End If
                txt_dropped = ODBCData(ll_Statement, 3)
                txt_Definition = ODBCMemoGet(ll_Statement, 4)
            Case Else
                MCombo_AddItemCode cbo_Topic, ODBCData(ll_Statement, 1), ODBCData(ll_Statement, 2)
                txt_Item = ODBCData(ll_Statement, 4)
                If ODBCData(ll_Statement, 5) = "X" Then
                    chk_Int.value = 1
                End If
                txt_dropped = ODBCData(ll_Statement, 6)
                txt_Definition = ODBCMemoGet(ll_Statement, 7)
        End Select
    End If
End If
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
Exit Function

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


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_IntFlag As String
Dim ls_DropFlag As String
Dim ls_DropDate As String

Upd_Table = KO

On Error GoTo suite

If chk_Int.value = 1 Then ls_IntFlag = "X"
If txt_dropped <> "" Then
    ls_DropFlag = "X"
    ls_DropDate = FormatD(txt_dropped, "mm/dd/yyyy")
End If
If Control Then
    Select Case gs_TableName
    Case "Quot_Comment"
        ls_Req = gs_ParamReqUpd & " " _
        & gs_TableCode & ", '" _
        & QuoteParam(txt_Item) & "','" _
        & QuoteParam(txt_Definition) & "', " _
        & gs_TableCode2 & ", '" _
        & ls_IntFlag & "', '" _
        & ls_DropFlag & "', '" _
        & ls_DropDate & "'"
    Case Else
        ls_Req = gs_ParamReqUpd & " '" _
        & QuoteParam(gs_TableCode) & "', '" _
        & QuoteParam(gs_TableCode3) & "', '" _
        & QuoteParam(txt_Item) & "', '" _
        & QuoteParam(txt_Definition) & "', " _
        & gs_TableCode6 & ", '" _
        & ls_IntFlag & "','" _
        & ls_DropFlag & "','" _
        & ls_DropDate & "'"
    End Select
    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
            
            Select Case gs_TableName
            Case "Quot_Comment"
                gs_TableCode2 = gs_TableCode2 + 1
                ls_Line = gs_TableCode & Chr(9) & gs_TableCode2 & Chr(9) & txt_Item & Chr(9) & ls_IntFlag & Chr(9) & ls_DropDate
            Case Else
                ls_Line = gs_TableCode & Chr(9) & cbo_Topic & Chr(9) & gs_TableCode3 & Chr(9) & txt_Item & Chr(9) & txt_Definition & Chr(9) & CInt(gs_TableCode6) + 1 & Chr(9) & ls_IntFlag & Chr(9) & ls_DropDate
            End Select
            
            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 Dlt_Table() 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

Dlt_Table = KO

MouseOn
If SendMessage(5, "Delete record ?", gut_LangLogin.Code, vbQuestion + vbYesNo, "Delete ") = vbYes Then
    MouseOff
    Select Case gs_TableName
        Case "Quot_Comment"
            ls_Req = gs_ParamReqDel & gs_TableCode & "," & gs_TableCode2
        Case Else
            ls_Req = gs_ParamReqDel & " '" _
            & QuoteParam(gs_TableCode) & "', '" _
            & QuoteParam(gs_TableCode3) & "', " _
            & gs_TableCode6
    End Select
    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
            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 Function Control() As Boolean

Control = KO
If cbo_Topic.ListIndex = -1 And gs_TableName <> "Quot_Comment" Then
    cbo_Topic.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
If txt_Item = "" Then
    txt_Item.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If

If Trim(txt_Definition) = "" Or left(txt_Definition, 1) = Chr(13) Then
    txt_Definition.SetFocus
    SendMessage 8, "Value must be filled in", gut_LangLogin.Code
    Exit Function
End If
Control = OK

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_IntFlag As String
Dim ls_DropFlag As String
Dim ls_DropDate As String
Dim ls_Line As String
Dim ls_Code As String
Dim ls_Conc As String

On Error GoTo suite

Add_Table = KO

If Control Then
    If chk_Int.value = 1 Then ls_IntFlag = "X"
    If txt_dropped <> "" Then
        ls_DropFlag = "X"
        ls_DropDate = FormatD(txt_dropped, "mm/dd/yyyy")
    End If

    Select Case gs_TableName
        Case "Quot_Comment"
            ls_Req = gs_ParamReqIns & " '" _
            & QuoteParam(txt_Item) & "', '" _
            & QuoteParam(txt_Definition) & "', '" _
            & ls_IntFlag & "', '" _
            & ls_DropFlag & "', '" _
            & ls_DropDate & "'"
        Case Else
            ls_Req = gs_ParamReqIns & " '" _
            & QuoteParam(MCombo_GetCode(cbo_Topic)) & "', '" _
            & QuoteParam(txt_Item) & "', '" _
            & QuoteParam(txt_Definition) & "', '" _
            & ls_IntFlag & "', '" _
            & ls_DropFlag & "', '" _
            & ls_DropDate & "'"
    End Select
    
    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
           ' Find code & concurrency created
            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_Code = ODBCData(ll_Statement, 1)
                    ls_Conc = ODBCData(ll_Statement, 2)
                End If
            Loop
            li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
            
            Select Case gs_TableName
                Case "Quot_Comment"
                    ls_Line = ls_Code & Chr(9) & ls_Conc & Chr(9) & txt_Item & Chr(9) & ls_IntFlag & Chr(9) & ls_DropDate
                Case Else
                    ls_Line = MCombo_GetCode(cbo_Topic) & Chr(9) & cbo_Topic & Chr(9) & ls_Code & Chr(9) & txt_Item & Chr(9) & txt_Definition & Chr(9) & ls_Conc & Chr(9) & ls_IntFlag & Chr(9) & ls_DropDate
            End Select
            C_main.Grid.AddItem ls_Line, C_main.Grid.Row
            Add_Table = OK
        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 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_Topic": lbl_Topic = ls_Text
        Case "lbl_Item": lbl_Item = ls_Text
        Case "lbl_Definition": lbl_Definition = 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 Sub cbo_Topic_DropButtonClick()
Dim lv_Topic

MouseOff
If cbo_Topic.Tag = UNLOADED Then
    lv_Topic = MCombo_GetCode(cbo_Topic)
    cbo_Topic.Clear
    MCombo_Fill cbo_Topic, "EXEC Glossary_Topic_cbo 'E'"
    MCombo_CodeSelect(cbo_Topic) = lv_Topic
    cbo_Topic.Tag = Loaded
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)
If gs_Action = "Delete" Then
    Pic_Dropped.Picture = LoadResPicture(RES_COMBOCOPYGRAY, 1)
Else
    Pic_Dropped.Picture = LoadResPicture(RES_COMBOCOPY, 1)
End If

Getcsts
cbo_Topic.Tag = UNLOADED

If gs_Action <> "Add" Then
    SetDescription
    cbo_Topic.Enabled = KO
    If gs_Action = "Delete" Or gs_Action = "MoreInfo" Then
        txt_Item.Enabled = KO
        txt_Definition.Enabled = KO
        chk_Int.Enabled = KO
        Pic_Dropped.Enabled = KO
        txt_dropped.Enabled = KO
    End If
    If gs_Action = "MoreInfo" Then spp_save.Visible = KO
End If
Select Case gs_TableName
    Case "Quot_Comment"
        lbl_Topic.Visible = KO
        cbo_Topic.Visible = KO
        txt_Item.MaxLength = 15
End Select

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_Item = ""
        txt_Definition = ""
        chk_Int.value = 0
        txt_dropped = ""
        txt_Item.SetFocus
        If gl_NbLineDisplay < 2 Then
            C_main.FillGrid
        End If
    End If
Case "Update"
    If Upd_Table Then
        Unload Me
        C_main.FillGrid
        Exit Sub
    End If
Case "Delete"
    If Dlt_Table Then
        Unload Me
        Exit Sub
    End If
End Select
MouseOn
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 ssp_quit_Click()
MouseOff
Unload Me
End Sub


