VERSION 5.00
Begin VB.Form frmDPC_Value 
   Caption         =   "#Value"
   ClientHeight    =   2295
   ClientLeft      =   120
   ClientTop       =   450
   ClientWidth     =   4860
   ControlBox      =   0   'False
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2295
   ScaleWidth      =   4860
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Tag             =   "frmDPC_Value"
   Visible         =   0   'False
   Begin VB.CommandButton btn_Quit 
      Height          =   612
      Left            =   4185
      Style           =   1  'Graphical
      TabIndex        =   2
      Tag             =   "btn_Quit"
      Top             =   1635
      Width           =   612
   End
   Begin VB.CommandButton btn_Validate 
      Height          =   612
      Left            =   3510
      Style           =   1  'Graphical
      TabIndex        =   1
      Tag             =   "btn_Validate"
      Top             =   1635
      Width           =   612
   End
   Begin VB.Frame fra_Value 
      Height          =   1500
      Left            =   15
      TabIndex        =   0
      Tag             =   "fra_Value"
      Top             =   60
      Width           =   4845
      Begin VB.CheckBox chk_CheckBox 
         Height          =   240
         Left            =   1545
         TabIndex        =   8
         Tag             =   "chk_CheckBox"
         Top             =   930
         Width           =   450
      End
      Begin VB.TextBox txt_Textbox 
         Height          =   330
         Left            =   1500
         TabIndex        =   6
         Tag             =   "txt_Textbox"
         Top             =   885
         Width           =   3240
      End
      Begin Project1.ArmCombobox cbo_Attribute 
         Height          =   345
         Left            =   1530
         TabIndex        =   4
         Tag             =   "cbo_Attribute"
         Top             =   225
         Width           =   3255
         _ExtentX        =   5741
         _ExtentY        =   609
      End
      Begin Project1.ArmCombobox cbo_Combo 
         Height          =   345
         Left            =   1500
         TabIndex        =   7
         Tag             =   "cbo_Combo"
         Top             =   900
         Width           =   3240
         _ExtentX        =   5741
         _ExtentY        =   609
      End
      Begin VB.Label lbl_Label 
         Caption         =   "#Value"
         Height          =   225
         Index           =   1
         Left            =   135
         TabIndex        =   5
         Tag             =   "lbl_Value"
         Top             =   915
         Width           =   930
      End
      Begin VB.Label lbl_Label 
         Caption         =   "#Attribute"
         Height          =   255
         Index           =   0
         Left            =   90
         TabIndex        =   3
         Tag             =   "lbl_Attribute"
         Top             =   270
         Width           =   1275
      End
   End
End
Attribute VB_Name = "frmDPC_Value"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const CL_COLOR_ENABLED As Long = &H80000005
Private Const CL_COLOR_DISABLED As Long = &H8000000F

Private Const C_ERRORRAISE As Long = 2500
Private Const SEP = "®©"
Private Const C_SEP As String = "@@"
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"
Private Const SCREEN_NAME As String = "frmDPC_Value"

Private Enum ArmErr
    DBCnxFailed = vbObjectError + 1             ' Unable to connect to the database
    CPTAlreadyInitialized = vbObjectError + 2   ' We try to initialize a component that is already initialized
    CPTNotInitialized = vbObjectError + 3       ' We try to use or free that is not initialized yet
    InvalidArgument = vbObjectError + 4
    PropertyNotSet = vbObjectError + 5
    SQLFailure = vbObjectError + 6               ' A SQL runtime error has occured : syntax wrong....
    SQLBadRowAffectedCount = vbObjectError + 7   ' A SQL request has not affected the expected rowcount (ex: one Update do nothing)
    SQLBadRowExpectedCount = vbObjectError + 8   ' A SQL request does not return the expected rowcount : select an item return nothing...
    DrivingError = vbObjectError + 9
    CompFncFailed = vbObjectError + 10           ' when component function fail
    GridLoadFailed = vbObjectError + 11          ' load function failed ... bad sql
    QuietException = vbObjectError + 12          ' do not display error message
    SQLTableReferenceConstraint = vbObjectError + 13 ' A SQL request cannot be executed : Table reference constraint
    DuplicityDetected = vbObjectError + 2301     ' detected row with same unique id
End Enum

Private ml_U_Code As Long
Private ms_Language_Code As String
Private mc_ScreenLabels As Long
Private mb_InternalInit As Boolean
Private mo_Tools As DPC_Tools
Private mc_PrdAttrChange As Long

