Attribute VB_Name = "modADO2"
Option Explicit

Public goConn As New Connection
Public goConn2 As New Connection
Public goConn3 As New Connection
Public goConn4 As New Connection
Public gintNTOID As Long ' this is to work with superceded takeoffs
Public gintPONUM As Long, gintPAYID As Long, gboolBAG As Boolean
Public gintTOID As Long, gintPRINT As Long, gbytINV_TYPE As Byte
Public gstrBEGDATE As String, gstrENDDATE As String
Public gintDEST As Integer, gintCOPY As Integer
Public gintLOTID As Long, gintPERCENT As Integer
Public gintPROJID As Long, glngORDERID As Long
Public gintOPTID As Long ', gboolMAS90 As Boolean
Public gintREPAIRID As Long, gintORDER As Long
Public gintESTID As Long, gstrPO As String, gintCOCODE As Integer
Public gstrLOGIN As String, gbytSECURITY As Byte
Public gintCREWID As Integer, gstrCREW As String
Public gstrFLAG As String, gstrPONUM As String, gstrTYPE As String
Public gboolPRINT As Boolean, gboolLOGIN As Boolean, gstrMODULE As String
Public gboolSYN As Boolean, gsngWAGE As Single, gdteUPDATE As Date, gbool2FIN As Boolean
Public gboolPULTE As Boolean, gboolCERTIFIED As Boolean, gboolPSpecialCALC As Boolean


Public gconACTION As Byte ' 1 = Add, 2 = Change, 3 = Delete, 5 = Copy

Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Const LB_SETTABSTOPS = &H192
Public Sub DataBase()

'*** Means that Main Database at VWP has been Updated
'tblTake - rename UPDATE to LSave and LUUser to LSUser ***
'tblTake - Add UPDATE and LUUser to End of Table - same type as renamed fields ***
'tblTake - Add OpenFlg (Yes/No) ***
'tblPlans - Add OpenFlg (Yes/No) ***
'tblPlans - Add Verified (Yes/No) ***
'tblPlans - rename UPDATE to LSave and LUUser to LSUser ***
'tblPlans - Add UPDATE and LUUser to End of Table - same type as renamed fields ***
'tblPlans - Add IMPORT (Date/Time) and IMUser (Text 6) ***
'tblPlans - Add SOURCE (Text 8) ***
'tblProject = add TAPE (Yes/No) ***
'tblLotInfo - Add OpenFlg (Yes/No) ***
'tblLotInfo - Add IMPORT (Date/Time) and IMUser (Text 6) ***
'tblLotInfo - Add CALCDATE (Date/Time) ***
'tblLotInfo - Add MultiPay (Yes/No)
'tblPOPTION - Add Invoice (Yes/No) - This it to indicate if this item should be excluded from the invoice
'tblPOPTION - Add OTSTONE (Yes/No) - To show that the stone is being installed by someone else
'tblOPTION - Add Invoice (Yes/No) - This it to indicate if this item should be excluded from the invoice
'tblOPTION - Add OTSTONE (Yes/No) - To show that the stone is being installed by someone else
'tblLotInfo - Add OTSTONE (Yes/No) - To show that the stone is being installed by someone else
'tblLotInfo - Add PAYCOMPLETE (YES/NO)
'tblLotInfo - ADD PAYYSTUCCO INTEGER
'tblLotInfo - ADD PAYYLATH INTEGER
'tblLotInfo - Add PayMetal Integer
'tblLotInfo - Add NoPayIssue (Yes/No)
'tblPaySheet - Create new table
'tblPaySheet - Add PAYID - Autonumber
'tblPaySheet - Add LOTID - Long
'tblPaySheet - Add TYPE Text 1 (L/S/V)
'tblPaySheet - Add PayYdge - Long
'tblPaySheet - Add Metal - Long
'tblPaySheet - Add PAID (Yes./No)
'tblPaySheet - Add Amt Single
'tblPaySheet - Add YRate Single
'tblPaySheet - Add MRage Single
'tblOPTION - Add Invoice Y/N
'tblOPTION - Add OTStone
'tblPaySheet - Add CREWID Long
'tblPaySheet - Add SHEET Integer (to know which pay sheet number)


End Sub
Public Sub Main()
Dim boolPerform As Boolean
Dim boolPerform2 As Boolean
Dim boolPerform3 As Boolean
Dim boolPerform4 As Boolean
   
   On Error GoTo Error_EH
   
   Screen.MousePointer = vbHourglass
   
   ' Open the Database Engine
   boolPerform = DataOpen(goConn)
   boolPerform2 = DataOpen2(goConn2)
   boolPerform3 = DataOpen3(goConn3)
   boolPerform4 = DataOpen4(goConn4)
   
   If boolPerform2 Then
'      gboolMAS90 = vbFalse
'      gboolMAS90 = vbTrue
   Else
'      gboolMAS90 = vbTrue
'      gboolMAS90 = vbFalse
   End If
   If boolPerform Then
      frmSplash.Show 1
      gboolLOGIN = False
      frmLogin.Show 1
      If gboolLOGIN Then
         frmMain.Show
      End If
   End If
'   End If
   
   Screen.MousePointer = vbDefault
   Exit Sub
   
Error_EH:
   gstrMODULE = "Module ADO.BAS - Sub Main"
   Call ErrorHandler2
   gstrMODULE = ""
   Exit Sub
End Sub

Public Function DataOpen(oConn As Connection) As Boolean
   On Error GoTo Open_EH
   
   oConn.CursorLocation = adUseClient
   
   ' Set the connection string by calling
   ' a function.
   oConn.ConnectionString = ConnectString()
      
   ' Set the mode of the connection
   oConn.Mode = adModeReadWrite
      
   ' Open the Connection
   oConn.Open
   
   DataOpen = True
   
   Exit Function
   
Open_EH:
   Call ErrorHandler(goConn)
   DataOpen = False
   Exit Function
