VERSION 5.00
Begin VB.Form frmDPC_Memo 
   Caption         =   "DPC_Memo"
   ClientHeight    =   7020
   ClientLeft      =   45
   ClientTop       =   390
   ClientWidth     =   11670
   LinkTopic       =   "Form2"
   ScaleHeight     =   7020
   ScaleWidth      =   11670
   StartUpPosition =   3  'Windows Default
   Visible         =   0   'False
   Begin VB.TextBox txt_MEM_Id 
      Enabled         =   0   'False
      Height          =   285
      Left            =   825
      TabIndex        =   8
      Tag             =   "MEM_Id"
      Top             =   6315
      Visible         =   0   'False
      Width           =   285
   End
   Begin VB.TextBox txt_MEM_Type 
      Height          =   375
      Left            =   360
      TabIndex        =   7
      Tag             =   "MEM_Type"
      Top             =   6270
      Visible         =   0   'False
      Width           =   345
   End
   Begin VB.Frame fra_Selection 
      Height          =   6165
      Left            =   0
      TabIndex        =   4
      Tag             =   "fra_Selection"
      Top             =   0
      Width           =   11652
      Begin VB.TextBox txt_MEM_Text 
         BeginProperty Font 
            Name            =   "Arial"
            Size            =   7.5
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   5415
         Left            =   120
         MaxLength       =   20000
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   2
         Tag             =   "MEM_Text"
         Top             =   645
         Width           =   11460
      End
      Begin VB.TextBox txt_MEM_Name 
         Height          =   375
         Left            =   1065
         TabIndex        =   0
         Tag             =   "MEM_Name"
         Top             =   195
         Width           =   7980
      End
      Begin VB.CommandButton cmd_NewMemo 
         Caption         =   "#New Memo"
         Height          =   375
         Left            =   9135
         TabIndex        =   1
         Tag             =   "cmd_SelExis"
         Top             =   180
         Width           =   2415
      End
      Begin VB.Label lbl_Label 
         Caption         =   "#Name"
         Height          =   255
         Index           =   0
         Left            =   165
         TabIndex        =   6
         Tag             =   "lbl_IMI_Width"
         Top             =   285
         Width           =   900
      End
   End
   Begin VB.CommandButton btn_Quit 
      Height          =   612
      Left            =   10920
      Style           =   1  'Graphical
      TabIndex        =   5
      Tag             =   "btn_Quit"
      Top             =   6240
      Width           =   612
   End
   Begin VB.CommandButton btn_Validate 
      Default         =   -1  'True
      Height          =   612
      Left            =   10200
      Style           =   1  'Graphical
      TabIndex        =   3
      Tag             =   "btn_Validate"
      Top             =   6240
      Width           =   612
   End
End
Attribute VB_Name = "frmDPC_Memo"
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_Memo"
Private Const C_MSG_ID_BASE As Long = 9800

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

#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

Private ml_U_Code As Long
Private ms_Language_Code As String
Private mc_ScreenLabels As Long
Private mo_Tools As DPC_Tools
Private ml_iConcurrency As Long
Private mb_ShowSelectExisting As Boolean
Private me_MemoType As eDPCMemoType
Private mb_NewMemo As Boolean


Public Mode As eDPCScreenMode
Public MEM_Id As Long
Public Result As Boolean

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 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

Property Let ShowSelectExisting(ab_ShowSel As Boolean)
  mb_ShowSelectExisting = ab_ShowSel
End Property

Property Let MemoType(ae_Type As eDPCMemoType)
  me_MemoType = ae_Type
End Property

Property Get NewMemo() As String
  NewMemo = mb_NewMemo
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 Sub Load_A_COM()
On Error GoTo ErrHandler