#If ENV = LIVE Then
Private mo_Db As Object
Private mo_FSO As Object
#Else
Private mo_Db As ARMSYSCOMLib.ArmDb
Private mo_FSO As FileSystemObject
#End If

Public Result As Boolean
Public AttributeName As String
Public AttributeValue As Variant
Public AttributeTable As String

Property Let Language_Code(AString As String)
  ms_Language_Code = AString
End Property

Property Get Language_Code() As String
  Language_Code = ms_Language_Code
End Property

Public Property Set Tools(ByRef ao_Tools As Object)
On Error GoTo ErrorHandler

  Set mo_Tools = ao_Tools
  Exit Property
ErrorHandler:
  Call ErrorHandler("Tools.Set")
End Property

Public Property Set ArmDb(ByRef lo_Db As Object)
  If Not (lo_Db Is Nothing) Then
      Set mo_Db = lo_Db
  End If
End Property

Property Let U_Code(al_Code As Long)

  ml_U_Code = al_Code
End Property

Public Sub Load_A_Com()
On Error GoTo ErrHandler
    
Dim ls_Req As String
  
  If mo_Db Is Nothing Then
      Call Err.Raise(ArmErr.PropertyNotSet)
  End If
  If mo_Tools Is Nothing Then
      Call Err.Raise(ArmErr.PropertyNotSet)
  End If
  
  btn_Validate.Picture = LoadResPicture(RES_OK, 1)
  btn_Quit.Picture = LoadResPicture(RES_QUIT, 1)
  Set mo_FSO = New FileSystemObject
  
  Result = False
  AttributeName = ""
  AttributeValue = Empty
  AttributeTable = ""
  Call mo_Tools.Load_A_ComControls(Me.Controls, mo_Db, ms_Language_Code)
  
  'Screen csts
  mc_ScreenLabels = mo_Tools.LoadLabels(mo_Db, Me.Controls, Me, SCREEN_NAME, ms_Language_Code)
  Call mo_Tools.ChangeCharset(Me.Controls, gl_CodePage, gl_CodePage, Me)
  
  ls_Req = "exec DPC_PrdAttrChange_lst"
  mc_PrdAttrChange = mo_Tools.OpenSQLSafe(mo_Db, ls_Req)
  
  ls_Req = "exec A_References_ML_Lst $GR_Code$, $Language_Code$"
  ls_Req = Replace(ls_Req, "$GR_Code$", mo_Tools.SqlInt(eDPCReferenceML.rfBatchEditAttribute), , , vbTextCompare)
  ls_Req = ReplaceCommonPlaceholders(ls_Req)
  cbo_Attribute.Request = ls_Req
  Call cbo_Attribute.Load
  If cbo_Attribute.Count > 0 Then
    Set cbo_Attribute.SelectedItem = cbo_Attribute.ComboItems(1)
    Call cbo_Attribute_ComboItemSelected
  End If
  Result = False
  Exit Sub
ErrHandler:
  Call ErrorHandler("Load_A_COM")
End Sub

Public Sub Unload_A_Com()
On Error GoTo ErrHandler

  Call mo_Tools.Unload_A_ComControls(Me.Controls)
  Call mo_Db.Close(mc_PrdAttrChange)
  Call mo_Db.Close(mc_ScreenLabels)
  Set mo_Db = Nothing
  Set mo_FSO = Nothing
  Exit Sub
ErrHandler:
  Call ErrorHandler("Unload_A_COM")
End Sub

Private Sub btn_Quit_Click()
On Error GoTo ErrHandler
  
  Result = False
  Hide
  Exit Sub
ErrHandler:
  Call ErrorMessage("btn_Quit_Click")
End Sub

Private Sub btn_Validate_Click()
On Error GoTo ErrHandler