End Function

Public Function DataOpen2(oConn2 As Connection) As Boolean
   On Error GoTo Open_EH
   
   oConn2.CursorLocation = adUseClient
   
   ' Set the connection string by calling
   ' a function.
   oConn2.ConnectionString = ConnectString2()
      
   ' Set the mode of the connection
   oConn2.Mode = adModeReadWrite
      
   ' Open the Connection
   oConn2.Open
   
   DataOpen2 = True
   
   Exit Function
   
Open_EH:
'   Call ErrorHandler(goConn2)
   DataOpen2 = False
   Exit Function
End Function

Public Function DataOpen3(oConn3 As Connection) As Boolean
   On Error GoTo Open_EH
   
   oConn3.CursorLocation = adUseClient
   
   ' Set the connection string by calling
   ' a function.
   oConn3.ConnectionString = ConnectString3()
      
   ' Set the mode of the connection
   oConn3.Mode = adModeReadWrite
      
   ' Open the Connection
   oConn3.Open
   
   DataOpen3 = True
   
   Exit Function
   
Open_EH:
'   Call ErrorHandler(goConn3)
   DataOpen3 = False
   Exit Function
End Function

Public Function DataOpen4(oConn4 As Connection) As Boolean
   On Error GoTo Open_EH
   
   oConn4.CursorLocation = adUseClient
   
   ' Set the connection string by calling
   ' a function.
   oConn4.ConnectionString = ConnectString4()
      
   ' Set the mode of the connection
   oConn4.Mode = adModeReadWrite
      
   ' Open the Connection
   oConn4.Open
   
   DataOpen4 = True
   
   Exit Function
   
Open_EH:
   Call ErrorHandler(goConn4)
   DataOpen4 = False
   Exit Function
End Function

Public Function ConnectString() As String
Dim strDB As String
   ' SQL Server using an ODBC Data Source
   'Provider=MSDASQL.1;Password="";Persist Security Info=True;User ID=DWW;Data Source=SOTAMAS90
'   ConnectString = "DSN=VWPMAS90"
   
   '                "UID=DWW;PWD=;" & _
   '                "DATABASE=Employees"
   
'   ConnectString = "DSN=SOTAMAS90;" & _
'                   "UID=DWW;PWD=;" ' & _
                    '"DATABASE="
   
   
   ' SQL Server using OLE DB Provider
   'ConnectString = "Provider        = sqloledb;" & _
   '                "Data Source     = (local);" & _
   '                "Initial Catalog = Employees;" & _
   '                "User Id         = sa;" & _
   '                "Password        = ; "
   
   ' Jet MDB
   strDB = App.Path & "\vwp.mdb"
'   ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0" & _
'                   ";Data Source=" & strDB & _
'                   ";User Id=admin;" & _
'                   "Password="                  ' ";
   ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0" & _
                   ";Data Source=" & strDB
'                   ";Data Source=vwp\vwp.mdb"
'  "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=vwp\vwp.mdb"
'                   ";Data Source=vwp\vwp.mdb"
End Function

Public Function ConnectString4() As String
Dim strDB As String
   ' SQL Server using an ODBC Data Source
   'Provider=MSDASQL.1;Password="";Persist Security Info=True;User ID=DWW;Data Source=SOTAMAS90
'   ConnectString = "DSN=VWPMAS90"
   
   '                "UID=DWW;PWD=;" & _
   '                "DATABASE=Employees"
   
'   ConnectString = "DSN=SOTAMAS90;" & _
'                   "UID=DWW;PWD=;" ' & _
                    '"DATABASE="
   
   
   ' SQL Server using OLE DB Provider
   'ConnectString = "Provider        = sqloledb;" & _
   '                "Data Source     = (local);" & _
   '                "Initial Catalog = Employees;" & _
   '                "User Id         = sa;" & _
   '                "Password        = ; "
   
   ' Jet MDB
   strDB = App.Path & "\vwp4.mdb"
'   ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0" & _
'                   ";Data Source=" & strDB & _
'                   ";User Id=admin;" & _
'                   "Password="                  ' ";
   ConnectString4 = "Provider=Microsoft.Jet.OLEDB.4.0" & _
                   ";Data Source=" & strDB
'                   ";Data Source=vwp\vwp.mdb"
'  "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=vwp\vwp.mdb"
'                   ";Data Source=vwp\vwp.mdb"
End Function

Public Function ConnectString2() As String
Dim strDB As String
   ' SQL Server using an ODBC Data Source

   ConnectString2 = "DSN=VWPMAS90"
   
End Function

Public Function ConnectString3() As String
Dim strDB As String
   ' SQL Server using an ODBC Data Source

   ConnectString3 = "DSN=MSCMAS90"
   
End Function

Public Sub ErrorHandler(oConn As Connection)
   Dim oErr As Error
   Dim strMSG As String
   
   For Each oErr In oConn.Errors
      strMSG = strMSG & _
               "Error #: " & _
               oErr.Number & vbCrLf
      strMSG = strMSG & _
               "Description: " & _
               oErr.Description & vbCrLf
      strMSG = strMSG & _
               "Source: " & _
               oErr.Source & vbCrLf
      strMSG = strMSG & _
               "SQL State: " & _
               oErr.SQLState & vbCrLf
      strMSG = strMSG & _
               "Native Error: " & _
               oErr.NativeError & vbCrLf
      strMSG = strMSG & vbCrLf
   Next
   
   MsgBox strMSG
End Sub

Public Sub ErrorHandler3(oConn2 As Connection)
   Dim oErr As Error
   Dim strMSG As String
   
   For Each oErr In oConn2.Errors
      strMSG = strMSG & _
               "Error #: " & _
               oErr.Number & vbCrLf
      strMSG = strMSG & _
               "Description: " & _
               oErr.Description & vbCrLf
      strMSG = strMSG & _
               "Source: " & _
               oErr.Source & vbCrLf
      strMSG = strMSG & _
               "SQL State: " & _
               oErr.SQLState & vbCrLf
      strMSG = strMSG & _
               "Native Error: " & _
               oErr.NativeError & vbCrLf
      strMSG = strMSG & vbCrLf
   Next
   
   MsgBox strMSG
