VERSION 5.00
Begin VB.Form Sample_pick 
   Caption         =   "Sample selection"
   ClientHeight    =   8055
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6180
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   ScaleHeight     =   8055
   ScaleWidth      =   6180
   StartUpPosition =   3  'Windows Default
   Begin VB.PictureBox tb_upd 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      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          =   615
      Left            =   4725
      ScaleHeight     =   585
      ScaleWidth      =   1380
      TabIndex        =   1
      Top             =   7395
      Width           =   1410
      Begin VB.PictureBox valid_upd 
         Appearance      =   0  'Flat
         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          =   495
         Left            =   120
         Picture         =   "Sample_pick.frx":0000
         ScaleHeight     =   495
         ScaleWidth      =   615
         TabIndex        =   3
         Top             =   60
         Width           =   615
      End
      Begin VB.PictureBox quit_upd 
         Appearance      =   0  'Flat
         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          =   495
         Left            =   720
         Picture         =   "Sample_pick.frx":030A
         ScaleHeight     =   495
         ScaleWidth      =   615
         TabIndex        =   2
         Top             =   60
         Width           =   615
      End
   End
   Begin DSWMGR.ArmGrid grd_main 
      Height          =   7245
      Left            =   60
      TabIndex        =   0
      Top             =   60
      Width           =   6075
      _extentx        =   10716
      _extenty        =   12779
   End
End
Attribute VB_Name = "Sample_pick"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMiliseconds As Long)

Private Const SCREEN_NAME As String = "DC_Sample_list"
Private Const SEP = "®©"
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"

Private ml_U_Code As Long
Private ms_LoginName As String
Private ms_Language_Code As String
Private ml_AT_Code As Long
Private ml_SDP_Code As Long
Private ms_CT_Code As String            ' to define logistic market


Private ml_SD_Code As Long
Private ms_SDG_Desc As String
Private ms_SD_desc As String
Private ml_SD_Qty As Long

#If LIVE = 1 Then
    Dim mo_db As Object
#Else
    Dim mo_db As ARMSYSCOMLib.ArmDB
#End If

Property Let Language_Code(AString As String)
On Error GoTo errhandler

  ms_Language_Code = AString
  Exit Property
errhandler:
  Call ErrorMessage("Language_Code.Let")
End Property

Property Let CT_Code(AString As String)
On Error GoTo errhandler

  ms_CT_Code = AString
  Exit Property
errhandler:
  Call ErrorMessage("CT_Code.Let")
End Property

Property Let U_Code(ByVal al_U_Code As Long)
On Error GoTo errhandler

  ml_U_Code = al_U_Code
  Exit Property
errhandler:
  Call ErrorMessage("U_Code.Let")
End Property

Property Let SDP_Code(ByVal al_SDP_Code As Long)
On Error GoTo errhandler

  ml_SDP_Code = al_SDP_Code
  Exit Property
errhandler:
  Call ErrorMessage("SDP_Code.Let")
End Property

Property Let AT_Code(ByVal al_AT_Code As Long)
On Error GoTo errhandler

  ml_AT_Code = al_AT_Code
  Exit Property
errhandler:
  Call ErrorMessage("AT_Code.Let")
End Property


Public Property Let LoginName(ByVal as_loginName As String)
On Error GoTo errhandler
    
    ms_LoginName = as_loginName
    Exit Property
errhandler:
    Call ErrorMessage(Me.Name & ".LoginName(Let)")
End Property

Public Property Set ArmDB(ByRef lo_Db As Object)
On Error GoTo errhandler
  
  Set mo_db = lo_Db
  Exit Property
errhandler:
  Call errorHandler("ArmDb.Set")
End Property

Public Property Get SD_Code() As Long
    SD_Code = ml_SD_Code
End Property

Public Property Get SD_desc() As String
    SD_desc = ms_SD_desc
End Property
    
Public Property Get SDG_Desc() As String
    SDG_Desc = ms_SDG_Desc
End Property
    
Public Property Get SD_Qty() As Long
    SD_Qty = ml_SD_Qty
End Property


Public Sub Load_A_COM()
    
On Error GoTo errhandler

    Dim lo_Control As Object
    Dim lo_ToolTip As Object
    
      For Each lo_Control In Controls
        Select Case UCase(TypeName(lo_Control))
        Case "ARMCOMBOBOX"
          Set lo_Control.ArmDB = mo_db
          Call lo_Control.Load_A_COM
        Case "ARMPICKER"
          Set lo_Control.ArmDB = mo_db
          Call lo_Control.Load_A_COM
        Case "TOOLBARCONTROL"
          lo_Control.Language = ms_Language_Code