Dim lb_IsMandatoryEmpty As Boolean

  Call mo_Tools.LockScreen(Me, True)
  lb_IsMandatoryEmpty = False
  If mo_Db.Find(mc_PrdAttrChange, "PAC_Id", mo_Tools.GetComboKey(cbo_Attribute)) >= 0 Then
    If StrComp(mo_Db.GetFields(mc_PrdAttrChange, "PAC_Mandatory"), "X", vbTextCompare) = 0 Then
      If mo_Db.GetFields(mc_PrdAttrChange, "PAC_SQL") = "" Then
        
        Select Case UCase(mo_Db.GetFields(mc_PrdAttrChange, "PAC_DataType"))
        Case "FLOAT"
          If mo_Tools.ScreenToDbl(txt_Textbox.Text) = 0 Then
            lb_IsMandatoryEmpty = True
          End If
        Case "INT"
          If mo_Tools.ScreenToLong(txt_Textbox.Text) = 0 Then
            lb_IsMandatoryEmpty = True
          End If
        Case "STRING"
          If Trim(txt_Textbox.Text) = "" Then
            lb_IsMandatoryEmpty = True
          End If
        Case "BOOL"
          If (chk_CheckBox.Value = vbUnchecked) Then
            lb_IsMandatoryEmpty = True
          End If
        End Select
      Else
        If mo_Tools.GetComboKey(cbo_Combo) = "" Then
            lb_IsMandatoryEmpty = True
        End If
      End If
    End If
  End If
  If lb_IsMandatoryEmpty Then
    Call mo_Tools.ShowMsg(mo_Db, ms_Language_Code, 9701, "#Please, enter mandatory field: $fieldname$", Array("$fieldname$", lbl_Label(1).Caption))
  Else
    Result = True
    Hide
  End If
  Call mo_Tools.LockScreen(Me, False)
  Exit Sub
ErrHandler:
  Call ErrorMessage("btn_Validate_Click")
End Sub

Private Sub cbo_Attribute_ComboItemSelected()
On Error GoTo ErrHandler

  txt_Textbox.Visible = False
  chk_CheckBox.Visible = False
  cbo_Combo.Visible = False
  
  If mo_Db.Find(mc_PrdAttrChange, "PAC_Id", mo_Tools.GetComboKey(cbo_Attribute)) >= 0 Then
    If (StrComp(mo_Db.GetFields(mc_PrdAttrChange, "PAC_DataType"), "BOOL", vbTextCompare) = 0) Then
      chk_CheckBox.Visible = True
      chk_CheckBox.Value = vbUnchecked
    Else
      txt_Textbox.Visible = mo_Db.GetFields(mc_PrdAttrChange, "PAC_SQL") = ""
      cbo_Combo.Visible = mo_Db.GetFields(mc_PrdAttrChange, "PAC_SQL") <> ""
      txt_Textbox.Text = ""
      txt_Textbox.MaxLength = mo_Db.GetFields(mc_PrdAttrChange, "PAC_MaxLen")
      Call cbo_Combo.Clear
      cbo_Combo.Request = ReplaceCommonPlaceholders(mo_Db.GetFields(mc_PrdAttrChange, "PAC_SQL"))
    End If
    AttributeName = mo_Db.GetFields(mc_PrdAttrChange, "PAC_Field")
    AttributeValue = Empty
    AttributeTable = mo_Db.GetFields(mc_PrdAttrChange, "PAC_Table")
  Else
    txt_Textbox.Visible = False
    cbo_Combo.Visible = False
    AttributeName = ""
    AttributeValue = Empty
    AttributeTable = ""
  End If
  Exit Sub
ErrHandler:
  Call ErrorMessage("cbo_Attribute_ComboItemSelected")
End Sub

Private Sub cbo_Combo_ComboItemSelected()
On Error GoTo ErrHandler

  AttributeValue = mo_Tools.GetComboKey(cbo_Combo)
  Exit Sub
ErrHandler:
  Call ErrorMessage("cbo_Combo_ComboItemSelected")
End Sub

Private Sub chk_CheckBox_Click()
  AttributeValue = (chk_CheckBox.Value = vbChecked)
End Sub

Private Sub txt_Textbox_Validate(Cancel As Boolean)
On Error GoTo ErrHandler

  If mo_Db.Find(mc_PrdAttrChange, "PAC_Id", mo_Tools.GetComboKey(cbo_Attribute)) >= 0 Then
    
    Select Case UCase(mo_Db.GetFields(mc_PrdAttrChange, "PAC_DataType"))
    Case "FLOAT"
      AttributeValue = mo_Tools.ScreenToDbl(txt_Textbox.Text)
      txt_Textbox.Text = mo_Tools.DblToScreen(AttributeValue)
    Case "INT"
      AttributeValue = mo_Tools.ScreenToLong(txt_Textbox.Text)
      txt_Textbox.Text = mo_Tools.LongToScreen(AttributeValue)
    Case "STRING"
      AttributeValue = txt_Textbox.Text
    End Select
  End If
  Exit Sub
ErrHandler:
  Call ErrorMessage("cbo_Attribute_ComboItemSelected")
End Sub