End Sub

Public Sub ErrorHandler4(oConn4 As Connection)
   Dim oErr As Error
   Dim strMSG As String
   
   For Each oErr In oConn4.Errors
      strMSG = strMSG & _
               "Error #: " & _
               oErr.Number & vbCrLf
      strMSG = strMSG & _
               "Description: " & _
               oErr.Description & vbCrLf
      strMSG = strMSG & _
               "Source: " & _
               oErr.Source & vbCrLf
      strMSG = strMSG & _
               "SQL State: " & _
               oErr.SQLState & vbCrLf
      strMSG = strMSG & _
               "Native Error: " & _
               oErr.NativeError & vbCrLf
      strMSG = strMSG & vbCrLf
   Next
   
   MsgBox strMSG
End Sub

Public Sub AppQuit()
   On Error Resume Next

   If goConn.State = adStateOpen Then
      goConn.Close
      Set goConn = Nothing
   End If
   If goConn2.State = adStateOpen Then
      goConn2.Close
      Set goConn2 = Nothing
   End If
   
   
   End
End Sub

Public Function Str2Field(strValue As String) As Variant
   If IsNull(strValue) Then
      strValue = ""
      If Trim$(strValue) = "" Then
         Str2Field = Null
      Else
         Str2Field = strValue
      End If
   Else
      If Trim$(strValue) = "" Then
         Str2Field = Null
      Else
         Str2Field = strValue
      End If
   End If
End Function
Public Function Integer2Field(strValue As Variant) As Integer
'   If strValue = "" Or strValue = " " Then
'   If Trim$(strValue) = "" Then
'      Integer2Field = 0
'   Else
      If IsNull(strValue) Then
         Integer2Field = 0
      ElseIf Trim$(strValue) = "" Then
         Integer2Field = 0
      Else
         Integer2Field = CInt(strValue)
      End If
'   End If

End Function

Public Function Long2Field(strValue As Variant) As Integer
'   If Trim$(strValue) = "" Then
'      Long2Field = 0
'   Else
      If IsNull(strValue) Then
         Long2Field = 0
      ElseIf Trim$(strValue) = "" Then
         Long2Field = 0
      Else
         Long2Field = CLng(strValue)
      End If
'   End If

End Function

Public Function Single2Field(strValue As Variant) As Single
'   If Trim$(strValue) = "" Then
'      Single2Field = 0
'   Else
      If IsNull(strValue) Then
         Single2Field = 0
      ElseIf Trim$(strValue) = "" Then
         Single2Field = 0
      Else
         Single2Field = CSng(strValue)
      End If
'   End If

End Function

Public Function Date2Field(strValue As String) As Variant
   If strValue = "" Then
      Date2Field = Null
   ElseIf strValue = "" Then
      Date2Field = Null
   Else
      If IsDate(strValue) Then
         Date2Field = CDate(strValue)
      Else
         Date2Field = Null
      End If
   End If
End Function

Public Function Double2Field(strValue As String) As Variant
   If IsNull(strValue) Then
      Double2Field = 0
   ElseIf Trim$(strValue) = "" Then
      Double2Field = 0
   Else
      Double2Field = CDbl(strValue)
   End If
'   If strValue = "" Then
'      Double2Field = Null
'   Else
'      If IsNumeric(strValue) Then
'         Double2Field = CDbl(strValue)
'      Else
'         Double2Field = Null
'      End If
'   End If
End Function

Public Function Field2Str(vntField As Variant) As String
   If IsNull(vntField) Then
      Field2Str = ""
   ElseIf vntField = "" Then
      Field2Str = ""
   Else
      Field2Str = Trim$(CStr(vntField))
   End If
End Function
Public Function Field2Str2(vntField As Variant) As String
'   If vntField = "" Then
'      Field2Str2 = 0
'   Else
      If IsNull(vntField) Then
         Field2Str2 = 0
      ElseIf Trim$(vntField) = "" Then
         Field2Str2 = 0
      Else
         Field2Str2 = Trim$(CStr(vntField))
      End If
'   End If
End Function

Public Function Field2Long(vntField As Variant) As Long
   If IsNull(vntField) Then
      Field2Long = -1
   ElseIf vntField = "" Then
      Field2Long = 0
   Else
      Field2Long = CLng(vntField)
   End If
End Function

Public Function Field2Double(vntField As Variant) As Long
'   If Trim$(vntField) = "" Then
'      Field2Double = 0
'   Else
      If IsNull(vntField) Then
         Field2Double = 0
      ElseIf Trim$(vntField) = "" Then
         Field2Double = 0
      Else
         Field2Double = CDbl(vntField)
      End If
'   End If
End Function

Public Function Field2Single(vntField As Variant) As Long
'   If Trim$(vntField) = "" Then
'      Field2Double = 0
'   Else
      If IsNull(vntField) Then
         Field2Single = 0
      ElseIf Trim$(vntField) = "" Then
         Field2Single = 0
      Else
         Field2Single = CSng(vntField)
      End If
'   End If
End Function

Public Function Field2Decimal(vntField As Variant) As Long
'   If Trim$(vntField) = "" Then
'      Field2Decimal = 0
'   Else
      If IsNull(vntField) Then
         Field2Decimal = 0
      ElseIf Trim$(vntField) = "" Then
         Field2Decimal = 0
      Else
         Field2Decimal = CDec(vntField)
      End If
'   End If
End Function

Public Function Field2Integer(vntField As Variant) As Long
'   If Trim$(vntField) = "" Then
      
'   Else
      If IsNull(vntField) Then
         Field2Integer = 0
      ElseIf Trim$(vntField) = "" Then
         Field2Integer = 0
      Else
         Field2Integer = CInt(vntField)
      End If
