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/frmPayHead.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

2808 lines
84 KiB
Plaintext
Raw Blame History

VERSION 5.00
Object = "{8DDE6232-1BB0-11D0-81C3-0080C7A2EF7D}#3.0#0"; "Flp32a30.ocx"
Begin VB.Form frmPayHead
Caption = "Payroll Summary Information"
ClientHeight = 6330
ClientLeft = 60
ClientTop = 345
ClientWidth = 12195
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 6330
ScaleWidth = 12195
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdCertPR
Caption = "Cert. Pay Rates"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 8220
TabIndex = 84
Top = 4095
Visible = 0 'False
Width = 1035
End
Begin VB.TextBox txtOTAmt
Alignment = 1 'Right Justify
Height = 315
Left = 10365
TabIndex = 14
Top = 5025
Width = 990
End
Begin VB.TextBox txtGross
Alignment = 1 'Right Justify
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 1033
SubFormatType = 1
EndProperty
Height = 315
Left = 9300
MaxLength = 10
TabIndex = 13
Top = 5025
Width = 990
End
Begin VB.TextBox txtTTLAmt
Alignment = 1 'Right Justify
Height = 315
Left = 9300
TabIndex = 15
Top = 5385
Width = 990
End
Begin VB.TextBox txtOTRate
Alignment = 1 'Right Justify
Height = 315
Left = 10365
TabIndex = 12
Top = 4725
Width = 990
End
Begin VB.TextBox txtOTHrs
Alignment = 1 'Right Justify
Height = 315
Left = 10365
TabIndex = 10
Top = 4425
Width = 990
End
Begin LpLib.fpList lstHouses
Height = 2400
Left = 60
TabIndex = 76
Top = 1185
Width = 3615
_Version = 196608
_ExtentX = 6376
_ExtentY = 4233
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 = 0 'False
BackColor = -2147483643
ForeColor = -2147483640
Columns = 4
Sorted = 0
LineWidth = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = -1
ColumnWidthScale= 2
RowHeight = -1
MultiSelect = 0
WrapList = 0 'False
WrapWidth = 0
SelMax = -1
AutoSearch = 1
SearchMethod = 0
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
VirtualPageSize = 0
VirtualPagesAhead= 0
ExtendCol = 0
ColumnLevels = 1
ListGrayAreaColor= -2147483637
GroupHeaderHeight= -1
GroupHeaderShow = 0 'False
AllowGrpResize = 0
AllowGrpDragDrop= 0
MergeAdjustView = 0 'False
ColumnHeaderShow= -1 'True
ColumnHeaderHeight= -1
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmPayHead.frx":0000
End
Begin VB.CommandButton cmdMoveInc
Caption = "Move All Time Inc"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 3840
TabIndex = 75
Top = 5235
Width = 1155
End
Begin VB.CommandButton cmdAllMove
Caption = "Move All Time"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 6960
TabIndex = 72
Top = 5235
Width = 1155
End
Begin VB.CommandButton cmd1Move
Caption = "Move 1 Time"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 5400
TabIndex = 71
Top = 5235
Width = 1155
End
Begin VB.TextBox txtEndTime
Enabled = 0 'False
Height = 285
Left = 4335
TabIndex = 64
Top = 5880
Width = 700
End
Begin VB.TextBox txtLunch
Enabled = 0 'False
Height = 285
Left = 2805
TabIndex = 63
Top = 5880
Width = 700
End
Begin VB.TextBox txtWrkDate
Enabled = 0 'False
Height = 285
Left = 7995
TabIndex = 62
Top = 5865
Width = 1080
End
Begin VB.TextBox txtStartTime
Enabled = 0 'False
Height = 285
Left = 870
TabIndex = 61
Top = 5880
Width = 700
End
Begin VB.TextBox txtPaint
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 315
Left = 11025
TabIndex = 60
Top = 420
Width = 690
End
Begin VB.CheckBox chkBiWeekly
BackColor = &H00C0FFFF&
Caption = "BiWeekly PR"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 285
Left = 1935
TabIndex = 58
Top = 840
Visible = 0 'False
Width = 1575
End
Begin VB.TextBox txtStone
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 315
Left = 9240
TabIndex = 54
TabStop = 0 'False
Top = 420
Width = 690
End
Begin VB.CheckBox chkReady
Caption = "Ready to Process"
Height = 255
Left = 3840
TabIndex = 42
Top = 3720
Width = 1995
End
Begin VB.CheckBox chkDeduct
Caption = "Deductions"
Height = 255
Left = 150
TabIndex = 39
TabStop = 0 'False
Top = 5550
Visible = 0 'False
Width = 1155
End
Begin VB.CommandButton cmdDivide
Caption = "Divide Equally"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 5400
TabIndex = 38
TabStop = 0 'False
Top = 4080
Width = 1155
End
Begin VB.CommandButton cmdSavePay
Caption = "&Save Emp. Pay"
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 = 555
Left = 5400
TabIndex = 16
Top = 4665
Width = 1155
End
Begin VB.CommandButton cmdTotal
Caption = "Update &Totals"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 6960
TabIndex = 27
TabStop = 0 'False
Top = 4665
Width = 1155
End
Begin VB.CommandButton cmdGetCrew
Caption = "Get &Crew List"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 6960
TabIndex = 26
TabStop = 0 'False
Top = 4080
Width = 1155
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 = 555
Left = 3840
TabIndex = 25
TabStop = 0 'False
Top = 4665
Width = 1155
End
Begin VB.CommandButton cmdAddLot
Caption = "Add &House/PO"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 3855
TabIndex = 17
TabStop = 0 'False
Top = 4080
Width = 1155
End
Begin VB.TextBox txtHRate
Alignment = 1 'Right Justify
Height = 315
Left = 9300
MaxLength = 10
TabIndex = 11
Top = 4725
Width = 990
End
Begin VB.TextBox txtHours
Alignment = 1 'Right Justify
Height = 315
Left = 9300
MaxLength = 10
TabIndex = 9
Top = 4425
Width = 990
End
Begin VB.TextBox txtPayDate
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 315
Left = 1200
TabIndex = 8
TabStop = 0 'False
Top = 60
Width = 1275
End
Begin VB.TextBox txtSumCrew
Alignment = 1 'Right Justify
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 315
Left = 9600
TabIndex = 2
TabStop = 0 'False
Top = 60
Width = 975
End
Begin VB.TextBox txtSumHouse
Alignment = 1 'Right Justify
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 315
Left = 7500
TabIndex = 1
TabStop = 0 'False
Top = 60
Width = 975
End
Begin VB.TextBox txtCrewID
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 315
Left = 3180
TabIndex = 0
TabStop = 0 'False
Top = 60
Width = 615
End
Begin VB.ListBox lstLots
Height = 2400
Left = 3780
Sorted = -1 'True
TabIndex = 28
TabStop = 0 'False
Top = 1200
Visible = 0 'False
Width = 4335
End
Begin LpLib.fpList lstCrew
Height = 2415
Left = 8235
TabIndex = 74
Top = 1185
Width = 3900
_Version = 196608
_ExtentX = 6879
_ExtentY = 4260
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 = 0 'False
BackColor = -2147483643
ForeColor = -2147483640
Columns = 4
Sorted = 0
LineWidth = 1
SelDrawFocusRect= -1 'True
ColumnSeparatorChar= 9
ColumnSearch = -1
ColumnWidthScale= 2
RowHeight = -1
MultiSelect = 0
WrapList = 0 'False
WrapWidth = 0
SelMax = -1
AutoSearch = 1
SearchMethod = 0
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
VirtualPageSize = 0
VirtualPagesAhead= 0
ExtendCol = 0
ColumnLevels = 1
ListGrayAreaColor= -2147483637
GroupHeaderHeight= -1
GroupHeaderShow = 0 'False
AllowGrpResize = 0
AllowGrpDragDrop= 0
MergeAdjustView = 0 'False
ColumnHeaderShow= -1 'True
ColumnHeaderHeight= 210
GrpsFrozen = 0
BorderGrayAreaColor= -2147483637
ExtendRow = 0
DataField = ""
OLEDragMode = 0
OLEDropMode = 0
EnableClickEvent= -1 'True
Redraw = -1 'True
ResizeRowToFont = 0 'False
TextTipMultiLine= 0
ColDesigner = "frmPayHead.frx":041B
End
Begin VB.Label lblCertPR
Alignment = 2 'Center
BackColor = &H0080FFFF&
Caption = "CERTIFIED"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 300
Left = 9615
TabIndex = 83
Top = 825
Visible = 0 'False
Width = 2505
End
Begin VB.Label lblNoCalc
BackColor = &H0080FFFF&
Caption = "NO CALC"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800080&
Height = 180
Left = 8280
TabIndex = 82
Top = 3600
Visible = 0 'False
Width = 855
End
Begin VB.Label lblTIE
Caption = "TIEBREAKER"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 180
Left = 9255
TabIndex = 81
Top = 3600
Visible = 0 'False
Width = 1320
End
Begin VB.Label lblTTLWage
AutoSize = -1 'True
Caption = "Total Wages:"
Height = 195
Left = 8235
TabIndex = 80
Top = 5490
Width = 960
End
Begin VB.Label lblRegTime
Alignment = 2 'Center
Caption = "Reg Time"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 9330
TabIndex = 79
Top = 4170
Width = 945
End
Begin VB.Label lblOTTime
Alignment = 2 'Center
Caption = "OT Time"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 225
Left = 10365
TabIndex = 78
Top = 4185
Width = 945
End
Begin VB.Label lblCtrl
Alignment = 2 'Center
Caption = "CTRL-F to See Lot Detail CTRL-K to LOOK"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 375
Left = 45
TabIndex = 77
Top = 3600
Visible = 0 'False
Width = 2610
End
Begin VB.Label lblInstruct
Caption = "Use The Buttons To The Left To Move Hours From The Hi-Lited House To The Hi-Lited Employee"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 585
Left = 9345
TabIndex = 73
Top = 5745
Width = 2805
End
Begin VB.Label lblLunch
AutoSize = -1 'True
Caption = "Lunch Length"
Height = 195
Left = 1710
TabIndex = 70
Top = 5925
Width = 990
End
Begin VB.Label lblEnd
AutoSize = -1 'True
Caption = "End Time:"
Height = 195
Left = 3585
TabIndex = 69
Top = 5925
Width = 720
End
Begin VB.Label lblPayTime
AutoSize = -1 'True
Caption = "Time To Be Paid:"
Height = 195
Left = 5070
TabIndex = 68
Top = 5895
Width = 1230
End
Begin VB.Label lblWrkDate
AutoSize = -1 'True
Caption = "Work Date:"
Height = 195
Left = 7110
TabIndex = 67
Top = 5910
Width = 825
End
Begin VB.Label lblNetTime
Alignment = 2 'Center
BorderStyle = 1 'Fixed Single
Height = 285
Left = 6360
TabIndex = 66
Top = 5865
Width = 705
End
Begin VB.Label lblStart
AutoSize = -1 'True
Caption = "Start Time:"
Height = 195
Left = 60
TabIndex = 65
Top = 5925
Width = 765
End
Begin VB.Label lblPaint
AutoSize = -1 'True
Caption = "Paint SqFt:"
Height = 195
Left = 10110
TabIndex = 59
Top = 480
Width = 780
End
Begin VB.Label lblFrameCnt
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 1740
TabIndex = 57
Top = 5310
Width = 675
End
Begin VB.Label lblFrames
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Frames:"
Height = 195
Left = 1125
TabIndex = 56
Top = 5310
Width = 555
End
Begin VB.Label lblWCCode
Alignment = 2 'Center
BorderStyle = 1 'Fixed Single
Height = 315
Left = 10365
TabIndex = 55
Top = 5370
Width = 990
End
Begin VB.Label lblStone
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Stone SqFt:"
Height = 195
Left = 8355
TabIndex = 53
Top = 480
Width = 840
End
Begin VB.Label lblMRate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Rate:"
Height = 195
Left = 6705
TabIndex = 52
Top = 480
Width = 825
End
Begin VB.Label lblDMRate
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Height = 315
Left = 7605
TabIndex = 51
Top = 420
Width = 690
End
Begin VB.Label lblDRate2
Alignment = 1 'Right Justify
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Height = 315
Left = 5925
TabIndex = 50
Top = 420
Width = 690
End
Begin VB.Label lblDRate
Alignment = 1 'Right Justify
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Height = 315
Left = 5220
TabIndex = 49
Top = 420
Width = 690
End
Begin VB.Label lblRate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Pay Rates:"
Height = 195
Left = 4320
TabIndex = 48
Top = 480
Width = 780
End
Begin VB.Label lblDMetal
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Height = 315
Left = 3180
TabIndex = 47
Top = 420
Width = 1035
End
Begin VB.Label lblMetal
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal:"
Height = 195
Left = 2670
TabIndex = 46
Top = 480
Width = 435
End
Begin VB.Label lblDFin2
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Height = 315
Left = 1680
TabIndex = 45
Top = 420
Width = 795
End
Begin VB.Label lblDYds
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Height = 315
Left = 600
TabIndex = 44
Top = 420
Width = 1035
End
Begin VB.Label lblYds
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Yds:"
Height = 195
Left = 240
TabIndex = 43
Top = 480
Width = 315
End
Begin VB.Label lblSelect
Alignment = 2 'Center
Caption = "CTRL-S to Select Lot"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 195
Left = 6240
TabIndex = 41
Top = 3720
Visible = 0 'False
Width = 1935
End
Begin VB.Label lblTerm
Caption = "TERMINATED"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 180
Left = 10590
TabIndex = 40
Top = 3600
Visible = 0 'False
Width = 1320
End
Begin VB.Label lblBalance
Alignment = 2 'Center
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 3780
TabIndex = 37
Top = 840
Width = 4335
End
Begin VB.Label lblDelete
Caption = "CTRL R to Delete Crews CTRL H to Delete Houses"
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 = 4800
TabIndex = 36
Top = 3240
Width = 2295
End
Begin VB.Label lblDifference
Alignment = 1 'Right Justify
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 315
Left = 10680
TabIndex = 35
Top = 60
Width = 1155
End
Begin VB.Label lblBC
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2700
TabIndex = 34
Top = 4110
Width = 915
End
Begin VB.Label lblPayAmt
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Pay Amount:"
Height = 195
Left = 780
TabIndex = 33
Top = 4950
Width = 900
End
Begin VB.Label lblType
BorderStyle = 1 'Fixed Single
Height = 315
Left = 960
TabIndex = 32
Top = 4095
Width = 1695
End
Begin VB.Label lblCrewType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Crew Type:"
Height = 195
Left = 120
TabIndex = 31
Top = 4155
Width = 810
End
Begin VB.Label lblPay
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 1740
TabIndex = 30
Top = 4950
Width = 1875
End
Begin VB.Label lblAddress
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 0
TabIndex = 29
Top = 4470
Width = 3615
End
Begin VB.Label lblGross
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Pay Amount:"
Height = 195
Left = 8295
TabIndex = 24
Top = 5145
Width = 900
End
Begin VB.Label lblHRate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Hourly Rate:"
Height = 195
Left = 8310
TabIndex = 23
Top = 4845
Width = 885
End
Begin VB.Label lblHours
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "# of Hours:"
Height = 195
Left = 8400
TabIndex = 22
Top = 4545
Width = 795
End
Begin VB.Label lblEmpName
BorderStyle = 1 'Fixed Single
Height = 315
Left = 9300
TabIndex = 21
Top = 3780
Width = 2535
End
Begin VB.Label lblEmpId
BorderStyle = 1 'Fixed Single
Height = 315
Left = 8220
TabIndex = 20
Top = 3780
Width = 1035
End
Begin VB.Label lblCrewMember
AutoSize = -1 'True
Caption = "Crew Workers"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 8280
TabIndex = 19
Top = 900
Width = 1200
End
Begin VB.Label lblHouse
AutoSize = -1 'True
Caption = "Houses && POs"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 120
TabIndex = 18
Top = 900
Width = 1215
End
Begin VB.Line Line1
BorderWidth = 2
X1 = 0
X2 = 11880
Y1 = 780
Y2 = 780
End
Begin VB.Label lblPayDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Payroll Date:"
Height = 195
Left = 225
TabIndex = 7
Top = 120
Width = 900
End
Begin VB.Label lblCrewName
BorderStyle = 1 'Fixed Single
Height = 315
Left = 3840
TabIndex = 6
Top = 60
Width = 2595
End
Begin VB.Label lblSumCrew
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Workers Sum:"
Height = 195
Left = 8520
TabIndex = 5
Top = 120
Width = 1005
End
Begin VB.Label lblSumHouse
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Houses Sum:"
Height = 195
Left = 6480
TabIndex = 4
Top = 120
Width = 945
End
Begin VB.Label lblCrew
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Crew:"
Height = 195
Left = 2700
TabIndex = 3
Top = 120
Width = 405
End
End
Attribute VB_Name = "frmPayHead"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mboolDelete As Boolean, mboolCERTIFIED As Boolean
Dim moRSPay As Recordset
Dim moRSCREW As Recordset
Dim moRSHEAD As Recordset
Dim mdblHours As Double, mdblRate As Double, mdblGROSS As Double
Dim mdblOTHours As Double, mdblOTRate As Double, mdblOTGROSS As Double
Dim mbytCOUNT As Byte
Dim mstrWTYPE As String, mstrWDone As String
Private Sub cmd1Move_Click()
Dim strHseHrs As String, strEmpHrs As String
If lblNetTime <> 0 Then
strHseHrs = lblNetTime
strEmpHrs = txtHours
strEmpHrs = CSng(strEmpHrs) + CSng(strHseHrs)
txtHours = Format(strEmpHrs, "#0.00")
Call CrewSave
cmdSavePay.Enabled = False
Else
MsgBox "Cannot Use The Hi-Lited House Because No Time Was Entered", vbOKOnly, "No Time For This House"
Exit Sub
End If
End Sub
Private Sub cmdAddLot_Click()
Dim strProj As String, strSQL As String, intPROJ As Integer
Dim strLine As String
Dim oRS As Recordset, oRSS As Recordset
strProj = InputBox("Enter the Project Code 'JPAR' for the Lot Your Want To Add", "Enter Project Code")
If Len(strProj) > 0 Then
strProj = UCase(strProj)
strSQL = "SELECT proj_id FROM tblProject WHERE proj_code = '" & Field2Str(strProj) & "'"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If oRS.EOF Then
frmProjList.txtSearch = strProj
frmProjList.Show 1
' MsgBox "No Project Was Found For The Project Code You Entered. Determine The Correct Code And Re-Enter", vbOKOnly, "No Project Found"
' Exit Sub
Else
gintPROJID = Field2Long(oRS!Proj_ID)
' gintPROJID = Field2Integer(oRS!proj_id)
End If
strSQL = "SELECT Lot_No, Lot_id, Address FROM tblLotInfo where proj_id = " & gintPROJID
Set oRSS = New Recordset
oRSS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
lstLots.Clear
lstLots.Visible = True
Do Until oRSS.EOF
With lstLots
strLine = Field2Str(oRSS!lot_no) & vbTab & Field2Str(oRSS!address)
.AddItem strLine
.ItemData(.NewIndex) = oRSS!LOT_ID
End With
oRSS.MoveNext
Loop
If lstLots.ListCount Then
lblSelect.Visible = True
lblCtrl.Visible = True
lstLots.ListIndex = 0
End If
' cmdAddLot.SetFocus
lstLots.SetFocus
' End If
Else
MsgBox "You Must Enter A Project Code", vbOKOnly, "No Project Code"
cmdAddLot.SetFocus
Exit Sub
End If
End Sub
Private Sub cmdAllMove_Click()
Dim strHseHrs As String, strEmpHrs As String, intCNT As Integer, intALL As Integer
intCNT = 1
lstHouses.ListIndex = 0
intALL = lstHouses.ListCount
Do
If lblNetTime <> 0 Then
strHseHrs = lblNetTime
strEmpHrs = txtHours
strEmpHrs = CSng(strEmpHrs) + CSng(strHseHrs)
txtHours = Format(strEmpHrs, "#0.00")
Call CrewSave
cmdSavePay.Enabled = False
' If intCNT > intALL Then
' lstHouses.ListIndex = intCNT
' intCNT = intCNT + 1
' Exit Sub
' End If
' Else
' MsgBox "Cannot Use The Hi-Lited House Because No Time Was Entered", vbOKOnly, "No Time For This House"
' Exit Sub
End If
If intCNT = intALL Then
Exit Sub
Else
lstHouses.ListIndex = intCNT
intCNT = intCNT + 1
End If
Loop
End Sub
Private Sub cmdDetail_Click()
gintPROJID = moRSPay!Proj_ID
gintLOTID = moRSPay!LOT_ID
Call ViewPayInfo
End Sub
Private Sub cmdCertPR_Click()
frmCertified.Show 1
End Sub
Private Sub cmdDivide_Click()
Dim dblPay As Double, intCOUNT As Integer, intZERO As Integer
Dim strSQL As String, strMSG As String, strSELECT As String
Dim oRS As Recordset, strPCID As String
On Error GoTo Error_EH
If mbytCOUNT = 0 Then
strMSG = "There Are No Crew Workers Shown, This Will Cause An Error"
strMSG = strMSG & Chr(13) & Chr(10)
strMSG = strMSG & Chr(13) & Chr(10)
strMSG = strMSG & "Exit Payroll and Add The Workers For This Crew!"
MsgBox strMSG, vbOKOnly, "Enter Crew Members"
Exit Sub
End If
strSELECT = "SELECT COUNT(pay_id) as cntPAY FROM tblPAYCREW WHERE gross = 0 and pay_id = " & gintPAYID
Set oRS = New Recordset
oRS.Open strSELECT, goConn, adOpenForwardOnly, adLockReadOnly
intZERO = Field2Integer(oRS!cntpay)
If intZERO > 0 Then
dblPay = Round((Field2Str2(lblDifference.Caption) / intZERO), 2)
intCOUNT = 1
Do Until intCOUNT > mbytCOUNT
lstCrew.ListIndex = intCOUNT - 1
lstCrew.col = 0
strPCID = lstCrew.ColText
strSQL = "SELECT * FROM tblPayCrew WHERE pc_Id = " & strPCID 'lstCrew.ItemData(lstCrew.ListIndex)
Set moRSCREW = New Recordset
moRSCREW.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Field2Str2(moRSCREW!gross) = 0 Then
If Field2Str2(moRSCREW!hours) = 0 Then
If Field2Str2(dblPay) < 120 Then
moRSCREW!hours = 10
ElseIf Field2Str2(dblPay) < 240 Then
moRSCREW!hours = 20
ElseIf Field2Str2(dblPay) < 360 Then
moRSCREW!hours = 30
' ElseIf Field2Str2(dblPay) < 480 Then
' moRSCREW!hours = 60
Else
moRSCREW!hours = 40
End If
End If
moRSCREW!gross = Field2Str2(dblPay)
moRSCREW!Reg_Wage = Field2Str2(dblPay)
moRSCREW!Rate = Format((Field2Str2(moRSCREW!gross) / Field2Str2(moRSCREW!hours)), "#0.00#")
moRSCREW.Update
End If
intCOUNT = intCOUNT + 1
Loop
End If
Call CrewLoad
Call cmdTotal_Click
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module cmdDivide_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdGetCrew_Click()
Call GetCrew
End Sub
Private Sub ClearCrew()
Dim strSQL As String, oRS As Recordset, intCNTC As Integer, intALLC As Integer
Dim lngCrewID As Integer, boolDONE As Boolean, strCrewID As String
boolDONE = False
intCNTC = 1
intALLC = lstCrew.ListCount
lstCrew.ListIndex = 0
Do Until boolDONE
lstCrew.col = 0
strCrewID = Format(Field2Str2(lstCrew.ColText), "######")
strSQL = "SELECT * FROM tblPAYCREW WHERE PC_ID = " & strCrewID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
oRS!INCLUDE = vbFalse
oRS.Update
oRS.Close
End If
If intCNTC = intALLC Then
boolDONE = True
intCNTC = 1
lstCrew.ListIndex = 0
Else
lstCrew.ListIndex = intCNTC
intCNTC = intCNTC + 1
End If
Loop
Call CrewLoad
End Sub
Private Sub ClearHouse()
Dim strSQL As String, oRS As Recordset, intCNTH As Integer, intALLH As Integer
Dim lngPAYID As Integer, boolDONE As Boolean, strPAYID As String
boolDONE = False
intCNTH = 1
intALLH = lstHouses.ListCount
lstHouses.ListIndex = 0
Do Until boolDONE
lstHouses.col = 0
strPAYID = Format(Field2Str2(lstHouses.ColText), "######")
strSQL = "SELECT * FROM tbltime WHERE IDNUM = " & strPAYID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
oRS!INCLUDE = vbFalse
oRS.Update
oRS.Close
End If
If intCNTH = intALLH Then
boolDONE = True
intCNTH = 1
lstHouses.ListIndex = 0
Else
lstHouses.ListIndex = intCNTH
intCNTH = intCNTH + 1
End If
Loop
Call PayLoad
End Sub
Private Sub cmdMoveInc_Click()
Dim strHseHrs As String, strEmpHrs As String, intCNT As Integer, intALL As Integer
Dim intCNTC As Integer, intALLC As Integer, boolDONE As Boolean, strY As String
Dim intHouseID As Integer, lngCrewID As Integer, boolDONEH As Boolean
Dim strSQL As String, oRS As Recordset, intYN As Integer
intHouseID = 0
lngCrewID = 0
strY = ""
boolDONE = False
boolDONEH = False
intCNT = 1
intCNTC = 1
lstHouses.ListIndex = 0
intALL = lstHouses.ListCount
intALLC = lstCrew.ListCount
Do Until boolDONEH
boolDONE = False
If lblNetTime <> 0 Then
Do Until boolDONE
lstCrew.col = 3
strY = lstCrew.ColText
If strY = "Y" Then
strHseHrs = lblNetTime
strEmpHrs = txtHours
strEmpHrs = CSng(strEmpHrs) + CSng(strHseHrs)
txtHours = Format(strEmpHrs, "#0.00")
Call CrewSave
cmdSavePay.Enabled = False
End If
If intCNTC = intALLC Then
boolDONE = True
intCNTC = 1
lstCrew.ListIndex = 0
Else
lstCrew.ListIndex = intCNTC
intCNTC = intCNTC + 1
End If
strY = ""
Loop
End If
If intCNT = intALL Then
' Exit Sub
lstHouses.ListIndex = 0
boolDONEH = True
Else
lstHouses.ListIndex = intCNT
intCNT = intCNT + 1
End If
Loop
intYN = MsgBox("Do You Want To Clear The Marked Crew Members?", vbYesNo, "Clear Crew List?")
If intYN = vbYes Then
Call ClearCrew
End If
intYN = MsgBox("Do You Want To Clear The Marked Houses?", vbYesNo, "Clear Houses List?")
If intYN = vbYes Then
Call ClearHouse
End If
End Sub
Private Sub cmdSavePay_Click()
Call CrewSave
cmdSavePay.Enabled = False
Call cmdTotal_Click
lstCrew.SetFocus
End Sub
Private Sub cmdTest_Click()
frmProjList.Show 1
End Sub
Private Sub cmdTotal_Click()
Dim strSQL As String
Dim oRS As Recordset
On Error GoTo Error_EH
strSQL = "SELECT sum(pay_amt) as SumHouse FROM tblTime where pay_id = " & gintPAYID & " and crew = " & gintCREWID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
txtSumHouse = Format(Field2Str2(oRS!SumHouse), "##,###.00")
End If
strSQL = "SELECT sum(gross) as SumWorker FROM tblpaycrew where pay_id = " & gintPAYID & " and crew_id = " & gintCREWID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
txtSumCrew = Format(Field2Str2(oRS!SumWorker), "##,###.00")
End If
lblDifference.Caption = Format(Field2Str2(txtSumHouse) - Field2Str2(txtSumCrew), "##,##0.00;(##,##0.00)")
If Field2Str2(lblDifference.Caption) < 0 Then
lblDifference.ForeColor = &HFF&
lblBalance.Caption = "Crew Greater Than Houses"
ElseIf Field2Str2(lblDifference.Caption) > 0 Then
lblDifference.ForeColor = &H0&
lblBalance.Caption = "Houses Greater Than Crew"
Else
lblDifference.ForeColor = &H0&
lblBalance.Caption = "Payroll is Balanced"
End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module cmdTotal_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdLook_Click()
gintPROJID = moRSPay!Proj_ID
gintLOTID = moRSPay!LOT_ID
Load frmPayroll
frmPayroll.chkLOOK = vbChecked
' cmdLook.Visible = False
' cmdDetail.Visible = False
frmPayroll.Show 1
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer
Dim strSQL As String
On Error GoTo Error_EH
mboolDelete = False
If chkBiWeekly = True Then
chkBiWeekly.Visible = True
Else
chkBiWeekly.Visible = False
End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module Form_Activate"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim ShiftDown, AltDown, CtrlDown
Dim intLOC As Integer, strWCCODE As String
If Shift = 4 Then
Exit Sub
End If
ShiftDown = (Shift And vbShiftMask) > 0
AltDown = (Shift And vbAltMask) > 0
CtrlDown = (Shift And vbCtrlMask) > 0
If KeyCode = vbKeyH Then ' Display key combinations.
If CtrlDown Then
Call HouseDelete
Call PayLoad
Call cmdTotal_Click
End If
Exit Sub
End If
If KeyCode = vbKeyR Then ' Display key combinations.
If CtrlDown Then
Call CrewDelete
Call CrewLoad
Call cmdTotal_Click
End If
Exit Sub
End If
If KeyCode = vbKeyS Then ' Display key combinations.
If CtrlDown Then
Call lstLots_DblClick
End If
Exit Sub
End If
If KeyCode = vbKeyT Then ' Put the out of balance amount to this employee
If CtrlDown Then
Call BalancePay
End If
Exit Sub
End If
If KeyCode = vbKeyA Then ' Display key combinations.
If CtrlDown Then
Call NoCalc
End If
Exit Sub
End If
If KeyCode = vbKeyF Then ' Display key combinations.
If CtrlDown Then
Call ViewPayInfo
End If
Exit Sub
End If
If KeyCode = vbKeyK Then ' Display key combinations.
If CtrlDown Then
Call cmdLook_Click
End If
Exit Sub
End If
If KeyCode = vbKeyQ Then ' Fix The Project Code (WC Code) for the highlighted employee
If CtrlDown Then
intLOC = lstCrew.ListIndex
strWCCODE = InputBox("Enter The Correct WC Code", "WC Code", moRSCREW!wc_code)
moRSCREW!wc_code = strWCCODE
moRSCREW.Update
End If
Exit Sub
End If
If KeyCode = vbKeyW Then ' Clear Marked Crew Members in lstCrew
If CtrlDown Then
Call ClearCrew
End If
Exit Sub
End If
If KeyCode = vbKeyE Then ' Clear Marked Houses in lstHouses
If CtrlDown Then
Call ClearHouse
End If
Exit Sub
End If
End Sub
Private Sub NoCalc()
Dim strSQL As String
Dim oRS As Recordset
' On Error GoTo Error_EH
strSQL = "SELECT * FROM tblpayheader WHERE pay_id = " & gintPAYID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
oRS!NoCalc = vbTrue
Else
oRS!NoCalc = vbFalse
End If
End Sub
Private Sub BalancePay()
Dim dblGROSS As Double, dblDIFF As Double
dblDIFF = CDbl(lblDifference)
dblGROSS = Field2Str2(moRSCREW!gross)
If lblBalance.Caption = "Payroll is Balanced" Then
moRSCREW!tiebreak = vbFalse
moRSCREW.Update
Call CrewLoad
ElseIf lblBalance.Caption = "Crew Greater Than Houses" Then
dblGROSS = dblGROSS + dblDIFF
' dblGROSS = dblGROSS - dblDIFF
moRSCREW!Reg_Wage = dblGROSS
moRSCREW!gross = dblGROSS
' moRSCREW!Gross = Field2Str2(moRSCREW!Gross) - Field2Str2(lblDifference)
moRSCREW!tiebreak = vbTrue
moRSCREW.Update
Call cmdTotal_Click
Call CrewLoad
ElseIf lblBalance.Caption = "Houses Greater Than Crew" Then
dblGROSS = dblGROSS + dblDIFF
' moRSCREW!Gross = Field2Str2(moRSCREW!Gross) + Field2Str2(lblDifference)
moRSCREW!gross = dblGROSS
moRSCREW!Reg_Wage = dblGROSS
moRSCREW!tiebreak = vbTrue
moRSCREW.Update
Call cmdTotal_Click
Call CrewLoad
End If
End Sub
Private Sub ViewPayInfo()
Load frmPayInput
frmPayInput.chkLOOK = vbChecked
' cmdLook.Visible = False
' cmdDetail.Visible = False
frmPayInput.Show 1
End Sub
Private Sub CrewDelete()
Dim strSQL As String, strPCID As String
lstCrew.col = 0
strPCID = lstCrew.ColText
strSQL = "DELETE * FROM tblPayCrew where Pc_id = " & strPCID 'lstCrew.ItemData(lstCrew.ListIndex)
goConn.Execute strSQL
End Sub
Private Sub HouseDelete()
Dim strSQL As String, strID As String
Call CheckScaf
mboolDelete = True
Call PaySheetUpdate
lstHouses.col = 0
strID = lstHouses.ColText
strSQL = "DELETE * FROM tblTime where idnum = " & strID 'lstHouses.ItemData(lstHouses.ListIndex)
goConn.Execute strSQL
mboolDelete = False
End Sub
Private Sub PaySheetUpdate()
Dim strSQL As String, strID As String
Dim oRS As Recordset
lstHouses.col = 0
strID = lstHouses.ColText
strSQL = "SELECT * FROM tblPaySheet WHERE timeid = " & strID 'lstHouses.ItemData(lstHouses.ListIndex)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If Not oRS.EOF Then
oRS!crewid = 0
oRS!paid = vbUnchecked
oRS!Amt = 0
oRS!y_rate = 0
oRS!m_Rate = 0
oRS.Update
oRS.Close
End If
End Sub
Private Sub CheckScaf()
Dim strSQL As String, oRS As Recordset, strID As String
Dim strSQLL As String, oRSS As Recordset
lstHouses.col = 0
strID = lstHouses.ColText
strSQL = "SELECT * FROM tblTIME WHERE idnum = " & strID 'lstHouses.ItemData(lstHouses.ListIndex)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
If oRS!scafid Then
strSQLL = "SELECT * FROM tblSCAFFOLD WHERE scaf_id = " & Field2Long(oRS!scafid)
Set oRSS = New Recordset
oRSS.Open strSQLL, goConn, adOpenKeyset, adLockOptimistic
If Not oRSS.EOF Then
oRSS!paid = vbUnchecked
oRSS!pdamt = 0
' oRSS!prcrew = 0
oRSS.Update
oRSS.Close
End If
End If
End If
If oRS.State = adStateOpen Then
oRS.Close
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_Load()
On Error GoTo Error_EH
lblCertPR.Visible = False
cmdCertPR.Visible = False
txtHours = 0
txtOTHrs = 0
txtHRate = 0
txtOTRate = 0
txtGross = 0
txtOTAmt = 0
txtTTLAmt = 0
frmPayHead.Width = 12315
lstCrew.Width = 3900
Call GetWage
Call GetHeader
Call PayLoad
Call CrewLoad
If lstCrew.ListIndex <> -1 Then
If FormFindCrew() Then
' If gboolMAS90 Then
' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
' Exit Sub
' End If
Call FormShowCrew
End If
End If
Call cmdTotal_Click
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module Form_Load"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Function FormFindPay() As Boolean
Dim strSQL As String, strID As String
On Error GoTo Error_EH
lstHouses.col = 0
strID = lstHouses.ColText
strSQL = "SELECT * FROM tblTIME WHERE IdNum = " & strID 'lstHouses.ItemData(lstHouses.ListIndex)
' strSQL = strSQL & "FROM tblTIME "
' strSQL = strSQL & "WHERE IdNum = " & lstHouses.ItemData(lstHouses.ListIndex)
Set moRSPay = New Recordset
moRSPay.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRSPay.EOF Then
FormFindPay = False
Else
FormFindPay = True
' If moRSPay!certpr Then
' mboolCERTIFIED = True
' End If
End If
Exit Function
Error_EH:
gstrMODULE = "Form PayHead - Module FormFindPay"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Function FormFindCrew() As Boolean
Dim strSQL As String, strPCID As String
On Error GoTo Error_EH
lstCrew.col = 0
strPCID = lstCrew.ColText
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblPayCrew "
strSQL = strSQL & "WHERE Pc_Id = " & Field2Str2(strPCID)
' strSQL = strSQL & "WHERE Pc_Id = " & lstCrew.ItemData(lstCrew.ListIndex)
Set moRSCREW = New Recordset
moRSCREW.Open strSQL, goConn, adOpenKeyset, adLockPessimistic
If moRSCREW.EOF Then
FormFindCrew = False
Else
FormFindCrew = True
End If
Exit Function
Error_EH:
gstrMODULE = "Form PayHead - Module FormFindCrew"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub FormShowPay()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset, oRSC As Recordset
On Error GoTo Error_EH
With moRSPay
strSQL = "SELECT * FROM tblLotInfo WHERE Lot_id = " & Field2Str(!LOT_ID)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
lblAddress.Caption = Field2Str(oRS!address)
If Len(moRSPay!StrtTM) > 0 Then
txtStartTime = Field2Str2(moRSPay!StrtTM)
txtEndTime = Field2Str2(moRSPay!EndTM)
txtLunch = Field2Str2(moRSPay!Lunch)
txtWrkDate = Field2Str(moRSPay!WorkDay)
lblNetTime = Field2Str2(moRSPay!NetTime)
Else
txtStartTime = ""
txtEndTime = ""
txtLunch = ""
txtWrkDate = ""
lblNetTime = 0
End If
If !pay_type = "S" Then
lblDYds.Caption = Field2Str(oRS!s_yds)
lblDMetal.Caption = ""
lblDFin2.Caption = Field2Str2(oRS!fin2)
ElseIf !pay_type = "L" Then
lblDYds.Caption = Field2Str(oRS!l_yds)
lblDMetal.Caption = Field2Str2(oRS!METAL)
lblDFin2.Caption = ""
ElseIf !pay_type = "V" Then
txtStone = Field2Str(oRS!ST_SQFT)
lblDYds.Caption = ""
lblDMetal.Caption = ""
lblDFin2.Caption = ""
ElseIf !pay_type = "C" Then
' strSQL2 = "SELECT * FROM tblScaffold WHERE Lot_id = " & Field2Str(!Lot_id)
' Set oRSC = New Recordset
' oRSC.Open strSQL2, goConn, adOpenForwardOnly, adLockReadOnly
' Call GetScaffold
' txtStone = Field2Str(oRSC!st_sqft)
' If oRSC!up Then
lblYds = "Frames:"
lblDYds.Caption = Field2Str2(oRS!Scaf6)
lblDMetal.Caption = ""
' End If
lblDFin2.Caption = Field2Str2(oRS!scaf10)
lblFrames.Visible = True
lblFrameCnt.Visible = True
ElseIf !pay_type = "X" Then
txtPaint = Field2Str(oRS!PNT_SQFT)
lblDYds.Caption = ""
lblDMetal.Caption = ""
lblDFin2.Caption = ""
Else
lblDYds.Caption = ""
lblDMetal.Caption = ""
lblDFin2.Caption = ""
End If
End If
If mboolCERTIFIED Then
lblCertPR.Visible = True
cmdCertPR.Visible = True
' Else
' lblCertPR.Visible = False
End If
If Field2Str(!pay_type) = "S" Then
lblType.Caption = "STUCCO"
ElseIf Field2Str(!pay_type) = "L" Then
lblType.Caption = "LATH"
ElseIf Field2Str(!pay_type) = "V" Then
lblType.Caption = "V_STONE"
ElseIf Field2Str(!pay_type) = "R" Then
lblType.Caption = "REPAIR/PO"
ElseIf Field2Str(!pay_type) = "C" Then
lblType.Caption = "SCAFFOLD"
ElseIf Field2Str(!pay_type) = "X" Then
lblType.Caption = "PAINT"
ElseIf Field2Str(!pay_type) = "W" Then
lblType.Caption = "WRAP"
ElseIf Field2Str(!pay_type) = "Q" Then
lblType.Caption = "MISC"
End If
If !bc Then
lblBC.Caption = "Back Chg"
ElseIf Field2Str(!workdone) = "W" Then
lblBC.Caption = "PO Work"
ElseIf Field2Str(!workdone) = "F" Then
lblBC.Caption = "Fence"
ElseIf Field2Str(!workdone) = "U" Then
lblBC.Caption = "CMU"
Else
lblBC.Caption = ""
End If
lblPay.Caption = Format(Field2Str2(!pay_amt), "##,##0.00;(##,##0.00)")
lblDRate.Caption = Field2Str2(!yd_rate)
lblDRate2.Caption = Field2Str2(!fin2_Rate)
lblDMRate.Caption = Field2Str2(!mtl_Rate)
lblFrameCnt = Field2Str2(!frames)
End With
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module FormShowPay"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormShowCrew()
Dim strSQL As String, strSql2 As String
Dim oRS As Recordset, oRSS As Recordset
On Error GoTo Error_EH
With moRSCREW
lblEmpId.Caption = Field2Str(!Emp_ID)
lblEmpName.Caption = Field2Str(!EmpName)
lblWCCode = Field2Str(!wc_code)
strSql2 = "SELECT * FROM PR1_EmployeeMaster WHERE EmployeeNumber = '" & Field2Str2(!Emp_ID) & "'"
Set oRSS = New Recordset
oRSS.Open strSql2, goConn, adOpenDynamic, adLockPessimistic
' oRSS.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
If Not oRSS.EOF Then
' oRSS.Open strSql2, goConn2, adOpenKeyset, adLockOptimistic
If oRSS!Terminated <> "A" Then
lblTerm.Visible = True
Else
lblTerm.Visible = False
End If
End If
txtHRate = Format(Field2Str2(!Rate), "#0.00#")
txtHours = Format(Field2Str2(!hours), "#0.0#")
txtGross = Format(Field2Str2(!Reg_Wage), "##,##0.00")
txtOTRate = Format(Field2Str2(!OT_Rate), "#0.00##")
txtOTHrs = Format(Field2Str2(!OT_Hours), "#0.0#")
txtOTAmt = Format(Field2Str2(!OT_Wage), "##,##0.00")
txtTTLAmt = Format(Field2Str2(!gross), "##,##0.00")
If Field2Str(!autodeduct) = "Y" Then
chkDeduct = vbChecked
Else
chkDeduct = vbUnchecked
End If
If !tiebreak Then
lblTIE.Visible = True
Else
lblTIE.Visible = False
End If
End With
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module FormShowCrew"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub GetCrew()
Dim oRS As Recordset, oRSS As Recordset
Dim strSQL As String, strCREW As String
On Error GoTo Error_EH
strCREW = "SELECT * FROM tblPayCrew WHERE pc_id = 1"
Set oRSS = New Recordset
oRSS.Open strCREW, goConn, adOpenForwardOnly, adLockOptimistic
strSQL = "SELECT * FROM tblCrewList WHERE crew_id = " & Str2Field(txtCrewId)
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If oRS.EOF Then
MsgBox "No Workers Were Found For The Highlited Crew. Exit and Enter the Workers", vbOKOnly, "Workers Not Dound"
Exit Sub
End If
Do Until oRS.EOF
oRSS.AddNew
oRSS!pay_id = gintPAYID
oRSS!Crew_ID = Field2Str(oRS!Crew_ID)
oRSS!Emp_ID = Field2Str(oRS!Emp_ID)
oRSS!EmpName = Field2Str(oRS!EmpName)
oRSS!Pay_Date = Field2Str(txtPayDate)
oRSS!wc_code = Field2Str(oRS!wc_code)
oRSS.Update
oRS.MoveNext
Loop
Call CrewLoad
Exit Sub
Error_EH:
If Err.Number = -2147467259 Then
MsgBox "Duplicate Crew Member - This Member will not be saved", , "Duplicate Record"
Resume Next
' Exit Sub
End If
gstrMODULE = "Form PayHead - Module GetCrew"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub GetHeader()
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblPayHeader WHERE pay_id = " & gintPAYID
Set moRSHEAD = New Recordset
moRSHEAD.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
chkReady = Field2CheckBox(moRSHEAD!P_FLAG)
' chkReady = moRSHEAD!p_flag
Exit Sub
Error_EH:
If Err.Number = -2147467259 Then
MsgBox "Duplicate Crew List - This will not be saved", , "Duplicate Record"
Exit Sub
End If
gstrMODULE = "Form PayHead - Module CrewSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub GetWage()
Dim strSQL As String, oRS As Recordset
strSQL = "SELECT * FROM tblSYSInfo"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRS.EOF Then
gsngWAGE = Field2Str2(oRS!WAGE)
End If
End Sub
Private Sub CrewSave()
On Error GoTo Error_EH
If moRSCREW.State = adStateClosed Then
Exit Sub
End If
With moRSCREW
!Rate = Str2Field(txtHRate.Text)
!hours = Str2Field(txtHours.Text)
!gross = Str2Field(txtTTLAmt.Text)
!OT_Wage = Str2Field(txtOTAmt.Text)
!Reg_Wage = Str2Field(txtGross.Text)
!OT_Hours = Str2Field(txtOTHrs.Text)
!OT_Rate = Str2Field(txtOTRate)
If chkDeduct Then
!autodeduct = "Y"
Else
!autodeduct = "N"
End If
End With
moRSCREW.Update
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module CrewSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub GetWorkType()
Dim strSQL As String, oRSW As Recordset
strSQL = "SELECT * FROM tblcboWorkType WHERE WTCode = '" & mstrWDone & "'"
Set oRSW = New Recordset
oRSW.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSW.EOF Then
mstrWTYPE = Field2Str(oRSW!worktype)
End If
oRSW.Close
End Sub
Private Sub PayLoad()
Dim oRS As Recordset
Dim strSQL As String, strLOT As String, strY As String
Dim strLine As String, strWORK As String
'Add to New 11/15/17
On Error GoTo Error_EH
lblCertPR.Visible = False
cmdCertPR.Visible = False
strSQL = "SELECT * from tblTime WHERE Pay_id = " & gintPAYID
Set moRSPay = New Recordset
moRSPay.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstHouses.Clear
Do Until moRSPay.EOF
If moRSPay!certpr Then
lblCertPR.Visible = True
cmdCertPR.Visible = True
End If
With lstHouses
mstrWDone = Field2Str(moRSPay!workdone)
Call GetWorkType
strWORK = mstrWTYPE
If moRSPay!INCLUDE = vbTrue Then
strY = "Y"
Else
strY = ""
End If
If moRSPay!bc Then
strLOT = Field2Long(moRSPay!idnum) & vbTab & Field2Str(moRSPay!proj_lot) & vbTab & "BACK CHARGE" & vbTab & strY
Else
strLOT = Field2Long(moRSPay!idnum) & vbTab & Field2Str(moRSPay!proj_lot) & vbTab & strWORK & vbTab & strY
End If
' ElseIf Field2Str(moRSPay!workdone) = "W" Then
' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "PO WORK"
' ElseIf Field2Str(moRSPay!workdone) = "U" Then
' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "CMU"
' ElseIf Field2Str(moRSPay!workdone) = "A" Then
' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "TYPAR WRAP"
' ElseIf Field2Str(moRSPay!workdone) = "C" Then
' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "COMPLETE"
' ElseIf Field2Str(moRSPay!workdone) = "P" Then
' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "PARTIAL"
' ElseIf Field2Str(moRSPay!workdone) = "F" Then
' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "FENCES"
' ElseIf Field2Str(moRSPay!workdone = "Y") Then
' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "UP"
' ElseIf Field2Str(moRSPay!workdone = "Z") Then
' strLOT = Field2Str(moRSPay!proj_lot) & vbTab & "DOWN"
' Else
' strLOT = Field2Str(moRSPay!proj_lot)
' End If
.AddItem strLOT
' .ItemData(.NewIndex) = Field2Long(moRSPay!idnum)
End With
moRSPay.MoveNext
Loop
' moRSPay.Close
If lstHouses.ListCount Then
lstHouses.ListIndex = 0
Else
lstHouses.ListIndex = -1
lblType.Caption = ""
lblAddress.Caption = ""
lblPay.Caption = ""
End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module PayLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub CrewLoad()
Dim oRS As Recordset
Dim strSQL As String, strY As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT * from tblPaycrew WHERE Pay_id = " & gintPAYID
Set moRSCREW = New Recordset
moRSCREW.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstCrew.Clear
mbytCOUNT = 0
Do Until moRSCREW.EOF
With lstCrew
If moRSCREW!INCLUDE = vbTrue Then
strY = "Y"
Else
strY = ""
End If
strLine = Field2Str2(moRSCREW!pc_id) & vbTab & Field2Str(moRSCREW!Emp_ID) & vbTab & Field2Str(moRSCREW!EmpName) & vbTab & strY
.AddItem strLine
' .ItemData(.NewIndex) = moRSCREW!pc_id
End With
mbytCOUNT = Field2Str2(mbytCOUNT) + 1
moRSCREW.MoveNext
Loop
If lstCrew.ListCount Then
lstCrew.ListIndex = 0
Else
lstCrew.ListIndex = -1
lblEmpId.Caption = ""
lblEmpName.Caption = ""
lblWCCode = ""
End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module CrewLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub CrewLoadOld()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
On Error GoTo Error_EH
strSQL = "SELECT * from tblPaycrew WHERE Pay_id = " & gintPAYID
Set moRSCREW = New Recordset
moRSCREW.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstCrew.Clear
mbytCOUNT = 0
Do Until moRSCREW.EOF
With lstCrew
strLine = Field2Str(moRSCREW!Emp_ID) & " " & Field2Str(moRSCREW!EmpName)
.AddItem strLine
.ItemData(.NewIndex) = moRSCREW!pc_id
End With
mbytCOUNT = Field2Str2(mbytCOUNT) + 1
moRSCREW.MoveNext
Loop
If lstCrew.ListCount Then
lstCrew.ListIndex = 0
Else
lstCrew.ListIndex = -1
lblEmpId.Caption = ""
lblEmpName.Caption = ""
lblWCCode = ""
End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module CrewLoadOld"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub SavePay()
Dim strSQL As String
Dim oRS As Recordset
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblpayheader WHERE pay_id = " & gintPAYID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If Not oRS.EOF Then
oRS!sum_houses = Field2Str2(txtSumHouse)
oRS!sum_workers = Field2Str2(txtSumCrew)
oRS!P_FLAG = chkReady
oRS.Update
End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module SavePay"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim intResponse As Integer, strMSG As String
On Error GoTo Error_EH
Call SavePay
If cmdSavePay.Enabled Then
strMSG = "Employee Pay 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 CrewSave
Case vbNo
Case vbCancel
Cancel = True
Exit Sub
End Select
End If
If Field2Str2(lblDifference.Caption) <> 0 Then
strMSG = "The Payroll Is Not Balanced"
strMSG = strMSG & Chr(13) & Chr(10)
strMSG = strMSG & "Are You Sure You Want To Exit ?"
intResponse = MsgBox(strMSG, vbQuestion + vbYesNo, "PAYROLL UNBALANCED")
Select Case intResponse
Case vbYes
Case vbNo
Cancel = True
Exit Sub
End Select
End If
If moRSPay.State = adStateOpen Then
moRSPay.Close
End If
If moRSCREW.State = adStateOpen Then
moRSCREW.Close
End If
Exit Sub
Error_EH:
If Err = 3219 Then
Resume Next
End If
End Sub
Private Sub lstCrew_Click()
On Error GoTo Error_EH
If lstCrew.ListIndex <> -1 Then
If FormFindCrew() Then
' If gboolMAS90 Then '***FIX Need to remove when new tables are setup
' MsgBox "No MAS90 Database on this computer", vbOKOnly, "No MAS90"
' Exit Sub
' End If
Call FormShowCrew
Else
lblEmpId.Caption = ""
lblEmpName.Caption = ""
lblWCCode = ""
txtHRate = "0"
txtHours = "0"
txtGross = "0"
txtTTLAmt = "0"
txtOTHrs = "0"
txtOTRate = "0"
txtOTAmt = "0"
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module lstCrew_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstCrew_DblClick()
Dim intBookmark As Integer
' frmCrewList.Show 1
' Call CrewLoad
intBookmark = lstCrew.ListIndex
If moRSCREW!INCLUDE = vbTrue Then
moRSCREW!INCLUDE = vbFalse
ElseIf moRSCREW!INCLUDE = vbFalse Then
moRSCREW!INCLUDE = vbTrue
End If
moRSCREW.Update
Call CrewLoad
lstCrew.ListIndex = intBookmark
cmdSavePay.Enabled = True
End Sub
Private Sub lstHouses_Click()
On Error GoTo Error_EH
If lstHouses.ListIndex <> -1 Then
If FormFindPay() Then
Call FormShowPay
Else
lblType.Caption = ""
lblAddress.Caption = ""
lblPay.Caption = ""
lblDYds.Caption = ""
lblDFin2.Caption = ""
lblDMetal.Caption = ""
lblDRate.Caption = ""
lblDRate2.Caption = ""
lblDMRate.Caption = ""
txtStartTime = ""
txtEndTime = ""
txtLunch = ""
txtWrkDate = ""
lblNetTime = ""
txtStone = ""
txtPaint = ""
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form PayHead - Module lstHouses_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstHouses_DblClick()
Dim intBookmark As Integer
' frmCrewList.Show 1
' Call CrewLoad
If lstHouses.ListCount > 0 Then
intBookmark = lstHouses.ListIndex
If moRSPay!INCLUDE = vbTrue Then
moRSPay!INCLUDE = vbFalse
ElseIf moRSPay!INCLUDE = vbFalse Then
moRSPay!INCLUDE = vbTrue
End If
moRSPay.Update
Call PayLoad
lstHouses.ListIndex = intBookmark
End If
' cmdSavePay.Enabled = True
' cmdDetail.Visible = True
' cmdLook.Visible = True
' gintPROJID = moRSPay!proj_id
' gintLOTID = moRSPay!Lot_id
End Sub
Private Sub lstLots_DblClick()
Dim strPAYID As String
strPAYID = gintPAYID
gintLOTID = lstLots.ItemData(lstLots.ListIndex)
lstLots.Visible = False
Load frmPayInput
frmPayInput.txtCrewNo = Field2Str(txtCrewId)
frmPayInput.txtCrewName = Field2Str(lblCrewName.Caption)
frmPayInput.chkADD = vbChecked
frmPayInput.Show 1
lblSelect.Visible = False
lblCtrl.Visible = False
Call PayLoad
Call cmdTotal_Click
cmdAddLot.SetFocus
End Sub
Private Sub txtGross_GotFocus()
mdblGROSS = Field2Str2(txtGross)
Call FieldSelect(txtGross)
End Sub
Private Sub txtGross_LostFocus()
If Not IsNumeric(txtGross) Then
Beep
MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid"
txtGross = 0
txtGross.SetFocus
Exit Sub
End If
If Field2Str2(txtGross) <> mdblGROSS Then
cmdSavePay.Enabled = True
End If
If Not moRSCREW!tiebreak Then
Call CalcPay
Call cmdTotal_Click
End If
End Sub
Private Sub txtHours_GotFocus()
'********** Remove comment sign after moved to keeping track of time
' If Field2Str2(txtHours) = 0 And gbool2WK Then
' txtHours = 80
' ElseIf Field2Str2(txtHours) = 0 And gbool1WK Then
' txtHours = 40
' End If
If Field2Str2(txtHours) = 0 Then
txtHours = 40
End If
mdblHours = Field2Str2(txtHours)
Call FieldSelect(txtHours)
End Sub
Private Sub txtHours_LostFocus()
If Not IsNumeric(txtHours) Then
Beep
MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid"
txtHours = 0
txtHours.SetFocus
Exit Sub
End If
If Field2Str2(txtHours) <> mdblHours Then
cmdSavePay.Enabled = True
End If
End Sub
Private Sub txtHRate_GotFocus()
mdblRate = Field2Str2(txtHRate)
Call FieldSelect(txtHRate)
End Sub
Private Sub txtHRate_LostFocus()
If txtHRate = "" Then
txtHRate = 0
End If
If Not IsNumeric(txtHRate) Then
Beep
MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid"
txtHRate = 0
txtHRate.SetFocus
Exit Sub
End If
If Field2Str2(txtHRate) <> mdblRate Then
cmdSavePay.Enabled = True
End If
End Sub
Private Sub CalcPay()
If Field2Str2(txtGross) > 0 Then
If Field2Str2(txtHours = 0) Then
txtHours = 40
mdblHours = Field2Str2(txtHours)
cmdSavePay.Enabled = True
End If
If Field2Str2(txtHRate) = 0 Then
txtHRate = Format((Field2Str2(txtGross) / Field2Str2(txtHours)), "##.00#")
mdblRate = Field2Str2(txtHRate)
cmdSavePay.Enabled = True
End If
If Field2Str2(txtHRate) < gsngWAGE Then
MsgBox "The Hourly Rate is below $" & Format(gsngWAGE, "###.00") & ", Change the Hours Worked To Correct This", vbOKOnly, "Hourly Rate Problem"
txtHRate = 0
txtHours.SetFocus
End If
' Exit Sub
End If
If Field2Str2(txtHours) > 0 And Field2Str2(txtHRate) > 0 Then
If mdblHours <> Field2Str2(txtHours) Or mdblRate <> Field2Str2(txtHRate) Then
txtGross = Format((Field2Str2(txtHours) * Field2Str2(txtHRate)), "##,###.00")
cmdSavePay.Enabled = True
End If
If Field2Str2(txtGross) = 0 Then
txtGross = Format((Field2Str2(txtHours) * Field2Str2(txtHRate)), "##,###.00")
cmdSavePay.Enabled = True
End If
' Exit Sub
End If
If Field2Str2(txtOTHrs) > 0 And Field2Str2(txtOTRate) > 0 Then
If mdblOTHours <> Field2Str2(txtOTHrs) Or mdblOTRate <> Field2Str2(txtOTRate) Then
txtOTAmt = Format((Field2Str2(txtOTHrs) * Field2Str2(txtOTRate)), "##,###.00")
cmdSavePay.Enabled = True
ElseIf Field2Str2(txtOTAmt) = 0 Then
txtOTAmt = Format((Field2Str2(txtOTHrs) * Field2Str2(txtOTRate)), "##,###.00")
cmdSavePay.Enabled = True
End If
' Exit Sub
End If
If Field2Str2(txtGross) > 0 Or Field2Str2(txtOTAmt) > 0 Then
txtTTLAmt = CDbl(Field2Str2(txtGross)) + CDbl(Field2Str2(txtOTAmt))
txtTTLAmt = Format(txtTTLAmt, "#,#,#.00")
End If
End Sub
Private Sub txtOTAmt_GotFocus()
mdblOTGROSS = Field2Str2(txtOTAmt)
Call FieldSelect(txtOTAmt)
End Sub
Private Sub txtOTAmt_LostFocus()
If Not IsNumeric(txtOTAmt) Then
Beep
MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid"
txtOTAmt = 0
txtOTAmt.SetFocus
Exit Sub
End If
If Field2Str2(txtOTAmt) <> mdblOTGROSS Then
cmdSavePay.Enabled = True
End If
Call CalcPay
Call cmdTotal_Click
End Sub
Private Sub txtOTHrs_GotFocus()
txtOTHrs = Field2Str2(txtOTHrs)
mdblOTHours = Field2Str2(txtOTHrs)
Call FieldSelect(txtOTHrs)
End Sub
Private Sub txtOTHrs_LostFocus()
If Not IsNumeric(txtOTHrs) Then
Beep
MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid"
txtOTHrs = 0
txtOTHrs.SetFocus
Exit Sub
End If
If Field2Str2(txtOTHrs) <> mdblOTHours Then
cmdSavePay.Enabled = True
End If
End Sub
Private Sub txtOTRate_GotFocus()
mdblOTRate = Field2Str2(txtOTRate)
Call FieldSelect(txtOTRate)
End Sub
Private Sub txtOTRate_LostFocus()
If txtOTRate = "" Then
txtOTRate = 0
End If
If Not IsNumeric(txtOTRate) Then
Beep
MsgBox "Invalid Number - ReEnter", vbOKOnly, "Invalid"
txtOTRate = 0
txtOTRate.SetFocus
Exit Sub
End If
If Field2Str2(txtOTRate) <> mdblOTRate Then
cmdSavePay.Enabled = True
End If
End Sub
Private Sub txtTTLAmt_GotFocus()
Call FieldSelect(txtTTLAmt)
End Sub
Reference in New Issue View Git Blame Copy Permalink