'Public Function ReplacePlaceholders(ByVal as_Req As String) As String
'On Error GoTo ErrHandler
'
'
'  Call mo_Db.First(mc_PrdAttrChange)
'  While Not mo_Db.EOF(mc_PrdAttrChange)
'    If mo_Db.GetFields(mc_PrdAttrChange, "PAC_Id") = mo_Tools.GetComboKey(cbo_Attribute) Then
'      Select Case UCase(mo_Db.GetFields(mc_PrdAttrChange, "PAC_DataType"))
'      Case "STRING"
'        If mo_Db.GetFields(mc_PrdAttrChange, "PAC_SQL") = "" Then
'          as_Req = Replace(as_Req, "$" & mo_Db.GetFields(mc_PrdAttrChange, "PAC_Field") & "$", mo_Tools.SQLStr(txt_Textbox.Text), , , vbTextCompare)
'        Else
'          as_Req = Replace(as_Req, "$" & mo_Db.GetFields(mc_PrdAttrChange, "PAC_Field") & "$", mo_Tools.SqlStrKey(mo_Tools.GetComboKey(cbo_Combo)), , , vbTextCompare)
'        End If
'      Case "INT"
'        If mo_Db.GetFields(mc_PrdAttrChange, "PAC_SQL") = "" Then
'          as_Req = Replace(as_Req, "$" & mo_Db.GetFields(mc_PrdAttrChange, "PAC_Field") & "$", mo_Tools.SqlInt(mo_Tools.ScreenToLong(txt_Textbox.Text)), , , vbTextCompare)
'        Else
'          as_Req = Replace(as_Req, "$" & mo_Db.GetFields(mc_PrdAttrChange, "PAC_Field") & "$", mo_Tools.SqlInt(mo_Tools.GetComboKey(cbo_Combo)), , , vbTextCompare)
'        End If
'      Case "FLOAT"
'        If mo_Db.GetFields(mc_PrdAttrChange, "PAC_SQL") = "" Then
'          as_Req = Replace(as_Req, "$" & mo_Db.GetFields(mc_PrdAttrChange, "PAC_Field") & "$", mo_Tools.SqlDbl(mo_Tools.ScreenToDbl(txt_Textbox.Text)), , , vbTextCompare)
'        Else
'          as_Req = Replace(as_Req, "$" & mo_Db.GetFields(mc_PrdAttrChange, "PAC_Field") & "$", mo_Tools.SqlDbl(mo_Tools.GetComboKey(cbo_Combo)), , , vbTextCompare)
'        End If
'      Case "DATE"
'      Case Else
'        Err.Raise ArmErr.InvalidArgument, "ReplaceChangeRequest", "Invalid PAC_DataType for: " & mo_Db.GetFields(mc_PrdAttrChange, "PAC_Id")
'      End Select
'    Else
'      as_Req = Replace(as_Req, "$" & mo_Db.GetFields(mc_PrdAttrChange, "PAC_Field") & "$", "NULL", , , vbTextCompare)
'    End If
'    Call mo_Db.Next(mc_PrdAttrChange)
'  Wend
'  ReplacePlaceholders = ReplaceCommonPlaceholders(as_Req)
'  Exit Function
'ErrHandler:
'  Call ErrorHandler("ReplaceCommonPlaceholders")
'End Function

Private Function ReplaceCommonPlaceholders(ByVal as_Request As String) As String
On Error GoTo ErrHandler

  as_Request = Replace(as_Request, "$Z_Creator$", mo_Tools.SqlInt(ml_U_Code), , , vbTextCompare)
  as_Request = Replace(as_Request, "$U_Code$", mo_Tools.SqlInt(ml_U_Code), , , vbTextCompare)
  as_Request = Replace(as_Request, "$Z_Last_Upd_User$", mo_Tools.SqlInt(ml_U_Code), , , vbTextCompare)
  as_Request = Replace(as_Request, "$Language_Code$", mo_Tools.SQLStr(ms_Language_Code), , , vbTextCompare)
  ReplaceCommonPlaceholders = as_Request
  Exit Function
ErrHandler:
  Call ErrorHandler("ReplaceCommonPlaceholders")
End Function


' display standard error message
Public 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 mo_Tools.LogMessage(mo_Db, ml_U_Code, SCREEN_NAME, ls_Message, "E")
    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)
  
    Call Err.Raise(Err.Number, Me.Name & "." & as_Fct & SEP1 & Err.Source, Err.Description)
End Sub