'          Set lo_Control.ArmDb = mo_Db
          Call lo_Control.Load_A_COM
        Case "ARMGRID"
          Set lo_Control.ArmDB = mo_db
          Call lo_Control.Load_A_COM
        Case "ARMTREEVIEW"
          Set lo_Control.ArmDB = mo_db
          lo_Control.Language = ms_Language_Code
          Call lo_Control.Load_A_COM
        Case "ARMCHECKVIEW"
          Set lo_Control.ArmDB = mo_db
          Call lo_Control.Load_A_COM
        Case "A_CALOCX"
          lo_Control.Language = ms_Language_Code
          Call lo_Control.reinit_cal
        Case "TOOLBR"
          Set lo_Control.ArmDB = mo_db
          Call lo_Control.Load_A_COM
        End Select
      Next
    
    grd_main.MultiSelect = False
    grd_main.AllowExcelExport = True
    grd_main.ExportTitles = True
    grd_main.FreeSelect = False
    grd_main.AllowSort = False
    grd_main.AllowPrint = True
    grd_main.Title = "#Sample list"
    
    If Not grd_main.SetColumns(Array( _
                          Join(Array("SD_code", 0, 1, "SD_code", "#SD_code", "INT"), SEP), _
                          Join(Array("SD_desc", 2000, 0, "SD_desc", "#SD_desc", "STRING"), SEP), _
                          Join(Array("SDC_Desc", 2000, 0, "SDC_Desc", "#SDC_Desc", "STRING"), SEP), _
                          Join(Array("SDG_Desc", 2000, 0, "SDG_Desc", "#SDG_Desc", "STRING"), SEP), _
                          Join(Array("SD_Qty", 1400, 0, "SD_Qty", "#quantity", "INT"), SEP) _
                        )) Then
                        
        MsgBox ("Grid not initialized!")
    End If
    
    Call LoadLabels(Me.Controls, SCREEN_NAME, ms_Language_Code)
    
    Call ChangeCharset(Me.Controls, GetCodePageFromLanguage(mo_db, ms_Language_Code))
    
    Exit Sub
    
errhandler:
    Call errorHandler("Load_A_COM")
    
End Sub

Private Sub RefreshMainGrid()
On Error GoTo errhandler
Const CREQ As String = "EXEC Cap_ActionSampleDoc_t_lst2 $AT_CODE$, $LANGUAGE_CODE$, $CT_CODE$, $SDP_CODE$"

    Dim ls_req As String
    
    ls_req = Replace(CREQ, "$LANGUAGE_CODE$", SqlStr(ms_Language_Code, 1), , , vbTextCompare)
    ls_req = Replace(ls_req, "$CT_CODE$", SqlStr(ms_CT_Code, 4), , , vbTextCompare)
    ls_req = Replace(ls_req, "$SDP_CODE$", SQLNum(ml_SDP_Code), , , vbTextCompare)
    ls_req = Replace(ls_req, "$AT_CODE$", SQLNum(ml_AT_Code), , , vbTextCompare)
    
    If Not grd_main.Load(ls_req, True) Then
        MsgBox ("Grid not loaded!")
    End If
    
    Exit Sub
errhandler:
    Call errorHandler("RefreshMainGrid")
End Sub

Public Sub InitControl()
On Error GoTo errhandler

    ml_SD_Code = 0
    ms_SDG_Desc = ""
    ms_SD_desc = ""
    ml_SD_Qty = 0

    Call RefreshMainGrid
    
    Exit Sub
errhandler:
    Call errorHandler("InitControl")
End Sub

Public Sub Unload_A_COM()
    
On Error GoTo errhandler
    
    Dim lo_Control As Object

    For Each lo_Control In Controls
      Select Case UCase(TypeName(lo_Control))
      Case "ARMCOMBOBOX"
        Call lo_Control.Unload_A_COM
      Case "ARMPICKER"
        Call lo_Control.Unload_A_COM
      Case "TOOLBARCONTROL"
        Call lo_Control.Unload_A_COM
      Case "ARMGRID"
        Call lo_Control.Unload_A_COM
      Case "ARMTREEVIEW"
        Call lo_Control.Unload_A_COM
      Case "ARMCHECKVIEW"
        Call lo_Control.Unload_A_COM
      Case "TOOLBR"
        Call lo_Control.Unload_A_COM
      End Select
    Next
    
    Exit Sub
    
errhandler:
    Call errorHandler("UnLoad_A_Com")
    
End Sub


' Load the labels of a containers
Private Sub LoadLabels(ByRef aControls As Variant, ByVal as_ScreenName As String, ByVal as_Language As String)