Dim ll_max As Long
    
  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
              
  If Mode = eDPCScreenMode.smNone Then
    Call mo_Tools.EnableFrame(Me.Controls, Me, False)
    btn_Quit.Enabled = True
  End If
  
  Call mo_Tools.Load_A_ComControls(Me.Controls, mo_Db, ms_Language_Code, Me.hwnd)
  'Screen csts
  mc_ScreenLabels = mo_Tools.LoadLabels(mo_Db, Me.Controls, Me, SCREEN_NAME, ms_Language_Code, Me.hwnd)
  Call mo_Tools.ChangeCharset(Me.Controls, gl_CodePage, mo_Tools.GetCodePageFromLanguage(mo_Db, ms_Language_Code), Me)
  
  Call ShowMemo(MEM_Id, "")
  
  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, Me.hwnd)
  Call mo_Db.Close(mc_ScreenLabels)
  Set mo_Db = Nothing
  Set mo_FSO = Nothing
  Set mo_Tools = Nothing
  
  Exit Sub
ErrHandler:
  Call ErrorHandler("Unload_A_COM")
End Sub

Private Function ShowMemo(ByVal al_MemId As Long, ByVal as_FileName As String) As Boolean
On Error GoTo ErrHandler

Dim ls_Request As String
Dim ll_Cursor As Long

    If al_MemId > 0 Then
        ls_Request = "exec DPC_Memo_sel " & al_MemId
        ll_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_Request)
        
        If Not mo_Db.EOF(ll_Cursor) Then
            txt_MEM_Name.Text = mo_Db.GetFields(ll_Cursor, "MEM_Name")
            txt_MEM_Id.Text = al_MemId
            txt_MEM_Text.Text = mo_Db.GetFields(ll_Cursor, "MEM_Text")
            txt_MEM_Type.Text = mo_Db.GetFields(ll_Cursor, "MEM_Type")
            ml_iConcurrency = mo_Db.GetFields(ll_Cursor, "iConcurrency")
        Else
            Err.Raise ArmErr.CompFncFailed, "ShowMemo", "#Memo does not exists in DPC_Memo table with MEM_Id=" & al_MemId
        End If
            
        Call mo_Db.Close(ll_Cursor)
        
    ElseIf as_FileName <> "" Then
        'txt_MEM_Text.Text = LoadMemo(as_FileName)
        
    End If
    
    ShowMemo = True
    
    Exit Function
ErrHandler:
        
    If ll_Cursor > 0 Then
        Call mo_Db.Close(ll_Cursor)
    End If

    ShowMemo = False
    Call ErrorHandler("ShowMemo")