'   End If
End Function

Public Function Field2CheckBox(vntField As Variant) As Integer
   If IsNull(vntField) Then
      Field2CheckBox = vbUnchecked
   Else
      Field2CheckBox = IIf(vntField, vbChecked, vbUnchecked)
   End If
End Function

Public Function Field2TrueFalse(vntField As Variant) As Integer
   If IsNull(vntField) Then
      Field2TrueFalse = False
   Else
      Field2TrueFalse = IIf(vntField, vbTrue, vbFalse)
'      Field2TrueFalse = IIf(vntField, True, False)
   End If
End Function

Public Sub ListFindItem(ctlAny As Control, lngValue As Long)
   Dim intLoop As Integer
   Dim boolFound As Boolean
   
   For intLoop = 0 To ctlAny.ListCount - 1
      If ctlAny.ItemData(intLoop) = lngValue Then
         ctlAny.ListIndex = intLoop
         boolFound = True
         intLoop = ctlAny.ListCount
      End If
   Next
   
   If Not boolFound Then
      ctlAny.ListIndex = -1
   End If
End Sub

Public Sub ListFindItem3(ctlAny As Control, lngValue As Long)
   Dim intLoop As Integer
   Dim boolFound As Boolean
   
   For intLoop = 0 To ctlAny.ListCount - 1
      If Field2Long(Left(ctlAny.ItemData(intLoop), 3)) = lngValue Then
         ctlAny.ListIndex = intLoop
         boolFound = True
         intLoop = ctlAny.ListCount
      End If
   Next
   
   If Not boolFound Then
      ctlAny.ListIndex = -1
   End If
End Sub

Public Sub ListFindItem2(ctlAny As Control, lngValue As String)
'   Dim intLoop As String
   Dim intLoop As Integer
   Dim boolFound As Boolean
   
   For intLoop = 0 To ctlAny.ListCount - 1
      If ctlAny.ItemData(intLoop) > lngValue Then
         ctlAny.ListIndex = intLoop - 1
         boolFound = True
         intLoop = ctlAny.ListCount
      End If
   Next
   
   If Not boolFound Then
      ctlAny.ListIndex = -1
   End If
End Sub

Public Function ListReposition(lstCtrl As Control, _
                               intINDEX As Integer) As Integer
   If lstCtrl.ListCount = 0 Then
      ListReposition = -1
   Else
      intINDEX = intINDEX + 1
      
      If intINDEX >= lstCtrl.ListCount - 1 Then
         ListReposition = lstCtrl.ListCount - 1
      Else
         intINDEX = intINDEX - 1
         If intINDEX <= 0 Then
            ListReposition = 0
         Else
            ListReposition = intINDEX
         End If
      End If
   End If
End Function
Public Sub CBFindString(ctrControlName As Control, strFindStr As String)

Dim intLoop As Integer, strSTR As String

For intLoop = 0 To ctrControlName.ListCount - 1
'   strStr = ctrControlName.ItemData(intLoop)
   strSTR = ctrControlName.List(intLoop)
   If Trim$(UCase$(strSTR)) = Trim(UCase$(strFindStr)) Then
      ctrControlName.ListIndex = intLoop
      intLoop = ctrControlName.ListCount
'      ctrControlName.SetFocus
   Else
      ctrControlName.ListIndex = -1
   End If
Next intLoop

End Sub

Public Sub CBFindString3(ctrControlName As Control, strFindStr As String)

Dim intLoop As Integer, strSTR As String

For intLoop = 0 To ctrControlName.ListCount - 1
'   strStr = ctrControlName.ItemData(intLoop)
   strSTR = ctrControlName.List(intLoop)
   If Left$(UCase$(strSTR), 2) = Trim(UCase$(strFindStr)) Then
      ctrControlName.ListIndex = intLoop
      intLoop = ctrControlName.ListCount
'      ctrControlName.SetFocus
   Else
      ctrControlName.ListIndex = -1
   End If
Next intLoop

End Sub

Public Sub CBFindString1(ctrControlName As Control, strFindStr As String)

Dim intLoop As Integer, strSTR As String

For intLoop = 0 To ctrControlName.ListCount - 1
'   strStr = ctrControlName.ItemData(intLoop)
   strSTR = ctrControlName.List(intLoop)
   If Left$(UCase$(strSTR), 1) = Trim(UCase$(strFindStr)) Then
      ctrControlName.ListIndex = intLoop
      intLoop = ctrControlName.ListCount
'      ctrControlName.SetFocus
   Else
      ctrControlName.ListIndex = -1
   End If
Next intLoop

End Sub

Public Sub CBFindString4(ctrControlName As Control, strFindStr As String)
'This Routine will find something in the Item Data are of a control.
'This works best when looking for an amount that not just the list index number.

Dim intLoop As Integer, strSTR As String

For intLoop = 0 To ctrControlName.ListCount - 1
   strSTR = ctrControlName.ItemData(intLoop)
   If Left$(UCase$(strSTR), 4) = Trim(UCase$(strFindStr)) Then
      ctrControlName.ListIndex = intLoop
      intLoop = ctrControlName.ListCount
      ctrControlName.SetFocus
   Else
      ctrControlName.ListIndex = -1
   End If
Next intLoop

End Sub

Public Sub CBFindString5(ctrControlName As Control, strFindStr As String)
'This Routine will find something in the Item Data are of a control.
'This works best when looking for an amount that not just the list index number.

Dim intLoop As Integer, strSTR As String

For intLoop = 0 To ctrControlName.ListCount - 1
   strSTR = ctrControlName.ItemData(intLoop)
   If Left$(UCase$(strSTR), 4) = Trim(UCase$(strFindStr)) Then
      ctrControlName.ListIndex = intLoop
      intLoop = ctrControlName.ListCount
      ctrControlName.SetFocus
   Else
      ctrControlName.ListIndex = -1
   End If