On Error GoTo errhandler

    Dim lIdx As Long, lCount As Long, lLabels As Long
    Dim lControl As Control
    
    lLabels = OpenSQLSafe(mo_db, "exec Screen_Csts '" & as_ScreenName & "','" & as_Language & "'")
    Debug.Assert (lLabels <> 0)
    
    lCount = aControls.Count - 1
    
    For lIdx = 0 To lCount
        Set lControl = aControls.Item(lIdx)
            Select Case UCase(TypeName(lControl))
                Case "LABEL", "FRAME", "COMMANDBUTTON", "OPTIONBUTTON", "MENU", "CHECKBOX"
                    If lControl.Tag <> "" Then
                        If mo_db.Find(lLabels, "FIELD_NAME", lControl.Tag, , 1) >= 0 Then
                            lControl.Caption = mo_db.GetFields(lLabels, "LOCAL_TEXT")
                        End If
                        ' once translation is done and control is not in array CLEAR tag
                        If Not TypeOf lControl Is frame And Not TypeOf lControl Is Label Then
                            lControl.Tag = ""
                        End If
                    End If
                Case "ARMGRID"
                    If mo_db.Find(lLabels, "FIELD_NAME", lControl.Tag, , 1) >= 0 Then
                      Call lControl.LoadConstants(ptStatic, mo_db.GetFields(lLabels, "LOCAL_TEXT"), ctColumns)
                        End If
                    If mo_db.Find(lLabels, "FIELD_NAME", lControl.Tag & "_Title", , 1) >= 0 Then
                      lControl.Title = mo_db.GetFields(lLabels, "LOCAL_TEXT")
                    End If
                Case "TABSTRIP"
                    If mo_db.Find(lLabels, "FIELD_NAME", lControl.Tag, , 1) >= 0 Then
                        Dim lsa_TextArr() As String
                        Dim ll_Index As Long
                        
                        lsa_TextArr = Split(mo_db.GetFields(lLabels, "LOCAL_TEXT"), SEP)
                        
                        For ll_Index = LBound(lsa_TextArr, 1) To UBound(lsa_TextArr, 1)
                            lControl.Tabs(ll_Index + 1).Caption = lsa_TextArr(ll_Index)
                        Next
                    End If
                    ' once translation is done and control is not in array CLEAR tag
                    lControl.Tag = ""
                Case "MSFLEXGRID", "TOOLBARCONTROL", "TEXTBOX", "ARMCHECKVIEW", "ARMCOMBOBOX", "A_CALOCX", "OPTIONBUTTON", "ARMTREEVIEW", "LISTBOX", "PICTUREBOX", "TOOLBR", "SPINBUTTON"
                    ' Do nothing !
                Case Else
                    'debug.print "LoadLabels " & UCase(TypeName(lControl))
            End Select
        Set lControl = Nothing
    Next
    
    ' SPECIAL INITIALIZATION
    ' Title
    If mo_db.Find(lLabels, "FIELD_NAME", "title", , 1) >= 0 Then
        Caption = mo_db.GetFields(lLabels, "LOCAL_TEXT")
    End If

    Call mo_db.Close(lLabels)

    Exit Sub

errhandler:
    If lLabels > 0 Then
        Call mo_db.Close(lLabels)
    End If
    Call errorHandler(Me.Name & ".LoadLabels")
End Sub


' display standard error message
Private Sub ErrorMessage(ByVal as_Fct As String)
    Dim ls_ErrSource As String
    Dim ls_errDescription As String
    Dim ls_Message As String
    
    ls_ErrSource = as_Fct & SEP1 & Err.Source
    ls_errDescription = Err.Description
    ls_Message = SCREEN_NAME & " exception. Nr:" & Err.Number & ",Desc: " & ls_errDescription & ",Src:" & ls_ErrSource & "@"
    Call MsgBox("Error occured, please contact IT. Application will now shutdown." & vbCrLf & ls_ErrSource & vbCrLf & "Description: " & ls_errDescription, vbCritical, App.Title & " " & App.Major & "." & App.Minor & "." & App.Revision)
'    End
End Sub


' Standard error handler
Private Sub errorHandler(ByVal as_Fct As String)
    Err.Raise Err.Number, Me.Name & "::" & as_Fct & SEP1 & Err.Source, Err.Description
End Sub

Private Function GetArrayValue(ByRef ao_variantArray As Variant, ByVal al_Index As Long) As Variant
    If IsArray(ao_variantArray) Then
        If UBound(ao_variantArray) <= al_Index Then
            GetArrayValue = ao_variantArray(al_Index)
        Else
            GetArrayValue = 0
        End If
    Else
        GetArrayValue = 0
    End If
End Function

Private Function GetDbError(ByVal lo_Db As ARMSYSCOMLib.ArmDB) As String
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:
    Call errorHandler("GetDbError()")
End Function

Private Sub grd_main_DblClick()
    Call valid_upd_Click
End Sub

Private Sub quit_upd_Click()
    Call Me.Hide
    Unload Me
End Sub

Private Sub valid_upd_Click()
    If grd_main.SelectedCount = 0 Then
        MsgBox ("Please select a line.")
        Exit Sub
    End If
    ms_SDG_Desc = grd_main.SelectedLine(0, "SDG_Desc")
    ms_SD_desc = grd_main.SelectedLine(0, "SD_desc")
    ml_SD_Qty = grd_main.SelectedLine(0, "SD_Qty")
    ml_SD_Code = grd_main.SelectedLine(0, "SD_code")
    
    Call Me.Hide
    Unload Me
End Sub