End Function

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 ll_MEM_Id_orig As Long
Dim ls_Request As String
Dim ls_Text As String

  Call mo_Tools.LockScreen(Me, True)
    
    If (Mode = eDPCScreenMode.smUpdate Or Mode = eDPCScreenMode.smAdd) And txt_MEM_Text.Text = "" Then
        Call mo_Tools.ShowMsg(mo_Db, ms_Language_Code, 9736, "#Please enter text")
        Call mo_Tools.LockScreen(Me, False)
        Exit Sub
    End If
    
    If (Mode = eDPCScreenMode.smUpdate Or Mode = eDPCScreenMode.smAdd) And txt_MEM_Name.Text = "" Then
        Call mo_Tools.ShowMsg(mo_Db, ms_Language_Code, 9736, "#Please enter name")
        Call mo_Tools.LockScreen(Me, False)
        Exit Sub
    End If
      
    If Mode = eDPCScreenMode.smUpdate Then
    
        If mb_NewMemo = True Then
            ll_MEM_Id_orig = MEM_Id
            MEM_Id = mo_Tools.GetNextID(mo_Db, "DPC_Memo")
            txt_MEM_Id.Text = MEM_Id
                        
            ls_Request = "exec DPC_Memo_ins $MEM_Id$,$Language_Code$,$MEM_Type$, $MEM_Name$,$MEM_Text$,$Z_creator$"
        
            ls_Request = Replace(ls_Request, "$MEM_Type$", mo_Tools.SqlInt(me_MemoType), , , vbTextCompare)
            ls_Request = Replace(ls_Request, "$MEM_Text$", mo_Tools.SQLStr(txt_MEM_Text.Text, txt_MEM_Text.MaxLength), , , vbTextCompare)
            
            ls_Request = mo_Tools.ReplaceRequestByFrameData(ls_Request, Me.Controls, fra_Selection)
            ls_Request = Replace(ls_Request, "$Language_Code$", mo_Tools.SQLStr(Language_Code), , , vbTextCompare)
            ls_Request = Replace(ls_Request, "$Z_creator$", ml_U_Code)
            
            Call mo_Tools.ExecuteSQLSafe(mo_Db, ls_Request)
        Else
            txt_MEM_Id.Text = MEM_Id
            
            ls_Request = "exec DPC_Memo_upd $MEM_Id$,$Language_code$,$MEM_Type$,$MEM_Name$,$MEM_Text$,$Z_last_upd_user$,$iConcurrency$"
            
            ls_Request = Replace(ls_Request, "$MEM_Type$", mo_Tools.SqlInt(me_MemoType), , , vbTextCompare)
            ls_Request = Replace(ls_Request, "$MEM_Id$", mo_Tools.SqlInt(MEM_Id), , , vbTextCompare)
            ls_Request = Replace(ls_Request, "$MEM_Text$", mo_Tools.SQLStr(txt_MEM_Text.Text, txt_MEM_Text.MaxLength), , , vbTextCompare)
            
            ls_Request = mo_Tools.ReplaceRequestByFrameData(ls_Request, Me.Controls, fra_Selection)
            ls_Request = Replace(ls_Request, "$Language_Code$", mo_Tools.SQLStr(Language_Code), , , vbTextCompare)
            ls_Request = Replace(ls_Request, "$Z_last_upd_user$", ml_U_Code)
            ls_Request = mo_Tools.ReplacePlaceHolder(ls_Request, "$iConcurrency$", ml_iConcurrency)
        
            Call mo_Tools.ExecuteSQLSafe(mo_Db, ls_Request, 1)
        End If
                        
    End If
  
    If Mode = eDPCScreenMode.smAdd Then
        
        MEM_Id = mo_Tools.GetNextID(mo_Db, "DPC_Memo")
        txt_MEM_Id.Text = MEM_Id
    
        ls_Request = "exec DPC_Memo_ins $MEM_Id$,$Language_Code$,$MEM_Type$, $MEM_Name$,$MEM_Text$,$Z_creator$"
    
        ls_Request = Replace(ls_Request, "$MEM_Type$", mo_Tools.SqlInt(me_MemoType), , , vbTextCompare)
        ls_Request = Replace(ls_Request, "$MEM_Text$", mo_Tools.SQLStr(txt_MEM_Text.Text, txt_MEM_Text.MaxLength), , , vbTextCompare)
        
        ls_Request = mo_Tools.ReplaceRequestByFrameData(ls_Request, Me.Controls, fra_Selection)
        ls_Request = Replace(ls_Request, "$Language_Code$", mo_Tools.SQLStr(Language_Code), , , vbTextCompare)
        ls_Request = Replace(ls_Request, "$Z_creator$", ml_U_Code)
        
        Call mo_Tools.ExecuteSQLSafe(mo_Db, ls_Request)
    End If
  
  Result = True
  Hide
  Call mo_Tools.LockScreen(Me, False)
  Exit Sub
ErrHandler:
  Call ErrorMessage("btn_Validate_Click")
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_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

Private Sub cmd_NewMemo_Click()
On Error GoTo ErrHandler
    
    mb_NewMemo = True
    
    txt_MEM_Name.Text = ""
    txt_MEM_Id.Text = "0"
    txt_MEM_Text.Text = ""
    ml_iConcurrency = "0"
    
    Exit Sub
ErrHandler:
    Call ErrorMessage("cmd_NewMemo_Click")
End Sub