Next intLoop

End Sub

Public Sub CBFindString2(ctrControlName As Control, strFindStr As String)

Dim intLoop As Integer, strSTR As String, strID As String

For intLoop = 0 To ctrControlName.ListCount - 1
'   strStr = ctrControlName.ItemData(intLoop)
   strSTR = ctrControlName.List(intLoop)
   strID = Left(Trim$(UCase$(strSTR)), 3)
   If Field2Str2(strID) = Trim(UCase$(strFindStr)) Then
'   If Left(Trim$(UCase$(strStr)), 3) = Trim(UCase$(strFindStr)) Then
      ctrControlName.ListIndex = intLoop
      intLoop = ctrControlName.ListCount
      ctrControlName.SetFocus
      Exit Sub
   Else
      ctrControlName.ListIndex = -1
   End If
Next intLoop

End Sub

'Public Function FindTexture(strTable As String, strField As String, strTYPE As String)
'Dim oRF As Recordset
'Dim strSQL As String
      
'   strSQL = "SELECT * FROM '" & strtable & "' WHERE '" & strField & "' = '" & strName & "'"
'   Set oRF = New Recordset
'   oRF.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
      
'   If Not oRF.EOF Then
'      strTYPE = Field2Str(oRF!id)
'   Else
'      strTYPE = ""
'   End If

'End Function

Public Function FieldSelect(lstCtrl As Control)
   lstCtrl.SelStart = 0
   If lstCtrl.MaxLength > 0 Then
      lstCtrl.SelLength = lstCtrl.MaxLength
   Else
      lstCtrl.SelLength = 1000
   End If
End Function

Public Sub ErrorHandler2()
   Set frmError.ErrorObj = Err
   frmError.Show vbModal
End Sub

Public Sub LotChange(strProjLot As String, strAction As String)

   Load frmChange
   frmChange.lblProjLot = strProjLot
   frmChange.lblAction = strAction
   
   
   frmChange.Show 1

End Sub

Public Sub LotChange2(strProjLot As String, strAction As String, strItem As String, strQTY1 As String, strQTY2 As String)

   Load frmChange
   frmChange.lblProjLot = strProjLot
   frmChange.lblAction = strAction
   frmChange.txtNotes2 = " - " & Trim(strItem) & " - " & strQTY1 & " To " & strQTY2
   
   frmChange.Show 1

End Sub

Public Function FindMax(ByVal strFile As String, ByVal strField As String)
Dim strSQL As String, oRSMAX As Recordset
'Dim strField As String, strFile As String

   strSQL = "SELECT Max(" & strField & ") as MAXField from " & strFile 'tblOption"
   Set oRSMAX = New Recordset
   oRSMAX.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly

   FindMax = oRSMAX!maxfield
   oRSMAX.Close

End Function

Public Function FindMax2(ByVal strFile As String, ByVal strField As String, ByVal strLookFLD As String, ByVal lngID As Long)
Dim strSQL As String, oRSMAX As Recordset
'Dim strField As String, strFile As String

   strSQL = "SELECT Max(" & strField & ") as MAXField FROM " & strFile & " WHERE " & strLookFLD & " = " & lngID 'tblOption"
   Set oRSMAX = New Recordset
   oRSMAX.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly

   FindMax2 = Field2Str2(oRSMAX!maxfield)
   oRSMAX.Close

End Function

Public Function FindMax4(ByVal strFile As String, ByVal strField As String, ByVal strLookFLD1 As String, ByVal lngID1 As Long, ByVal strLookFLD2 As String, ByVal strID2 As String)
Dim strSQL As String, oRSMAX As Recordset
'Dim strField As String, strFile As String

   strSQL = "SELECT SUM(" & strField & ") as MAXField FROM " & strFile & " WHERE " & strLookFLD1 & " = " & lngID1 'tblOption"
   strSQL = strSQL & " and " & strLookFLD2 & " = '" & strID2 & "'"
   Set oRSMAX = New Recordset
   oRSMAX.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly

'   FindMax4 = oRSMAX!maxfield
   FindMax4 = Field2Str2(oRSMAX!maxfield)
   oRSMAX.Close

End Function

Public Function FindMax6(ByVal strFile As String, ByVal strField As String, ByVal strLookFLD1 As String, ByVal lngID1 As Long, ByVal strLookFLD2 As String, ByVal strID2 As String)
Dim strSQL As String, oRSMAX As Recordset
'Dim strField As String, strFile As String

   strSQL = "SELECT MAX(" & strField & ") as MAXField FROM " & strFile & " WHERE " & strLookFLD1 & " = " & lngID1 'tblOption"
   strSQL = strSQL & " and " & strLookFLD2 & " = '" & strID2 & "'"
   Set oRSMAX = New Recordset
   oRSMAX.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly

'   FindMax4 = oRSMAX!maxfield
   FindMax6 = Field2Str2(oRSMAX!maxfield)
   oRSMAX.Close

End Function

Public Function FindSum(ByVal strFile As String, ByVal strField As String, ByVal strLookFLD1 As String, ByVal lngID1 As Long, ByVal strLookFLD2 As String, ByVal strID2 As String)
Dim strSQL As String, oRSSUM As Recordset
'Dim strField As String, strFile As String

'   strSQL = "SELECT SUM(" & strField & ") as MAXField FROM " & strFile & " WHERE " & strLookFLD & " = " & lngID 'tblOption"
   strSQL = "SELECT SUM(" & strField & ") as MAXField FROM " & strFile & " WHERE " & strLookFLD1 & " = " & lngID1 'tblOption"
   strSQL = strSQL & " and " & strLookFLD2 & " = '" & strID2 & "'"
   Set oRSSUM = New Recordset
   oRSSUM.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
   If Not oRSSUM.EOF Then
      FindSum = Field2Str2(oRSSUM!maxfield)
   Else
      FindSum = 0
   End If
   oRSSUM.Close

