VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form Test_Visu 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Test_Visu XX"
   ClientHeight    =   9420
   ClientLeft      =   45
   ClientTop       =   390
   ClientWidth     =   10935
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   9420
   ScaleWidth      =   10935
   ShowInTaskbar   =   0   'False
   Begin MSFlexGridLib.MSFlexGrid test_list 
      Height          =   2055
      Left            =   0
      TabIndex        =   13
      Top             =   7200
      Width           =   3135
      _ExtentX        =   5530
      _ExtentY        =   3625
      _Version        =   393216
      FixedCols       =   0
      FocusRect       =   0
      HighLight       =   0
      AllowUserResizing=   1
   End
   Begin VB.CommandButton Expand_all 
      Caption         =   "+"
      Height          =   255
      Left            =   3120
      TabIndex        =   11
      Top             =   720
      Width           =   255
   End
   Begin MSFlexGridLib.MSFlexGrid grd_testDoc 
      Height          =   2835
      Left            =   3180
      TabIndex        =   10
      Top             =   6540
      Width           =   7695
      _ExtentX        =   13573
      _ExtentY        =   5001
      _Version        =   393216
      FixedCols       =   0
      AllowBigSelection=   0   'False
      FocusRect       =   0
      HighLight       =   2
      SelectionMode   =   1
      AllowUserResizing=   1
   End
   Begin MSFlexGridLib.MSFlexGrid Grid_Detail 
      Height          =   4755
      Left            =   3180
      TabIndex        =   9
      Top             =   1800
      Width           =   7695
      _ExtentX        =   13573
      _ExtentY        =   8387
      _Version        =   393216
      Rows            =   1
      FixedRows       =   0
      FixedCols       =   0
      AllowBigSelection=   0   'False
      HighLight       =   0
      SelectionMode   =   1
      AllowUserResizing=   1
   End
   Begin MSComctlLib.ImageList img_pictList 
      Left            =   9960
      Top             =   840
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      MaskColor       =   12632256
      _Version        =   393216
   End
   Begin MSComctlLib.TreeView tvw_test 
      Height          =   6375
      Left            =   0
      TabIndex        =   8
      Top             =   720
      Width           =   3135
      _ExtentX        =   5530
      _ExtentY        =   11245
      _Version        =   393217
      Style           =   7
      Appearance      =   1
   End
   Begin VB.PictureBox pic_pic 
      BackColor       =   &H00FFFFFF&
      Height          =   675
      Left            =   0
      ScaleHeight     =   615
      ScaleWidth      =   10815
      TabIndex        =   2
      Top             =   0
      Width           =   10875
      Begin VB.PictureBox pic_Excel 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         DrawStyle       =   5  'Transparent
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   384
         Left            =   2020
         ScaleHeight     =   390
         ScaleWidth      =   390
         TabIndex        =   7
         Top             =   60
         Width           =   384
      End
      Begin VB.PictureBox pic_quit 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         DragIcon        =   "TESTVISU.frx":0000
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   384
         Left            =   3020
         ScaleHeight     =   390
         ScaleWidth      =   390
         TabIndex        =   5
         TabStop         =   0   'False
         Top             =   60
         Width           =   384
      End
      Begin VB.PictureBox pic_Refresh 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         DragIcon        =   "TESTVISU.frx":030A
         DrawStyle       =   5  'Transparent
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   384
         Left            =   1020
         ScaleHeight     =   390
         ScaleWidth      =   390
         TabIndex        =   4
         Top             =   60
         Width           =   384
      End
      Begin VB.PictureBox pic_Print 
         Appearance      =   0  'Flat
         AutoSize        =   -1  'True
         BackColor       =   &H00FFFFFF&
         BorderStyle     =   0  'None
         DrawStyle       =   5  'Transparent
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000008&
         Height          =   384
         Left            =   120
         ScaleHeight     =   390
         ScaleWidth      =   390
         TabIndex        =   3
         Top             =   60
         Width           =   384
      End
   End
   Begin VB.CommandButton cmd_Detail 
      Caption         =   "Show details"
      Enabled         =   0   'False
      Height          =   372
      Left            =   6600
      TabIndex        =   1
      Top             =   1200
      Width           =   1392
   End
   Begin VB.ListBox lst_Detail 
      Height          =   450
      ItemData        =   "TESTVISU.frx":0614
      Left            =   3480
      List            =   "TESTVISU.frx":0616
      MultiSelect     =   1  'Simple
      TabIndex        =   0
      Top             =   960
      Width           =   3012
   End
   Begin VB.Label expand_state 
      Caption         =   "0"
      Height          =   255
      Left            =   3120
      TabIndex        =   12
      Top             =   1080
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.Label lbl_Detail 
      Caption         =   "Details :"
      Height          =   225
      Left            =   3480
      TabIndex        =   6
      Top             =   720
      Width           =   3015
   End
End
Attribute VB_Name = "Test_Visu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMiliseconds As Long)

'Indicate if test or detail view is selected
Dim m_TestSelected As Boolean
Dim m_DetailSelected As Boolean

Dim ms_testTypeLabel As String        ' type of the test

'list of color for the different states of test
Dim ml_Color(1 To 4) As Long

' traductions of the type of test in Getcsts to use it in the test list
Dim ms_TradRealTest As String
Dim ms_TradAssessement As String
Dim ms_TradOpinion As String
Dim ms_TradOpinionOnRealTest As String
Dim ms_TradOpinionOnAssessment As String

Dim m_PreviousIndex As Integer

Dim msa_testDocGridCI() As String

Private Enum ArmErr
    CompFncFailed = C_ERRORRAISE + 161          ' when component function fail
End Enum

Public mb_Load As Integer

Public Function LineColor(al_Row As Long, al_Color As Long)
Dim ll_Row As Long
Dim ll_Col As Long, ll_ColSel As Long

    'll_Row = al_Row 'test_list.Row
    'll_Col = test_list.Col
 '   ll_ColSel = test_list.ColSel
 '   test_list.FillStyle = flexFillRepeat
    'test_list.Row = al_Row + 1
    test_list.Col = 0
    test_list.ColSel = 0
    test_list.Row = al_Row
    test_list.RowSel = al_Row
    test_list.CellForeColor = al_Color
'    test_list.FillStyle = flexFillSingle
    'test_list.Row = ll_Row
    'test_list.Col = 0
    'test_list.ColSel = ll_ColSel

End Function
Private Sub Getcsts()
'------------------------------------------------------------------
' Name : GetCsts
'
' Purpose : Initialize the constants of the form
'
' Parameters : None
'
' review : 06/25/1999 by AD
'------------------------------------------------------------------

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

'Read the string for type of test

'Construct the request
ls_req = "EXEC Screen_Csts 'main_Test', '" & gut_LangLogin.Code & "'"
'Execute the request
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
    'Read the new record
    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)
        
        'Fill the variables
        Select Case ls_Field
            Case "ms_TradRealTest":
                ms_TradRealTest = ls_Text
            Case "ms_TradAssmt":
                ms_TradAssessement = ls_Text
            Case "ms_TradOpnRT":
                ms_TradOpinionOnRealTest = ls_Text
            Case "ms_TradOpnAssmt":
                ms_TradOpinionOnAssessment = ls_Text
            Case "ms_TradOpn":
                ms_TradOpinion = ls_Text
        End Select
    End If
Loop
'delete the statement
li_status = SQLFreeStatement(ll_statement, SQL_DROP)

'Read the strings for the screen

'Construct the request
ls_req = "EXEC Screen_Csts 'Test_Visu', '" & gut_LangLogin.Code & "'"
'Execute the request
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 & " - " & ms_testTypeLabel
        Case "lbl_Detail": lbl_Detail = ls_Text
        Case "cmd_detail": cmd_Detail.Caption = ls_Text
        Case "grd_testDoc":
            Dim lv_labels As Variant
            Dim ll_i As Long
            lv_labels = Split(ls_Text, CH_LDELIMIT)
            
            Debug.Assert (grd_testDoc.Cols > UBound(lv_labels) - LBound(lv_labels))
            Debug.Assert (grd_testDoc.Rows > 0)
            
            For ll_i = LBound(lv_labels) To UBound(lv_labels)
                grd_testDoc.TextMatrix(0, ll_i) = lv_labels(ll_i)
            Next
        Case Else
            If Mid(ls_Field, 1, 10) = "lst_detail" Then
                lst_Detail.AddItem ls_Text
            End If
        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

