VERSION 5.00
Begin VB.Form qfASProduct 
   Caption         =   "AS Product"
   ClientHeight    =   7440
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   12690
   LinkTopic       =   "Form1"
   ScaleHeight     =   7440
   ScaleWidth      =   12690
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame frm_DropFlag 
      Caption         =   "Drop Status"
      Height          =   735
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   4695
      Begin VB.OptionButton opt_DropStatus 
         Caption         =   "Undropped Only"
         Height          =   255
         Index           =   2
         Left            =   960
         TabIndex        =   5
         Tag             =   "N"
         Top             =   240
         Width           =   1695
      End
      Begin VB.OptionButton opt_DropStatus 
         Caption         =   "Dropped Only"
         Height          =   255
         Index           =   1
         Left            =   3000
         TabIndex        =   4
         Tag             =   "Y"
         Top             =   240
         Width           =   1455
      End
      Begin VB.OptionButton opt_DropStatus 
         Caption         =   "All"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   3
         Top             =   240
         Value           =   -1  'True
         Width           =   615
      End
   End
   Begin VB.CommandButton cmd_Reload 
      Caption         =   "Refresh"
      Height          =   495
      Left            =   6000
      TabIndex        =   1
      Top             =   120
      Width           =   1095
   End
   Begin Project1.ArmGrid ucGrid 
      Height          =   6255
      Left            =   0
      TabIndex        =   0
      Top             =   960
      Width           =   12615
      _ExtentX        =   22251
      _ExtentY        =   11033
   End
End
Attribute VB_Name = "qfASProduct"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'what is new
'2.6.9 : Updated rights handling (JN) - now this module is available in readonly mode for everybody (JN)


Private Const C_Request_ASProductList As String = "QF_ASProductLst '$Language_Code$', $Drop_Flag$"
Private Const C_Request_ASProductUpdate As String = "QF_ASProduct_Update '$BI_SAP_Code$', '$BI_A_Free1$', $iConcurrency$, '$Login_Name$'"

Private mo_Db As ArmDb
Private ms_Language_Code As String
Private ms_LoginName As String
Private mb_readOnly As Boolean


Public Property Set DB(ao_DB As ArmDb)
    Set mo_Db = ao_DB
End Property

Public Property Let Language_Code(as_Language_Code As String)
    ms_Language_Code = as_Language_Code
End Property


Public Property Let LoginName(as_LoginName As String)
    ms_LoginName = as_LoginName
End Property

Public Property Let ReadOnly(ByVal ab_value As Boolean)
    mb_readOnly = ab_value
End Property

Public Sub Load_A_Com()

    Set ucGrid.ArmDb = mo_Db
    ucGrid.Load_A_Com
    ucGrid.AllowExcelExport = True
    ucGrid.AllowSort = True
    ucGrid.AllowMultiSort = True
    ucGrid.ExportTitles = True
    ucGrid.ExportOnlyVisibleColumns = True
   
    Dim la_Columns(7) As String

    'Grille
    la_Columns(0) = "BI_SAP_Code" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "1" & CH_LDELIMIT & "BI_SAP_Code" & CH_LDELIMIT & "BI SAP Code"
    la_Columns(1) = "BM_Desc" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "BM_Desc" & CH_LDELIMIT & "Base Material"
    la_Columns(2) = "PF_Desc" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "PF_Desc" & CH_LDELIMIT & "Product Family"
    la_Columns(3) = "PE_Desc" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "PE_Desc" & CH_LDELIMIT & "Products Edge"
    la_Columns(4) = "BI_A_Free1" & CH_LDELIMIT & "1000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "BI_A_Free1" & CH_LDELIMIT & "Is AS Product"
    la_Columns(5) = "iConcurrency" & CH_LDELIMIT & "0" & CH_LDELIMIT & "0" & CH_LDELIMIT & "iConcurrency" & CH_LDELIMIT & "iConcurrency"
    la_Columns(6) = "CG_Desc" & CH_LDELIMIT & "1000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "CG_Desc" & CH_LDELIMIT & "Category"
    la_Columns(7) = "BI_Type" & CH_LDELIMIT & "1000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "BI_Type" & CH_LDELIMIT & "Type"
    
    
    ucGrid.SetColumns la_Columns
    
    ReadOnly = True

    Call LoadGrid

End Sub


Private Sub LoadGrid()
    Dim ls_Request As String
    ls_Request = C_Request_ASProductList
    ls_Request = Replace(ls_Request, "$Language_Code$", ms_Language_Code, , , vbTextCompare)
    ls_Request = Replace(ls_Request, "$Drop_Flag$", GetDropFlag(), , , vbTextCompare)
    Call ucGrid.Load(ls_Request, False)
End Sub

Private Sub cmd_Reload_Click()
    LoadGrid
End Sub

Private Sub opt_DropStatus_Click(Index As Integer)
    Call LoadGrid
End Sub

Private Sub ucGrid_DblClick()

    If mb_readOnly Then Exit Sub
    
    Dim ls_BI_SAP_Code As String
    Dim lb_IsASProduct As Boolean
    Dim ll_iConcurrency As Long
    
    ls_BI_SAP_Code = ucGrid.CurrentKey(0)
        
    lb_IsASProduct = ucGrid.CurrentLine("BI_A_Free1") = "X"
    ll_iConcurrency = ucGrid.CurrentLine("iConcurrency")
    
    If UpdateASProductFlag(ls_BI_SAP_Code, Not lb_IsASProduct, ll_iConcurrency) Then
        ucGrid.CurrentLine("BI_A_Free1") = IIf(Not lb_IsASProduct, "X", "")
        ucGrid.CurrentLine("iConcurrency") = ll_iConcurrency + 1
    End If

End Sub


Private Function UpdateASProductFlag(as_BI_SAP_Code As String, ab_isASProduct As Boolean, al_iConcurrency As Long) As Boolean

    UpdateASProductFlag = False
    
    Dim ls_Request As String
    ls_Request = C_Request_ASProductUpdate
    ls_Request = Replace(ls_Request, "$BI_SAP_Code$", as_BI_SAP_Code, , , vbTextCompare)
    ls_Request = Replace(ls_Request, "$IConcurrency$", al_iConcurrency, , , vbTextCompare)
    ls_Request = Replace(ls_Request, "$BI_A_Free1$", IIf(ab_isASProduct, "X", ""), , , vbTextCompare)
    ls_Request = Replace(ls_Request, "$Login_Name$", ms_LoginName, , , vbTextCompare)
        
    Dim ls_Message As String
    If mo_Db.ExecuteSQL(ls_Request) <> -1 Then
        ls_Message = "An error occured when tryed to update the flag of the Product " & as_BI_SAP_Code & vbCrLf & mo_Db.LastErrorMessage & vbCrLf & "Please contact your IT Support"
        Call MsgBox(ls_Message, vbCritical, "Quick Form AS Product Flag")
        Exit Function
    End If

    If mo_Db.SQLRowsAffected = 0 Then
        ls_Message = "The product " & as_BI_SAP_Code & " has been updated since your load your grid and can't be updated. Please refresh first the grid"
        Call MsgBox(ls_Message, vbCritical, "Quick Form AS Product Flag")
        Exit Function
    End If
    
    UpdateASProductFlag = True

End Function

Private Function GetDropFlag() As String

    Dim ls_DropFlag As String
    
    If opt_DropStatus(0).value Then ls_DropFlag = "NULL"
    If opt_DropStatus(1).value Then ls_DropFlag = "'Y'"
    If opt_DropStatus(2).value Then ls_DropFlag = "'N'"

    GetDropFlag = ls_DropFlag

End Function





