VERSION 5.00
Begin VB.Form frmDPC_ErrorMsg 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "#Messages"
   ClientHeight    =   7125
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   15210
   ControlBox      =   0   'False
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7125
   ScaleWidth      =   15210
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Tag             =   "frmDPC_ErrorMsg"
   Visible         =   0   'False
   Begin VB.Frame fra_Comment 
      Height          =   1890
      Left            =   60
      TabIndex        =   3
      Tag             =   "fra_Comment"
      Top             =   4440
      Visible         =   0   'False
      Width           =   15090
      Begin VB.TextBox txt_Error 
         BackColor       =   &H8000000F&
         Height          =   300
         Left            =   1560
         Locked          =   -1  'True
         TabIndex        =   5
         Top             =   180
         Width           =   13425
      End
      Begin VB.TextBox txt_Comment 
         Height          =   1200
         Left            =   1545
         MultiLine       =   -1  'True
         TabIndex        =   4
         Top             =   525
         Width           =   13455
      End
      Begin VB.Label lbl_Label 
         Caption         =   "#Comment"
         Height          =   225
         Index           =   0
         Left            =   90
         TabIndex        =   7
         Tag             =   "lbl_Comment"
         Top             =   630
         Width           =   1290
      End
      Begin VB.Label lbl_Label 
         Caption         =   "#Message"
         Height          =   225
         Index           =   1
         Left            =   120
         TabIndex        =   6
         Tag             =   "lbl_Message"
         Top             =   210
         Width           =   1290
      End
   End
   Begin Project1.ArmGrid grd_Summary 
      Height          =   4350
      Left            =   60
      TabIndex        =   2
      Tag             =   "grd_Summary"
      Top             =   15
      Width           =   15090
      _ExtentX        =   26617
      _ExtentY        =   7673
   End
   Begin VB.CommandButton btn_Validate 
      Height          =   612
      Left            =   13845
      Style           =   1  'Graphical
      TabIndex        =   1
      Tag             =   "btn_Validate"
      Top             =   6450
      Width           =   612
   End
   Begin VB.CommandButton btn_Quit 
      Height          =   612
      Left            =   14520
      Style           =   1  'Graphical
      TabIndex        =   0
      Tag             =   "btn_Quit"
      Top             =   6450
      Width           =   612
   End
End
Attribute VB_Name = "frmDPC_ErrorMsg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const SEP = "®©"
Private Const C_SEP As String = "@@"
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"
Private Const CL_COLOR_ENABLED As Long = &H80000005
Private Const CL_COLOR_DISABLED As Long = &H8000000F
Private Const SCREEN_NAME As String = "frmDPC_ErrorMsg"
Private Const SW_SHOWNORMAL = 1

Public Result As Boolean
Private mo_ErrCollection As Collection
Private ml_U_Code As Long
Private ms_Language_Code As String
Private mc_ScreenLabels As Long
Private mo_Tools As DPC_Tools

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

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

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 lo_Error As DPC_Error
  
  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
  
  Call mo_Tools.Load_A_ComControls(Me.Controls, mo_Db, ms_Language_Code)
  
  btn_Validate.Picture = LoadResPicture(RES_OK, 1)
  btn_Quit.Picture = LoadResPicture(RES_QUIT, 1)
  
  grd_Summary.UnBound = True
  grd_Summary.WordWrap = True
  ReDim la_Columns(5) As Variant
  la_Columns(0) = "ERR_Id" & CH_LDELIMIT & "500" & CH_LDELIMIT & "1" & CH_LDELIMIT & "ERR_Id" & CH_LDELIMIT & "#ID"
  la_Columns(1) = "ERR_Type" & CH_LDELIMIT & "0" & CH_LDELIMIT & "0" & CH_LDELIMIT & "ERR_Type" & CH_LDELIMIT & ""
  la_Columns(2) = "ERR_TypeBMP" & CH_LDELIMIT & "400" & CH_LDELIMIT & "0" & CH_LDELIMIT & "ERR_TypeBMP" & CH_LDELIMIT & "" & CH_LDELIMIT & "BITMAP"
  la_Columns(3) = "LEV_Id" & CH_LDELIMIT & "0" & CH_LDELIMIT & "0" & CH_LDELIMIT & "LEV_Id" & CH_LDELIMIT & ""
  la_Columns(4) = "Message_Text" & CH_LDELIMIT & "8200" & CH_LDELIMIT & "0" & CH_LDELIMIT & "Message_Text" & CH_LDELIMIT & "#Message"
  la_Columns(5) = "TXT_Text" & CH_LDELIMIT & "8200" & CH_LDELIMIT & "0" & CH_LDELIMIT & "TXT_Text" & CH_LDELIMIT & "#Comment"
  Call grd_Summary.SetColumns(la_Columns)

  If Not (mo_ErrCollection Is Nothing) Then
    For Each lo_Error In mo_ErrCollection
      If lo_Error.ERR_Type = eDPCErrorType.etNone Then
        Call grd_Summary.AddLine(Array(lo_Error.ERR_ID, lo_Error.ERR_Type, "", lo_Error.LEV_Id, lo_Error.Message_Text, lo_Error.TXT_Text))
      Else
        Call grd_Summary.AddLine(Array(lo_Error.ERR_ID, lo_Error.ERR_Type, "ERRORTYPE" & lo_Error.ERR_Type, lo_Error.LEV_Id, lo_Error.Message_Text, lo_Error.TXT_Text))
      End If
    Next
    btn_Validate.Visible = Not IsErrorCritical(mo_ErrCollection)
  End If
  Call grd_Summary.SetAutoRowHeight("Message_Text")
  Call grd_Summary.DeselectRow
  
  '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)
  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_ScreenLabels)
  Set mo_Db = Nothing
  Exit Sub
