VERSION 5.00
Begin VB.Form Query_Title 
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   4410
   ClientLeft      =   1740
   ClientTop       =   1500
   ClientWidth     =   5550
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4410
   ScaleWidth      =   5550
   Begin VB.Frame ssp_Command 
      BackColor       =   &H80000009&
      BorderStyle     =   0  'None
      Height          =   612
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   5772
      Begin VB.PictureBox pic_ok 
         Appearance      =   0  'Flat
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         ForeColor       =   &H80000008&
         Height          =   465
         Left            =   120
         ScaleHeight     =   468
         ScaleMode       =   0  'User
         ScaleWidth      =   465
         TabIndex        =   6
         Top             =   120
         Width           =   465
      End
      Begin VB.PictureBox pic_delete 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   465
         Left            =   720
         ScaleHeight     =   465
         ScaleWidth      =   465
         TabIndex        =   5
         Top             =   120
         Width           =   465
      End
      Begin VB.PictureBox pic_quit 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         DragIcon        =   "Q_TITLE.frx":0000
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   465
         Left            =   1320
         ScaleHeight     =   465
         ScaleWidth      =   465
         TabIndex        =   4
         Top             =   120
         Width           =   465
      End
      Begin VB.PictureBox pic_add 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         DragIcon        =   "Q_TITLE.frx":030A
         BeginProperty Font 
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   465
         Left            =   120
         ScaleHeight     =   465
         ScaleWidth      =   465
         TabIndex        =   3
         Top             =   120
         Width           =   465
      End
   End
   Begin VB.TextBox txt_Title 
      Height          =   288
      Left            =   180
      MaxLength       =   80
      TabIndex        =   1
      Top             =   960
      Width           =   5172
   End
   Begin VB.ListBox lst_Title 
      Height          =   2790
      ItemData        =   "Q_TITLE.frx":0614
      Left            =   180
      List            =   "Q_TITLE.frx":0616
      TabIndex        =   0
      Top             =   1320
      Width           =   5172
   End
End
Attribute VB_Name = "Query_Title"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim mi_Code As Integer
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

AddTitle = KO

On Error GoTo suite

If lst_Title.ListIndex = -1 Then
' New title
    ls_Req = "EXEC Query_Save_ins '" _
        & prg.LoginName & "', '" _
        & gut_Param.Str1 & "', '" _
        & gut_Param.Str2 & "', " _
        & gut_Param.Str3 & ", '" _
        & gut_LangLogin.Code & "', '" _
        & QuoteParam(txt_Title) & "'"
Else
' Existing title
    mi_Code = lst_Title.ItemData(lst_Title.ListIndex)
    ls_Req = "EXEC Query_Save_Detail_del " _
        & mi_Code
End If
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
    Else
        li_Status = SQLFetch(ll_Statement)
        If li_Status = SQL_SUCCESS Or li_Status = SQL_SUCCESS_WITH_INFO Then
            mi_Code = ODBCData(ll_Statement, 1)
        End If
        li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
        AddTitle = OK
    End If
Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    SendMessage 4, "Insert failed", gut_LangLogin.Code
End If
Exit Function

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

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

On Error GoTo suite

MouseOn
If SendMessage(5, "Delete record ?", gut_LangLogin.Code, vbQuestion + vbYesNo, "Delete ") = vbNo Then
    MouseOff
    Exit Sub
End If
MouseOff
ls_Req = "EXEC Query_Save_del " _
    & lst_Title.ItemData(lst_Title.ListIndex)
If SQLSubmit(gl_Environment, gl_Database, ll_Statement, ls_Req) Then
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
Else
    li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
    SendMessage 6, "Delete failed", gut_LangLogin.Code
End If
Exit Sub

suite:
li_Status = SQLFreeStatement(ll_Statement, SQL_DROP)
StdError
End Sub
Private Sub FillLstTitles()

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

On Error GoTo suite

lst_Title.Clear
ls_Req = "EXEC Query_Save_lst '" _
    & prg.LoginName & "', '" _
    & gut_Param.Str1 & "', '" _
    & gut_Param.Str2 & "', " _
    & gut_Param.Str3 & ", '" _
    & 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
        li_Code = ODBCData(ll_Statement, 1)
        lst_Title.AddItem ODBCData(ll_Statement, 2)
        lst_Title.ItemData(lst_Title.ListCount - 1) = li_Code
    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 Getcsts()

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

On Error GoTo suite

ls_Req = "EXEC Screen_Csts Query_title, '" & 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 = Left(ODBCData(ll_Statement, 2), 30)
        Select Case ls_Field
            Case "title": Caption = ls_Text
            Case "titleO": If gs_Action = "LOAD" Then Caption = Caption & " - " & ls_Text
            Case "titleS": If gs_Action = "SAVE" Then Caption = Caption & " - " & 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()

MouseOff

If gl_CodePage <> 1252 And gl_CodePage <> 0 Then ChangeCharset Me

pic_ok.Picture = LoadResPicture(RES_OK, 1)
pic_add.Picture = LoadResPicture(RES_ADD, 1)
pic_delete.Picture = LoadResPicture(RES_DELETE, 1)
pic_quit.Picture = LoadResPicture(RES_QUIT, 1)
Getcsts
FillLstTitles
Select Case gs_Action
Case "LOAD"
    pic_ok.Visible = OK
    pic_add.Visible = KO
    txt_Title.Locked = OK
Case "SAVE"
    pic_ok.Visible = KO
    pic_add.Visible = OK
End Select
MouseOn

End Sub

Private Sub lst_Title_Click()

MouseOff
If lst_Title.ListIndex <> -1 Then
    txt_Title = lst_Title
    txt_Title.SetFocus
End If
MouseOn

End Sub
Private Sub lst_Title_DblClick()

MouseOff
Select Case gs_Action
Case "LOAD"
    If lst_Title.ListIndex <> -1 Then
        pic_ok_Click
    End If
End Select
MouseOn

End Sub
Private Sub pic_add_Click()

MouseOff
If txt_Title <> "" Then
    If BeginTran(gl_Environment, gl_Database) Then
        If AddTitle Then
            If Query.SaveQuery(mi_Code) Then
                If CommitTran(gl_Environment, gl_Database) Then
                Else
                    RollbackTran gl_Environment, gl_Database
                    SendMessage 4, "Insert failed", gut_LangLogin.Code
                End If
            Else
                RollbackTran gl_Environment, gl_Database
            End If
        Else
            RollbackTran gl_Environment, gl_Database
            SendMessage 4, "Insert failed", gut_LangLogin.Code
        End If
    End If
    FillLstTitles
    lst_Title = txt_Title
End If
Unload Me
MouseOn

End Sub
Private Sub pic_delete_Click()

MouseOff
If txt_Title <> "" And lst_Title.ListIndex <> -1 Then
    DltTitle
    FillLstTitles
    txt_Title = ""
End If
txt_Title.SetFocus
MouseOn

End Sub
Private Sub pic_ok_Click()

MouseOff
If lst_Title.ListIndex = -1 Then
    gut_Param.Str15 = ""
Else
    gut_Param.Str15 = lst_Title.ItemData(lst_Title.ListIndex)
End If
pic_quit_Click
MouseOn

End Sub
Private Sub pic_quit_Click()

MouseOff
Unload Me
MouseOn

End Sub


Private Sub txt_Title_Change()

If lst_Title.ListIndex <> -1 Then
    If txt_Title <> lst_Title Then
        lst_Title.ListIndex = -1
    End If
End If

End Sub
