VERSION 5.00
Begin VB.Form frmDPC_BOR 
   Caption         =   "#Routing search"
   ClientHeight    =   6690
   ClientLeft      =   120
   ClientTop       =   450
   ClientWidth     =   14100
   ControlBox      =   0   'False
   LinkTopic       =   "Form2"
   ScaleHeight     =   6690
   ScaleWidth      =   14100
   StartUpPosition =   3  'Windows Default
   Tag             =   "frmDPC_BOR"
   Visible         =   0   'False
   Begin VB.Frame fra_Article 
      Height          =   750
      Left            =   15
      TabIndex        =   0
      Tag             =   "fra_Filter"
      Top             =   705
      Width           =   14055
      Begin VB.TextBox txt_AgBen_Fremd 
         Height          =   330
         Left            =   7515
         TabIndex        =   7
         Top             =   255
         Width           =   1485
      End
      Begin VB.TextBox txt_KostSt 
         Height          =   330
         Left            =   4590
         TabIndex        =   5
         Top             =   240
         Width           =   1485
      End
      Begin VB.TextBox txt_StAgNr 
         Height          =   330
         Left            =   1485
         TabIndex        =   1
         Top             =   255
         Width           =   1485
      End
      Begin VB.Label lbl_Label 
         Caption         =   "#Operation"
         Height          =   270
         Index           =   2
         Left            =   6195
         TabIndex        =   8
         Tag             =   "lbl_Operation"
         Top             =   285
         Width           =   1200
      End
      Begin VB.Label lbl_Label 
         Caption         =   "#Cost centre"
         Height          =   270
         Index           =   1
         Left            =   3270
         TabIndex        =   6
         Tag             =   "lbl_CostCentre"
         Top             =   270
         Width           =   1200
      End
      Begin VB.Label lbl_Label 
         Caption         =   "#Std Route Nr"
         Height          =   270
         Index           =   0
         Left            =   165
         TabIndex        =   2
         Tag             =   "lbl_StdRouteNr"
         Top             =   285
         Width           =   1200
      End
   End
   Begin Project1.ToolbarControl tlb_Main 
      Height          =   690
      Left            =   0
      TabIndex        =   3
      Tag             =   "2911"
      Top             =   0
      Width           =   14070
      _ExtentX        =   24818
      _ExtentY        =   1217
   End
   Begin Project1.ArmGrid grd_Routing 
      Height          =   5190
      Left            =   15
      TabIndex        =   4
      Tag             =   "grd_Routing"
      Top             =   1470
      Width           =   14130
      _ExtentX        =   24924
      _ExtentY        =   9155
   End
End
Attribute VB_Name = "frmDPC_BOR"
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_BOR"
Private Const SW_SHOWNORMAL = 1

Private Const LOCALE_SDECIMAL = &HE ' Decimal separator
Private Const LOCALE_STHOUSAND = &HF ' Thousand separator
Private Const LOCALE_USER_DEFAULT = &H400
Private Const C_ERRORRAISE As Long = 2500
Private Const C_MSG_ID_BASE As Long = 9700

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

Private mo_Tools As DPC_Tools

Private ml_U_Code As Long
Private mb_Initialized As Boolean
Private ms_DecimalSeparator As String
Private ms_ThousandSeparator As String
Private mc_ScreenLabels As Long
Private mc_Toolbars As Long
Private mo_WshNetwork As Object
Private ms_ComputerName As String
Private ms_Language_Code                As String       'current user interface language
Private ms_LoginName                    As String       'contain loginname
Private ms_UserName                     As String       'contain name of logged user as defined in GEN_People
Private mb_Result As Boolean
Private ml_AgId As Long
Private ml_KostSt As Long
Private ms_AgId_Desc As String
Private mo_BOR As DPC_BOR

Private mb_InternalInit As Boolean

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 ArmDb(ByRef lo_Db As Object)
  If Not (lo_Db Is Nothing) Then
      Set mo_Db = lo_Db
  End If
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 ArmDbBaeurer(ByRef lo_Db As Object)
  If Not (lo_Db Is Nothing) Then
      Set mo_DbBaeurer = lo_Db
  End If
End Property

Property Let U_Code(al_Code As Long)
  ml_U_Code = al_Code
End Property

Public Property Set BOR(ByRef ao_BOR As DPC_BOR)
On Error GoTo ErrorHandler

  Set mo_BOR = ao_BOR
  Exit Property
ErrorHandler:
  Call ErrorHandler("BOR.Set")
End Property

Public Property Get AgId() As Long
  AgId = ml_AgId