Public Sub FillTest()
'------------------------------------------------------------------
' Name : FillTest
'
' Purpose : Fill the list of test
'
' Parameters : None
'
' review : 06/25/1999 by AD
'------------------------------------------------------------------
Dim ll_statement As Long
Dim li_status As Integer
Dim ls_req As String
Dim ls_PreviousMarket As String
Dim ls_NewMarket As String
Dim ls_PreviousTestType As String
Dim ls_NewTestType As String
Dim li_TestState As Integer
Dim ls_TestState As String
Dim lo_marketNode As MSComctlLib.Node
Dim lo_typeNode As MSComctlLib.Node
Dim lo_itemNode As MSComctlLib.Node

'Initialize variables
ls_PreviousMarket = ""
ls_PreviousTestType = ""

On Error GoTo suite

'Clear the list of test
tvw_test.Nodes.Clear
'out_test.Clear
'out_Test1.Clear

'make the print button invisible
pic_Print.Visible = False
pic_Excel.Visible = False

'Clear the result grid
GridClear Grid_Detail
grd_testDoc.Rows = 1

DoEvents

'Prepare the request
ls_req = "EXEC Test_t_lst5 " & gut_Param.Str14 & ",'" & gs_SAPCode & "','E'"
Set lo_marketNode = Nothing
Set lo_typeNode = Nothing

MouseOff
'Execute the request
If SQLSubmit(gl_Environment, gl_Database, ll_statement, ls_req) Then
    li_status = SQL_SUCCESS
    Do While li_status = SQL_SUCCESS Or li_status = SQL_SUCCESS_WITH_INFO
        'read the new record
        li_status = SQLFetch(ll_statement)
        If li_status = SQL_SUCCESS Or li_status = SQL_SUCCESS_WITH_INFO Then
            
            'read the code
            ls_NewMarket = ODBCData(ll_statement, 1)
            If ls_NewMarket <> ls_PreviousMarket Then
                'if it is a new market, insert it in the list
                'code
'                out_Test1.AddItem ls_NewMarket
'                out_Test1.Shift(out_Test1.ListCount - 1) = 0
                'description
'                out_test.AddItem ODBCData(ll_Statement, 2)
'                out_test.Shift(out_test.ListCount - 1) = 0
                
                Set lo_marketNode = InsertNode(tvw_test, "", "_0_" & ls_NewMarket, ODBCData(ll_statement, 2), _
                                               RES_CLOSEFOLDER, RES_OPENFOLDER, , vbResBitmap)
                
                
                ls_PreviousMarket = ls_NewMarket
                ls_PreviousTestType = ""
            End If
            'read the type of test
            ls_NewTestType = ODBCData(ll_statement, 3)
            If ls_NewTestType <> ls_PreviousTestType Then
                'debug.assert (Not lo_marketNode Is Nothing)
                
                'if it is a new type of test, insert it in the list
                'code
'                out_Test1.AddItem ls_NewTestType
'                out_Test1.Indent(out_Test1.ListCount - 1) = 1
                
                'description
                Select Case ls_NewTestType
                Case CStr(TEST_REAL)
'                    out_test.AddItem ms_TradRealTest
                    Set lo_typeNode = InsertNode(tvw_test, lo_marketNode.Key, "_1_" & ls_NewTestType & "_" & Mid(lo_marketNode.Key, 4), ms_TradRealTest, _
                                                 RES_CLOSEFOLDER, RES_OPENFOLDER, , vbResBitmap)
                Case CStr(TEST_ASSESSMENT)
'                    out_test.AddItem ms_TradAssessement
                    Set lo_typeNode = InsertNode(tvw_test, lo_marketNode.Key, "_1_" & ls_NewTestType & "_" & Mid(lo_marketNode.Key, 4), ms_TradAssessement, _
                                                 RES_CLOSEFOLDER, RES_OPENFOLDER, , vbResBitmap)
                Case CStr(TEST_OPINION_ONREAL)
'                    out_test.AddItem ms_TradOpinionOnRealTest
                    Set lo_typeNode = InsertNode(tvw_test, lo_marketNode.Key, "_1_" & ls_NewTestType & "_" & Mid(lo_marketNode.Key, 4), ms_TradOpinionOnRealTest, _
                                                 RES_CLOSEFOLDER, RES_OPENFOLDER, , vbResBitmap)
                Case CStr(TEST_OPINION_ONASSESSMENT)
'                    out_test.AddItem ms_TradOpinionOnAssessment
                    Set lo_typeNode = InsertNode(tvw_test, lo_marketNode.Key, "_1_" & ls_NewTestType & "_" & Mid(lo_marketNode.Key, 4), ms_TradOpinionOnAssessment, _
                                                 RES_CLOSEFOLDER, RES_OPENFOLDER, , vbResBitmap)
                Case CStr(TEST_OPINION_ONNOTHING)
'                    out_test.AddItem ms_TradOpinion
                    Set lo_typeNode = InsertNode(tvw_test, lo_marketNode.Key, "_1_" & ls_NewTestType & "_" & Mid(lo_marketNode.Key, 4), ms_TradOpinion, _
                                                 RES_CLOSEFOLDER, RES_OPENFOLDER, , vbResBitmap)
                End Select
'                out_test.Indent(out_test.ListCount - 1) = 1
                ls_PreviousTestType = ls_NewTestType
            End If
            'read and insert the new test
            'code
'            out_Test1.AddItem ODBCData(ll_Statement, 4)
'            out_Test1.Indent(out_Test1.ListCount - 1) = 2
            'description
'            out_test.AddItem ODBCData(ll_Statement, 5)
'            out_test.Indent(out_test.ListCount - 1) = 2

            Set lo_itemNode = InsertNode(tvw_test, lo_typeNode.Key, "_2_" & ODBCData(ll_statement, 4) & "_" & Mid(lo_typeNode.Key, 4), ODBCData(ll_statement, 5), _
                                         RES_DOCUMENT, RES_DOCUMENT, , vbResBitmap)
            'read the state of the test
            ls_TestState = ODBCData(ll_statement, 6)
            If ls_TestState <> "" Then
                li_TestState = CInt(ls_TestState)
            Else
                li_TestState = 4
            End If
            'change the color of the test in function of the state
'            out_test.ItemForeColor(out_test.ListCount - 1) = ml_Color(li_TestState)
            lo_itemNode.ForeColor = ml_Color(li_TestState)
        End If
    Loop
End If
'delete the statement
li_status = SQLFreeStatement(ll_statement, SQL_DROP)
MouseOn
Exit Sub

suite:
li_status = SQLFreeStatement(ll_statement, SQL_DROP)
StdError
End Sub

Public Sub FillDetail1(ls_Detail As String)
Dim Col As Integer
Dim i As Integer
Dim li_line As Integer
Dim ll_statement As Long
Dim li_status As Integer
Dim ll_Statement1 As Long
Dim ls_req As String
Dim ls_req1 As String
Dim li_StartRow As Integer
On Error GoTo suite

' ensure that node is selected from level 2
'debug.assert (Not tvw_test.SelectedItem Is Nothing)
'debug.assert (tvw_test.SelectedItem.Key Like "_2_*")

'Construct the request
ls_req = "EXEC Test_t_Dtl5 " & GetString(tvw_test.SelectedItem.Key, 2, "_") & ",'" & gut_LangWork.Code & "'"

'Prepare the grid and read the first valid line
li_StartRow = DetailBegin(ls_Detail, tvw_test.SelectedItem.Text)

