Mike Swanson
5359e7c49e
Recovered Darv's VB6 source for the Valley Wide Plastering Orders application from the D: backup drive (label "Backup", 8 TB, 5.3 TB used). This is the first time we've had the actual source — prior session only had a single frmPayroll.frm from the AD server. Three project variants identified across two snapshots: - Full-Project/ (2,129 files, 124 MB) — D:\Office-Estimates\Darv\Full\Project\ - Kingston-Project/ (2,189 files, 130 MB) — D:\Office-Estimates\Darv\Kingston\Project\ - Source/ (170 files, 559 MB) — D:\Office-Estimates\Darv\Source\ wholesale - SOURCE-HOLD/ (3 files, 1 MB) — D:\Office-Estimates\Darv\SOURCE HOLD\ Latest ORDERS_C.vbp date is 2020-06-09 (Kingston snapshot). Production Orders_10A.exe was live as of April 2024 — open question whether newer source exists on other backup drives Mike will scan next. Also includes per-category and per-keyword analysis CSVs from a WizTree file-list export, plus the analyzer script that produced them (re-runnable for the next drive's CSV). VMs (VWIN7-DW.vdi 8.3 GB + XP-for-ORDERS_copy.vdi 2.8 GB), the live VWP.mdb, and the 393 MB raw WizTree CSV stay on disk only — gitignored. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
1436 lines
41 KiB
QBasic
1436 lines
41 KiB
QBasic
Attribute VB_Name = "modADO"
|
|
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, glngPS_ID As Long, glngTIMEID As Long
|
|
Public gintESTID As Long, gstrPO As String, gintCOCODE As Integer
|
|
Public gstrLOGIN As String, gbytSECURITY As Byte, glngPO_NUM As Long
|
|
Public gintCREWID As Integer, gstrCREW As String, glngPSID As Long
|
|
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 gboolAP 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 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 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 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
|
|
If goConn3.State = adStateOpen Then
|
|
goConn3.Close
|
|
Set goConn3 = Nothing
|
|
End If
|
|
If goConn4.State = adStateOpen Then
|
|
goConn4.Close
|
|
Set goConn4 = 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)
|
|
' Field2Single = CDbl(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 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 Sub ListFindItem2(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 - 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
|
|
|
|
|