End Property

Public Property Get KostSt() As Long
  KostSt = ml_KostSt
End Property

Public Property Get AgIdDesc() As String
  AgIdDesc = ms_AgId_Desc
End Property

Public Property Get Result() As Boolean
  Result = mb_Result
End Property

Public Function Load_A_COM() As Boolean
On Error GoTo ErrHandler

Dim ll_Index As Long
Dim lo_Control As Object
Dim la_Columns As Variant
    
  Load_A_COM = False
  
  If mb_Initialized Then
      Call Err.Raise(ArmErr.CPTAlreadyInitialized)
  End If
  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
  mb_InternalInit = False
  Call mo_Tools.Load_A_ComControls(Me.Controls, mo_Db, ms_Language_Code)
  
  ms_ThousandSeparator = mo_Tools.GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_STHOUSAND)
  ms_DecimalSeparator = Format(0, ".")
  mc_Toolbars = 0
  
  Set mo_FSO = CreateObject("Scripting.FileSystemObject")
  
#If ENV = LIVE Then
  Set mo_Sys = CreateObject("ArmSYSCOM.ArmSys")
#Else
  Set mo_Sys = New ARMSYSCOMLib.ArmSYS
#End If
  
  Set mo_WshNetwork = CreateObject("WScript.Network")
  ms_ComputerName = mo_WshNetwork.ComputerName
  
  Set grd_Routing.ArmDb = mo_DbBaeurer
  ReDim la_Columns(6) As Variant
  la_Columns(0) = "agid" & CH_LDELIMIT & "0" & CH_LDELIMIT & "1" & CH_LDELIMIT & "agid" & CH_LDELIMIT & "#Ag Id"
  la_Columns(1) = "stagnr" & CH_LDELIMIT & "1500" & CH_LDELIMIT & "0" & CH_LDELIMIT & "stagnr" & CH_LDELIMIT & "#Std. operation" & CH_LDELIMIT & "STRING"
  la_Columns(2) = "kostst" & CH_LDELIMIT & "800" & CH_LDELIMIT & "0" & CH_LDELIMIT & "kostst" & CH_LDELIMIT & "#Cost centre"
  la_Columns(3) = "agben" & CH_LDELIMIT & "3000" & CH_LDELIMIT & "0" & CH_LDELIMIT & "agben" & CH_LDELIMIT & "#Operation" & CH_LDELIMIT & "STRING"
  la_Columns(4) = "lgrp" & CH_LDELIMIT & "800" & CH_LDELIMIT & "0" & CH_LDELIMIT & "lgrp" & CH_LDELIMIT & "#Salary group"
  la_Columns(5) = "anz_bedien" & CH_LDELIMIT & "800" & CH_LDELIMIT & "0" & CH_LDELIMIT & "anz_bedien" & CH_LDELIMIT & "#Worker count"
  la_Columns(6) = "agben_fremd" & CH_LDELIMIT & "800" & CH_LDELIMIT & "0" & CH_LDELIMIT & "agben_fremd" & CH_LDELIMIT & "#Short name"
  Call grd_Routing.SetColumns(la_Columns)
  
  'Call tlb_Main.SetToolbarInfoStringParameters("001EE®01760®QESFGIDR/BAC®AHHFLLSTT", "001")
  'Call tlb_Main.DisplayFace("0")
  'tlb_Main.Visible = True

  ml_AgId = 0
  ml_KostSt = 0
  ms_AgId_Desc = ""
  Call mo_Tools.LoadToolbars(mo_Db, Me.Controls, "DPC", SCREEN_NAME)
  '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)

  If Not mo_BOR Is Nothing Then
    txt_StAgNr.Text = mo_BOR.BOR_StagNr
    If txt_StAgNr.Text <> "" Then
      Call RefreshGrid
    End If
  End If
  mb_Result = False
  mb_Initialized = True
  Load_A_COM = mb_Initialized
  Exit Function
ErrHandler:
  Call ErrorMessage("Load_A_COM")
End Function

Public Function Unload_A_COM() As Boolean
On Error GoTo ErrHandler

  Call mo_Tools.Unload_A_ComControls(Me.Controls)
  Call mo_Db.Close(mc_ScreenLabels)
  Set mo_Sys = Nothing
  Set mo_FSO = Nothing
  Set mo_Db = Nothing
  Set mo_BOR = Nothing
  Exit Function
ErrHandler:
  Call ErrorMessage("Unload_A_COM")
End Function

