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

2521 lines
81 KiB
Plaintext
Raw Blame History

VERSION 5.00
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX"
Object = "{8DDE6232-1BB0-11D0-81C3-0080C7A2EF7D}#3.0#0"; "Flp32a30.ocx"
Begin VB.Form frmPaySheet
Caption = "Pay Sheet Information"
ClientHeight = 6435
ClientLeft = 60
ClientTop = 345
ClientWidth = 8310
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 6435
ScaleWidth = 8310
StartUpPosition = 3 'Windows Default
Visible = 0 'False
Begin VB.TextBox txtIWYds
BackColor = &H0080FFFF&
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 = 315
Left = 7050
TabIndex = 65
Top = 600
Width = 750
End
Begin VB.TextBox txtWrapYds
Alignment = 1 'Right Justify
BackColor = &H0080FFFF&
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 = 315
Left = 6210
TabIndex = 64
Top = 600
Width = 750
End
Begin VB.CheckBox chkBC
Caption = "B/C"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 7050
TabIndex = 63
Top = 3135
Width = 975
End
Begin VB.CheckBox chkPaid
Alignment = 1 'Right Justify
BackColor = &H00FFFF00&
Caption = "PaySheet Paid"
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 = 255
Left = 3300
TabIndex = 62
Top = 2220
Visible = 0 'False
Width = 1695
End
Begin VB.TextBox txtNotes
Enabled = 0 'False
Height = 915
Left = 1035
TabIndex = 22
Top = 5490
Width = 7215
End
Begin VB.TextBox txtMDesc
Enabled = 0 'False
Height = 375
Left = 1035
MaxLength = 40
TabIndex = 21
Top = 5070
Width = 5505
End
Begin VB.CheckBox chkInvalid
BackColor = &H0080FFFF&
Caption = "Invalid PaySheet"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 255
Left = 5670
TabIndex = 59
Top = 3855
Visible = 0 'False
Width = 2175
End
Begin VB.TextBox txtIFrames
BackColor = &H0080FFFF&
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 = 315
Left = 7050
TabIndex = 56
Top = 2775
Width = 750
End
Begin VB.TextBox txtFrames
Alignment = 1 'Right Justify
BackColor = &H0080FFFF&
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 = 315
Left = 6210
TabIndex = 55
Top = 2775
Width = 750
End
Begin VB.TextBox txtIStYds
BackColor = &H0080FFFF&
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 = 315
Left = 7050
TabIndex = 54
Top = 1695
Width = 750
End
Begin VB.TextBox txtStYds
Alignment = 1 'Right Justify
BackColor = &H0080FFFF&
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 = 315
Left = 6210
TabIndex = 53
Top = 1695
Width = 750
End
Begin Crystal.CrystalReport crPAY
Left = 7830
Top = 30
_ExtentX = 741
_ExtentY = 741
_Version = 348160
WindowState = 2
PrintFileLinesPerPage= 60
End
Begin VB.TextBox txtMDollars
BackColor = &H0080FFFF&
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 = 315
Left = 7050
TabIndex = 51
Top = 3495
Width = 750
End
Begin VB.TextBox txtIStone
BackColor = &H0080FFFF&
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 = 315
Left = 7050
TabIndex = 49
Top = 2415
Width = 750
End
Begin VB.TextBox txtICMU
BackColor = &H0080FFFF&
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 = 315
Left = 7050
TabIndex = 48
Top = 2055
Width = 750
End
Begin VB.TextBox txtIMetal
BackColor = &H0080FFFF&
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 = 315
Left = 7050
TabIndex = 47
Top = 1335
Width = 750
End
Begin VB.TextBox txtILYds
BackColor = &H0080FFFF&
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 = 315
Left = 7050
TabIndex = 46
Top = 975
Width = 750
End
Begin VB.TextBox txtLathYds
Alignment = 1 'Right Justify
BackColor = &H0080FFFF&
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 = 315
Left = 6210
TabIndex = 39
Top = 975
Width = 750
End
Begin VB.TextBox txtMetalFt
Alignment = 1 'Right Justify
BackColor = &H0080FFFF&
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 = 315
Left = 6210
TabIndex = 38
Top = 1335
Width = 750
End
Begin VB.TextBox txtCMUYds
Alignment = 1 'Right Justify
BackColor = &H0080FFFF&
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 = 315
Left = 6210
TabIndex = 37
Top = 2055
Width = 750
End
Begin VB.TextBox txtMatYds
Alignment = 1 'Right Justify
BackColor = &H0080FFFF&
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 = 315
Left = 6210
TabIndex = 36
Top = 3135
Width = 750
End
Begin VB.TextBox txtStone
Alignment = 1 'Right Justify
BackColor = &H0080FFFF&
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 = 315
Left = 6210
TabIndex = 35
Top = 2415
Width = 750
End
Begin VB.TextBox txtFtMetal
Height = 315
Left = 1020
TabIndex = 20
Top = 3240
Width = 1695
End
Begin VB.TextBox txtYdge
Height = 315
Left = 1020
TabIndex = 19
Top = 2880
Width = 1695
End
Begin VB.ComboBox cboType
Height = 315
ItemData = "frmPaySheet.frx":0000
Left = 1020
List = "frmPaySheet.frx":001F
Style = 2 'Dropdown List
TabIndex = 18
Top = 2160
Width = 1695
End
Begin VB.CommandButton cmdSave
Caption = "&Save"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 6810
TabIndex = 24
Top = 4215
Width = 1455
End
Begin VB.CommandButton cmdAddPS
Caption = "&Add"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 5310
TabIndex = 4
Top = 4215
Width = 1455
End
Begin VB.CommandButton cmdRePrint
Caption = "Re&Print"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 5310
TabIndex = 3
Top = 4665
Width = 1455
End
Begin VB.CommandButton cmdExit
Caption = "E&xit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 6810
TabIndex = 2
Top = 4665
Width = 1455
End
Begin VB.ListBox lstPayInfo
Height = 1620
Left = 120
TabIndex = 0
Top = 480
Width = 5055
End
Begin LpLib.fpCombo cboWorkType
Height = 315
Left = 1020
TabIndex = 67
Top = 2520
Width = 2115
_Version = 196608
_ExtentX = 3731
_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 = "frmPaySheet.frx":0075
End
Begin VB.Label lblUpPntPay
BackColor = &H0080FFFF&
Caption = "Paint Pay Updated"
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 = 240
Left = 6630
TabIndex = 68
Top = 5190
Width = 1635
End
Begin VB.Label lblWrap
AutoSize = -1 'True
Caption = "Wrap Yds:"
Height = 195
Left = 5430
TabIndex = 66
Top = 630
Width = 750
End
Begin VB.Label lblNotes
Alignment = 1 'Right Justify
Caption = "PaySheet Notes:"
Height = 435
Left = 195
TabIndex = 61
Top = 5550
Width = 795
End
Begin VB.Label lblMDesc
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Pay Desc."
Height = 195
Left = 255
TabIndex = 60
Top = 5130
Width = 735
End
Begin VB.Label txtWorkType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Work Type:"
Height = 195
Left = 120
TabIndex = 58
Top = 2580
Width = 840
End
Begin VB.Label lblScaf
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Frames:"
Height = 195
Left = 5625
TabIndex = 57
Top = 2835
Width = 555
End
Begin VB.Label lblStucco
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Stucco Yds:"
Height = 195
Left = 5310
TabIndex = 52
Top = 1755
Width = 870
End
Begin VB.Label lblMisc
Alignment = 1 'Right Justify
Caption = "Misc. Pay Dollars"
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 = 5370
TabIndex = 50
Top = 3555
Width = 1575
End
Begin VB.Label lblOrder
Alignment = 2 'Center
Caption = "Orders / Issued"
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 = 6180
TabIndex = 45
Top = 360
Width = 1575
End
Begin VB.Label lblLath
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Lath Yds:"
Height = 195
Left = 5505
TabIndex = 44
Top = 1035
Width = 675
End
Begin VB.Label lblMetalLI
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Ft:"
Height = 195
Left = 5565
TabIndex = 43
Top = 1395
Width = 615
End
Begin VB.Label lblCMU
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "CMU Yds:"
Height = 195
Left = 5460
TabIndex = 42
Top = 2115
Width = 720
End
Begin VB.Label lblMaterial
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Material Yds:"
Height = 195
Left = 5265
TabIndex = 41
Top = 3195
Width = 915
End
Begin VB.Label lblStone
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Stone SqFt:"
Height = 195
Left = 5340
TabIndex = 40
Top = 2475
Width = 840
End
Begin VB.Label txtCrewName
BackColor = &H0080FFFF&
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 = 1860
TabIndex = 34
Top = 4680
Width = 3255
End
Begin VB.Label txtCrew
BackColor = &H0080FFFF&
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 = 1020
TabIndex = 33
Top = 4680
Width = 795
End
Begin VB.Label txtMetal
BackColor = &H0080FFFF&
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 = 1020
TabIndex = 32
Top = 4320
Width = 1695
End
Begin VB.Label txtYRate
BackColor = &H0080FFFF&
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 = 1020
TabIndex = 31
Top = 3960
Width = 1695
End
Begin VB.Label txtAmount
BackColor = &H0080FFFF&
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 = 1020
TabIndex = 30
Top = 3600
Width = 1695
End
Begin VB.Label txtRPDate
BackColor = &H0080FFFF&
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 = 3960
TabIndex = 29
Top = 4320
Width = 1155
End
Begin VB.Label txtRPId
BackColor = &H0080FFFF&
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 = 3960
TabIndex = 28
Top = 3960
Width = 1155
End
Begin VB.Label txtCDate
BackColor = &H0080FFFF&
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 = 3960
TabIndex = 27
Top = 3600
Width = 1155
End
Begin VB.Label txtLogin
BackColor = &H0080FFFF&
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 = 3960
TabIndex = 26
Top = 3240
Width = 1155
End
Begin VB.Label txtRPCount
BackColor = &H0080FFFF&
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 = 3960
TabIndex = 25
Top = 2880
Width = 1155
End
Begin VB.Label txtPSNum
BackColor = &H0080FFFF&
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 = 4155
TabIndex = 23
Top = 2505
Width = 1155
End
Begin VB.Label lblRPCount
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Reprint Count:"
Height = 195
Left = 2895
TabIndex = 17
Top = 2940
Width = 1020
End
Begin VB.Label lblRPDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Date RePrinted:"
Height = 195
Left = 2775
TabIndex = 16
Top = 4380
Width = 1140
End
Begin VB.Label lblReprint
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "RePrinted By:"
Height = 195
Left = 2940
TabIndex = 15
Top = 4020
Width = 975
End
Begin VB.Label lblCDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Date Created:"
Height = 195
Left = 2925
TabIndex = 14
Top = 3660
Width = 990
End
Begin VB.Label lblCreate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "CreatedBy:"
Height = 195
Left = 3135
TabIndex = 13
Top = 3300
Width = 780
End
Begin VB.Label lblPSNum
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Pay Sheet #:"
Height = 195
Left = 3180
TabIndex = 12
Top = 2565
Width = 930
End
Begin VB.Label lblCrew
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Crew:"
Height = 195
Left = 585
TabIndex = 11
Top = 4740
Width = 405
End
Begin VB.Label lblMRate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Rate:"
Height = 195
Left = 165
TabIndex = 10
Top = 4380
Width = 825
End
Begin VB.Label lblYRage
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Rate/Yard:"
Height = 195
Left = 195
TabIndex = 9
Top = 4020
Width = 795
End
Begin VB.Label lblAmt
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Amt. Paid:"
Height = 195
Left = 270
TabIndex = 8
Top = 3660
Width = 720
End
Begin VB.Label lblMetal
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Ft:"
Height = 195
Left = 375
TabIndex = 7
Top = 3300
Width = 615
End
Begin VB.Label lblYardge
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Yardage:"
Height = 195
Left = 345
TabIndex = 6
Top = 2940
Width = 645
End
Begin VB.Label lblType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Crew Type:"
Height = 195
Left = 180
TabIndex = 5
Top = 2220
Width = 810
End
Begin VB.Label lblPSheet
Caption = "Pay Sheets for "
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 = 120
TabIndex = 1
Top = 60
Width = 7035
End
End
Attribute VB_Name = "frmPaySheet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mintCREW As Integer, mstrCREW As String, mlngLOTID As Long
Dim moRS As Recordset, moRSProj As Recordset, mboolAdding As Boolean
Dim mlngTIME As Long, mboolPRINT As Boolean, mboolSTOP As Boolean
Dim moRSPay As Recordset, mstrType As String
Dim mboolOVERRIDE As Boolean, mstrPROJLOT As String
Dim mstrWDone As String, mstrWTYPE As String, mstrWPayType
Private Sub SetInvalid()
Dim intBookmark As Integer
Dim intYARDS As Integer, intMETAL As Integer
If chkInvalid Then
MsgBox "This PaySheet has already been marked Invalid", vbOKOnly, "Invalid Option"
Exit Sub
End If
intBookmark = lstPayInfo.ListIndex
If Not chkPaid = vbChecked Then
moRSPay!invalid = vbChecked
moRSPay.Update
If moRSPay!Type = "S" Then
If moRSPay!worktype = "C" Or moRSPay!worktype = "P" Then
intYARDS = Field2Str2(moRS!pystucco)
moRS!pystucco = intYARDS - Int(Field2Long(moRSPay!pay_ydge))
moRS.Update
End If
End If
If moRSPay!Type = "L" Then
If moRSPay!worktype = "C" Or moRSPay!worktype = "P" Then
intYARDS = Field2Str2(moRS!pylath)
intMETAL = Field2Str2(moRS!pmetal)
moRS!pmetal = intMETAL - Field2Integer(moRSPay!METAL)
moRS!pylath = intYARDS - Field2Integer(moRSPay!pay_ydge)
moRS.Update
End If
End If
If moRSPay!worktype = "W" Or moRSPay!worktype = "R" Or moRSPay!worktype = "F" Or moRSPay!worktype = "U" Then
intYARDS = Field2Str2(moRS!pmdollars)
moRS!pmdollars = intYARDS - Field2Integer(moRSPay!pay_ydge)
moRS.Update
End If
Call PayLoad
Else
MsgBox "This PaySheet Has Already Been Paid", vbOKOnly, "Already Paid"
End If
lstPayInfo.ListIndex = intBookmark
End Sub
Private Sub UpPaintPay()
Dim intBookmark As Integer
Dim intYARDS As Integer, intMETAL As Integer
Dim strWTYPE As String
' If chkInvalid Then
' MsgBox "This PaySheet has already been marked Invalid", vbOKOnly, "Invalid Option"
' Exit Sub
' End If
intBookmark = lstPayInfo.ListIndex
cboWorkType.col = 1
strWTYPE = cboWorkType.ColText
If strWTYPE = "PREP" Then
moRS!PREPL = vbTrue
moRS.Update
lblUpPntPay.Visible = True
ElseIf strWTYPE = "PINT" Then
moRS!PINTL = vbTrue
moRS.Update
lblUpPntPay.Visible = True
ElseIf strWTYPE = "PEXT" Then
moRS!PEXTL = vbTrue
moRS.Update
lblUpPntPay.Visible = True
ElseIf strWTYPE = "IS" Then
moRS!ISL = vbTrue
moRS.Update
lblUpPntPay.Visible = True
ElseIf strWTYPE = "ES" Then
moRS!ESL = vbTrue
moRS.Update
lblUpPntPay.Visible = True
ElseIf strWTYPE = "2T" Then
moRS!TwoTL = vbTrue
moRS.Update
lblUpPntPay.Visible = True
ElseIf strWTYPE = "OH" Then
moRS!OHL = vbTrue
moRS.Update
lblUpPntPay.Visible = True
ElseIf strWTYPE = "FS" Then
moRS!FSL = vbTrue
moRS.Update
lblUpPntPay.Visible = True
ElseIf strWTYPE = "F2" Then
moRS!F2L = vbTrue
moRS.Update
lblUpPntPay.Visible = True
ElseIf strWTYPE = "FG1" Then
moRS!FG1L = vbTrue
moRS.Update
lblUpPntPay.Visible = True
ElseIf strWTYPE = "FG2" Then
moRS!FG2L = vbTrue
moRS.Update
lblUpPntPay.Visible = True
ElseIf strWTYPE = "CC" Then
moRS!CCL = vbTrue
moRS.Update
lblUpPntPay.Visible = True
ElseIf strWTYPE = "BT1" Then
moRS!BT1L = vbTrue
moRS.Update
lblUpPntPay.Visible = True
ElseIf strWTYPE = "BT2" Then
moRS!BT2L = vbTrue
moRS.Update
lblUpPntPay.Visible = True
ElseIf strWTYPE = "PO" Then
moRS!POL = vbTrue
moRS.Update
lblUpPntPay.Visible = True
ElseIf strWTYPE = "CS" Then
moRS!CSL = vbTrue
moRS.Update
lblUpPntPay.Visible = True
ElseIf strWTYPE = "WH" Then
moRS!WHL = vbTrue
moRS.Update
lblUpPntPay.Visible = True
End If
' If Not chkPaid = vbChecked Then
' moRSPay!invalid = vbChecked
' moRSPay.Update
' If moRSPay!Type = "S" Then
' If moRSPay!worktype = "C" Or moRSPay!worktype = "P" Then
' intYARDS = Field2Str2(moRS!pystucco)
' moRS!pystucco = intYARDS - Int(Field2Long(moRSPay!pay_ydge))
' moRS.Update
' End If
' End If
' If moRSPay!Type = "L" Then
' If moRSPay!worktype = "C" Or moRSPay!worktype = "P" Then
' intYARDS = Field2Str2(moRS!pylath)
' intMETAL = Field2Str2(moRS!pmetal)
' moRS!pmetal = intMETAL - Field2Integer(moRSPay!METAL)
' moRS!pylath = intYARDS - Field2Integer(moRSPay!pay_ydge)
' moRS.Update
' End If
' End If
' If moRSPay!worktype = "W" Or moRSPay!worktype = "R" Or moRSPay!worktype = "F" Or moRSPay!worktype = "U" Then
' intYARDS = Field2Str2(moRS!pmdollars)
' moRS!pmdollars = intYARDS - Field2Integer(moRSPay!pay_ydge)
' moRS.Update
' End If
Call PayLoad
' Else
' MsgBox "This PaySheet Has Already Been Paid", vbOKOnly, "Already Paid"
' End If
lstPayInfo.ListIndex = intBookmark
End Sub
Private Sub cboType_LostFocus()
Dim strTYPE As String
If cboType.ListIndex > -1 Then
strTYPE = Left(Str2Field(cboType.Text), 1)
End If
If strTYPE = "L" Then 'Or strTYPE = "R" Or strTYPE = "W" Then
txtFtMetal.Enabled = True
txtFtMetal.BackColor = &H80000005
Else
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
End If
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 cboWorkType_LostFocus()
Dim strTYPE As String, strWTYPE As String, strMSG As String
strTYPE = Left(Str2Field(cboType), 1)
mstrType = strTYPE
If cboWorkType.ListIndex > -1 Then
cboWorkType.col = 1
strWTYPE = cboWorkType.ColText
' strWTYPE = Left(Str2Field(cboWorkType), 1)
mstrWTYPE = strWTYPE
End If
If strTYPE = "S" Then
If strWTYPE = "Y" Or strWTYPE = "Z" Then
' If strWTYPE = "C" Or strWTYPE = "P" Or strWTYPE = "Y" Or strWTYPE = "Z" Then
' or strqtype="W" or strwtype = "F" or strwtypeThen
MsgBox "Invalid Work Type has been selected, Select a valid worktype", vbOKOnly, "Invalid WorkType"
cboWorkType.SetFocus
Exit Sub
End If
If strWTYPE = "W" Or strWTYPE = "F" Or strWTYPE = "U" Or strWTYPE = "R" Then
' lblyardage.Caption = "Pay Amount"
lblYardge.Caption = "Pay Amount"
txtMDesc.Enabled = True
txtNotes.Enabled = True
End If
ElseIf strTYPE = "L" Then
If strWTYPE = "B" Or strWTYPE = "T" Or strWTYPE = "Y" Or strWTYPE = "Z" Or _
strWTYPE = "S" Or strWTYPE = "F" Or strWTYPE = "U" Then
MsgBox "Invalid Work Type has been selected, Select a valid worktype", vbOKOnly, "Invalid WorkType"
cboWorkType.SetFocus
Exit Sub
End If
If strWTYPE = "W" Or strWTYPE = "F" Or strWTYPE = "U" Or strWTYPE = "R" Then
' lblyardage.Caption = "Pay Amount"
lblYardge.Caption = "Pay Amount"
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
txtMDesc.Enabled = True
txtNotes.Enabled = True
End If
'**** start here
' ElseIf strTYPE = "L" Then
' If strWTYPE = "B" Or strWTYPE = "T" Or strWTYPE = "Y" Or strWTYPE = "Z" Or _
' strWTYPE = "S" Or strWTYPE = "F" Or strWTYPE = "U" Then
' MsgBox "Invalid Work Type has been selected, Select a valid worktype", vbOKOnly, "Invalid WorkType"
' cboWorkType.SetFocus
' Exit Sub
' End If
ElseIf strTYPE = "V" Then
If strWTYPE <> "C" And strWTYPE <> "W" Then
MsgBox "Invalid Work Type has been selected, Select a valid worktype", vbOKOnly, "Invalid WorkType"
cboWorkType.SetFocus
Exit Sub
End If
If strWTYPE = "C" Then
lblYardge.Caption = "Sq Feet"
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
End If
If strWTYPE = "W" Then
lblYardge.Caption = "Pay Amount"
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
txtMDesc.Enabled = True
txtNotes.Enabled = True
End If
ElseIf strTYPE = "Y" Then
If strWTYPE = "F" Or strWTYPE = "U" Or strWTYPE = "R" Or strWTYPE = "S" Or strWTYPE = "P" Or strWTYPE = "C" Or strWTYPE = "Y" Or strWTYPE = "Z" Then
strMSG = "Invalid Work Type has been selected. Only 'T', 'B' or 'W' are allowed, Select a valid worktype"
MsgBox strMSG, vbOKOnly, "Invalid WorkType"
cboWorkType.SetFocus
Exit Sub
End If
If strWTYPE = "B" Or strWTYPE = "T" Then
' lblYardge.Caption = "Sq Feet"
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
End If
If strWTYPE = "W" Then
lblYardge.Caption = "Pay Amount"
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
txtMDesc.Enabled = True
txtNotes.Enabled = True
End If
ElseIf strTYPE = "C" Then
If strWTYPE = "F" Or strWTYPE = "U" Or strWTYPE = "R" Or strWTYPE = "S" Or strWTYPE = "P" Or strWTYPE = "C" Or strWTYPE = "B" Or strWTYPE = "T" Then
MsgBox "Invalid Work Type has been selected. Only 'Y', 'Z' or 'W' are allowed. Select a valid worktype", vbOKOnly, "Invalid WorkType"
cboWorkType.SetFocus
Exit Sub
End If
If strWTYPE = "Y" Or strWTYPE = "Z" Then
lblYardge.Caption = "Frames"
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
End If
If strWTYPE = "W" Then
lblYardge.Caption = "Pay Amount"
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
txtMDesc.Enabled = True
txtNotes.Enabled = True
End If
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub LotLoad()
Dim strSQL As String, strSql2 As String
strSQL = "SELECT * FROM tblLotInfo where lot_id = " & gintLOTID
Set moRS = New Recordset
moRS.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
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 PayLoad()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String
Dim lngRET As Long, aTabs(4) As Long
aTabs(0) = 25
aTabs(1) = 50
aTabs(2) = 90
aTabs(3) = 150
aTabs(4) = 200
' strSQL = "SELECT idnum, lot_id, pay_type, workdone, pct_done, paydt, crew from tblTime WHERE lot_id =" & gintLOTID
strSQL = "SELECT * from tblPaySheet WHERE lotid =" & 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!crewid)
Call GetCrew
strLine = oRS!Type & vbTab & oRS!worktype & vbTab & oRS!pay_ydge & vbTab & IIf(oRS!METAL = 0, "", oRS!METAL)
strLine = strLine & vbTab & IIf(oRS!paid, "Paid", (IIf(oRS!invalid, "InValid", (IIf(oRS!bc, "B/C", "Not Paid")))))
If oRS!paid Then
strLine = strLine & vbTab & oRS!crewid & vbTab & mstrCREW
End If
.AddItem strLine
.ItemData(.NewIndex) = Field2Long(oRS!payid)
End With
oRS.MoveNext
Loop
oRS.Close
If lstPayInfo.ListCount Then
lstPayInfo.ListIndex = 0
Else
strSQL = "SELECT * FROM tblPaySheet WHERE payid = 10"
Set moRSPay = New Recordset
moRSPay.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
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 cmdRePrint_Click()
Dim strTYPE As String, strREPORT As String, intCOUNT As Integer
Dim strSQL As String, i As Integer
Dim intTOTAL As Integer, intYDS As Integer
Dim strWORK As String, intResponse As Integer, strREPRINT As String
On Error GoTo Error_EH
gintCOPY = 1
strTYPE = Left(Str2Field(cboType.Text), 1)
cboWorkType.col = 1
strWORK = cboWorkType.ColText
' strWORK = Left(Str2Field(cboWorkType.Text), 1)
If strTYPE = "S" Then
If strWORK = "C" Or strWORK = "P" Then
strREPORT = App.Path & "\RPstuccopay.rpt"
Call LotChange(mstrPROJLOT, "STC Paysheet RePrint")
ElseIf strWORK = "S" Then
strREPORT = App.Path & "\RPstuccopayS.rpt"
Call LotChange(mstrPROJLOT, "STC Paysheet RePrint")
ElseIf strWORK = "B" Then
strREPORT = App.Path & "\RPstuccopayB.rpt"
Call LotChange(mstrPROJLOT, "STC Paysheet RePrint")
ElseIf strWORK = "T" Then
strREPORT = App.Path & "\RPstuccopayT.rpt"
Call LotChange(mstrPROJLOT, "STC Paysheet RePrint")
Else
strREPORT = App.Path & "\RPPOpay.rpt"
Call LotChange(mstrPROJLOT, "STC Paysheet RePrint")
End If
ElseIf strTYPE = "L" Then
If strWORK = "C" Or strWORK = "P" Then
strREPORT = App.Path & "\RPLathpay.rpt"
Call LotChange(mstrPROJLOT, "LA Paysheet RePrint")
Else
strREPORT = App.Path & "\RPPOpay.rpt"
Call LotChange(mstrPROJLOT, "LA Paysheet RePrint")
End If
ElseIf strTYPE = "W" Then
If strWORK = "C" Or strWORK = "P" Then
strREPORT = App.Path & "\RPWrapPay.rpt"
Call LotChange(mstrPROJLOT, "WP Paysheet RePrint")
' Else
' strREPORT = App.Path & "\RPPOpay.rpt"
' Call LotChange(mstrPROJLOT, "LA Paysheet RePrint")
End If
ElseIf strTYPE = "V" Then
If strWORK = "C" Or strWORK = "P" Then
MsgBox "No PaySheet Defined", vbOKOnly, "No Report"
Call LotChange(mstrPROJLOT, "STN Paysheet RePrint")
Else
strREPORT = App.Path & "\RPPOpay.rpt"
Call LotChange(mstrPROJLOT, "STN Paysheet RePrint")
End If
ElseIf strTYPE = "C" Then
If strWORK = "Y" Or strWORK = "Z" Then
strREPORT = App.Path & "\RPScaffoldpay.rpt"
Call LotChange(mstrPROJLOT, "SCF Paysheet RePrint")
Else
strREPORT = App.Path & "\RPPOpay.rpt"
Call LotChange(mstrPROJLOT, "SCF Paysheet RePrint")
End If
ElseIf strTYPE = "Y" Then
If strWORK = "B" Or strWORK = "T" Then
strREPORT = App.Path & "\RPSYNpay.rpt"
Call LotChange(mstrPROJLOT, "SYN Paysheet RePrint")
Else
strREPORT = App.Path & "\RPPOpay.rpt"
Call LotChange(mstrPROJLOT, "SYN Paysheet RePrint")
End If
ElseIf strTYPE = "X" Then
strREPORT = App.Path & "\RPPaintPay3.rpt"
strREPRINT = "PAINT " & strWORK & " Paysheet RePrint"
Call LotChange(mstrPROJLOT, strREPRINT)
'' Call LotChange(mstrPROJLOT, "PAINT Paysheet RePrint")
'' MsgBox "No Pay Sheet Reprint Setup For Paint", vbOKOnly, "Not Set Up"
'' cmdRePrint.Enabled = False
'' cmdAddPS.Enabled = True
'' Exit Sub
' If strWORK = "B" Or strWORK = "T" Then
' strREPORT = App.Path & "\RPSYNpay.rpt"
' Call LotChange(mstrPROJLOT, "SYN Paysheet RePrint")
' Else
' strREPORT = App.Path & "\RPPOpay.rpt"
' Call LotChange(mstrPROJLOT, "SYN Paysheet RePrint")
' End If
End If
intResponse = MsgBox("Do You Want To Print To The Printer?", vbQuestion + vbYesNo, "Print to Printer")
' intRESPONSE = InputBox("Do You Want To Print To The Printer?", "Print to Printer")
If intResponse = vbYes Then
crPAY.Destination = crptToPrinter
Else
crPAY.Destination = crptToWindow
End If
strSQL = "{tblPAYSHEET.payid} = " & gintPAYID
crPAY.ReportFileName = strREPORT
crPAY.ReplaceSelectionFormula (strSQL)
' crPAY.SelectionFormula = (strSQL)
crPAY.CopiesToPrinter = gintCOPY
'crpay.
' crPAY.Destination = crptToWindow
' crpay.Destination = crptToPrinter
crPAY.Action = 1
intCOUNT = Field2Integer(moRSPay!rpcount)
intCOUNT = intCOUNT + 1
moRSPay!rpcount = intCOUNT
moRSPay!rpdate = Date
moRSPay!RPUSER = gstrLOGIN
moRSPay.Update
cmdRePrint.Enabled = False
cmdAddPS.Enabled = True
Exit Sub
Error_EH:
gstrMODULE = "Form Payroll - Module cmdRePrint"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdSave_Click()
mboolSTOP = False
Call AddPay
If Not mboolSTOP Then
Call FormSave
lstPayInfo.Enabled = True
cmdSave.Enabled = False
cmdAddPS.Enabled = True
cmdExit.Enabled = True
txtMDesc.Enabled = False
txtNotes.Enabled = False
gintPAYID = FindMax("tblPaySHeet", "payid")
Call PrintPay
chkBC.Enabled = False
Else
cboType.SetFocus
End If
' Call PrintPay
End Sub
Private Sub PrintPay()
Dim strSQL As String, strTYPE As String, strWTYPE As String
Dim intResponse As Integer
strTYPE = mstrType
strWTYPE = mstrWTYPE
If strTYPE = "S" Then
If strWTYPE = "W" Or strWTYPE = "R" Or strWTYPE = "F" Or strWTYPE = "U" Then
crPAY.ReportFileName = App.Path & "\PSPOpay.rpt"
Else
crPAY.ReportFileName = App.Path & "\PSStuccopay.rpt"
End If
ElseIf strTYPE = "L" Then
If strWTYPE = "W" Or strWTYPE = "R" Then
crPAY.ReportFileName = App.Path & "\PSPOpay.rpt"
Else
crPAY.ReportFileName = App.Path & "\PSLathpay.rpt"
End If
ElseIf strTYPE = "V" Then
If strWTYPE = "W" Or strWTYPE = "R" Then
crPAY.ReportFileName = App.Path & "\PSPOpay.rpt"
Else
crPAY.ReportFileName = App.Path & "\PSStonepay.rpt"
End If
ElseIf strTYPE = "Y" Then
If strWTYPE = "W" Or strWTYPE = "R" Then
crPAY.ReportFileName = App.Path & "\PSPOpay.rpt"
Else
crPAY.ReportFileName = App.Path & "\PSSynPay.rpt"
End If
ElseIf strTYPE = "C" Then
If strWTYPE = "W" Or strWTYPE = "R" Then
crPAY.ReportFileName = App.Path & "\PSPOpay.rpt"
Else
crPAY.ReportFileName = App.Path & "\PSScaffoldpay.rpt"
End If
End If
If intResponse = vbYes Then
crPAY.Destination = crptToPrinter
Else
crPAY.Destination = crptToWindow
End If
gintCOPY = 2
strSQL = "{tblPaySheet.PayId} = " & gintPAYID
' crPAY.ReportFileName = App.Path & "\PSLathpay.rpt"
crPAY.ReplaceSelectionFormula (strSQL)
crPAY.CopiesToPrinter = gintCOPY
' crPAY.Destination = crptToWindow
' crPAY.Destination = crptToPrinter
' crPAY.Formulas(1) = "PaySheetCount = " & i
' crPAY.Formulas(3) = "PaySheetX = 'PARTIAL PAY SHEET'"
' crPAY.CopiesToPrinter = gintCOPY ' / 2
crPAY.CopiesToPrinter = 1
crPAY.Action = 1
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer
If Not mboolOVERRIDE Then
If lstPayInfo.ListCount = 0 Then
intResponse = MsgBox("No Payroll Information, do you wish to add some?", vbYesNo + vbQuestion, "Add Records")
If intResponse = vbYes Then
Call cmdAddPS_Click
strSQL = "SELECT * FROM tblPaySheet WHERE payid = 10"
Set moRSPay = New Recordset
moRSPay.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If moRSPay.EOF Then
End If
Else
Unload Me
End If
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
cboType.Enabled = False
' cboType.Enabled = False
' txtCrewName.Enabled = False
End If
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim txtYRate 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 = vbKeyB Then ' Mark the Pay Sheet as invalid
' If KeyCode = vbKeyV And gbytSECURITY < 3 Then ' Display key combinations.
If CtrlDown Then
Call SetInvalid
End If
Exit Sub
End If
If KeyCode = vbKeyA Then ' Save New Yardage
' If KeyCode = vbKeyV And gbytSECURITY < 3 Then ' Display key combinations.
If CtrlDown Then
moRSPay!pay_ydge = Integer2Field(txtYdge)
moRSPay.Update
End If
Exit Sub
End If
If KeyCode = vbKeyM Then ' Mark the Pay Sheet as duplicate
' If KeyCode = vbKeyV And gbytSECURITY < 3 Then ' Display key combinations.
If CtrlDown Then
Call UpPaintPay
End If
Exit Sub
End If
If KeyCode = vbKeyO Then ' Display key combinations.
' If KeyCode = vbKeyV And gbytSECURITY < 3 Then ' Display key combinations.
If CtrlDown Then
mboolOVERRIDE = True
Call LotChange(mstrPROJLOT, "Paysheet OVERRIDE")
End If
Exit Sub
End If
If KeyCode = vbKeyF Then ' Display key combinations.
' If KeyCode = vbKeyV And gbytSECURITY < 3 Then ' Display key combinations.
If CtrlDown Then
txtYRate = InputBox("Enter the Correct Stone Sq. Footage For This Lot", "New Rate", 0#)
Call LotChange(mstrPROJLOT, "Correct Stone SqFt")
moRS!ST_SQFT = Field2Str2(txtYRate)
moRS.Update
txtStone = txtYRate
End If
Exit Sub
End If
' If Not cmdSave.Enabled Then
' cmdSave.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 cmdSave_Click
Case vbNo
Case vbCancel
Cancel = True
End Select
End If
If moRS.State = adStateOpen Then
moRS.Close
End If
If moRSPay.State = adStateOpen Then
moRSPay.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
If gbytSECURITY = 1 Then
' cmdDelPay.Enabled = True
End If
Call WTLoad
Call ProjLoad
Call LotLoad
mstrPROJLOT = moRSProj!Proj_Code & " " & moRSProj!Proj_Desc & " " & moRS!lot_no
' lblPSheet = "Pay Sheets for " & Trim$(moRSProj!proj_desc) & " Lot # " & Trim$(moRS!lot_no)
Call PayLoad
mboolOVERRIDE = False
' If lstPayInfo.ListCount Then
' If FormFind() Then
' Call FormShow
' End If
' End If
End Sub
Private Function FormFind() As Boolean
Dim strSQL As String, strPlan As String
strSQL = "SELECT * FROM tblPaySheet WHERE payid = " & mlngTIME
Set moRSPay = New Recordset
' If moRSTime.State = adStateOpen Then
' moRSTime.Close
' End If
moRSPay.Open strSQL, goConn, _
adOpenKeyset, adLockPessimistic
If moRSPay.EOF Then
FormFind = False
Else
FormFind = True
End If
End Function
Private Sub FormClear()
txtCDate = ""
txtLogin = ""
txtRPDate = ""
txtRPId = ""
txtRPCount = ""
txtPSNum = ""
txtYdge = ""
txtFtMetal = ""
txtYRate = ""
txtMetal = ""
txtCrew = ""
txtCrewName = ""
txtAmount = ""
txtNotes = ""
txtMDesc = ""
chkBC = vbUnchecked
chkPaid = vbUnchecked
chkPaid.Visible = False
chkInvalid = vbUnchecked
chkInvalid.Visible = False
cboType.ListIndex = -1
cboWorkType.ListIndex = -1
End Sub
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
mboolSTOP = False
If mboolAdding Then
moRSPay.AddNew
End If
' Store the controls to the recordset
Call FieldsSave
If mboolSTOP = True Then
Exit Sub
End If
moRSPay.Update
If mboolAdding Then
mboolAdding = False
mboolPRINT = True
End If
mboolOVERRIDE = False
Exit Sub
Error_EH:
Call ErrorHandler(moRSPay.ActiveConnection)
Exit Sub
End Sub
Private Sub FormShow()
Dim strWTYPE As String, strDONE As String
Dim intLoop As Integer, strSTR As String, intLEN As Integer
mboolSHOW = True
' txtProjLot = Trim$(moRSProj!proj_code) & " " & moRS!lot_no
txtWrapYds = Format((Field2Integer(moRS!l_yds)), "##,###")
txtLathYds = Format((Field2Integer(moRS!l_yds)), "##,###")
txtStYds = Format((Field2Integer(moRS!s_yds)), "##,###")
' txtLathYds = Format((Field2Integer(moRS!sq_yd) - 19), "##,###")
' txtStYds = Format((Field2Integer(moRS!s_yds) -24), "##,###")
txtFrames = Format((Field2Integer(moRS!Scaf6) + Field2Integer(moRS!scaf10)), "##,###")
txtCMUYds = Format(Field2Integer(moRS!CMU), "##,###")
txtMatYds = Format(Field2Integer(moRS!sq_yd), "##,###")
txtMetalFt = Format(Field2Long(moRS!METAL), "##,###")
lblPSheet = "Pay Sheets for " & Trim$(moRSProj!Proj_Desc) & " Lot # " & Trim$(moRS!lot_no) & " " & Trim$(Field2Str(moRS!model))
' txtModel = Field2Str(moRS!model)
txtStone = Format(Field2Str(moRS!ST_SQFT), "##,###")
txtIStone = Field2Str2(moRS!PMisc)
With moRSPay
If !paid Then
chkPaid.Visible = True
chkPaid = vbChecked
Else
chkPaid.Visible = False
chkPaid = vbUnchecked
End If
If !invalid Then
chkInvalid.Visible = True
chkInvalid = vbChecked
Else
chkInvalid.Visible = False
chkInvalid = vbUnchecked
End If
chkBC = Field2CheckBox(!bc)
txtCDate = FormatDateTime(Field2Str(!C_Date), 2)
txtLogin = Field2Str(!Create)
txtRPDate = Field2Str(!rpdate)
txtRPId = Field2Str(!RPUSER)
txtRPCount = Field2Str2(!rpcount)
txtPSNum = Field2Str(!sheet)
txtYdge = Format(Field2Str2(!pay_ydge), "##,###")
' txtAmount = Field2Str2(!amt)
txtFtMetal = Format(Field2Str2(!METAL), "##,###")
txtYRate = IIf(Field2Str2(!y_rate) > 0, Format(Field2Str2(!y_rate), "#.00"), "")
txtMetal = IIf(Field2Str2(!m_Rate) > 0, Format(Field2Str2(!m_Rate), "#.00"), "")
txtMDesc = Field2Str(!m_desc)
txtCrew = Field2Integer(!crewid)
mintCREW = Field2Integer(!crewid)
txtNotes = Field2Str(!notes)
Call GetCrew
txtCrewName = mstrCREW
' txtPayDate = IIf(Field2Str(!prdate) = "12:00:00 AM", "", Field2Str(!prdate))
' txtCheckNo = Field2Str(!prcheck)
txtAmount = IIf(Field2Str2(!amt) > 0, Format(Field2Str(!amt), "##,###.00"), "")
If !Type = "S" Then
cboType.Text = "Stucco"
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
lblYardge = "Yardage:"
ElseIf !Type = "L" Then
txtFtMetal.Enabled = True
txtFtMetal.BackColor = &H80000005
cboType.Text = "Lath"
lblYardge = "Yardage:"
ElseIf !Type = "V" Then
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
cboType.Text = "V_Stone"
lblYardge = "Sq. Feet:"
ElseIf !Type = "Y" Then
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
cboType.Text = "Y_Synthetic"
lblYardge = "Yardage:"
ElseIf !Type = "C" Then
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
cboType.Text = "C_Scaffold"
lblYardge = "Frames:"
ElseIf !Type = "W" Then
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
cboType.Text = "Wrap"
lblYardge = "Yardage:"
ElseIf !Type = "X" Then
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
cboType.Text = "X_Paint"
lblYardge = "SQ Feet:"
End If
'*******
strWTYPE = Field2Str(!worktype)
' intLEN = Len(strWTYPE)
For intLoop = 0 To cboWorkType.ListCount - 1
cboWorkType.ListIndex = (intLoop)
cboWorkType.col = 1
strSTR = cboWorkType.ColText
If Trim(UCase$(strSTR)) = Trim(UCase$(strWTYPE)) Then
cboWorkType.ListIndex = intLoop
intLoop = cboWorkType.ListCount
Else
cboWorkType.ListIndex = -1
End If
Next intLoop
If !worktype = "B" Then
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
' cboWorkType.Text = "Brown"
ElseIf !worktype = "C" Then
If !Type = "L" Then
txtFtMetal.Enabled = True
txtFtMetal.BackColor = &H80000005
Else
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
End If
' cboWorkType.Text = "Complete"
ElseIf !worktype = "P" Then
If !Type = "L" Then
txtFtMetal.Enabled = True
txtFtMetal.BackColor = &H80000005
Else
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
End If
' cboWorkType.Text = "Partial"
ElseIf !worktype = "T" Then
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
' cboWorkType.Text = "Texture"
ElseIf !worktype = "S" Then
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
' cboWorkType.Text = "Scratch"
ElseIf !worktype = "R" Then
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
' cboWorkType.Text = "Repair"
lblYardge = "Pay Amount:"
' txtFtMetal.Enabled = False
ElseIf !worktype = "W" Then
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
' cboWorkType.Text = "WorkOrder/PO"
lblYardge = "Pay Amount:"
ElseIf !worktype = "F" Then
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
' cboWorkType.Text = "Fence"
lblYardge = "Pay Amount:"
ElseIf !worktype = "U" Then
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
' cboWorkType.Text = "U_CMU"
lblYardge = "Pay Amount:"
ElseIf !worktype = "Y" Then
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
' cboWorkType.Text = "Y_UP"
lblYardge = "Frames:"
ElseIf !worktype = "Z" Then
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
' cboWorkType.Text = "Z_DOWN"
lblYardge = "Frames:"
Else
' cboWorkType.ListIndex = -1
End If
End With
If mboolLOOK Then
txtPercentDone.Enabled = False
txtVerify.Enabled = False
txtCrewNo.Enabled = False
txtPayDate.Enabled = False
txtCheckNo.Enabled = False
txtPayAmt.Enabled = False
txtNotes.Enabled = False
txtOffice.Enabled = False
cboType.Enabled = False
End If
txtIWYds = IIf(Field2Str2(moRS!WrapAmt) > 0, Format(Field2Str2(moRS!WrapAmt), "##,###"), "")
txtILYds = IIf(Field2Str2(moRS!pylath) > 0, Format(Field2Str2(moRS!pylath), "##,###"), "")
txtIStYds = IIf(Field2Str2(moRS!pystucco) > 0, Format(Field2Str2(moRS!pystucco), "##,###"), "")
' txtIFrames = IIf(Field2Str2(moRS!pylath) > 0, Format(Field2Str2(moRS!pylath), "##,###"), "")
txtIMetal = IIf(Field2Str2(moRS!pmetal) > 0, Format(Field2Str2(moRS!pmetal), "##,###"), "")
txtICMU = IIf(Field2Str2(moRS!pcmu) > 0, Format(Field2Str2(moRS!pcmu), "##,###"), "")
' txtMYds = IIf(Field2Str2(moRS!pmisc) > 0, Format(Field2Str2(moRS!pmisc), "##,###"), "")
txtMDollars = IIf(Field2Str2(moRS!pmdollars) > 0, Format(Field2Str2(moRS!pmdollars), "##,###"), "")
mboolSHOW = False
End Sub
Private Sub lstPayInfo_Click()
If lstPayInfo.ListIndex <> -1 Then
mlngTIME = lstPayInfo.ItemData(lstPayInfo.ListIndex)
gintPAYID = lstPayInfo.ItemData(lstPayInfo.ListIndex)
If FormFind() Then
Call FormShow
Else
Call FormClear
End If
End If
lblUpPntPay.Visible = False
End Sub
Private Sub cmdAddPS_Click()
Call FormClear
lstPayInfo.Enabled = False
' txtVerify = Date
cmdSave.Enabled = True
cmdAddPS.Enabled = False
' cmdFindCrew.Visible = True
mboolAdding = True
chkBC.Enabled = True
cboType.SetFocus
End Sub
Private Sub AddPay()
Dim intLATH As Long, intSTUCCO As Long, intMETAL As Long, strTYPE As String
Dim intPLATH As Long, intPSTUCCO As Long, intPMETAL As Long, strMSG As String
Dim intPCMU As Long, intPSTONE As Long, intPDOLLARS As Long, intCALC As Long
Dim intCLATH As Long, intCSTUCCO As Long, intCMETAL As Long, lngID As Long
Dim strWTYPE As String, intSTONE As Long, intCSTONE As Long
Dim intFRAMES As Long, intCFRAMES As Long, intPFRAMES As Long
Dim strSQL As String, oRSM As Recordset
strTYPE = Left(Str2Field(cboType.Text), 1)
cboWorkType.col = 1
strWTYPE = cboWorkType.ColText
' strWTYPE = Left(Str2Field(cboWorkType.Text), 1)
lngID = Field2Str2(moRS!Lot_id)
intLATH = Field2Str2(moRS!l_yds)
intSTUCCO = Field2Str2(moRS!s_yds)
intMETAL = Field2Str2(moRS!METAL)
intSTONE = Field2Str2(moRS!ST_SQFT)
intFRAMES = Field2Integer(moRS!Scaf6) + Field2Integer(moRS!scaf10)
intPLATH = Field2Str2(moRS!pylath)
intPSTUCCO = Field2Str2(moRS!pystucco)
intPMETAL = Field2Str2(moRS!pmetal)
intPCMU = Field2Str2(moRS!pcmu)
intPSTONE = Field2Str2(moRS!PMisc)
intPDOLLARS = Field2Str2(moRS!pmdollars)
If strTYPE = "S" Then
If strWTYPE = "C" Or strWTYPE = "P" Then
intCSTUCCO = intPSTUCCO + Field2Str2(txtYdge)
If Not mboolOVERRIDE Then
If intCSTUCCO > intSTUCCO Then
strMSG = CStr(intCSTUCCO) & " is greater than the " & CStr(intSTUCCO) & " yards allowed"
MsgBox strMSG, vbOKOnly, "Yards to High"
mboolSTOP = True
' mboolAdding = False
Exit Sub
End If
End If
moRS!pystucco = intCSTUCCO
moRS.Update
ElseIf strWTYPE = "B" Then
intCALC = FindMax4("tblPaySheet", "pay_ydge", "lotid", lngID, "worktype", strWTYPE)
intCSTUCCO = intCALC + Field2Str2(txtYdge)
If Not mboolOVERRIDE Then
If intCSTUCCO > intSTUCCO Then
strMSG = CStr(intCSTUCCO) & " Brown Yards is greater than the " & CStr(intSTUCCO) & " yards allowed"
MsgBox strMSG, vbOKOnly, "Yards too High"
mboolSTOP = True
' mboolAdding = False
Exit Sub
End If
End If
ElseIf strWTYPE = "S" Then
intCALC = FindMax4("tblPaySheet", "pay_ydge", "lotid", lngID, "worktype", strWTYPE)
intCSTUCCO = intCALC + Field2Str2(txtYdge)
If Not mboolOVERRIDE Then
If intCSTUCCO > intSTUCCO Then
strMSG = CStr(intCSTUCCO) & " Scratch Yards is greater than the " & CStr(intSTUCCO) & " yards allowed"
MsgBox strMSG, vbOKOnly, "Yards too High"
mboolSTOP = True
' mboolAdding = False
Exit Sub
End If
End If
ElseIf strWTYPE = "T" Then
intCALC = FindMax4("tblPaySheet", "pay_ydge", "lotid", lngID, "worktype", strWTYPE)
intCSTUCCO = intCALC + Field2Str2(txtYdge)
If Not mboolOVERRIDE Then
If intCSTUCCO > intSTUCCO Then
strMSG = CStr(intCSTUCCO) & " Texture Yards is greater than the " & CStr(intSTUCCO) & " yards allowed"
MsgBox strMSG, vbOKOnly, "Yards too High"
mboolSTOP = True
' mboolAdding = False
Exit Sub
End If
End If
ElseIf strWTYPE = "W" Or strWTYPE = "F" Or strWTYPE = "R" Or strWTYPE = "U" Then
' intCALC = FindMax4("tblPaySheet", "pay_ydge", "lotid", lngID, "worktype", strWTYPE)
' intCSTUCCO = intCALC + Field2Str2(txtYdge)
' If intCSTUCCO > intSTUCCO Then
' strMSG = CStr(intCSTUCCO) & " Texture Yards is greater than the " & CStr(intSTUCCO) & " yards allowed"
' MsgBox strMSG, vbOKOnly, "Yards to High"
' mboolSTOP = True
' mboolAdding = False
' Exit Sub
' End If
moRS!pmdollars = Field2Integer(txtYdge) + intPDOLLARS
moRS.Update
End If
' moRS!pystucco = intCSTUCCO
' moRS.Update
ElseIf strTYPE = "L" Then
If strWTYPE = "C" Or strWTYPE = "P" Then
intCLATH = intPLATH + Field2Str2(txtYdge)
intCMETAL = intPMETAL + Field2Str2(txtFtMetal)
If Not mboolOVERRIDE Then
If intCLATH > intLATH Then
strMSG = CStr(intCLATH) & " is greater than the " & CStr(intLATH) & " yards allowed"
MsgBox strMSG, vbOKOnly, "Yards too High"
mboolSTOP = True
' mboolAdding = False
Exit Sub
End If
End If
If Not mboolOVERRIDE Then
If intCMETAL > intMETAL Then
strMSG = CStr(intCMETAL) & " is greater than the " & CStr(intMETAL) & " metal feet allowed"
MsgBox strMSG, vbOKOnly, "Metal too High"
mboolSTOP = True
' mboolAdding = False
Exit Sub
End If
End If
moRS!pylath = intCLATH
moRS!pmetal = intCMETAL
moRS.Update
ElseIf strWTYPE = "W" Or strWTYPE = "F" Or strWTYPE = "R" Or strWTYPE = "U" Then
moRS!pmdollars = Field2Integer(txtYdge) + intPDOLLARS
moRS.Update
End If
ElseIf strTYPE = "V" Then
' intCALC = FindMax4("tblPaySheet", "pay_ydge", "lotid", lngID, "type", strTYPE)
intCSTONE = intPSTONE + Field2Str2(txtYdge)
If strWTYPE = "C" Then
If Not mboolOVERRIDE Then
If intCSTONE > intSTONE Then
strMSG = CStr(intCSTONE) & " Sq Feet of Stone is greater than the " & CStr(intSTONE) & " Sq Feet allowed"
MsgBox strMSG, vbOKOnly, "Square Footage to High"
mboolSTOP = True
' mboolAdding = False
Exit Sub
End If
End If
moRS!PMisc = Field2Str2(intCSTONE)
moRS.Update
End If
If strWTYPE = "W" Then
moRS!pmdollars = Field2Integer(txtYdge) + intPDOLLARS
moRS.Update
End If
ElseIf strTYPE = "Y" Then
' intCALC = FindMax4("tblPaySheet", "pay_ydge", "lotid", lngID, "type", strTYPE)
intCSTUCCO = Field2Str2(txtYdge)
If strWTYPE = "B" Then
intCALC = FindMax4("tblPaySheet", "pay_ydge", "lotid", lngID, "worktype", strWTYPE)
intCSTUCCO = intCALC + Field2Str2(txtYdge)
If Not mboolOVERRIDE Then
If intCSTUCCO > intSTUCCO Then
strMSG = CStr(intCSTUCCO) & " Brown Yards is greater than the " & CStr(intSTUCCO) & " yards allowed"
MsgBox strMSG, vbOKOnly, "Yards too High"
mboolSTOP = True
' mboolAdding = False
Exit Sub
End If
End If
ElseIf strWTYPE = "T" Then
intCALC = FindMax4("tblPaySheet", "pay_ydge", "lotid", lngID, "worktype", strWTYPE)
intCSTUCCO = intCALC + Field2Str2(txtYdge)
If Not mboolOVERRIDE Then
If intCSTUCCO > intSTUCCO Then
strMSG = CStr(intCSTUCCO) & " Texture Yards is greater than the " & CStr(intSTUCCO) & " yards allowed"
MsgBox strMSG, vbOKOnly, "Yards too High"
mboolSTOP = True
' mboolAdding = False
Exit Sub
End If
End If
ElseIf strWTYPE = "W" Then
moRS!pmdollars = Field2Integer(txtYdge) + intPDOLLARS
moRS.Update
End If
ElseIf strTYPE = "C" Then
strSQL = "SELECT SUM(pay_ydge) as MAXField FROM tblPaySHeet WHERE lotid = " & lngID
strSQL = strSQL & " and type = 'C' and worktype = '" & strWTYPE & "'" 'W'"
Set oRSM = New Recordset
oRSM.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRSM.EOF Then
intCALC = Field2Integer(oRSM!maxfield)
Else
intCALC = 0
End If
oRSM.Close
' intCALC = FindSum("tblPaySheet", "pay_ydge", "lotid", lngID, "type", strTYPE)
intCFRAMES = intCALC + Field2Str2(txtYdge)
If strWTYPE = "Y" Or strWTYPE = "Z" Then
If Not mboolOVERRIDE Then
If intCFRAMES > intFRAMES Then
strMSG = CStr(intCFRAMES) & " Scaffold Frames is greater than the " & CStr(intFRAMES) & " frames allowed"
MsgBox strMSG, vbOKOnly, "Too Many Frames"
mboolSTOP = True
' mboolAdding = False
Exit Sub
End If
End If
End If
If strWTYPE = "W" Then
moRS!pmdollars = Field2Integer(txtYdge) + intPDOLLARS
moRS.Update
Exit Sub
End If
' moRS!PMisc = intCFRAMES
' moRS.Update
End If
End Sub
Private Sub FieldsSave()
On Error GoTo Error_EH
If mboolAdding Then
' moRSPay!proj_id = gintPROJID
moRSPay!lotid = gintLOTID
moRSPay!Create = gstrLOGIN
moRSPay!totalsheet = 1
moRSPay!sheet = 1
' Call AddPay
If mboolSTOP Then
Exit Sub
End If
End If
'need to make this so that if different types of work are selected only certain type of pay can ge celected
With moRSPay
!pay_ydge = Integer2Field(txtYdge)
' !crew = Integer2Field(txtCrewNo)
!METAL = Integer2Field(txtFtMetal)
!Type = Left(Str2Field(cboType.Text), 1)
cboWorkType.col = 1
!worktype = cboWorkType.ColText 'this will not save correctly if worktype length is greater than one.
' !worktype = Left(Str2Field(cboWorkType), 1) 'this will not save correctly if worktype length is greater than one.
!m_desc = Str2Field(txtMDesc)
!notes = Str2Field(txtNotes)
If chkBC Then
!bc = vbChecked
Else
!bc = vbUnchecked
End If
If chkPaid Then
!paid = vbChecked
Else
!paid = vbUnchecked
End If
' !rpdate = Date
' !RPUSER = gstrLOGIN
' !Update = Date
End With
' On Error Resume Next
' moRS.Update
' On Error GoTo 0
moRSPay.Update
If mboolAdding Then
' Call GetLotID
' Call POptLoad
mboolAdding = False
mboolPRINT = True
End If
Call PayLoad
Exit Sub
Error_EH:
gstrMODULE = "Form Payroll - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstPayInfo_DblClick()
If chkInvalid Then
MsgBox "Reprint of this PaySheet is not allowed", vbOKOnly, "No Reprint"
Exit Sub
End If
If chkPaid Then
MsgBox "No Reprint Allowed - Already Paid", vbOKOnly, "No Reprint"
Exit Sub
End If
cmdAddPS.Enabled = False
cmdRePrint.Enabled = True
txtNotes.Enabled = True
' cmdSave.Enabled = True
End Sub
Private Sub txtFtMetal_GotFocus()
Call FieldSelect(txtFtMetal)
End Sub
Private Sub txtMDesc_GotFocus()
Call FieldSelect(txtMDesc)
End Sub
Private Sub txtMDesc_LostFocus()
txtMDesc = UCase(txtMDesc)
End Sub
Private Sub txtNotes_GotFocus()
txtNotes.SelStart = 2000
End Sub
Private Sub txtNotes_LostFocus()
txtNotes = UCase(txtNotes)
End Sub
Private Sub txtYdge_GotFocus()
Call FieldSelect(txtYdge)
End Sub
Reference in New Issue View Git Blame Copy Permalink