End Function

Public Function ComboLoad(ctlAny As Control)
   ctlAny.AddItem ("Lath")
   ctlAny.AddItem ("Brown")
   ctlAny.AddItem ("Scratch")
   ctlAny.AddItem ("Texture")
   ctlAny.AddItem ("CMU")
   ctlAny.AddItem ("PreOrder")
   ctlAny.AddItem ("Veneer-Stone")
   ctlAny.AddItem ("Wrap Typar")
   ctlAny.AddItem ("Z-PreCast")
   ctlAny.AddItem ("E-Synthetic")
   ctlAny.AddItem ("J-PaintPrep")
   ctlAny.AddItem ("K-P-Interior")
   ctlAny.AddItem ("N-P-Exterior")
   ctlAny.AddItem ("M-PaintFinal")
   ctlAny.AddItem ("D-Coated PO")
End Function

Public Function MTypeLoad2(ctlAny As Control)

   ctlAny.AddItem 1 & vbTab & "Lath"
   ctlAny.AddItem 2 & vbTab & "Brown"
   ctlAny.AddItem 3 & vbTab & "Scratch"
'   ctlAny.AddItem ("Texture")
'   ctlAny.AddItem ("CMU")
'   ctlAny.AddItem ("PreOrder")
'   ctlAny.AddItem ("Veneer-Stone")
'   ctlAny.AddItem ("Wrap Typar")
'   ctlAny.AddItem ("Z-PreCast")
'   ctlAny.AddItem ("E-Synthetic")
   
End Function

Public Function MTypeLoad(ctlAny As Control)
   ctlAny.AddItem ("Lath")
   ctlAny.AddItem ("Brown")
   ctlAny.AddItem ("Scratch")
   ctlAny.AddItem ("Texture")
   ctlAny.AddItem ("CMU")
   ctlAny.AddItem ("PreOrder")
   ctlAny.AddItem ("Veneer-Stone")
   ctlAny.AddItem ("Wrap Typar")
   ctlAny.AddItem ("Z-PreCast")
   ctlAny.AddItem ("E-Synthetic")
   ctlAny.AddItem ("J-PaintPrep")
   ctlAny.AddItem ("K-P-Interior")
   ctlAny.AddItem ("N-P-Exterior")
   ctlAny.AddItem ("M-PaintFinal")
   ctlAny.AddItem ("D-Coated PO")
End Function

Public Function FindType3(strINDEX As Long, strTYPE As String)

      If strTYPE = "L" Then
         strINDEX = 1
'         ctlAny.Text = "Lath"
'         ctlAny.List = "Lath"
'         ctlAny.ListIndex = 0
      ElseIf strTYPE = "B" Then
'         ctlAny.ListIndex = 1
'         ctlAny.Text = "Brown"
      ElseIf strTYPE = "S" Then
'         ctlAny.ListIndex = 1
'         ctlAny.Text = "Scratch"
      ElseIf strTYPE = "T" Then
'         ctlAny.ListIndex = 1
'         ctlAny.Text = "Texture"
      ElseIf strTYPE = "C" Then
'         ctlAny.ListIndex = 1
'         ctlAny.Text = "CMU"
      ElseIf strTYPE = "P" Then
'         ctlAny.ListIndex = 1
'         ctlAny.Text = "PreOrder"
      ElseIf strTYPE = "V" Then
'         ctlAny.ListIndex = 1
'         ctlAny.Text = "Veneer-Stone"
      ElseIf strTYPE = "W" Then
'         ctlAny.ListIndex = 1
'         ctlAny.Text = "Wrap Typar"
      ElseIf strTYPE = "Z" Then
'         ctlAny.ListIndex = 1
'         ctlAny.Text = "Z-PreCast"
      ElseIf strTYPE = "E" Then
      ElseIf strTYPE = "D" Then
'         ctlAny.ListIndex = 1
'         ctlAny.Text = "E-Synthetic"
      Else
'         ctlAny.ListIndex = -1
      End If

End Function

Public Function FindType(ctlAny As Control, strTYPE As String)

      If strTYPE = "L" Then
         ctlAny.Text = "Lath"
'         ctlAny.List = "Lath"
'         ctlAny.ListIndex = 0
      ElseIf strTYPE = "B" Then
         ctlAny.Text = "Brown"
      ElseIf strTYPE = "S" Then
         ctlAny.Text = "Scratch"
      ElseIf strTYPE = "T" Then
         ctlAny.Text = "Texture"
      ElseIf strTYPE = "C" Then
         ctlAny.Text = "CMU"
      ElseIf strTYPE = "P" Then
         ctlAny.Text = "PreOrder"
      ElseIf strTYPE = "V" Then
         ctlAny.Text = "Veneer-Stone"
      ElseIf strTYPE = "W" Then
         ctlAny.Text = "Wrap Typar"
      ElseIf strTYPE = "Z" Then
         ctlAny.Text = "Z-PreCast"
      ElseIf strTYPE = "E" Then
         ctlAny.Text = "E-Synthetic"
      ElseIf strTYPE = "J" Then
         ctlAny.Text = "J-PaintPrep"
      ElseIf strTYPE = "K" Then
         ctlAny.Text = "K-P-Interior"
      ElseIf strTYPE = "N" Then
         ctlAny.Text = "N-P-Exterior"
      ElseIf strTYPE = "M" Then
         ctlAny.Text = "M-PaintFinal"
      ElseIf strTYPE = "D" Then
         ctlAny.Text = "D-Coated PO"
      Else
         ctlAny.ListIndex = -1
      End If

End Function