MouseOff
'Execute the request
If SQLSubmit(gl_Environment, gl_Database, ll_statement, ls_req) Then
    li_status = SQL_SUCCESS
    'read the first and unique record
    li_status = SQLFetch(ll_statement)
    'read the number of columns
    li_status = li_status And SQLNumResultCols(ll_statement, Col)
        
    'Display all columns in the result grid
    For i = 1 To Col
        If li_status = SQL_SUCCESS Or li_status = SQL_SUCCESS_WITH_INFO Then
            
            Grid_Detail.Col = 1
            Grid_Detail.Rows = i + li_StartRow
            Grid_Detail.Row = i + li_StartRow - 1
            Grid_Detail.Text = ODBCData(ll_statement, i)
            
        End If
    Next
End If
'delete the statement
li_status = SQLFreeStatement(ll_statement, SQL_DROP)

'Read the description

'Construct the request
ls_req = "EXEC Screen_Csts 'Test_Visu_01','" & gut_LangWork.Code & "'"

MouseOff
'Execute the request
If SQLSubmit(gl_Environment, gl_Database, ll_statement, ls_req) Then
    li_status = SQL_SUCCESS
    li_line = li_StartRow + 1
    Do While li_status = SQL_SUCCESS Or li_status = SQL_SUCCESS_WITH_INFO
        'Read the next record
        li_status = SQLFetch(ll_statement)
        
        'Display record in the result grid
        If li_status = SQL_SUCCESS Or li_status = SQL_SUCCESS_WITH_INFO Then
            
            If ODBCData(ll_statement, 1) <> "title" Then
                Grid_Detail.Col = 0
                Grid_Detail.Row = li_line - 1
                Grid_Detail.Text = ODBCData(ll_statement, 2)
            End If
        End If
        li_line = li_line + 1
    Loop
End If
'delete the statement
li_status = SQLFreeStatement(ll_statement, SQL_DROP)

MouseOn
Exit Sub

suite:
li_status = SQLFreeStatement(ll_statement, SQL_DROP)
StdError
End Sub

Private Sub FillTestDocs(ByRef ao_grid As MSFlexGridLib.MSFlexGrid, ByVal as_testCode As String)
'------------------------------------------------------------------
' Name : FillTestDocs
'
' Purpose : reset and fill ao_grid with documents associated with test
'
' Parameters : ao_grid      ... grid to be filled
'              as_testCode  ... ID of test
'
' review :
'------------------------------------------------------------------

Dim ll_statement As Long
Dim li_status As Integer
Dim ll_i As Long
Dim ls_req As String
Dim ls_Data As String
Dim ll_colInd As Long
Dim lsa_colNames() As String

On Error GoTo ErrorHandler
    Const CL_REQUEST As String = "EXEC Test_Media_Lst2 $test_code$, 1"
    Const C_COLUMN_NAMES As String = "MD_Code®©Zip_Code®©iConcurrency®©PT_Title®©Language_Desc®©SRC_Size®©FE_Desc"
    
    Debug.Assert (UBound(msa_testDocGridCI) - LBound(msa_testDocGridCI) = ao_grid.Cols - 1)
    
    lsa_colNames = Split(C_COLUMN_NAMES, SEP)
    Debug.Assert (UBound(lsa_colNames) - LBound(lsa_colNames) = ao_grid.Cols - 1)
    
    ' clear grid
    ao_grid.Rows = 1
    
    ls_req = Replace(CL_REQUEST, "$test_code$", as_testCode)
    
    'Execute the request
    If SQLSubmit(gl_Environment, gl_Database, ll_statement, ls_req) Then
        li_status = SQL_SUCCESS
        Do While li_status = SQL_SUCCESS Or li_status = SQL_SUCCESS_WITH_INFO
            'Read the next record
            li_status = SQLFetch(ll_statement)
            If li_status = SQL_SUCCESS Or li_status = SQL_SUCCESS_WITH_INFO Then
                
                ' insert row
                ao_grid.Rows = ao_grid.Rows + 1
                
                ' Fill grid
                For ll_i = LBound(msa_testDocGridCI) To UBound(msa_testDocGridCI)
                    ll_colInd = GetDBColumnIndex(lsa_colNames(ll_i))
                    If ll_colInd <> -1 Then
                        ao_grid.TextMatrix(ao_grid.Rows - 1, ll_colInd) = ODBCData(ll_statement, ll_i + 1)
                    End If
                 Next
            End If
        Loop
    End If
    'delete the statement
    li_status = SQLFreeStatement(ll_statement, SQL_DROP)
Exit Sub