Private Sub grd_Routing_Click()
On Error GoTo ErrHandler

  ml_AgId = 0
  ml_KostSt = 0
  ms_AgId_Desc = ""
  If grd_Routing.SelectedCount = 1 Then
    ml_AgId = grd_Routing.SelectedLine(0, "agid")
    ml_KostSt = grd_Routing.SelectedLine(0, "kostst")
    ms_AgId_Desc = grd_Routing.SelectedLine(0, "stagnr") + " - " + grd_Routing.SelectedLine(0, "agben")
  End If
  Exit Sub
ErrHandler:
    Call ErrorMessage("grd_Routing_Click")
End Sub

Private Sub grd_Routing_ItemSelected()
On Error GoTo ErrHandler

  If ml_AgId = 0 Then Exit Sub
  mb_Result = True
  Hide
  Exit Sub
ErrHandler:
    Call ErrorMessage("grd_Routing_ItemSelected")
End Sub

Private Sub txt_StAgNr_KeyPress(KeyAscii As Integer)
On Error GoTo ErrHandler
  
  Call mo_Tools.LockScreen(Me, True)
  If KeyAscii = 13 Then
    Call RefreshGrid
  End If
  Call mo_Tools.LockScreen(Me, False)
  Exit Sub
ErrHandler:
    Call ErrorMessage("txt_StAgNr_KeyPress")
End Sub

Private Sub tlb_Main_action(ByVal as_Role As String, as_Language As String)
On Error GoTo ErrHandler

  Call mo_Tools.LockScreen(Me, True)
  Select Case as_Role
  Case "H"
    If ml_AgId = 0 Then
      Call mo_Tools.LockScreen(Me, False)
      Exit Sub
    End If
    mb_Result = True
    Hide
  Case "L"
    Call RefreshGrid
  Case "T"
    mb_Result = False
    Hide
  End Select
  Call mo_Tools.LockScreen(Me, False)
  Exit Sub
ErrHandler:
  Call ErrorMessage("tlb_Main_action")
End Sub

Private Sub RefreshGrid()
On Error GoTo ErrHandler

Dim ls_req As String
  
  ml_AgId = 0
  ml_KostSt = 0
  ms_AgId_Desc = ""
  
  ls_req = "SELECT TOP 500 f250.agid,f250.stagnr,f250.kostst,f250.lgrp,f250.anz_bedien,f250.agben,f250.matr,f250.mate,f250.la,f250.arbplatz,f250.agbs," & _
          "f250.konto,f250.agben_fremd,f250.genau,f250.mauez,f250.lhs,f250.mehrm,f250.trko,f250.teko,f250.frzeit,f250.mind_gut,f250.kz_kannag,f250.agmenge," & _
          "f310.ks_varper " & _
          "FROM f250 " & _
          "LEFT JOIN f310 ON (f310.fi_nr=f250.fi_nr AND f310.kostst=f250.kostst AND f310.lgrp=f250.lgrp) " & _
          "WHERE " & _
          "((f250.stagnr LIKE $StAgNr$) OR ($StAgNr$ IS NULL) AND " & _
          "(f250.kostst = $kostst$ OR $kostst$ IS NULL) AND " & _
          "((UPPER(f250.agben) LIKE $agben$) OR ($agben$ IS NULL)) AND " & _
          "(f250.fi_nr = 1))" & _
          "ORDER BY f250.stagnr"
  ls_req = Replace(ls_req, "$Lang_Ext$", mo_Tools.SQLStr("en_us"), , , vbTextCompare)
  If Trim(txt_StAgNr.Text) = "" Then
    ls_req = Replace(ls_req, "$StAgNr$", "NULL", , , vbTextCompare)
  Else
    ls_req = Replace(ls_req, "$StAgNr$", mo_Tools.SQLStr("%" & txt_StAgNr.Text & "%"), , , vbTextCompare)
  End If
  ls_req = Replace(ls_req, "$kostst$", mo_Tools.SqlIntKey(Val(txt_KostSt.Text)), , , vbTextCompare)
  If Trim(txt_AgBen_Fremd.Text) = "" Then
    ls_req = Replace(ls_req, "$agben$", "NULL", , , vbTextCompare)
  Else
    ls_req = Replace(ls_req, "$agben$", mo_Tools.SQLStr("%" & UCase(txt_AgBen_Fremd.Text) & "%"), , , vbTextCompare)
  End If
  
  If Not grd_Routing.Load(ls_req, True) Then
    Err.Raise ArmErr.CompFncFailed, "grd_Routing.Load", "Grid load failed: " & ls_req
  End If
  Exit Sub
ErrHandler:
  Call ErrorHandler("RefreshGrid")
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