Public Function SetType(strTYPE As String, strDESC As String)

      If strTYPE = "L" Then
         strDESC = "Lath"
      ElseIf strTYPE = "B" Then
         strDESC = "Brown"
      ElseIf strTYPE = "S" Then
         strDESC = "Scratch"
      ElseIf strTYPE = "T" Then
         strDESC = "Texture"
      ElseIf strTYPE = "C" Then
         strDESC = "CMU"
      ElseIf strTYPE = "P" Then
         strDESC = "PreOrder"
      ElseIf strTYPE = "V" Then
         strDESC = "Veneer-Stone"
      ElseIf strTYPE = "W" Then
         strDESC = "Wrap Typar"
      ElseIf strTYPE = "Z" Then
         strDESC = "Z-PreCast"
      ElseIf strTYPE = "A" Then
         strDESC = "A-Sand"
      ElseIf strTYPE = "R" Then
         strDESC = "R-Special PO"
      ElseIf strTYPE = "E" Then
         strDESC = "E-Synthetic"
      ElseIf strTYPE = "D" Then
         strDESC = "D-Coated PO"
      ElseIf strTYPE = "Q" Then
         strDESC = "Q-Misc_Crew"
      Else
         strDESC = "UNKNOWN"
      End If

End Function

Public Function FindTexture(strName As String, strTYPE As String)
Dim oRF As Recordset
Dim strSQL As String
      
   strSQL = "SELECT * FROM tblFINISH WHERE Desc = '" & strName & "'"
   Set oRF = New Recordset
   oRF.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
      
   If Not oRF.EOF Then
      strTYPE = Field2Str(oRF!id)
   Else
      strTYPE = ""
   End If

End Function

Public Function FindTexture2(strName As String, strTYPE As String)
Dim oRF As Recordset
Dim strSQL As String
      
   strSQL = "SELECT * FROM tblFINISH WHERE ID = '" & strName & "'"
   Set oRF = New Recordset
   oRF.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
      
   If Not oRF.EOF Then
      strTYPE = Field2Str(oRF!Desc)
   Else
      strTYPE = ""
   End If

End Function

Public Function CheckTime(txtTime As String)
Dim intHR As Integer, intMN As Integer
   If Len(txtTime) = 2 Then
      intHR = Val(txtTime)
      intMN = 0
   End If
   
   If Len(txtTime) = 3 Then
      intHR = 0
      intMN = Val(Mid(txtTime, 2, 2))
   End If
   
   If Len(txtTime) = 4 Then
      intHR = Val(Mid(txtTime, 1, 2))
      intMN = Val(Mid(txtTime, 3, 2))
   End If
   
   If intHR > 24 Then
      CheckTime = False
   ElseIf intMN > 59 Then
      CheckTime = False
   Else
      CheckTime = True
   End If
End Function

Public Function ShowTime(strSTime)
Dim intHR As Integer, intMN As Integer

   intHR = Val(Mid(strSTime, 1, 2))
   If intHR > 12 Then
      intHR = intHR - 12
   End If
   intMN = Val(Mid(strSTime, 3, 2))
   ShowTime = Format(intHR, "##") & ":" & Format(intMN, "00")
   If ShowTime = ":00" Then
      ShowTime = ""
   End If
End Function

Public Function TimeCalc(strCTime)
Dim intHR As Integer, intMN As Integer, intTIME As Integer

   intHR = Val(Mid(strCTime, 1, 2))
   intMN = Val(Mid(strCTime, 4, 2))
   intTIME = intMN + (intHR * 60)
   TimeCalc = intTIME / 60

End Function

Public Function MinuteCalc(strCTime)
Dim intHR As Integer, intMN As Integer, intTIME As Integer

   intHR = Val(Mid(strCTime, 1, 2))
   intMN = Val(Mid(strCTime, 4, 2))
   intTIME = intMN + (intHR * 60)
   MinuteCalc = intTIME ' / 60

End Function

Public Function TimeFormat(tField As String, tName As String)
Dim intHour As Integer, intMIN As Integer
'   If Mid(tName, 3, 1) = ":" Then
   If Mid(tField, 3, 1) = ":" Then
      tField = tField
   Else
'      If Val(tField) < 7 Then
'         tField = Val(tField) + 12
'      End If
      If Len(tField) = 1 Then
''         If Val(tField) < 7 Or Val(tField) < 0 Then
'            tField = Val(tField) + 12
            tField = tField & "00"
''         Else
''            tField = "0" & tField & "00"
''         End If
      End If
      If Len(tField) = 2 Then
''         If Val(tField) < 7 Or Val(tField) < 0 Then
'            tField = Val(tField) + 12
            tField = tField & "00"
''         Else
'            tField = "0" & tField & "00"
''            tField = tField & "00"
''         End If
      End If
      If Len(tField) = 3 Then
''      If Val(Mid(tField, 1, 1)) < 7 Or Val(tField) < 0 Then
         intHour = Val(Mid(tField, 1, 1))
         intMIN = Val(Mid(tField, 2, 2))
'         intHour = intHour + 12
         tField = Format(intHour, "00") & Format(intMIN, "00")
''      Else
''         tField = "0" & tField ' & "0"
''      End If
'         tField = "0" & tField ' & "0"
      End If
      tField = Format(tField, "00:00")
'      If Mid(tField, 1, 2) < "07" Then
'         intHour = Val(Mid(tField, 1, 2))
         
'      End If
   End If
   TimeFormat = tField
End Function

Public Function TimeFormat2(tField As String, tName As String)
Dim intHour As Integer, intMIN As Integer
'   If Mid(tName, 3, 1) = ":" Then
   If Mid(tField, 3, 1) = ":" Then
      tField = tField
   Else
'      If Val(tField) < 7 Then
'         tField = Val(tField) + 12
'      End If
      If Len(tField) = 1 Then
         If Val(tField) < 7 Or Val(tField) < 0 Then
            tField = Val(tField) + 12
            tField = tField & "00"
         Else
            tField = "0" & tField & "00"
         End If
      End If
      If Len(tField) = 2 Then
         If Val(tField) < 7 Or Val(tField) < 0 Then
            tField = Val(tField) + 12
            tField = tField & "00"
         Else
