azcomputerguru/claudetools
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
0a264ee3fabfdfded7e2bb64dc86ece16c31d99e
claudetools/clients/valleywide/app-modernization/source-code/Full-Project/VWP_Inv/frmPayrollxx.frm
Mike Swanson 5359e7c49e feat(valleywide): recover VWP Orders VB6 source from D: backup drive 
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>
2026-05-16 17:36:27 -07:00

1335 lines
38 KiB
Plaintext
Raw Blame History

VERSION 5.00
Object = "{8DDE6232-1BB0-11D0-81C3-0080C7A2EF7D}#3.0#0"; "Flp32a30.ocx"
Begin VB.Form frmPayroll
Caption = "Payroll Information"
ClientHeight = 4920
ClientLeft = 60
ClientTop = 345
ClientWidth = 11880
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 4920
ScaleWidth = 11880
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtStone
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 315
Left = 11010
TabIndex = 42
Top = 60
Width = 855
End
Begin VB.TextBox txtLotNotes
Height = 795
Left = 6960
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 39
Top = 4020
Width = 4815
End
Begin VB.CheckBox chkLook
Caption = "Look"
Height = 315
Left = 240
TabIndex = 38
Top = 3900
Visible = 0 'False
Width = 315
End
Begin VB.TextBox txtOffice
Height = 795
Left = 6960
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 30
Top = 3180
Width = 4815
End
Begin VB.ListBox lstCrew
Height = 1425
Left = 6960
Sorted = -1 'True
TabIndex = 36
Top = 900
Visible = 0 'False
Width = 4815
End
Begin VB.CommandButton cmdExit
Caption = "&Exit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 0
TabIndex = 35
Top = 4380
Width = 1155
End
Begin VB.TextBox txtVerify
Enabled = 0 'False
Height = 315
Left = 2340
TabIndex = 34
Top = 3240
Width = 1095
End
Begin VB.CommandButton cmdAddPay
Caption = "&Add Payroll"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1780
TabIndex = 33
Top = 4380
Width = 1275
End
Begin VB.CommandButton cmdSavePay
Caption = "&Save Payroll"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3680
TabIndex = 31
Top = 4380
Width = 1275
End
Begin VB.CommandButton cmdDelPay
Caption = "&Delete Payroll"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 5580
TabIndex = 32
Top = 4380
Width = 1275
End
Begin VB.CommandButton cmdFindCrew
Height = 435
Left = 1080
Picture = "frmPayroll.frx":0000
Style = 1 'Graphical
TabIndex = 25
Top = 3900
Visible = 0 'False
Width = 435
End
Begin VB.TextBox txtNotes
Height = 735
Left = 6960
MaxLength = 255
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 29
Top = 2400
Width = 4815
End
Begin VB.ComboBox cboCrewType
Height = 315
ItemData = "frmPayroll.frx":0442
Left = 1620
List = "frmPayroll.frx":0458
Style = 2 'Dropdown List
TabIndex = 21
Top = 2520
Width = 1815
End
Begin VB.TextBox txtPayAmt
Alignment = 1 'Right Justify
Height = 315
Left = 4800
MaxLength = 10
TabIndex = 28
Top = 3240
Width = 1035
End
Begin VB.TextBox txtCheckNo
Height = 315
Left = 4800
MaxLength = 8
TabIndex = 27
Top = 2880
Width = 1035
End
Begin VB.TextBox txtPayDate
Height = 315
Left = 4800
MaxLength = 10
TabIndex = 26
Top = 2520
Width = 1035
End
Begin VB.TextBox txtCrewName
Height = 315
Left = 1620
TabIndex = 20
Top = 3960
Width = 3255
End
Begin VB.TextBox txtCrewNo
Alignment = 1 'Right Justify
Height = 315
Left = 1620
MaxLength = 4
TabIndex = 24
Top = 3600
Width = 675
End
Begin VB.TextBox txtPercentDone
Alignment = 1 'Right Justify
Height = 315
Left = 1620
MaxLength = 3
TabIndex = 23
Top = 3240
Width = 675
End
Begin VB.TextBox txtMatYds
Alignment = 1 'Right Justify
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 315
Left = 9270
TabIndex = 19
Top = 60
Width = 855
End
Begin VB.TextBox txtCMUYds
Alignment = 1 'Right Justify
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 315
Left = 7410
TabIndex = 18
Top = 60
Width = 855
End
Begin VB.TextBox txtMetalFt
Alignment = 1 'Right Justify
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 285
Left = 5715
TabIndex = 17
Top = 60
Width = 855
End
Begin VB.TextBox txtLathYds
Alignment = 1 'Right Justify
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 285
Left = 4095
TabIndex = 16
Top = 60
Width = 855
End
Begin VB.TextBox txtModel
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 285
Left = 2400
TabIndex = 15
Top = 60
Width = 855
End
Begin VB.TextBox txtProjLot
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 285
Left = 600
TabIndex = 14
Top = 60
Width = 1695
End
Begin VB.ListBox lstPayInfo
Height = 1425
Left = 120
Sorted = -1 'True
TabIndex = 0
Top = 900
Width = 6735
End
Begin LpLib.fpCombo cboWorkType
Height = 315
Left = 1620
TabIndex = 22
Top = 2865
Width = 2355
_Version = 196608
_ExtentX = 4154
_ExtentY = 556
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Enabled = -1 'True
MousePointer = 0
Object.TabStop = -1 'True
BackColor = -2147483643
ForeColor = -2147483640
Text = ""
Columns = 3
Sorted = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = 1
ColumnWidthScale= 2
RowHeight = -1
WrapList = 0 'False
WrapWidth = 0
AutoSearch = 2
SearchMethod = 1
VirtualMode = 0 'False
VRowCount = 0
DataSync = 3
ThreeDInsideStyle= 1
ThreeDInsideHighlightColor= -2147483633
ThreeDInsideShadowColor= -2147483627
ThreeDInsideWidth= 1
ThreeDOutsideStyle= 1
ThreeDOutsideHighlightColor= -2147483628
ThreeDOutsideShadowColor= -2147483632
ThreeDOutsideWidth= 1
ThreeDFrameWidth= 0
BorderStyle = 0
BorderColor = -2147483642
BorderWidth = 1
ThreeDOnFocusInvert= 0 'False
ThreeDFrameColor= -2147483633
Appearance = 2
BorderDropShadow= 0
BorderDropShadowColor= -2147483632
BorderDropShadowWidth= 3
ScrollHScale = 2
ScrollHInc = 0
ColsFrozen = 0
ScrollBarV = 1
NoIntegralHeight= 0 'False
HighestPrecedence= 0
AllowColResize = 0
AllowColDragDrop= 0
ReadOnly = 0 'False
VScrollSpecial = 0 'False
VScrollSpecialType= 0
EnableKeyEvents = -1 'True
EnableTopChangeEvent= -1 'True
DataAutoHeadings= -1 'True
DataAutoSizeCols= 2
SearchIgnoreCase= -1 'True
ScrollBarH = 1
DataFieldList = ""
ColumnEdit = -1
ColumnBound = -1
Style = 2
MaxDrop = 8
ListWidth = -1
EditHeight = -1
GrayAreaColor = -2147483633
ListLeftOffset = 0
ComboGap = -2
MaxEditLen = 150
VirtualPageSize = 0
VirtualPagesAhead= 0
ExtendCol = 0
ColumnLevels = 1
ListGrayAreaColor= -2147483637
GroupHeaderHeight= -1
GroupHeaderShow = 0 'False
AllowGrpResize = 0
AllowGrpDragDrop= 0
MergeAdjustView = 0 'False
ColumnHeaderShow= 0 'False
ColumnHeaderHeight= -1
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
EnableClickEvent= -1 'True
ListPosition = 0
ButtonThreeDAppearance= 0
OLEDragMode = 0
OLEDropMode = 0
Redraw = -1 'True
AutoSearchFill = 0 'False
AutoSearchFillDelay= 500
EditMarginLeft = 1
EditMarginTop = 1
EditMarginRight = 0
EditMarginBottom= 3
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
AutoMenu = -1 'True
EditAlignH = 0
EditAlignV = 0
ColDesigner = "frmPayroll.frx":0493
End
Begin VB.Label lblScaf
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Scaffolding Frames:"
Height = 195
Left = 7380
TabIndex = 47
Top = 480
Width = 1395
End
Begin VB.Label lbl68
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "6'8"" :"
Height = 195
Left = 8880
TabIndex = 46
Top = 480
Width = 375
End
Begin VB.Label lblD68
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Height = 315
Left = 9270
TabIndex = 45
Top = 420
Width = 855
End
Begin VB.Label lbl108
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "10'8"" :"
Height = 195
Left = 10500
TabIndex = 44
Top = 480
Width = 465
End
Begin VB.Label lblD108
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Height = 315
Left = 11010
TabIndex = 43
Top = 420
Width = 855
End
Begin VB.Label lblStone
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Stone SqFt:"
Height = 195
Left = 10155
TabIndex = 41
Top = 135
Width = 840
End
Begin VB.Label lblLotNotes
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Lot Notes:"
Height = 195
Left = 6150
TabIndex = 40
Top = 4020
Width = 735
End
Begin VB.Label lblOffice
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Office Notes:"
Height = 195
Left = 5955
TabIndex = 37
Top = 3180
Width = 930
End
Begin VB.Line Line1
BorderWidth = 2
X1 = 60
X2 = 11880
Y1 = 780
Y2 = 780
End
Begin VB.Label lblMaterial
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Material Yds:"
Height = 195
Left = 8310
TabIndex = 13
Top = 120
Width = 915
End
Begin VB.Label lblCMU
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "CMU Yds:"
Height = 195
Left = 6630
TabIndex = 12
Top = 120
Width = 720
End
Begin VB.Label lblMetal
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Ft:"
Height = 195
Left = 4995
TabIndex = 11
Top = 120
Width = 615
End
Begin VB.Label lblLath
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Lath Yds:"
Height = 195
Left = 3315
TabIndex = 10
Top = 120
Width = 675
End
Begin VB.Label lblLotNo
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Lot #:"
Height = 195
Left = 120
TabIndex = 9
Top = 120
Width = 420
End
Begin VB.Label lblNotes
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "PR Notes:"
Height = 195
Left = 6150
TabIndex = 8
Top = 2400
Width = 735
End
Begin VB.Label lblPayAmt
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Check Amt:"
Height = 195
Left = 3885
TabIndex = 7
Top = 3300
Width = 825
End
Begin VB.Label lblCheck
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Check #:"
Height = 195
Left = 4050
TabIndex = 6
Top = 2940
Width = 660
End
Begin VB.Label lblPayDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Check Date:"
Height = 195
Left = 3810
TabIndex = 5
Top = 2580
Width = 900
End
Begin VB.Label lblCrew
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Crew:"
Height = 195
Left = 1125
TabIndex = 4
Top = 3660
Width = 405
End
Begin VB.Label lblPercent
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Percentage Done:"
Height = 195
Left = 225
TabIndex = 3
Top = 3300
Width = 1305
End
Begin VB.Label lblWorkType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Type of Work Done:"
Height = 195
Left = 75
TabIndex = 2
Top = 2940
Width = 1455
End
Begin VB.Label lblCrewType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Crew Type:"
Height = 195
Left = 720
TabIndex = 1
Top = 2580
Width = 810
End
End
Attribute VB_Name = "frmPayroll"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRS As Recordset
Dim moRSTIME As Recordset
Dim moRSProj As Recordset
Dim moRSMemo As Recordset
Dim mboolSHOW As Boolean
Dim mboolAdding As Boolean, mboolSAVE As Boolean
Dim mstrType As String, mstrCREW As String
Dim mlngFind As Long, mboolLOOK As Boolean
Dim mlngTIME As Long, mboolDONE As Boolean
Dim mintCREW As Integer
Dim mstrWTYPE As String, mstrWDone As String
Private Sub cmdDelPay_Click()
cmdSavePay.Enabled = False
cmdDelPay.Enabled = False
cmdAddPay.Enabled = True
moRSTIME.Delete
Call PayLoad
End Sub
Private Sub WTLoad()
Dim oRS As Recordset, strSQL As String
Dim strID As String, strWT As String, strWTYPE As String
cboWorkType.Clear
strSQL = "SELECT * FROM tblCBOWorkType"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRS.EOF Then
Do Until oRS.EOF
strID = (oRS!WTID)
strWT = (oRS!WTCode)
strWTYPE = (oRS!worktype)
cboWorkType.AddItem strID & vbTab & strWT & vbTab & strWTYPE ' & vbTab & Format(strPHONE, "(###) ###-####") & vbTab & Format(strFAX, "(###) ###-####")
oRS.MoveNext
Loop
End If
If cboWorkType.ListCount Then
cboWorkType.ListIndex = 0
Else
cboWorkType.ListIndex = -1
End If
End Sub
Private Sub cmdFindCrew_Click()
Dim oRS As Recordset
Dim strSQL As String, lngFind As Long
strSQL = "SELECT * from tblcrew WHERE crew_id = " & Field2Integer(txtCrewNo) & " and type = '" & Left(Str2Field(cboCrewType.Text), 1) & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRS.EOF Then
If oRS!inactive Then
MsgBox "This Crew - " & oRS!crew_boss & " - Is Inactive - Select an Active Crew", vbOKOnly, "Inactive Crew"
txtCrewNo.SetFocus
' cmdAdd.Enabled = True
Exit Sub
End If
End If
If Not oRS.EOF Then
mstrCREW = oRS!crew_boss
txtCrewName = mstrCREW
txtPayDate.SetFocus
Else
Call CrewLoad
lstCrew.SetFocus
End If
oRS.Close
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer, strSQL As String
' Call WTLoad
mboolDONE = False
If lstPayInfo.ListCount = 0 Then
intResponse = MsgBox("No Payroll Information, do you wish to add some?", vbYesNo + vbQuestion, "Add Records")
If intResponse = vbYes Then
strSQL = "SELECT * FROM tblTIME"
Set moRSTIME = New Recordset
moRSTIME.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If moRSTIME.EOF Then
End If
Call cmdAddPay_Click
Else
Unload Me
End If
End If
If chkLook Then
mboolLOOK = True
End If
' If chkLook Then
If mboolLOOK Then
cmdSavePay.Enabled = False
cmdDelPay.Enabled = False
cmdAddPay.Enabled = False
cmdFindCrew.Visible = False
txtPercentDone.Enabled = False
txtVerify.Enabled = False
txtCrewNo.Enabled = False
txtPayDate.Enabled = False
txtCheckNo.Enabled = False
txtPayAmt.Enabled = False
txtNotes.Enabled = False
txtOffice.Enabled = False
cboWorkType.Enabled = False
cboCrewType.Enabled = False
txtCrewName.Enabled = False
End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 4 Then
Exit Sub
End If
If Not cmdSavePay.Enabled Then
cmdSavePay.Enabled = True
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim intResponse As Integer, strMSG As String
On Error GoTo Error_EH
If cmdSavePay.Enabled Then
strMSG = "Data Has Been Changed"
strMSG = strMSG & Chr(13) & Chr(10)
strMSG = strMSG & "Save Changes ?"
intResponse = MsgBox(strMSG, vbQuestion + vbYesNoCancel, Me.Caption)
Select Case intResponse
Case vbYes
Call FormSave
Case vbNo
Case vbCancel
Cancel = True
End Select
End If
If moRS.State = adStateOpen Then
moRS.Close
End If
If moRSTIME.State = adStateOpen Then
moRSTIME.Close
End If
Exit Sub
Error_EH:
If Err = 3219 Then
Resume Next
End If
End Sub
Private Sub Form_Load()
Set moRS = New Recordset
Set moRSProj = New Recordset
' Set moRSTime = New Recordset
' gbytSECURITY = 1
If gbytSECURITY = 1 Then
' cmdDelPay.Enabled = True
End If
Call ProjLoad
Call LotLoad
Call PayLoad
Call WTLoad
mboolDONE = True
' If FormFind() Then
' Call PlanFind
' Call FormShow
' Call MatLoad
' Call POptLoad
' Call LOptLoad
' Call OptMatLoad
' Call OrderLoad
' Call POLoad
' Call POMatLoad
' End If
End Sub
Private Sub ProjLoad()
Dim strSQL As String
strSQL = "SELECT * FROM tblProject where proj_id = " & gintPROJID
Set moRSProj = New Recordset
moRSProj.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
End Sub
Private Sub LotLoad()
Dim strSQL As String, strSql2 As String
strSQL = "SELECT * FROM tblLotInfo where lot_id = " & gintLOTID
moRS.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
strSql2 = "SELECT * FROM tblYardMemo WHERE lot_id = " & gintLOTID
Set moRSMemo = New Recordset
moRSMemo.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
If moRSMemo.EOF Then
strSql2 = "SELECT * FROM tblYardMemo" ' WHERE lot_id = " & gintLOTID
Set moRSMemo = New Recordset
moRSMemo.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
moRSMemo.AddNew
moRSMemo!Lot_id = gintLOTID
moRSMemo.Update
strSql2 = "SELECT * FROM tblYardMemo WHERE lot_id = " & gintLOTID
Set moRSMemo = New Recordset
moRSMemo.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
End If
End Sub
Private Sub FormShow()
Dim strWTYPE As String
Dim intLoop As Integer, strSTR As String, intLEN As Integer
mboolSHOW = True
txtProjLot = Trim$(moRSProj!proj_code) & " " & moRS!lot_no
txtLathYds = Field2Integer(moRS!sq_yd) - 19
txtCMUYds = Field2Integer(moRS!CMU)
txtMatYds = Field2Integer(moRS!sq_yd)
txtMetalFt = Field2Long(moRS!METAL)
txtModel = Field2Str(moRS!model)
txtStone = Field2Str(moRS!ST_SQFT)
lblD68 = Field2Str2(moRS!Scaf6)
lblD108 = Field2Str2(moRS!scaf10)
With moRSTIME
txtPercentDone = Field2Str(!pct_done)
txtVerify = IIf(Field2Str(!paydt) = "12:00:00 AM", "", Field2Str(!paydt))
txtCrewNo = Field2Integer(!crew)
mintCREW = Field2Integer(!crew)
Call GetCrew
txtCrewName = mstrCREW
txtPayDate = IIf(Field2Str(!prdate) = "12:00:00 AM", "", Field2Str(!prdate))
txtCheckNo = Field2Str(!prcheck)
txtPayAmt = Format(Field2Str(!pay_amt), "##,###.00")
txtNotes = Field2Str(!notes)
txtOffice = Field2Str(!office)
If !pay_type = "L" Then
cboCrewType.Text = "LATH"
ElseIf !pay_type = "S" Then
cboCrewType.Text = "STUCCO"
ElseIf !pay_type = "R" Then
cboCrewType.Text = "Repair/PO"
ElseIf !pay_type = "V" Then
cboCrewType.Text = "V_Stone"
ElseIf !pay_type = "C" Then
cboCrewType.Text = "C_SCAFFOLD"
ElseIf !pay_type = "X" Then
cboCrewType.Text = "X_PAINT"
End If
' strWTYPE = "X"
strWTYPE = Field2Str(!workdone)
intLEN = Len(strWTYPE)
For intLoop = 0 To cboWorkType.ListCount - 1
' strStr = cboWorkType.ItemData(2)
cboWorkType.ListIndex = (intLoop)
cboWorkType.col = 1
strSTR = cboWorkType.ColText
' strStr = cboWorkType.ColDataField
' strStr = cboWorkType.List(intLoop)
' If intLEN = 1 Then
' If Left$(UCase$(strStr), 1) = Trim(UCase$(strWTYPE)) Then
If Trim(UCase$(strSTR)) = Trim(UCase$(strWTYPE)) Then
cboWorkType.ListIndex = intLoop
intLoop = cboWorkType.ListCount
' ctrControlName.SetFocus
Else
cboWorkType.ListIndex = -1
End If
' ElseIf intLEN > 1 Then
' End If
Next intLoop
' Call CBFindString1(cboWorkType, strWTYPE)
' If !workdone = "A" Then
' cboWorkType.Text = "A_WRAP"
' ElseIf !workdone = "C" Then
' cboWorkType.Text = "COMPLETE"
' ElseIf !workdone = "P" Then
' cboWorkType.Text = "PARTIAL"
' ElseIf !workdone = "B" Then
' cboWorkType.Text = "BROWN"
' ElseIf !workdone = "T" Then
' cboWorkType.Text = "TEXTURE"
' ElseIf !workdone = "S" Then
' cboWorkType.Text = "SCRATCH"
' ElseIf !workdone = "R" Then
' cboWorkType.Text = "REPAIR"
' ElseIf !workdone = "W" Then
' cboWorkType.Text = "WORK ORDER/PO"
' ElseIf !workdone = "F" Then
' cboWorkType.Text = "FENCE"
' ElseIf !workdone = "U" Then
' cboWorkType.Text = "U_CMU"
' ElseIf !workdone = "Y" Then
' cboWorkType.Text = "Y_UP"
' ElseIf !workdone = "Z" Then
' cboWorkType.Text = "Z_DOWN"
' End If
End With
txtLotNotes = Field2Str(moRSMemo!payroll)
' If chkLook Then
If mboolLOOK Then
cmdSavePay.Enabled = False
cmdDelPay.Enabled = False
cmdAddPay.Enabled = False
cmdFindCrew.Visible = False
txtPercentDone.Enabled = False
txtVerify.Enabled = False
txtCrewNo.Enabled = False
txtPayDate.Enabled = False
txtCheckNo.Enabled = False
txtPayAmt.Enabled = False
txtNotes.Enabled = False
txtOffice.Enabled = False
cboWorkType.Enabled = False
cboCrewType.Enabled = False
txtCrewName.Enabled = False
End If
mboolSHOW = False
End Sub
Private Sub cmdAddPay_Click()
Call FormClear
txtVerify = Date
cmdSavePay.Enabled = True
cmdDelPay.Enabled = False
cmdAddPay.Enabled = False
cmdFindCrew.Visible = True
mboolAdding = True
cboCrewType.SetFocus
End Sub
Private Sub cmdSavePay_Click()
mboolSAVE = False
Call CheckCrew
If mboolSAVE Then
cmdSavePay.Enabled = False
cmdDelPay.Enabled = False
cmdAddPay.Enabled = True
cmdFindCrew.Visible = False
lstCrew.Visible = False
Call FormSave
Call PayLoad
End If
End Sub
Private Sub FormSave()
Dim strName As String, strSQL As String, moRSTIME As Recordset
On Error GoTo Error_EH
If mboolAdding Then
' Set moRSTIME = New Recordset
'' If moRSTIME.State = adStateOpen Then
'' moRSTIME.AddNew
' moRSTIME.Close
'' Else
strSQL = "SELECT * FROM tblTIME WHERE IDNUM = " & mlngTIME
' strSQL = strSQL & "WHERE IDNUM = " & mlngTIME
Set moRSTIME = New Recordset
moRSTIME.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
'' If Not moRSTIME.EOF Then
moRSTIME.AddNew
'' End If
'' End If
End If
' Store the controls to the recordset
Call FieldsSave
' moRSTIME.Update
moRSMemo!payroll = Str2Field(txtLotNotes)
moRSMemo.Update
If mboolAdding Then
mboolAdding = False
End If
Exit Sub
Error_EH:
Call ErrorHandler(moRSTIME.ActiveConnection)
Exit Sub
End Sub
Private Function FormFind() As Boolean
Dim strSQL As String, strPlan As String
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblTIME "
strSQL = strSQL & "WHERE IDNUM = " & mlngTIME
Set moRSTIME = New Recordset
' If moRSTime.State = adStateOpen Then
' moRSTime.Close
' End If
moRSTIME.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If moRSTIME.EOF Then
FormFind = False
Else
FormFind = True
End If
End Function
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub FieldsSave()
On Error GoTo Error_EH
If mboolAdding Then
' moRS.AddNew
moRSTIME!proj_id = gintPROJID
moRSTIME!Lot_id = gintLOTID
moRSTIME!lot_no = Str2Field(moRS!lot_no)
moRSTIME!paydt = Date
moRSTIME!C_USER = gstrLOGIN
End If
With moRSTIME
!pct_done = Integer2Field(txtPercentDone)
' !paydt = Date
' !paydt = Str2Field(txtVerify)
!crew = Integer2Field(txtCrewNo)
!prdate = Str2Field(txtPayDate)
!prcheck = Str2Field(txtCheckNo)
!pay_amt = Str2Field(txtPayAmt)
!notes = Str2Field(txtNotes)
!office = Str2Field(txtOffice)
!pay_type = Left(Str2Field(cboCrewType.Text), 1)
cboWorkType.col = 1
!workdone = cboWorkType.ColText
' !workdone = Left(Str2Field(cboWorkType.Text), 4)
!U_USER = gstrLOGIN
!Update = Date
End With
' On Error Resume Next
' moRS.Update
' On Error GoTo 0
moRSTIME.Update
If mboolAdding Then
' Call GetLotID
Call PayLoad
' Call POptLoad
mboolAdding = False
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Payroll - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormClear()
txtPercentDone = "0"
txtVerify = ""
txtCrewNo = "0"
txtCrewName = ""
txtPayDate = ""
txtCheckNo = "0"
txtPayAmt = "0"
txtNotes = ""
txtOffice = ""
txtLotNotes = ""
cboCrewType.ListIndex = -1
cboWorkType.ListIndex = 0
End Sub
Private Sub PayLoad()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
Dim lngRET As Long, aTabs(4) As Long
aTabs(0) = 10
aTabs(1) = 40
aTabs(2) = 70
aTabs(3) = 90
aTabs(4) = 110
' strSQL = "SELECT idnum, lot_id, pay_type, workdone, pct_done, paydt, crew from tblTime WHERE lot_id =" & gintLOTID
strSQL = "SELECT * from tblTime WHERE lot_id =" & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lngRET = SendMessage(lstPayInfo.hwnd, LB_SETTABSTOPS, 5, aTabs(0))
lstPayInfo.Clear
Do Until oRS.EOF
With lstPayInfo
mintCREW = Field2Integer(oRS!crew)
Call GetCrew
strLine = oRS!pay_type & vbTab & oRS!workdone & vbTab & oRS!pct_done
strLine = strLine & vbTab & oRS!prdate
strLine = strLine & vbTab & oRS!crew & vbTab & mstrCREW
.AddItem strLine
.ItemData(.NewIndex) = Field2Long(oRS!idnum)
End With
oRS.MoveNext
Loop
oRS.Close
If lstPayInfo.ListCount Then
lstPayInfo.ListIndex = 0
End If
End Sub
Private Sub CrewLoad()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
Dim lngRET As Long ', aTabs(4) As Long
' aTabs(0) = 10
' aTabs(1) = 20
' aTabs(2) = 40
' aTabs(3) = 90
' aTabs(4) = 110
strSQL = "SELECT * from tblcrew WHERE type = '" & Left(Field2Str(cboCrewType), 1) & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lngRET = SendMessage(lstCrew.hwnd, LB_SETTABSTOPS, 1, 160)
lstCrew.Clear
lstCrew.Visible = True
Do Until oRS.EOF
With lstCrew
mintCREW = Field2Integer(oRS!crew_id)
strLine = oRS!crew_boss & vbTab & oRS!crew_id
' strLine = strLine & vbTab & oRS!paydt
' strLine = strLine & vbTab & oRS!crew & vbTab & mstrCREW
.AddItem strLine
.ItemData(.NewIndex) = oRS!crew_id
End With
oRS.MoveNext
Loop
oRS.Close
If lstCrew.ListCount Then
lstCrew.ListIndex = 0
End If
End Sub
Private Sub lstCrew_DblClick()
mintCREW = lstCrew.ItemData(lstCrew.ListIndex)
Call GetCrew
txtCrewName = mstrCREW
txtCrewNo = mintCREW
lstCrew.Visible = False
txtPayDate.SetFocus
End Sub
Private Sub lstPayInfo_Click()
If lstPayInfo.ListIndex <> -1 Then
mlngTIME = lstPayInfo.ItemData(lstPayInfo.ListIndex)
If FormFind() Then 'And mboolDONE Then
Call FormShow
Else
txtPercentDone = "0"
txtVerify = ""
txtCrewNo = "0"
txtCrewName = ""
txtPayDate = ""
txtCheckNo = "0"
txtPayAmt = "0"
txtNotes = ""
cboCrewType.ListIndex = -1
cboWorkType.ListIndex = -1
End If
End If
End Sub
Private Sub GetCrew()
Dim oRS As Recordset
Dim strSQL As String, lngFind As Long
strSQL = "SELECT * from tblcrew WHERE crew_id = " & mintCREW
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRS.EOF Then
mstrCREW = oRS!crew_boss
End If
oRS.Close
End Sub
Private Sub lstPayInfo_DblClick()
If Not mboolLOOK Then
cmdDelPay.Enabled = True
cmdSavePay.Enabled = True
cmdFindCrew.Visible = True
End If
End Sub
Private Sub txtCheckNo_GotFocus()
Call FieldSelect(txtCheckNo)
End Sub
Private Sub txtCrewNo_GotFocus()
Call FieldSelect(txtCrewNo)
End Sub
Private Sub txtNotes_GotFocus()
Call FieldSelect(txtNotes)
End Sub
Private Sub txtNotes_LostFocus()
txtNotes = UCase(txtNotes)
End Sub
Private Sub txtPayAmt_GotFocus()
Call FieldSelect(txtPayAmt)
End Sub
Private Sub txtPayDate_GotFocus()
Call FieldSelect(txtPayDate)
End Sub
Private Sub txtPayDate_LostFocus()
If Len(txtPayDate) > 0 Then
txtPayDate = Format(txtPayDate, "00/00/####")
If Not IsDate(txtPayDate) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtPayDate.SetFocus
End If
End If
End Sub
Private Sub txtPercentDone_GotFocus()
Call FieldSelect(txtPercentDone)
End Sub
Private Sub CheckCrew()
Dim oRS As Recordset
Dim strSQL As String, lngFind As Long
strSQL = "SELECT * from tblcrew WHERE crew_id = " & Field2Integer(txtCrewNo) & " and type = '" & Left(Str2Field(cboCrewType.Text), 1) & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRS.EOF Then
If oRS!inactive Then
MsgBox "This Crew - " & oRS!crew_boss & " - Is Inactive - Select an Active Crew", vbOKOnly, "Inactive Crew"
txtCrewNo.SetFocus
' cmdAdd.Enabled = True
Exit Sub
End If
End If
mboolSAVE = True
End Sub
Reference in New Issue View Git Blame Copy Permalink