ErrorHandler:
    Call UpdateError(True)
    
    If ll_statement <> 0 Then li_status = SQLFreeStatement(ll_statement, SQL_DROP)
    
    Call UpdateError(False)
    Call Err.Raise(Err.Number, "FillTestDocs" & CH_LDELIMIT & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
End Sub

Private Function GetDBColumnIndex(ByVal as_DBColumnName As String) As Long
On Error GoTo ErrorHandler
    GetDBColumnIndex = GetColumnIndex(as_DBColumnName, 3)
Exit Function
ErrorHandler:
    Call Err.Raise(Err.Number, "GetDBColumnIndex" & CH_LDELIMIT & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
End Function

Private Function GetColumnIndex(ByVal as_ColumnName As String, ByVal al_dataIndex As Long) As Long
On Error GoTo ErrorHandler
    Dim ll_i As Long
    GetColumnIndex = -1
    For ll_i = LBound(msa_testDocGridCI) To UBound(msa_testDocGridCI)
        If StrComp(GetString(msa_testDocGridCI(ll_i), al_dataIndex, CH_LDELIMIT), as_ColumnName, vbTextCompare) = 0 Then
            GetColumnIndex = ll_i
            Exit For
        End If
    Next
Exit Function
ErrorHandler:
    Call Err.Raise(Err.Number, "GetColumnIndex" & CH_LDELIMIT & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
End Function

Private Function DetailBegin(ls_Detail As String, lS_Code As String) As Integer
'------------------------------------------------------------------
' Name : DetailBegin
'
' Purpose : Prepare the grid for a new detail and return the number of the first valid line
'
' Parameters : None
'
' review : 06/25/1999 by AD
'------------------------------------------------------------------
Dim li_StartRow As Integer
Dim ls_Line  As String

ls_Line = "======================================"

If Grid_Detail.Rows = 1 Then
    li_StartRow = 1
Else
    li_StartRow = Grid_Detail.Rows + 1
    Grid_Detail.Rows = Grid_Detail.Rows + 1
End If

Grid_Detail.Row = li_StartRow - 1
Grid_Detail.Col = 0
Grid_Detail.Text = ls_Line
Grid_Detail.Col = 1
Grid_Detail.Text = ls_Line

Grid_Detail.Rows = Grid_Detail.Rows + 1
li_StartRow = li_StartRow + 1
Grid_Detail.Row = li_StartRow - 1
Grid_Detail.Col = 0
Grid_Detail.Text = ls_Detail
Grid_Detail.Col = 1
Grid_Detail.Text = lS_Code

Grid_Detail.Rows = Grid_Detail.Rows + 1
li_StartRow = li_StartRow + 1
Grid_Detail.Row = li_StartRow - 1
Grid_Detail.Col = 0
Grid_Detail.Text = ls_Line
Grid_Detail.Col = 1
Grid_Detail.Text = ls_Line

DetailBegin = li_StartRow

End Function

Public Sub FillDetail2(ls_Detail As String)
'------------------------------------------------------------------
' Name : FillDetail2
'
' Purpose : Second view of detail: Result
'
' Parameters :
'       ls_Detail       Label of the view
'
' review : 06/25/1999 by AD
'------------------------------------------------------------------
Dim li_line As Integer
Dim i As Integer
Dim ll_statement As Long
Dim li_status As Integer
Dim ls_req As String
Dim ls_ScreenName As String
Dim li_StartRow As Integer
On Error GoTo suite

' ensure that node is selected from level 2
'debug.assert (Not tvw_test.SelectedItem Is Nothing)
'debug.assert (tvw_test.SelectedItem.Key Like "_2_*")

'Prepare the grid and read the first valid line
li_StartRow = DetailBegin(ls_Detail, tvw_test.SelectedItem.Text)

'Construct the name of the screen name
ls_ScreenName = "TestRs" & CStr(gut_Param.Str14)

'Construct the request
ls_req = "EXEC Test_t_Dtl6 " & GetString(tvw_test.SelectedItem.Key, 2, "_") & ",'" & ls_ScreenName & "','" & gut_LangWork.Code & "'"

MouseOff

'Execute the request
If SQLSubmit(gl_Environment, gl_Database, ll_statement, ls_req) Then
    li_status = SQL_SUCCESS
    li_line = li_StartRow + 1
    Do While li_status = SQL_SUCCESS Or li_status = SQL_SUCCESS_WITH_INFO
        'Read the next record
        li_status = SQLFetch(ll_statement)
        If li_status = SQL_SUCCESS Or li_status = SQL_SUCCESS_WITH_INFO Then
           
            Grid_Detail.Rows = li_line
            Grid_Detail.Row = li_line - 1
            
            'Fill the grid
            Grid_Detail.Col = 0
            Grid_Detail.Text = ODBCData(ll_statement, 1)
            
            Grid_Detail.Col = 1
            Grid_Detail.Text = ODBCData(ll_statement, 2)
            
        End If
        li_line = li_line + 1
    Loop
End If
'delete the statement
li_status = SQLFreeStatement(ll_statement, SQL_DROP)
MouseOn
Exit Sub

suite:
li_status = SQLFreeStatement(ll_statement, SQL_DROP)
StdError
End Sub

Public Sub FillDetail3(ls_Detail As String)
'------------------------------------------------------------------
' Name : FillDetail3
'
' Purpose : Third view of detail: Available Countries
'
' Parameters :
'       ls_Detail       Label of the view
'
' review : 10/07/1999 by AD
'------------------------------------------------------------------
Dim li_line As Integer
Dim i As Integer
Dim ll_statement As Long
Dim li_status As Integer
Dim ls_req As String
Dim li_StartRow As Integer
On Error GoTo suite

' ensure that node is selected from level 2
'debug.assert (Not tvw_test.SelectedItem Is Nothing)
'debug.assert (tvw_test.SelectedItem.Key Like "_2_*")

'Prepare the grid and read the first valid line
li_StartRow = DetailBegin(ls_Detail, tvw_test.SelectedItem.Text)
            
'Construct the request
ls_req = "EXEC Test_t_Dtl7 " & GetString(tvw_test.SelectedItem.Key, 2, "_") & ",'" & gut_LangWork.Code & "'"

MouseOff

'Execute the request
If SQLSubmit(gl_Environment, gl_Database, ll_statement, ls_req) Then
    li_status = SQL_SUCCESS
    li_line = li_StartRow + 1
    Do While li_status = SQL_SUCCESS Or li_status = SQL_SUCCESS_WITH_INFO
        'Read the next record
        li_status = SQLFetch(ll_statement)
        If li_status = SQL_SUCCESS Or li_status = SQL_SUCCESS_WITH_INFO Then
           
            Grid_Detail.Rows = li_line
            Grid_Detail.Row = li_line - 1

            'Fill the grid
            Grid_Detail.Col = 1
            Grid_Detail.Text = ODBCData(ll_statement, 1)
            
        End If
        li_line = li_line + 1
    Loop
End If
'delete the statement
li_status = SQLFreeStatement(ll_statement, SQL_DROP)
MouseOn
Exit Sub

suite:
li_status = SQLFreeStatement(ll_statement, SQL_DROP)
StdError
End Sub


Public Sub FillDetail4(ls_Detail As String)
'------------------------------------------------------------------
' Name : FillDetail4
'
' Purpose : Third view of detail: Unavailable Countries
'
' Parameters :
'       ls_Detail       Label of the view
'
' review : 10/07/1999 by AD
'------------------------------------------------------------------
Dim li_line As Integer
Dim i As Integer
Dim ll_statement As Long
Dim li_status As Integer
Dim ls_req As String
Dim li_StartRow As Integer
On Error GoTo suite

' ensure that node is selected from level 2
'debug.assert (Not tvw_test.SelectedItem Is Nothing)
'debug.assert (tvw_test.SelectedItem.Key Like "_2_*")

'Prepare the grid and read the first valid line
li_StartRow = DetailBegin(ls_Detail, tvw_test.SelectedItem.Text)

'Construct the request
ls_req = "EXEC Test_t_Dtl8 " & GetString(tvw_test.SelectedItem.Key, 2, "_") & ",'" & gut_LangWork.Code & "'"

MouseOff

'Execute the request
If SQLSubmit(gl_Environment, gl_Database, ll_statement, ls_req) Then
    li_status = SQL_SUCCESS
    li_line = li_StartRow + 1
    Do While li_status = SQL_SUCCESS Or li_status = SQL_SUCCESS_WITH_INFO
        'Read the next record
        li_status = SQLFetch(ll_statement)
        If li_status = SQL_SUCCESS Or li_status = SQL_SUCCESS_WITH_INFO Then
           
            Grid_Detail.Rows = li_line
            Grid_Detail.Row = li_line - 1
            
            'Fill the grid
            Grid_Detail.Col = 1
            Grid_Detail.Text = ODBCData(ll_statement, 1)
            
        End If
        li_line = li_line + 1
    Loop
End If
'delete the statement
li_status = SQLFreeStatement(ll_statement, SQL_DROP)
MouseOn
Exit Sub

suite:
li_status = SQLFreeStatement(ll_statement, SQL_DROP)
StdError
End Sub

Public Sub InitializeDetail()
If tvw_test.SelectedItem Is Nothing Then Exit Sub

pic_Print.Visible = False
pic_Excel.Visible = False

If m_TestSelected = False Or GetString(tvw_test.SelectedItem.Key, 2, "_") <> m_PreviousIndex Then
    GridClear Grid_Detail
    grd_testDoc.Rows = 1
Else
    If Grid_Detail.Rows > 1 Then
        pic_Print.Visible = True
        pic_Excel.Visible = True
    End If
End If

'If m_DetailSelected = False Or m_TestSelected = False Then
'    'If detail view or test is not selected, disable the detail view button
'    cmd_Detail.Enabled = False
'Else
'    'if the both detail view and test are selected, enabled the detail view button
'    cmd_Detail.Enabled = True
'End If
End Sub

Private Sub cmd_Detail_Click()
Dim li_NumDetail As Integer
  'show the detail selected
  pic_Print.Visible = True
  
  'Clear the result grid
  GridClear Grid_Detail
  
  For li_NumDetail = 1 To lst_Detail.ListCount
    If lst_Detail.Selected(li_NumDetail - 1) Then
      Select Case li_NumDetail
      Case 1: 'General
        FillDetail1 lst_Detail.List(li_NumDetail - 1)
      Case 2: 'Result
        FillDetail2 lst_Detail.List(li_NumDetail - 1)
      Case 3: 'Available countries
        FillDetail3 lst_Detail.List(li_NumDetail - 1)
      Case 4: 'Unavailable countries
        FillDetail4 lst_Detail.List(li_NumDetail - 1)
      End Select
    End If
  Next li_NumDetail
  
  ' fill test docs
  If Not tvw_test.SelectedItem Is Nothing Then
      Call FillTestDocs(grd_testDoc, GetString(tvw_test.SelectedItem.Key, 2, "_"))
  End If
End Sub

Public Property Let TestTypeLabel(ByVal as_testLabel As String)
    ms_testTypeLabel = as_testLabel
End Property

Private Sub Expand_all_Click()
Dim indx As Integer
If expand_state = "0" Then
For indx = 1 To tvw_test.Nodes.Count
tvw_test.Nodes.Item(indx).Expanded = True
Next indx
expand_state = "1"
Expand_all.Caption = "-"
Else
For indx = 1 To tvw_test.Nodes.Count
tvw_test.Nodes.Item(indx).Expanded = False
Next indx
expand_state = "0"
Expand_all.Caption = "+"
End If
End Sub

Private Sub Form_Load()
Dim indx As Integer
If gl_CodePage <> 1252 And gl_CodePage <> 0 Then ChangeCharset Me
Dim mylist As String
mb_Load = OK

'Declare the colors used for the test states
ml_Color(1) = RGB(255, 0, 0) 'Red
ml_Color(2) = RGB(255, 255, 0) 'Yellow
ml_Color(3) = RGB(255, 0, 0) 'Red
ml_Color(4) = RGB(0, 0, 255) 'Blue

'Load all the pictures
pic_Print.Picture = LoadResPicture(RES_PRINT, 1)
pic_Refresh.Picture = LoadResPicture(RES_REFRESH, 1)
pic_quit.Picture = LoadResPicture(RES_QUIT, 1)
pic_Excel.Picture = LoadResPicture(RES_EXCEL, 1)
pic_Print.Visible = False
pic_Excel.Visible = False

'Prepare the grid for the results
Grid_Detail.ColWidth(0) = 2000
Grid_Detail.ColWidth(1) = 20000
Grid_Detail.ColAlignment(0) = flexAlignLeftCenter
Grid_Detail.ColAlignment(1) = flexAlignLeftCenter

'the test or detail view are not selected
m_TestSelected = False
m_DetailSelected = False

    ' NEW remove TreeView begin
    Call InitImageList(img_pictList)
    Call InitTreeView(tvw_test, img_pictList)
    ' NEW remove TreeView end

    Call InitControls
'Initialize the constants
Getcsts

'Fill the test list
FillTest

If tvw_test.Nodes.Count = 0 Then
    SendMessage 120, "There is no test for this product", gut_LangLogin.Code
    mb_Load = KO
Else
test_list.Clear
test_list.Rows = 2
test_list.ColWidth(0) = 2000
test_list.ColWidth(1) = 2000
test_list.ColAlignment(0) = 0
test_list.ColAlignment(1) = 0
mylist = ""
For indx = 1 To tvw_test.Nodes.Count
If tvw_test.Nodes.Item(indx).children = 0 Then
If InStr(1, mylist, tvw_test.Nodes.Item(indx).Text & SEP) = 0 Then
mylist = mylist & tvw_test.Nodes.Item(indx).Text & SEP

test_list.TextMatrix(test_list.Rows - 1, 0) = tvw_test.Nodes.Item(indx).Text
test_list.TextMatrix(test_list.Rows - 1, 1) = tvw_test.Nodes.Item(indx).Parent.Text

Call LineColor(test_list.Rows - 1, tvw_test.Nodes.Item(indx).ForeColor)
test_list.Rows = test_list.Rows + 1
End If
End If
Next indx
If test_list.Rows > 1 Then test_list.Rows = test_list.Rows - 1
End If
expand_state = "0"
Expand_all.Caption = "+"
'hide former controls
Hide_Control

Grid_Detail.Top = tvw_test.Top
'Grid_Detail.Height = tvw_test.Height

grd_testDoc.Top = Grid_Detail.Top + Grid_Detail.Height
grd_testDoc.Height = tvw_test.Height - Grid_Detail.Height

End Sub

Private Sub grd_testDoc_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then Call grd_testDoc_DblClick
End Sub


Private Sub grd_testDoc_DblClick()

On Error GoTo ErrorHandler
    
    If grd_testDoc.RowSel = -1 Then Exit Sub
    
    MouseOff
    
    Dim ls_MediaCode As String
        
    ls_MediaCode = GetGridData(grd_testDoc, grd_testDoc.RowSel, "MD_code")
    
    If ls_MediaCode = "" Then
        ' media file not found
        Call MouseOn
        Call MsgBox("Media not found.", , "Error")
        Exit Sub
    End If
    
    Call DisplayMedia(ADB, ls_MediaCode)
    Call MouseOn
Exit Sub
    
ErrorHandler:
    Call UpdateError(True)
    
    ' save error into DB
    Call UploadSQLError(ADB, adb_err, "/grd_testDoc_DblClick")
    
    Call UpdateError(False)
    
    ' display error
    Call StdError
    
    Call MouseOn
End Sub

#If LIVE Then
Private Sub DisplayMedia(ByVal ao_Armdb As Object, ByVal as_MD_code As String)
#Else
Private Sub DisplayMedia(ByVal ao_Armdb As ARMSYSCOMLib.ArmDb, ByVal as_MD_code As String)
#End If

Const MEDIA_SEL_REQ = "SELECT MBL.Zip_code, MF.FE_desc" & vbCrLf & _
                      "FROM Media M" & vbCrLf & _
                      "  INNER JOIN Media_File_Ext MF ON MF.FE_code=M.FE_code and MF.Language_code='E'" & vbCrLf & _
                      "  INNER JOIN Media_BlobLink MBL ON M.MD_Code=MBL.MD_Code and MBL.Language_code='E'" & vbCrLf & _
                      "WHERE M.MD_code = '$MD_CODE$'"

Dim ls_req As String
Dim ll_Cursor As Long
Dim ls_ext As String
Dim ll_ZipCode As Long
Dim ls_mediaFile As String
Dim ls_Command As String


On Error GoTo ErrorHandler

    ' Get extension and zip_code of the media
    ls_req = Replace(MEDIA_SEL_REQ, "$MD_CODE$", SqlStr(as_MD_code))
    
    ll_Cursor = OpenSQLSafe(ao_Armdb, ls_req)
    Debug.Assert (ll_Cursor <> 0)
    
    ' only one zip per media
    If ao_Armdb.RowCount(ll_Cursor) <> 1 Then
        Call Err.Raise(CompFncFailed, "RowCount", "Invalid media link")
    End If
    
    ll_ZipCode = CLng(ao_Armdb.GetFields(ll_Cursor, "Zip_code"))
    ls_ext = LCase(ao_Armdb.GetFields(ll_Cursor, "FE_desc"))
    
    ' close cursor
    Call ao_Armdb.Close(ll_Cursor)
    
    ' download media file
    ls_mediaFile = DownloadMediaFile(ao_Armdb, ll_ZipCode, ls_ext)
    Debug.Assert (ls_mediaFile <> "")
    
    ' create shell object to access Registry and Runtime
    Dim lo_shell As Object
    Set lo_shell = CreateObject("WSCript.Shell")
    If lo_shell Is Nothing Then
        Call Err.Raise(CompFncFailed, "CreateObject()", "Cannot create WSCript.Shell.")
    End If
    
    ' get command defined for extension
    Dim ls_DDEExec As String, ls_Application As String, ls_topic As String
    ls_Command = GetCommand(ls_ext, ls_DDEExec, ls_Application, ls_topic, lo_shell)
    
    If ls_Command = "" Then
        ' TODO: Manage status: no associate application found
        ' TODO: here we can try explorer.exe to display media
        Call Err.Raise(CompFncFailed, "", "No Application associated with file.")
    End If
    
    ' anyway, to execute document we don't need ls_command
    Call lo_shell.Run("""" & ls_mediaFile & """")
    
    Set lo_shell = Nothing
    
Exit Sub

ErrorHandler:
    If ll_Cursor <> 0 Then ao_Armdb.Close ll_Cursor
    If Not lo_shell Is Nothing Then Set lo_shell = Nothing
    Call Err.Raise(Err.Number, "DisplayMedia" & CH_LDELIMIT & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
End Sub

#If LIVE Then
Private Function DownloadMediaFile(ByVal ao_Armdb As Object, ByVal al_zipCode As Long, ByVal as_ext As String) As String
#Else
Private Function DownloadMediaFile(ByVal ao_Armdb As ARMSYSCOMLib.ArmDb, ByVal al_zipCode As Long, ByVal as_ext As String) As String
#End If
On Error GoTo ErrHandler
    
Const MEDIA_BLOB_REQ = "EXEC Media_Zip_sel $ZIP_CODE$"
    
    Dim ls_req As String
    Dim ls_path As String
    Dim ls_fileName As String
    Dim lo_Fso As Object
    
    Set lo_Fso = CreateObject("Scripting.FileSystemObject")
    If lo_Fso Is Nothing Then
        Call Err.Raise(CompFncFailed, "CreateObject()", "Cannot create Scripting.FileSystemObject.")
    End If
    
    ls_path = App.Path & REP_DOWNLOAD & al_zipCode & "\"
    
    ' check if file exists in local temporary directory
    ls_fileName = GetFirstFileName(lo_Fso, ls_path, as_ext)
    If ls_fileName <> "" Then
        DownloadMediaFile = ls_fileName
        Set lo_Fso = Nothing
        Exit Function
    End If
    
    If Not lo_Fso.FolderExists(ls_path) Then
        Call CreateDirStruct(ls_path, lo_Fso)
        Debug.Assert (lo_Fso.FolderExists(ls_path))     ' folder Download must exists
    End If
    
    ' download media from SQL server and decompress
    ls_req = Replace(MEDIA_BLOB_REQ, "$ZIP_CODE$", CStr(al_zipCode))
    If Not ao_Armdb.BlobToFileSQL(ls_req, ls_path, True, True) Then
        ' some issue with decompression
        Call Err.Raise(CompFncFailed, "BlobToFileSQL()", "Cannot download blob." & vbCrLf & GetDbError(ao_Armdb))
    End If

    DownloadMediaFile = GetFirstFileName(lo_Fso, ls_path, as_ext)
    
    Set lo_Fso = Nothing
Exit Function
ErrHandler:
    If Not lo_Fso Is Nothing Then Set lo_Fso = Nothing
    Call Err.Raise(Err.Number, "DownloadMediaFile" & CH_LDELIMIT & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
End Function

Private Function GetFirstFileName(ByVal ao_FSO As Object, ByVal as_path As String, ByVal as_ext As String) As String

On Error GoTo ErrorHandler
    Dim lo_folder As Object, lo_File As Object
    
    GetFirstFileName = ""
    If ao_FSO.FolderExists(as_path) Then
        Set lo_folder = ao_FSO.GetFolder(as_path)
        If Not lo_folder Is Nothing Then
            For Each lo_File In lo_folder.Files
                If Len(lo_File.Name) > Len(as_ext) Then
                    If StrComp(right(lo_File.Name, Len(as_ext)), as_ext, vbTextCompare) = 0 Then
                        GetFirstFileName = lo_File.Path
                        Exit For
                    End If
                End If
            Next
        End If
    End If

    Set lo_File = Nothing
    Set lo_folder = Nothing
Exit Function
ErrorHandler:
    If Not lo_File Is Nothing Then Set lo_File = Nothing
    If Not lo_folder Is Nothing Then Set lo_folder = Nothing
    Call Err.Raise(Err.Number, "GetFirstFileName" & CH_LDELIMIT & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
End Function


' return command to be executed to open file with specific extension
Private Function GetCommand(ByVal as_ext As String, ByRef as_DDEExec As String, ByRef as_Application As String, ByRef as_Topic As String, ByVal ao_shell As Object) As String

Dim ls_defValue As String
Dim lo_Registry As New Registry

    GetCommand = ""

    On Error GoTo exitFnc
    ls_defValue = ao_shell.RegRead("HKCR\." & as_ext & "\")
    If ls_defValue = "" Then
        Call Err.Raise(CompFncFailed, "", "File extension is not supported.")
    End If
    
    Dim ls_cmd As String
    
    ls_cmd = ao_shell.RegRead("HKCR\" & ls_defValue & "\shell\Open\command\")
    If ls_cmd = "" Then
        Call Err.Raise(CompFncFailed, "", "Open command not defined.")
    End If
    GetCommand = ls_cmd
    
    ' try to locate DDEExec, if not exception is rised
    as_DDEExec = ao_shell.RegRead("HKCR\" & ls_defValue & "\shell\Open\ddeexec\")
    as_Application = ao_shell.RegRead("HKCR\" & ls_defValue & "\shell\Open\ddeexec\application\")
    as_Topic = ao_shell.RegRead("HKCR\" & ls_defValue & "\shell\Open\ddeexec\topic\")

    Exit Function
exitFnc:
End Function




Private Sub lst_Detail_Click()
    'Indicate if one detail view is selected
    m_DetailSelected = (lst_Detail.SelCount <> 0)
    
    'Initialize the form with this new indication
'    Grid_Detail.cle
    InitializeDetail
End Sub


Private Sub out_Test_Click()
'Indicate if one test is selected
m_TestSelected = (tvw_test.SelectedItem.Key Like "_2_*")

'Initialize the form with this new indication
InitializeDetail

End Sub


Private Sub pic_Excel_Click()
Dim lo_appExcel As New CExcel
Dim li_Row As Integer
Dim li_Col As Integer
Dim la_Line() As String

On Error GoTo Err_ExportExcel
MouseOff

ReDim la_Line(Grid_Detail.Cols - 1)

lo_appExcel.NewDocument ""
With lo_appExcel.o_ExcelSheet1
    For li_Row = 0 To Grid_Detail.Rows - 1
        Grid_Detail.Row = li_Row
        For li_Col = 0 To Grid_Detail.Cols - 1
            Grid_Detail.Col = li_Col
            la_Line(li_Col) = ConvertCodePageFromAnsi("'" & Grid_Detail.Text, gl_CodePage)
        Next
        .Range(.cells(li_Row + 1, 1), .cells(li_Row + 1, Grid_Detail.Cols)) = la_Line
    Next
End With
Set lo_appExcel = Nothing
MouseOn
SendMessage 129, "Press ALT+TAB to switch to the Excel application.", gut_LangLogin.Code
Exit Sub

Err_ExportExcel:
    SendMessage 124, "Error on export process.", gut_LangLogin.Code
    MouseOn
End Sub

Private Sub pic_print_Click()

If Printers.Count = 0 Then
    SendMessage 135, "No printer is installed on your computer. Please, contact your system administrator.", gut_LangLogin.Code
    Exit Sub
End If

    QryPrintGrid 1, 20, Caption, "Technical test", Grid_Detail, Array(25, 75)

End Sub

Private Sub pic_quit_Click()
  MouseOff
  Unload Me
End Sub

Private Sub pic_refresh_Click()
    'Refresh the test list
    FillTest
        
End Sub

Private Sub All_Details()

Grid_Detail.Visible = True

'save actual index
m_PreviousIndex = GetString(tvw_test.SelectedItem.Key, 2, "_")  'Mid(tvw_test.SelectedItem.Key, 4) 'out_Test1.List(out_test.ListIndex)

'fill all details available
FillDetail1 lst_Detail.List(0)
FillDetail2 lst_Detail.List(1)
FillDetail3 lst_Detail.List(2)
FillDetail4 lst_Detail.List(3)
FillDetail5 "Plants"
FillDetail6 "Suppliers"

pic_Excel.Visible = True
pic_Print.Visible = True

End Sub

Private Sub Hide_Control()
    lbl_Detail.Visible = False
    lst_Detail.Visible = False
    cmd_Detail.Visible = False
    
    Grid_Detail.Visible = False
    grd_testDoc.Visible = False
End Sub

Public Sub FillDetail5(ls_Detail As String)
Dim li_line As Integer
Dim i As Integer
Dim ll_statement As Long
Dim li_status As Integer
Dim ls_req As String
Dim li_StartRow As Integer
On Error GoTo suite

' ensure that node is selected from level 2
'debug.assert (Not tvw_test.SelectedItem Is Nothing)
'debug.assert (tvw_test.SelectedItem.Key Like "_2_*")

'Prepare the grid and read the first valid line
li_StartRow = DetailBegin(ls_Detail, tvw_test.SelectedItem.Text)

'Construct the request
ls_req = "EXEC Test_t_Dtl9 " & GetString(tvw_test.SelectedItem.Key, 2, "_")

'Execute the request
If SQLSubmit(gl_Environment, gl_Database, ll_statement, ls_req) Then
    li_status = SQL_SUCCESS
    li_line = li_StartRow + 1
    Do While li_status = SQL_SUCCESS Or li_status = SQL_SUCCESS_WITH_INFO
        'Read the next record
        li_status = SQLFetch(ll_statement)
        If li_status = SQL_SUCCESS Or li_status = SQL_SUCCESS_WITH_INFO Then
           
            Grid_Detail.Rows = li_line
            Grid_Detail.Row = li_line - 1
            
            'Fill the grid
            Grid_Detail.Col = 1
            Grid_Detail.Text = ODBCData(ll_statement, 1)
            
        End If
        li_line = li_line + 1
    Loop
End If
'delete the statement
li_status = SQLFreeStatement(ll_statement, SQL_DROP)
MouseOn
Exit Sub

suite:
li_status = SQLFreeStatement(ll_statement, SQL_DROP)
StdError
End Sub

Public Sub FillDetail6(ls_Detail As String)
Dim li_line As Integer
Dim i As Integer
Dim ll_statement As Long
Dim li_status As Integer
Dim ls_req As String
Dim li_StartRow As Integer
On Error GoTo suite

' ensure that node is selected from level 2
'debug.assert (Not tvw_test.SelectedItem Is Nothing)
'debug.assert (tvw_test.SelectedItem.Key Like "_2_*")

'Prepare the grid and read the first valid line
li_StartRow = DetailBegin(ls_Detail, tvw_test.SelectedItem.Text)

'Construct the request
ls_req = "EXEC Test_t_DtlA " & GetString(tvw_test.SelectedItem.Key, 2, "_")

'Execute the request
If SQLSubmit(gl_Environment, gl_Database, ll_statement, ls_req) Then
    li_status = SQL_SUCCESS
    li_line = li_StartRow + 1
    Do While li_status = SQL_SUCCESS Or li_status = SQL_SUCCESS_WITH_INFO
        'Read the next record
        li_status = SQLFetch(ll_statement)
        If li_status = SQL_SUCCESS Or li_status = SQL_SUCCESS_WITH_INFO Then
           
            Grid_Detail.Rows = li_line
            Grid_Detail.Row = li_line - 1
            
            'Fill the grid
            Grid_Detail.Col = 1
            Grid_Detail.Text = ODBCData(ll_statement, 1)
            
        End If
        li_line = li_line + 1
    Loop
End If
'delete the statement
li_status = SQLFreeStatement(ll_statement, SQL_DROP)
MouseOn
Exit Sub

suite:
li_status = SQLFreeStatement(ll_statement, SQL_DROP)
StdError
End Sub

' NEW remove TreeView begin
Private Function InsertNode(ByVal ao_tvw As MSComctlLib.TreeView, ByVal ao_parentKey As String, ByVal as_key As String, ByVal as_Text As String, Optional ByVal al_image As Long = -1, Optional ByVal al_imageSel As Long = -1, Optional ByVal al_relationship As MSComctlLib.TreeRelationshipConstants = tvwChild, Optional ByVal al_imageType As LoadResConstants = vbResIcon) As MSComctlLib.Node
    Dim lo_retNode As MSComctlLib.Node
    Set lo_retNode = GetNode(ao_tvw, as_key, ao_parentKey)
    If lo_retNode Is Nothing Then
        Set lo_retNode = ao_tvw.Nodes.Add(IIf(ao_parentKey = "", Null, ao_parentKey), _
                                          al_relationship, _
                                          as_key, _
                                          as_Text, _
                                          GetImageIndex(ao_tvw.ImageList, al_image, al_imageType), _
                                          GetImageIndex(ao_tvw.ImageList, al_imageSel, al_imageType))
    End If
    Set InsertNode = lo_retNode
End Function

Private Function GetNode(ByVal ao_tvw As MSComctlLib.TreeView, ByVal as_key As String, ByVal as_parentKey As String) As MSComctlLib.Node
    Dim lo_Node As MSComctlLib.Node
    
    Set GetNode = Nothing
    For Each lo_Node In ao_tvw.Nodes
        If lo_Node.Key = as_key Then
            Set GetNode = lo_Node
            Exit For
        End If
    Next
End Function

Private Function GetImageIndex(ByVal ao_imageList As MSComctlLib.ImageList, ByVal al_resIndex As Long, ByVal al_resType As LoadResConstants) As Variant
    If (ao_imageList Is Nothing) Or (al_resIndex = -1) Then
        GetImageIndex = Empty
        Exit Function
    End If
    
    Dim lo_image As MSComctlLib.ListImage
    For Each lo_image In ao_imageList.ListImages
        If lo_image.Key = "_" & al_resIndex Then
            GetImageIndex = lo_image.Index
            Exit Function
        End If
    Next
    
    GetImageIndex = LoadImage(ao_imageList, al_resIndex, al_resType)
End Function

' if ll_index is negative value string is indexed backward
Private Function GetString(ByVal as_string As String, ByVal ll_Index As Long, Optional ByVal as_delimiter As String = SEP) As String
On Error GoTo ErrHandler
    Dim lsa_tmpArray() As String
    lsa_tmpArray = Split(as_string, as_delimiter)
    
    If ll_Index < 0 Then ll_Index = ll_Index + UBound(lsa_tmpArray) + 1    ' backward index
    
    If UBound(lsa_tmpArray) >= ll_Index And LBound(lsa_tmpArray) <= ll_Index Then GetString = lsa_tmpArray(ll_Index)
    
    Exit Function
ErrHandler:
    StdError
End Function

Private Function LoadImage(ByVal ao_imageList As MSComctlLib.ImageList, ByVal al_resIndex As Long, ByVal al_resType As LoadResConstants) As Long
    Dim lo_image As MSComctlLib.ListImage
    Set lo_image = ao_imageList.ListImages.Add(, "_" & al_resIndex, LoadResPicture(al_resIndex, al_resType))
    LoadImage = lo_image.Index
End Function

Private Sub InitTreeView(ByRef ao_tvw As MSComctlLib.TreeView, Optional ByVal ao_imgList As MSComctlLib.ImageList = Nothing)
    ao_tvw.HideSelection = False        ' don't hide selection when lostFocus
    ao_tvw.LineStyle = tvwRootLines ' tvwTreeLines
    ao_tvw.LabelEdit = tvwManual        ' disable edit labels
    ao_tvw.Indentation = 300
    ao_tvw.FullRowSelect = True         ' special setting
    Set ao_tvw.ImageList = ao_imgList
End Sub

Private Sub InitImageList(ByRef ao_imgList As MSComctlLib.ImageList)
    ao_imgList.ImageHeight = 16
    ao_imgList.ImageWidth = 16
    ao_imgList.MaskColor = vbMagenta

    ' at least one image must be loaded to correctly initialize imagelist
    Call LoadImage(ao_imgList, RES_OPENFOLDER, vbResBitmap)
    
End Sub
' NEW remove TreeView end

Private Sub test_list_DblClick()
Dim indx As Integer
If test_list.Row > 0 Then
For indx = 1 To tvw_test.Nodes.Count
If tvw_test.Nodes.Item(indx).Text = test_list.TextMatrix(test_list.Row, 0) Then
'tvw_test.Nodes.Item(indx).Expanded = True
tvw_test.Nodes.Item(indx).Selected = True
Exit For
End If
Next indx
End If
tvw_test_DblClick
End Sub


Private Sub tvw_test_Collapse(ByVal Node As MSComctlLib.Node)
    'Indicate if one test is selected
        If Not tvw_test.SelectedItem Is Nothing Then

    m_TestSelected = (tvw_test.SelectedItem.Key Like "_2_*")
    
    'Initialize the form with this new indication
    InitializeDetail
    End If
End Sub

Private Sub tvw_test_DblClick()
    m_TestSelected = (tvw_test.SelectedItem.Key Like "_2_*")
    
    InitializeDetail
    If m_TestSelected Then
        Dim ls_testCode As String
        ls_testCode = GetString(tvw_test.SelectedItem.Key, 2, "_")
        Call All_Details
        Call FillTestDocs(grd_testDoc, ls_testCode)
        grd_testDoc.Visible = True
    End If
End Sub

Private Sub tvw_test_Expand(ByVal Node As MSComctlLib.Node)
    'Indicate if one test is selected
    If Not tvw_test.SelectedItem Is Nothing Then
    m_TestSelected = (tvw_test.SelectedItem.Key Like "_2_*")
    
    'Initialize the form with this new indication
    InitializeDetail
    End If
End Sub

Private Sub tvw_test_NodeClick(ByVal Node As MSComctlLib.Node)
    'Indicate if one test is selected
    m_TestSelected = (tvw_test.SelectedItem.Key Like "_2_*")
    
    'Initialize the form with this new indication
    InitializeDetail
End Sub

Private Sub InitControls()
On Error GoTo ErrorHandler

    Dim lv_labels As Variant
    Dim ll_i As Long
    
    lv_labels = Array("#MD_code", "#Zip_Code", "#iconcurrency", "#Language", "#Title", "#Size in byte", "#File type")
    ReDim msa_testDocGridCI(UBound(lv_labels)) As String
    
    msa_testDocGridCI(0) = "MD_code" & CH_LDELIMIT & "0" & CH_LDELIMIT & "1" & CH_LDELIMIT & "MD_code" & CH_LDELIMIT & lv_labels(0)
    msa_testDocGridCI(1) = "Zip_Code" & CH_LDELIMIT & "0" & CH_LDELIMIT & "2" & CH_LDELIMIT & "Zip_Code" & CH_LDELIMIT & lv_labels(1)
    msa_testDocGridCI(2) = "iconcurrency" & CH_LDELIMIT & "0" & CH_LDELIMIT & "3" & CH_LDELIMIT & "iconcurrency" & CH_LDELIMIT & lv_labels(2)
    msa_testDocGridCI(3) = "Language_Desc" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "Language_Desc" & CH_LDELIMIT & lv_labels(3)
    msa_testDocGridCI(4) = "PT_Title" & CH_LDELIMIT & "3000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "PT_Title" & CH_LDELIMIT & lv_labels(4)
    msa_testDocGridCI(5) = "SRC_Size" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "SRC_Size" & CH_LDELIMIT & lv_labels(5)
    msa_testDocGridCI(6) = "FE_Desc" & CH_LDELIMIT & "1000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "FE_Desc" & CH_LDELIMIT & lv_labels(6)
    
    ' when string found in translation table col index must mutch translation of colum, Field_name='grd_testDoc'
    grd_testDoc.Cols = UBound(lv_labels) - LBound(lv_labels) + 1
    grd_testDoc.Rows = 1
    For ll_i = LBound(lv_labels) To UBound(lv_labels)
        grd_testDoc.TextMatrix(0, ll_i) = GetString(msa_testDocGridCI(ll_i), 4, CH_LDELIMIT)
        grd_testDoc.ColAlignment(ll_i) = flexAlignLeftCenter
        grd_testDoc.ColWidth(ll_i) = CLng(GetString(msa_testDocGridCI(ll_i), 1, CH_LDELIMIT))
    Next

Exit Sub
ErrorHandler:
    Call Err.Raise(Err.Number, "InitControls" & CH_LDELIMIT & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
End Sub

Private Function GetGridData(ByVal ao_grid As MSFlexGridLib.MSFlexGrid, ByVal al_Row As Long, ByVal av_col As Variant) As String
On Error GoTo ErrorHandler

    If isNumeric(av_col) Then
        GetGridData = ao_grid.TextMatrix(al_Row, av_col)
        Exit Function
    End If
    
    Dim ll_Col As Long
    
    ll_Col = GetColumnIndex(av_col, 0)
    If ll_Col = -1 Then
        GetGridData = ""
        Exit Function
    End If
    
    GetGridData = ao_grid.TextMatrix(al_Row, ll_Col)
    
Exit Function
ErrorHandler:
    Call Err.Raise(Err.Number, "GetGridData" & CH_LDELIMIT & Err.Source, Err.Description, Err.HelpFile, Err.HelpContext)
End Function


' ************************************************************************************
' **************************** DB-ACCESS FUNCTIONS ***********************************
' ************************************************************************************
#If LIVE = 1 Then
Private Sub ExecuteSQLSafe(ByVal ao_Db As Object, ByVal as_req As String)
#Else
Private Sub ExecuteSQLSafe(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_req As String)
#End If

    If Not ao_Db.ExecuteSQL(as_req) Then
        Call Err.Raise(CompFncFailed, "ExecuteSQLSafe", "SQL Error: " & GetDbError(ao_Db))
    End If

End Sub

#If LIVE = 1 Then
Private Function OpenSQLSafe(ByVal ao_Db As Object, ByVal as_req As String) As Long
#Else
Private Function OpenSQLSafe(ByVal ao_Db As ARMSYSCOMLib.ArmDb, ByVal as_req As String) As Long
#End If

    OpenSQLSafe = ao_Db.OpenSQL(as_req)
    
    If OpenSQLSafe = 0 Then Call Err.Raise(CompFncFailed, "OpenSQLSafe", "SQL Error: " & GetDbError(ao_Db))

End Function

Private Function SqlStr(ByVal as_Str As String) As String
    SqlStr = Replace(as_Str, "'", "''")
End Function

' ************************************************************************************
' ********************** ERROR-HANDLING SUPPORT FUNCTIONS ****************************
' ************************************************************************************
#If LIVE = 1 Then
Private Function GetDbError(ByVal lo_Db As Object) As String
#Else
Private Function GetDbError(ByVal lo_Db As ARMSYSCOMLib.ArmDb) As String
#End If
On Error GoTo ErrHandler
    If IsArray(lo_Db.SQLErrorMessages) Then
        Debug.Assert (IsArray(lo_Db.SQLErrorCodes))
        ' Display errors msgBox
        GetDbError = Join(lo_Db.SQLErrorCodes, ",") & vbCrLf & Join(lo_Db.SQLErrorMessages, vbCrLf)
    Else
        ' ExecuteSQL failed but no error message?
        GetDbError = "Unknown error"
    End If
    Exit Function
ErrHandler:
End Function

' procedure save/restore err object
Private Sub UpdateError(Optional ab_saveError As Boolean = False)
Static ls_errDesc As String
Static ls_errSource As String
Static ll_errNum As Long
Static ls_errHelpFile As String
Static ls_errHelpContext As String

    If ab_saveError Then
        ls_errDesc = Err.Description
        ls_errSource = Err.Source
        ll_errNum = Err.Number
        ls_errHelpContext = Err.HelpContext
        ls_errHelpFile = Err.HelpFile
    Else
        Err.Description = ls_errDesc
        Err.Source = ls_errSource
        Err.Number = ll_errNum
        Err.HelpContext = ls_errHelpContext
        Err.HelpFile = ls_errHelpFile
    End If
End Sub


' *******************************************************************************
' ************************ DISK IO FUNCTIONS ************************************
' *******************************************************************************
' create directory if not exist
Private Function CreateDirStruct(ByVal strPath As String, ByVal ao_FSO As Object) As Boolean

On Error GoTo Create_Dir_Struct_Errors
    Dim intIndex    As Integer
    Dim strTmpPath  As String
    
    If Len(Trim$(strPath)) = 0 Then
        ' if we specify wrong path it is error
        CreateDirStruct = False
        Exit Function
    End If
    
    If right$(strPath, 1) <> "\" Then strPath = strPath & "\"
    intIndex = 0
    
    Do
        ' get the next path chunk
        intIndex = InStr(intIndex + 1, strPath, "\")
        
        If intIndex > 0 Then
            strTmpPath = Left$(strPath, intIndex - 1)
        Else
            Exit Do
        End If
        
        ' see if this folder exists
        If Not ao_FSO.FolderExists(strTmpPath) Then
            ' Create this folder.
            ' If there is an error, it will be trapped bellow
            ao_FSO.CreateFolder strTmpPath
            intIndex = 1
        End If
    Loop
    CreateDirStruct = True
    Exit Function

Create_Dir_Struct_Errors:
    CreateDirStruct = False
End Function

