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_Current/frmGetPaySheet.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

2546 lines
83 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 frmGetPaySheet
Caption = "Select Pay Sheet To Pay"
ClientHeight = 6780
ClientLeft = 60
ClientTop = 345
ClientWidth = 8310
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 6780
ScaleWidth = 8310
StartUpPosition = 3 'Windows Default
Begin VB.CheckBox chkBC
Caption = "B/C"
Height = 375
Left = 7140
TabIndex = 69
Top = 5400
Visible = 0 'False
Width = 915
End
Begin VB.TextBox txtCrewType
Height = 285
Left = 3960
TabIndex = 68
Top = 5100
Visible = 0 'False
Width = 855
End
Begin VB.TextBox txtCrewId
Height = 285
Left = 2940
TabIndex = 67
Top = 5100
Visible = 0 'False
Width = 735
End
Begin VB.TextBox txtFin2Yds
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 = 6180
TabIndex = 66
Top = 1320
Width = 750
End
Begin VB.TextBox txtPercentDone
Height = 315
Left = 1200
TabIndex = 64
Top = 5040
Width = 750
End
Begin VB.CommandButton cmdCalc
Caption = "Calculate &Pay"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 5280
TabIndex = 61
Top = 4200
Width = 1455
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 = 6540
TabIndex = 60
Top = 60
Visible = 0 'False
Width = 1695
End
Begin VB.TextBox txtNotes
Enabled = 0 'False
Height = 915
Left = 1020
TabIndex = 20
Top = 5820
Width = 7215
End
Begin VB.TextBox txtMDesc
Enabled = 0 'False
Height = 375
Left = 1020
MaxLength = 50
TabIndex = 19
Top = 5400
Width = 5715
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 = 5640
TabIndex = 57
Top = 3840
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 = 7020
TabIndex = 54
Top = 2760
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 = 6180
TabIndex = 53
Top = 2760
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 = 7020
TabIndex = 52
Top = 1680
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 = 6180
TabIndex = 51
Top = 1680
Width = 750
End
Begin Crystal.CrystalReport crPAY
Left = 5400
Top = 240
_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 = 7020
TabIndex = 49
Top = 3480
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 = 7020
TabIndex = 47
Top = 2400
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 = 7020
TabIndex = 46
Top = 2040
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 = 7020
TabIndex = 45
Top = 960
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 = 7020
TabIndex = 44
Top = 600
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 = 6180
TabIndex = 37
Top = 600
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 = 6180
TabIndex = 36
Top = 960
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 = 6195
TabIndex = 35
Top = 2040
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 = 6195
TabIndex = 34
Top = 3120
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 = 6195
TabIndex = 33
Top = 2400
Width = 750
End
Begin VB.TextBox txtFtMetal
Enabled = 0 'False
Height = 315
Left = 1020
TabIndex = 18
Top = 3240
Width = 1695
End
Begin VB.TextBox txtYdge
Enabled = 0 'False
Height = 315
Left = 1020
TabIndex = 17
Top = 2880
Width = 1695
End
Begin VB.ComboBox cboType
Enabled = 0 'False
Height = 315
ItemData = "frmGetPaySheet.frx":0000
Left = 1020
List = "frmGetPaySheet.frx":0016
Style = 2 'Dropdown List
TabIndex = 16
Top = 2160
Width = 1695
End
Begin VB.CommandButton cmdSave
Caption = "&Save Pay Info"
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 = 555
Left = 6780
TabIndex = 22
Top = 4200
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 = 555
Left = 6780
TabIndex = 2
Top = 4800
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 = 70
Top = 2505
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 = "frmGetPaySheet.frx":0053
End
Begin VB.Label lblFin2
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Finish 2 Yds:"
Height = 195
Left = 5220
TabIndex = 65
Top = 1380
Width = 900
End
Begin VB.Label lblPercent
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Percent Done:"
Height = 195
Left = 0
TabIndex = 63
Top = 5100
Width = 1035
End
Begin VB.Label lblFINISH
Alignment = 1 'Right Justify
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 = 2940
TabIndex = 62
Top = 2160
Width = 2175
End
Begin VB.Label lblNotes
Alignment = 1 'Right Justify
Caption = "TimeSheet Notes:"
Height = 435
Left = 180
TabIndex = 59
Top = 5880
Width = 795
End
Begin VB.Label lblMDesc
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Pay Desc."
Height = 195
Left = 240
TabIndex = 58
Top = 5460
Width = 735
End
Begin VB.Label txtWorkType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Work Type:"
Height = 195
Left = 120
TabIndex = 56
Top = 2580
Width = 840
End
Begin VB.Label lblScaf
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Frames:"
Height = 195
Left = 5595
TabIndex = 55
Top = 2820
Width = 555
End
Begin VB.Label lblStucco
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Stucco Yds:"
Height = 195
Left = 5280
TabIndex = 50
Top = 1740
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 = 5340
TabIndex = 48
Top = 3540
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 = 43
Top = 360
Width = 1575
End
Begin VB.Label lblLath
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Lath Yds:"
Height = 195
Left = 5475
TabIndex = 42
Top = 660
Width = 675
End
Begin VB.Label lblMetalLI
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Ft:"
Height = 195
Left = 5535
TabIndex = 41
Top = 1020
Width = 615
End
Begin VB.Label lblCMU
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "CMU Yds:"
Height = 195
Left = 5400
TabIndex = 40
Top = 2100
Width = 720
End
Begin VB.Label lblMaterial
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Material Yds:"
Height = 195
Left = 5235
TabIndex = 39
Top = 3180
Width = 915
End
Begin VB.Label lblStone
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Stone SqFt:"
Height = 195
Left = 5310
TabIndex = 38
Top = 2460
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 = 32
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 = 31
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 = 30
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 = 29
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 = 28
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 = 27
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 = 26
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 = 25
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 = 24
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 = 23
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 = 21
Top = 2520
Width = 1155
End
Begin VB.Label lblRPCount
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Reprint Count:"
Height = 195
Left = 2895
TabIndex = 15
Top = 2940
Width = 1020
End
Begin VB.Label lblRPDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Date RePrinted:"
Height = 195
Left = 2775
TabIndex = 14
Top = 4380
Width = 1140
End
Begin VB.Label lblReprint
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "RePrinted By:"
Height = 195
Left = 2940
TabIndex = 13
Top = 4020
Width = 975
End
Begin VB.Label lblCDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Date Created:"
Height = 195
Left = 2925
TabIndex = 12
Top = 3660
Width = 990
End
Begin VB.Label lblCreate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "CreatedBy:"
Height = 195
Left = 3135
TabIndex = 11
Top = 3300
Width = 780
End
Begin VB.Label lblPSNum
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Pay Sheet #:"
Height = 195
Left = 3180
TabIndex = 10
Top = 2580
Width = 930
End
Begin VB.Label lblCrew
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Crew:"
Height = 195
Left = 585
TabIndex = 9
Top = 4740
Width = 405
End
Begin VB.Label lblMRate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Rate:"
Height = 195
Left = 165
TabIndex = 8
Top = 4380
Width = 825
End
Begin VB.Label lblYRate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Rate/Yard:"
Height = 195
Left = 195
TabIndex = 7
Top = 4020
Width = 795
End
Begin VB.Label lblAmt
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Amt. Paid:"
Height = 195
Left = 270
TabIndex = 6
Top = 3660
Width = 720
End
Begin VB.Label lblMetal
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Metal Ft:"
Height = 195
Left = 375
TabIndex = 5
Top = 3300
Width = 615
End
Begin VB.Label lblYardge
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Yardage:"
Height = 195
Left = 345
TabIndex = 4
Top = 2940
Width = 645
End
Begin VB.Label lblType
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Crew Type:"
Height = 195
Left = 180
TabIndex = 3
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 = "frmGetPaySheet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mintCREW As Integer, mstrCREW As String
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 mboolCALC As Boolean, mstrWDone As String, mstrWTYPE As String
Dim mstrPCrew As String, mstrPType As String
Dim moRSTIME As Recordset, moRSCREW As Recordset
Private Sub SetInvalid()
Dim intBOOKMARK 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
Call PayLoad
Else
MsgBox "This PaySheet Has Already Been Paid", vbOKOnly, "Already Paid"
End If
lstPayInfo.ListIndex = intBOOKMARK
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 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 cboWorkType_LostFocus()
Dim strTYPE As String, strWTYPE As String, strMSG As String
strTYPE = Left(Str2Field(cboType), 1)
mstrType = strTYPE
If cboWorkType.ListIndex > -1 Then
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 cmdCalc_Click()
Dim dblPAYAMT As Double
Dim strTYPE As String, strWTYPE As String
If txtPercentDone = "" Then
txtPercentDone = "100"
End If
If moRSPay.State = adStateOpen Then
strTYPE = Field2Str(moRSPay!Type)
strWTYPE = Field2Str(moRSPay!worktype)
' If strTYPE = "S" Then
' If strWTYPE = "C" Or strWTYPE = "P" Then
' ElseIf strWTYPE = "B" Or strWTYPE = "S" Or strWTYPE = "T" Then
' ElseIf strWTYPE = "W" Or strWTYPE = "R" Or strWTYPE = "U" Or strWTYPE = "F" Then
' End If
' End If
If strTYPE = "L" Then
If (Not strWTYPE = "W" Or strWTYPE = "R") Then
dblPAYAMT = (((Field2Str2(txtYRate) * Field2Str2(txtYdge)) * Field2Str2(txtPercentDone)) / 100)
dblPAYAMT = dblPAYAMT + (((Field2Str2(txtMetal) * Field2Str2(txtFtMetal)) * Field2Str2(txtPercentDone)) / 100)
' dblPayAmt = dblPayAmt + (Field2Str2(txtFin2Rate) * Field2Str2(txtFin2))
txtAmount = Format(dblPAYAMT, "##,##0.00")
Else
dblPAYAMT = Format(txtYdge, "##,##0.00")
txtAmount = Format(dblPAYAMT, "##,##0.00")
End If
End If
If strTYPE = "V" Then
If (Not strWTYPE = "W" Or strWTYPE = "R") Then
dblPAYAMT = (((Field2Str2(txtYRate) * Field2Str2(txtYdge)) * Field2Str2(txtPercentDone)) / 100)
' dblPayAmt = dblPayAmt + (((Field2Str2(txtmetal) * Field2Str2(txtMetalFt)) * Field2Str(txtPercentDone)) / 100)
' dblPayAmt = dblPayAmt + (Field2Str2(txtFin2Rate) * Field2Str2(txtFin2))
txtAmount = Format(dblPAYAMT, "##,##0.00")
Else
txtAmount = Format(txtYdge, "##,##0.00")
End If
End If
If strTYPE = "C" Then
' If Not (strWTYPE = "W" Or strWTYPE = "R") Then
' dblPAYAMT = (((Field2Str2(txtYRate) * Field2Str2(txtStone)) * Field2Str2(txtPercentDone)) / 100)
' dblPayAmt = dblPayAmt + (((Field2Str2(txtmetal) * Field2Str2(txtMetalFt)) * Field2Str(txtPercentDone)) / 100)
' dblPayAmt = dblPayAmt + (Field2Str2(txtFin2Rate) * Field2Str2(txtFin2))
' txtAmount = Format(dblPAYAMT, "##,##0.00")
' End If
MsgBox "Scaffolding Payroll is not available", vbOKOnly, "No Calc Allowed"
Exit Sub
End If
If strTYPE = "S" Then
If strWTYPE = "U" Or strWTYPE = "W" Or strWTYPE = "R" Or strWTYPE = "F" Then
txtAmount = Format(txtYdge, "##,##0.00")
' txtAmount = Format((((Field2Str2(txtYRate) * (Field2Str2(txtCMUYds)) * Field2Str(txtPercentDone)) / 100)), "##,##0.00")
Else 'If Not (strWTYPE = "W" Or strWTYPE = "F") Then
If Field2Str(moRS!texture) = "DF" Or Field2Str(moRS!texture) = "MF" Or Field2Str(moRS!texture) = "SS" Or Field2Str(moRS!texture) = "QS" Then
dblPAYAMT = (((Field2Str2(txtYRate) * (Field2Str2(txtYdge) - Field2Str2(txtFin2Yds))) * Field2Str2(txtPercentDone)) / 100)
dblPAYAMT = dblPAYAMT + (((Field2Str2(txtMetal) * Field2Str2(txtFin2Yds)) * Field2Str2(txtPercentDone)) / 100)
txtAmount = Format(dblPAYAMT, "##,##0.00")
Else
dblPAYAMT = (((Field2Str2(txtYRate) * Field2Str2(txtYdge)) * Field2Str2(txtPercentDone)) / 100)
txtAmount = Format(dblPAYAMT, "##,##0.00")
End If
End If
End If
End If
mboolCALC = True
End Sub
Private Sub GetCrew()
Dim strSQL As String, lngFind As Long
mintCREW = Field2Str2(txtCrewId)
strSQL = "SELECT * from tblCrewRate WHERE crew_id = " & mintCREW
' strSQL = "SELECT * from tblcrew WHERE crew_id = " & mintCREW
Set moRSCREW = New Recordset
moRSCREW.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not moRSCREW.EOF Then
mstrCREW = moRSCREW!Crew_Boss
If Field2Str(moRSCREW!Type) = "L" Then
txtYRate = Format(Field2Str2(moRSCREW!lath_skip), "#0.00")
txtMetal = Format(Field2Str2(moRSCREW!METAL), "#0.00")
' txtFin2Rate = 0
' cboCrewType = "LATH"
End If
If Field2Str(moRSCREW!Type) = "V" Then
txtYRate = Format(Field2Str2(moRSCREW!lath_skip), "#0.00")
txtMetal = 0
txtMetal.Visible = False
' txtFin2Rate = 0
' txtFin2Rate.Visible = False
' cboCrewType = "V_STONE"
End If
If Field2Str(moRSCREW!Type) = "C" Then
txtYRate = Format(Field2Str2(moRSCREW!lath_skip), "#0.00")
txtMetal = Format(Field2Str2(moRSCREW!sand), "#0.00")
lblYRate = "Up Rate:"
lblMtlRate = "Down Rate:"
' txtMetal.Visible = False
' txtFin2Rate = Field2Str2(moRSCREW!sand)
' txtFin2Rate = 0
' cboCrewType = "C_SCAFFOLD"
' cboWorkType = "Y_UP"
' cmdScaffold.SetFocus
' chkBC.Enabled = False
End If
If Field2Str(moRSCREW!Type) = "S" Then
If Field2Str(moRS!texture) = "SK" Or Field2Str(moRS!texture) = "CS" Then
txtYRate = Format(Field2Str2(moRSCREW!lath_skip), "#0.00")
lblFinish = "SKIP"
txtMetal = 0
txtMetal.Visible = False
' txtFin2Rate = 0
ElseIf Field2Str(moRS!texture) = "SM" Then
txtYRate = Format(Field2Str2(moRSCREW!lath_skip), "#0.00")
lblFinish = "SMOOTH"
txtMetal = 0
txtMetal.Visible = False
' txtFin2Rate = 0
ElseIf Field2Str(moRS!texture) = "SA" Then
txtYRate = Format(Field2Str2(moRSCREW!sand), "#0.00")
lblFinish = "SAND"
txtMetal = 0
txtMetal.Visible = False
' txtFin2Rate = 0
ElseIf Field2Str(moRS!texture) = "S2" Then
txtYRate = Format(Field2Str2(moRSCREW!sand), "#0.00")
lblFinish = "SAND"
txtMetal = 0
txtMetal.Visible = False
' txtFin2Rate = 0
ElseIf Field2Str(moRS!texture) = "S3" Then
txtYRate = Format(Field2Str2(moRSCREW!sand), "#0.00")
lblFinish = "SAND"
txtMetal = 0
txtMetal.Visible = False
' txtFin2Rate = 0
ElseIf Field2Str(moRS!texture) = "S4" Then
txtYRate = Format(Field2Str2(moRSCREW!sand), "#0.00")
lblFinish = "SAND"
txtMetal = 0
txtMetal.Visible = False
ElseIf Field2Str(moRS!texture) = "SB" Then
txtYRate = Format(Field2Str2(moRSCREW!syn), "#0.00")
lblFinish = "SYNTHETIC"
txtMetal = 0
txtMetal.Visible = False
' txtFin2Rate = 0
ElseIf Field2Str(moRS!texture) = "QU" Then
txtYRate = Format(Field2Str2(moRSCREW!qu), "#0.00")
lblFinish = "QUERNAVACA"
txtMetal = 0
txtMetal.Visible = False
' txtFin2Rate = 0
ElseIf Field2Str(moRS!texture) = "MN" Then
txtYRate = Format(Field2Str2(moRSCREW!mn), "#0.00")
lblFinish = "MONTERREY"
txtMetal = 0
txtMetal.Visible = False
' txtFin2Rate = 0
ElseIf Field2Str(moRS!texture) = "DA" Then
txtYRate = Format(Field2Str2(moRSCREW!dash), "#0.00")
lblFinish = "DASH"
txtMetal = 0
txtMetal.Visible = False
' txtFin2Rate = 0
ElseIf Field2Str(moRS!texture) = "DF" Or Field2Str(moRS!texture) = "SS" Then
txtYRate = Format(Field2Str2(moRSCREW!lath_skip), "#0.00")
lblFinish = "SKIP AND SAND"
txtMetal = Format(Field2Str2(moRSCREW!sand), "#0.00")
lblMRate = "Finish 2 Rate:"
' txtFin2Rate = Field2Str2(moRSCREW!sand)
ElseIf Field2Str(moRS!texture) = "MF" Then
txtYRate = Format(Field2Str2(moRSCREW!mn), "#0.00")
lblFinish = "MONTERREY AND SAND"
txtMetal = Format(Field2Str2(moRSCREW!sand), "#0.00")
lblMRate = "Finish 2 Rate:"
ElseIf Field2Str(moRS!texture) = "QS" Then
txtYRate = Format(Field2Str2(moRSCREW!qu), "#0.00")
lblFinish = "QUERNAVACA AND SAND"
txtMetal = Format(Field2Str2(moRSCREW!sand), "#0.00")
lblMRate = "Finish 2 Rate:"
End If
' cboCrewType = "STUCCO"
End If
End If
End Sub
Private Sub StoneFix()
Dim intResponse As Integer
intResponse = InputBox("Enter The Correct Square Footage Of The Stone Veneer", "Correct Stone", 0)
moRS!ST_SQFT = Integer2Field(intResponse)
moRS.Update
Call FormShow
End Sub
Private Sub CMUFix()
Dim intResponse As Integer
intResponse = InputBox("Enter The Correct Square Yardage Of The CMU", "Correct CMU Yardage", 0)
moRS!CMU = Integer2Field(intResponse)
moRS.Update
Call FormShow
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
' strSql2 = "SELECT * FROM tblYardMemo WHERE lot_id = " & gintLOTID
' Set moRSMemo = New Recordset
' moRSMemo.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
' If moRSMemo.EOF Then
' strSql2 = "SELECT * FROM tblYardMemo" ' WHERE lot_id = " & gintLOTID
' Set moRSMemo = New Recordset
' moRSMemo.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
' moRSMemo.AddNew
' moRSMemo!Lot_id = gintLOTID
' moRSMemo.Update
' strSql2 = "SELECT * FROM tblYardMemo WHERE lot_id = " & gintLOTID
' Set moRSMemo = New Recordset
' moRSMemo.Open strSql2, goConn, adOpenKeyset, adLockOptimistic
' End If
End Sub
Private Sub 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
mstrPType = txtCrewType
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 not paid and not invalid and type <> 'C' and lotid =" & gintLOTID & " and type = '" & mstrPType & "'"
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!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 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
On Error GoTo Error_EH
gintCOPY = 1
strTYPE = Left(Str2Field(cboType.Text), 1)
If strTYPE = "S" Then
strREPORT = App.Path & "\RPstuccopay.rpt"
ElseIf strTYPE = "L" Then
strREPORT = App.Path & "\RPLathpay.rpt"
' Exit Sub
ElseIf strTYPE = "B" Then
MsgBox "No PaySheet Defined", vbOKOnly, "No Report"
Exit Sub
ElseIf strTYPE = "T" Then
MsgBox "No PaySheet Defined", vbOKOnly, "No Report"
Exit Sub
ElseIf strTYPE = "H" Then
MsgBox "No PaySheet Defined", vbOKOnly, "No Report"
Exit Sub
ElseIf strTYPE = "R" Then
MsgBox "No PaySheet Defined", vbOKOnly, "No Report"
Exit Sub
ElseIf strTYPE = "W" Then
MsgBox "No PaySheet Defined", vbOKOnly, "No Report"
Exit Sub
ElseIf strTYPE = "F" Then
MsgBox "No PaySheet Defined", vbOKOnly, "No Report"
Exit Sub
ElseIf strTYPE = "U" Then
MsgBox "No PaySheet Defined", vbOKOnly, "No Report"
Exit Sub
End If
strSQL = "{tblPAYSHEET.payid} = " & gintPAYID
crPAY.ReportFileName = strREPORT
crPAY.ReplaceSelectionFormula (strSQL)
crPAY.CopiesToPrinter = gintCOPY
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 mboolCALC Then
MsgBox "You Must Calculate the Pay before Saving", vbOKOnly, "Calc Required"
Exit Sub
End If
If Not mboolSTOP Then
Call FormSave
lstPayInfo.Enabled = True
cmdSave.Enabled = False
' cmdAddPS.Enabled = True
cmdExit.Enabled = True
txtMDesc.Enabled = False
txtNotes.Enabled = False
' frmPayHead.chkADD = vbUnchecked
' Call PrintPay
Else
cboType.SetFocus
End If
' Call PrintPay
Call cmdExit_Click
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer
mboolCALC = False
Call ProjLoad
Call LotLoad
' lblPSheet = "Pay Sheets for " & Trim$(moRSProj!proj_desc) & " Lot # " & Trim$(moRS!lot_no)
Call PayLoad
Call WTLoad
' Call SetTime
If lstPayInfo.ListCount = 0 Then
intResponse = MsgBox("No Payroll Information, You Cannot Pay", vbOKOnly + vbQuestion, "No Pay SHeets")
' 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
' 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)
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 ' Display key combinations.
' If KeyCode = vbKeyV And gbytSECURITY < 3 Then ' Display key combinations.
If CtrlDown Then
Call MarkPaid
End If
Exit Sub
End If
If KeyCode = vbKeyY Then ' Display key combinations.
If CtrlDown Then
' txtYRate.Enabled = True
txtYRate = InputBox("Enter the New Rate Per Yard (#.##) For This Lot", "New Rate", 0#)
' txtYRate.Enabled = False
End If
Exit Sub
End If
If KeyCode = vbKeyM Then ' Display key combinations.
If CtrlDown Then
' txtYRate.Enabled = True
txtMetal = InputBox("Enter the New Rate Per Foot On Metal (#.##) For This Lot", "New Rate", 0#)
' txtYRate.Enabled = False
End If
Exit Sub
End If
' If Not cmdSave.Enabled Then
' cmdSave.Enabled = True
' End If
End Sub
Private Sub MarkPaid()
Dim intBOOKMARK As Integer
intBOOKMARK = lstPayInfo.ListIndex
' moRSPay!pdamt = 0
moRSPay!paid = vbChecked
moRSPay.Update
Call PayLoad
If lstPayInfo.ListIndex <> -1 Then
lstPayInfo.ListIndex = intBOOKMARK
Else
Call cmdExit_Click
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim intResponse As Integer, strMSG As String
On Error GoTo Error_EH
If cmdSavePay.Enabled Then
strMSG = "Data Has Been Changed"
strMSG = strMSG & Chr(13) & Chr(10)
strMSG = strMSG & "Save Changes ?"
intResponse = MsgBox(strMSG, vbQuestion + vbYesNoCancel, Me.Caption)
Select Case intResponse
Case vbYes
' Call FormSave
Case vbNo
Case vbCancel
Cancel = True
End Select
End If
If moRS.State = adStateOpen Then
moRS.Close
End If
If 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 moRSProj = New Recordset
mboolCALC = False
Call ProjLoad
Call LotLoad
' lblPSheet = "Pay Sheets for " & Trim$(moRSProj!proj_desc) & " Lot # " & Trim$(moRS!lot_no)
Call PayLoad
Call SetTime
If FormFind() Then
Call FormShow
End If
End Sub
Private Sub SetTime()
Dim strSQL As String
strSQL = "SELECT * FROM tblTIME WHERE idnum = 10"
Set moRSTIME = New Recordset
moRSTIME.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
End Sub
Private Function FormFind() As Boolean
Dim strSQL As String, strPlan As String
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblPaySheet "
strSQL = strSQL & "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 = ""
txtFin2Yds = ""
txtPercentDone = ""
chkPaid = vbUnchecked
chkPaid.Visible = False
chkInvalid = vbUnchecked
chkInvalid.Visible = False
cboType.ListIndex = -1
cboWorkType.ListIndex = -1
End Sub
Private Sub FormSave()
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblTIME WHERE idnum = 10"
Set moRSTIME = New Recordset
moRSTIME.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If mboolAdding Then
moRSTIME.AddNew
End If
' Store the controls to the recordset
If Not moRS.EOF Then
Call FieldsSave
End If
' moRSMemo!payroll = Str2Field(txtLotNotes)
' moRSMemo.Update
Exit Sub
Error_EH:
Call ErrorHandler(moRSTIME.ActiveConnection)
Exit Sub
End Sub
Private Sub FormShow()
Dim intLoop As Integer, strSTR As String, intLEN As Integer
Dim strWTYPE As String
mboolSHOW = True
' txtProjLot = Trim$(moRSProj!proj_code) & " " & moRS!lot_no
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)
txtFin2Yds = Field2Str2(moRS!fin2)
txtCrew = Field2Integer(txtCrewId)
mintCREW = Field2Integer(txtCrewId)
With moRSPay
If !bc Then
chkBC = vbChecked
Else
chkBC = vbUnchecked
End If
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
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 !pay_type = "L" Then
' cboType.Text = "LATH"
' ElseIf !pay_type = "S" Then
' cboType.Text = "STUCCO"
' ElseIf !pay_type = "R" Then
' cboCrewType.Text = "Repair/PO"
' ElseIf !pay_type = "V" Then
' cboCrewType.Text = "V_Stone"
' End If
If !Type = "S" Then
cboType.Text = "Stucco"
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
lblYardge = "Yardage:"
ElseIf !Type = "L" Then
txtFtMetal.Enabled = False
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 = "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
cboWorkType.col = 2
strWTYPE = cboWorkType.ColText
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 = False
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 = False
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:"
ElseIf !Type = "X" Then
txtFtMetal.Enabled = False
txtFtMetal.BackColor = &H80FFFF
' cboWorkType.Text = "Z_DOWN"
lblYardge = "Pay Amount:"
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
txtILYds = IIf(Field2Str2(moRS!pylath) > 0, Format(Field2Str2(moRS!pylath), "##,###"), "")
txtIStYds = IIf(Field2Str2(moRS!pystucco) > 0, Format(Field2Str2(moRS!pystucco), "##,###"), "")
txtIMetal = IIf(Field2Str2(moRS!pmetal) > 0, Format(Field2Str2(moRS!pmetal), "##,###"), "")
txtICMU = IIf(Field2Str2(moRS!pcmu) > 0, Format(Field2Str2(moRS!pcmu), "##,###"), "")
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
End Sub
Private Sub cmdAddPS_Click()
Call FormClear
lstPayInfo.Enabled = False
' txtVerify = Date
cmdSave.Enabled = True
cmdAddPS.Enabled = False
' cmdFindCrew.Visible = True
mboolAdding = True
cboType.SetFocus
End Sub
Private Sub AddPay()
Dim intLATH As Integer, intSTUCCO As Integer, intMETAL As Integer, strTYPE As String
Dim intPLATH As Integer, intPSTUCCO As Integer, intPMETAL As Integer, strMSG As String
Dim intPCMU As Integer, intPSTONE As Integer, intPDOLLARS As Integer, intCALC As Integer
Dim intCLATH As Integer, intCSTUCCO As Integer, intCMETAL As Integer, lngID As Long
Dim strWTYPE As String, intSTONE As Integer, intCSTONE As Integer
Dim intFRAMES As Integer, intCFRAMES As Integer, intPFRAMES As Integer
Dim strSQL As String, oRSM As Recordset
strTYPE = Left(Str2Field(cboType.Text), 1)
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 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
moRS!pystucco = intCSTUCCO
moRS.Update
ElseIf strWTYPE = "B" Then
intCALC = FindMax4("tblPaySheet", "pay_ydge", "lotid", lngID, "worktype", strWTYPE)
intCSTUCCO = intCALC + Field2Str2(txtYdge)
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
ElseIf strWTYPE = "S" Then
intCALC = FindMax4("tblPaySheet", "pay_ydge", "lotid", lngID, "worktype", strWTYPE)
intCSTUCCO = intCALC + Field2Str2(txtYdge)
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
ElseIf strWTYPE = "T" 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 too High"
mboolSTOP = True
' mboolAdding = False
Exit Sub
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 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
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
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 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
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 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
ElseIf strWTYPE = "T" 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 too High"
mboolSTOP = True
' mboolAdding = False
Exit Sub
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 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
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()
Dim lngTIMEID As Long, strID As String, strWT As String, strDESC As String
On Error GoTo Error_EH
With moRSTIME
!PROJ_ID = gintPROJID
!Lot_ID = gintLOTID
!lot_no = Str2Field(moRS!lot_no)
!paydt = Date
!pay_type = Left(Str2Field(cboType.Text), 1)
' cboWorkType.col = 0
' strID = cboWorkType.ColText
cboWorkType.col = 1
strWT = cboWorkType.ColText
' cboWorkType.col = 2
' strDESC = cboWorkType.ColText
' !workdone = Left(Str2Field(cboWorkType.Text), 1)
!WorkDone = strWT
!C_USER = gstrLOGIN
!pct_done = Integer2Field(txtPercentDone)
!pay_id = gintPAYID
!proj_lot = Trim(Field2Str(moRSProj!Proj_Code)) & " " & Trim(Field2Str(moRS!lot_no))
!yd_rate = Double2Field(txtYRate)
If Left(Str2Field(cboType.Text), 1) = "S" Then
!fin2_Rate = Double2Field(txtMetal)
ElseIf Left(Str2Field(cboType.Text), 1) = "L" Then
!mtl_Rate = Double2Field(txtMetal)
End If
' !bc = vbUnchecked
!ponum = 0
!scafid = 0
!up = vbUnchecked
!frames = 0
!crew = Integer2Field(txtCrewId)
' !pay_amt = Str2Field(txtAmount)
!notes = Str2Field(txtMDesc)
If chkBC Then
!bc = vbChecked
!pay_amt = (Double2Field(txtAmount) * -1)
' !pay_amt = (Integer2Field(txtAmount) * -1)
Else
!bc = vbUnchecked
!pay_amt = (Double2Field(txtAmount))
' !pay_amt = (Integer2Field(txtAmount))
End If
!office = Str2Field(txtNotes)
!U_USER = gstrLOGIN
!Update = Date
End With
moRSTIME.Update
lngTIMEID = FindMax("tblTIME", "IDNUM")
With moRSPay
' !pdamt = Field2Str2(txtPayAmt)
!Amt = Field2Str2(txtAmount)
!GROSSPAY = Field2Str2(txtAmount)
!paid = vbChecked
!Y_Rate = Field2Str2(txtYRate)
!M_Rate = Field2Str2(txtMetal)
!crewID = Field2Str2(txtCrewId)
!timeid = lngTIMEID
End With
moRSPay.Update
If mboolAdding Then
mboolAdding = False
End If
Exit Sub
Error_EH:
If Err.Number = -2147467259 Then
MsgBox "Duplicate Lot Record - This will not be saved - ReEnter", , "Duplicate Record"
Resume Next
End If
gstrMODULE = "FormScaffold - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstPayInfo_DblClick()
Dim strPAYID As String
strPAYID = gintPAYID
' If chkInvalid Then
' MsgBox "Reprint of this PaySheet is not allowed", vbOKOnly, "No Reprint"
' Exit Sub
' End If
' cmdAddPS.Enabled = False
' cmdRePrint.Enabled = True
lstPayInfo.Enabled = False
mboolAdding = True
If cboWorkType.ListIndex = -1 Then
cboWorkType.Enabled = True
cboWorkType.SetFocus
Else
txtPercentDone.SetFocus
End If
txtNotes.Enabled = True
txtMDesc.Enabled = True
cmdSave.Enabled = True
End Sub
Private Sub txtFtMetal_GotFocus()
Call FieldSelect(txtFtMetal)
End Sub
'Private Sub PrintStuccoPay()
'Dim strSQL As String, i As Integer
'Dim intTOTAL As Integer, intYDS As Integer
'
' On Error GoTo Error_EH
'
' strSQL = "{tblLOTINFO.lot_id} = " & gintLOTID
' crOrder.ReportFileName = App.Path & "\stuccopay.rpt"
' crOrder.ReplaceSelectionFormula (strSQL)
' crOrder.CopiesToPrinter = gintCOPY
'' crOrder.Destination = crptToWindow
' crOrder.Destination = crptToPrinter
' intTOTAL = Int((gintCOPY / 2) + 0.99)
' intYDS = Int((moRS!s_yds / intTOTAL) + 0.99)
' i = 1
' If gintCOPY > 3 Then
' crOrder.Formulas(2) = "PaySheetTotal = " & (gintCOPY / 2)
' intTOTAL = Int((gintCOPY / 2) + 0.99)
' intYDS = Int((moRS!s_yds / intTOTAL) + 0.99)
' i = 1
' Do Until i = ((gintCOPY / 2) + 1)
' crOrder.Formulas(1) = "PaySheetCount = " & i
' crOrder.Formulas(3) = "PaySheetX = 'PARTIAL PAY SHEET'"
' crOrder.CopiesToPrinter = gintCOPY / 2
' crOrder.Action = 1
' moRSPay.AddNew
' moRSPay!lotid = gintLOTID
' moRSPay!Type = "S"
' moRSPay!pay_ydge = intYDS
' moRSPay!sheet = i
' moRSPay!Create = gstrLOGIN
' moRSPay!printed = vbChecked
' moRSPay.Update
' moRS!pystucco = Field2Integer(moRS!pystucco) + intYDS
' moRS!multipay = vbChecked
' moRS.Update
' i = i + 1
' Loop
' Exit Sub
' Else
' crOrder.CopiesToPrinter = gintCOPY
' crOrder.Action = 1
' moRSPay.AddNew
' moRSPay!lotid = gintLOTID
' moRSPay!Type = "S"
' moRSPay!pay_ydge = intYDS
' moRSPay!sheet = i
' moRSPay!Create = gstrLOGIN
' moRSPay!printed = vbChecked
' moRSPay.Update
' moRS!pystucco = Field2Integer(moRS!pystucco) + intYDS
' moRS.Update
' End If
' Exit Sub
'
'Error_EH:
' gstrMODULE = "Form LotInfo - Module PrintStuccoPay"
' Call ErrorHandler2
' gstrMODULE = ""
' Exit Sub
'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