'            tField = "0" & tField & "00"
            tField = tField & "00"
         End If
      End If
      If Len(tField) = 3 Then
      If Val(Mid(tField, 1, 1)) < 7 Or Val(tField) < 0 Then
         intHour = Val(Mid(tField, 1, 1))
         intMIN = Val(Mid(tField, 2, 2))
         intHour = intHour + 12
         tField = Format(intHour, "00") & Format(intMIN, "00")
      Else
         tField = "0" & tField ' & "0"
      End If
'         tField = "0" & tField ' & "0"
      End If
      tField = Format(tField, "00:00")
'      If Mid(tField, 1, 2) < "07" Then
'         intHour = Val(Mid(tField, 1, 2))
         
'      End If
   End If
   TimeFormat2 = tField
End Function

Public Sub ListFindItemS1(ctlAny As Control, lngValue As String) ', intcol As Integer) '**********
   Dim intLoop As Integer, strValue As String
   Dim boolFound As Boolean, intcol As Integer
   
   intcol = 0
'   ctlAny.col = intCOL
'   strVALUE = ctlAny.ColText
   For intLoop = 0 To ctlAny.ListCount - 1
      ctlAny.ListIndex = intLoop
      ctlAny.col = intcol
      strValue = ctlAny.ColText
'      If ctlAny.ItemData(intLoop) = lngValue Then
      If strValue = lngValue Then
         ctlAny.ListIndex = intLoop
         boolFound = True
         intLoop = ctlAny.ListCount
      End If
 '     intLoop = intLoop + 1
   Next
   
   If Not boolFound Then
      ctlAny.ListIndex = -1
   End If
End Sub

Public Sub ListFindItemS2(ctlAny As Control, lngValue As String) ', intcol As Integer) '**********
   Dim intLoop As Integer, strValue As String
   Dim boolFound As Boolean, intcol As Integer
   
   intcol = 1
'   ctlAny.col = intCOL
'   strVALUE = ctlAny.ColText
   For intLoop = 0 To ctlAny.ListCount - 1
      ctlAny.ListIndex = intLoop
      ctlAny.col = intcol
      strValue = ctlAny.ColText
'      If ctlAny.ItemData(intLoop) = lngValue Then
      If strValue = lngValue Then
         ctlAny.ListIndex = intLoop
         boolFound = True
         intLoop = ctlAny.ListCount
      End If
 '     intLoop = intLoop + 1
   Next
   
   If Not boolFound Then
      ctlAny.ListIndex = -1
   End If
End Sub

Public Sub ListFindItemS3(ctlAny As Control, lngValue As String) ', intcol As Integer) '**********
   Dim intLoop As Integer, strValue As String
   Dim boolFound As Boolean, intcol As Integer
   
   intcol = 2
'   ctlAny.col = intCOL
'   strVALUE = ctlAny.ColText
   For intLoop = 0 To ctlAny.ListCount - 1
      ctlAny.ListIndex = intLoop
      ctlAny.col = intcol
      strValue = ctlAny.ColText
'      If ctlAny.ItemData(intLoop) = lngValue Then
      If strValue = lngValue Then
         ctlAny.ListIndex = intLoop
         boolFound = True
         intLoop = ctlAny.ListCount
      End If
 '     intLoop = intLoop + 1
   Next
   
   If Not boolFound Then
      ctlAny.ListIndex = -1
   End If
End Sub

Public Sub ListFindItemS4(ctlAny As Control, lngValue As String) ', intcol As Integer) '**********
   Dim intLoop As Integer, strValue As String
   Dim boolFound As Boolean, intcol As Integer
   
   intcol = 3
'   ctlAny.col = intCOL
'   strVALUE = ctlAny.ColText
   For intLoop = 0 To ctlAny.ListCount - 1
      ctlAny.ListIndex = intLoop
      ctlAny.col = intcol
      strValue = ctlAny.ColText
'      If ctlAny.ItemData(intLoop) = lngValue Then
      If strValue = lngValue Then
         ctlAny.ListIndex = intLoop
         boolFound = True
         intLoop = ctlAny.ListCount
      End If
 '     intLoop = intLoop + 1
   Next
   
   If Not boolFound Then
      ctlAny.ListIndex = -1
   End If
End Sub

Public Sub ListFindItemS5(ctlAny As Control, lngValue As String) ', intCOL As Integer) '**********
   Dim intLoop As Integer, strValue As String
   Dim boolFound As Boolean, intcol As Integer
   
   intcol = 4
'   ctlAny.col = intCOL
'   strVALUE = ctlAny.ColText
   For intLoop = 0 To ctlAny.ListCount - 1
      ctlAny.ListIndex = intLoop
      ctlAny.col = intcol
      strValue = ctlAny.ColText
'      If ctlAny.ItemData(intLoop) = lngValue Then
      If strValue = lngValue Then
         ctlAny.ListIndex = intLoop
         boolFound = True
         intLoop = ctlAny.ListCount
      End If
 '     intLoop = intLoop + 1
   Next
   
   If Not boolFound Then
      ctlAny.ListIndex = -1
   End If
End Sub

Public Sub ListFindItemS6(ctlAny As Control, lngValue As String) ', intCOL As Integer) '**********
   Dim intLoop As Integer, strValue As String
   Dim boolFound As Boolean, intcol As Integer
   
   intcol = 5
'   ctlAny.col = intCOL
'   strVALUE = ctlAny.ColText
   For intLoop = 0 To ctlAny.ListCount - 1
      ctlAny.ListIndex = intLoop
      ctlAny.col = intcol
      strValue = ctlAny.ColText
'      If ctlAny.ItemData(intLoop) = lngValue Then
      If strValue = lngValue Then
         ctlAny.ListIndex = intLoop
         boolFound = True
         intLoop = ctlAny.ListCount
      End If
 '     intLoop = intLoop + 1
   Next
   
   If Not boolFound Then
      ctlAny.ListIndex = -1
   End If
End Sub