ErrHandler:
  Call ErrorHandler("Unload_A_COM")
End Sub

Public Property Set ErrCollection(ByVal ao_ErrCollection As Collection)
On Error GoTo ErrHandler


  Set mo_ErrCollection = ao_ErrCollection
  Exit Property
ErrHandler:
  Call ErrorHandler("ErrCollection.Set")
End Property

Public Property Get ErrCollection() As Collection
On Error GoTo ErrHandler

  Set ErrCollection = mo_ErrCollection
  Exit Property
ErrHandler:
  Call ErrorHandler("ErrCollection.Get")
End Property

Private Sub btn_Validate_Click()
On Error GoTo ErrHandler
  
  Call mo_Tools.LockScreen(Me, True)
  Call UpdateComment
  Result = True
  Hide
  Call mo_Tools.LockScreen(Me, False)
  Exit Sub
ErrHandler:
  Call ErrorMessage("btn_Validate_Click")
End Sub

Private Sub btn_Quit_Click()
On Error GoTo ErrHandler
  
  Call mo_Tools.LockScreen(Me, True)
  Call UpdateComment
  Result = False
  Hide
  Call mo_Tools.LockScreen(Me, False)
  Exit Sub
ErrHandler:
  Call ErrorMessage("btn_Quit_Click")
End Sub

Private Sub UpdateComment()
On Error GoTo ErrHandler

Dim lo_DPC_Error As DPC_Error

  grd_Summary.Redraw = False
  For Each lo_DPC_Error In mo_ErrCollection
    If grd_Summary.SearchKey(True, lo_DPC_Error.ERR_ID) Then
      lo_DPC_Error.TXT_Text = grd_Summary.Data(grd_Summary.Row, "TXT_Text")
    End If
  Next
  grd_Summary.Redraw = True
  Exit Sub
ErrHandler:
  Call ErrorHandler("UpdateComment")
End Sub

Public Function IsErrorCritical(ByVal lo_ErrCol As Collection) As Boolean
On Error GoTo ErrHandler

Dim lo_Error As DPC_Error

  IsErrorCritical = False
  For Each lo_Error In lo_ErrCol
    If lo_Error.ERR_Type = eDPCErrorType.etStop Then
      IsErrorCritical = True
      Exit Function
    End If
  Next
  Exit Function
ErrHandler:
  Call ErrorHandler("IsErrorCritical")
End Function

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error GoTo ErrHandler
  
  Call mo_Tools.LockScreen(Me, True)
  Call UpdateComment
  Call mo_Tools.LockScreen(Me, False)
  Exit Sub
ErrHandler:
  Call ErrorMessage("Form_QueryUnload")
End Sub

Private Sub grd_Summary_Click()
On Error GoTo ErrHandler

  Call mo_Tools.LockScreen(Me, True)
  fra_Comment.Visible = False
  If grd_Summary.SelectedCount = 1 Then
    If grd_Summary.SelectedLine(0, "ERR_Type") = eDPCErrorType.etNeedApproval Then
      txt_Error.Text = grd_Summary.SelectedLine(0, "Message_Text")
      txt_Comment.Text = grd_Summary.SelectedLine(0, "TXT_Text")
      fra_Comment.Visible = True
    End If
  End If
  Call mo_Tools.LockScreen(Me, False)
  Exit Sub
ErrHandler:
  Call ErrorMessage("grd_Summary_Click")
End Sub

Private Sub txt_Comment_Change()
On Error GoTo ErrHandler
  
  If grd_Summary.SelectedCount = 1 Then
    grd_Summary.SelectedLine(0, "TXT_Text") = txt_Comment.Text
  End If
  Exit Sub
ErrHandler:
  Call ErrorMessage("txt_Comment_Change")
End Sub


' 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_Message, 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



