azcomputerguru/claudetools
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
claudetools/clients/valleywide/app-modernization/source-code/Full-Project/VWP_Current/frmScafPay.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

1051 lines
29 KiB
Plaintext
Raw Permalink Blame History

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Begin VB.Form frmScafPay
Caption = "Scaffolding Information"
ClientHeight = 4260
ClientLeft = 60
ClientTop = 345
ClientWidth = 8700
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 4260
ScaleWidth = 8700
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtCrewID
Enabled = 0 'False
Height = 315
Left = 4680
TabIndex = 38
Top = 2520
Visible = 0 'False
Width = 555
End
Begin VB.ComboBox cboSCrew
Height = 315
Left = 3240
Style = 2 'Dropdown List
TabIndex = 37
Top = 2520
Visible = 0 'False
Width = 1275
End
Begin VB.TextBox txtPayAmt
Height = 315
Left = 6720
TabIndex = 35
Top = 2040
Width = 855
End
Begin VB.TextBox txtPrimRate
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 285
Left = 1020
MaxLength = 7
TabIndex = 34
Top = 2520
Width = 615
End
Begin VB.TextBox txtFin2Rate
Alignment = 1 'Right Justify
Enabled = 0 'False
Height = 285
Left = 2340
MaxLength = 7
TabIndex = 33
Top = 2520
Width = 615
End
Begin VB.TextBox txtCrewNo
Alignment = 1 'Right Justify
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 255
Left = 5835
MaxLength = 4
TabIndex = 31
Top = 1140
Width = 675
End
Begin VB.TextBox txtCrewName
BackColor = &H00C0FFFF&
Enabled = 0 'False
Height = 255
Left = 5820
TabIndex = 30
Top = 1440
Width = 2835
End
Begin VB.TextBox txtPercentDone
Alignment = 1 'Right Justify
Height = 285
Left = 6735
MaxLength = 3
TabIndex = 28
Top = 1740
Width = 675
End
Begin VB.TextBox txtCrew
Height = 315
Left = 7500
TabIndex = 27
Top = 480
Visible = 0 'False
Width = 1095
End
Begin VB.CheckBox chkPaid
Caption = "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 = 315
Left = 7020
TabIndex = 26
Top = 120
Width = 855
End
Begin VB.TextBox txt108
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 = 21
Top = 3000
Width = 435
End
Begin VB.TextBox txt68
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 = 20
Top = 2640
Width = 435
End
Begin VB.ComboBox cboArea
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
ItemData = "frmScafPay.frx":0000
Left = 5820
List = "frmScafPay.frx":001C
Style = 2 'Dropdown List
TabIndex = 17
Top = 840
Width = 1275
End
Begin MSComCtl2.DTPicker dtpScaffold
Height = 315
Left = 5820
TabIndex = 16
Top = 480
Width = 1455
_ExtentX = 2566
_ExtentY = 556
_Version = 393216
Enabled = 0 'False
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Format = 91226113
CurrentDate = 37103
End
Begin VB.Frame fraStory
Caption = "House Size"
Enabled = 0 'False
Height = 855
Left = 6900
TabIndex = 13
Top = 3360
Width = 1515
Begin VB.OptionButton optStory
Caption = "Single Story"
Height = 255
Index = 1
Left = 180
TabIndex = 15
Top = 480
Width = 1155
End
Begin VB.OptionButton optStory
Caption = "Two Story"
Height = 195
Index = 0
Left = 180
TabIndex = 14
Top = 240
Width = 1095
End
End
Begin VB.TextBox txtNotes
Height = 1335
Left = 180
TabIndex = 7
Top = 2820
Width = 5115
End
Begin VB.CommandButton cmdExit
Caption = "&Exit"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 7320
TabIndex = 10
TabStop = 0 'False
Top = 2820
Width = 1035
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 = 495
Left = 7320
TabIndex = 9
TabStop = 0 'False
Top = 2340
Width = 1035
End
Begin VB.Frame fraUPDown
Caption = "Scaffold Action"
Enabled = 0 'False
Height = 855
Left = 5460
TabIndex = 4
Top = 3360
Width = 1395
Begin VB.OptionButton optScaffold
Caption = "Take Down"
Height = 255
Index = 1
Left = 180
TabIndex = 6
Top = 480
Width = 1155
End
Begin VB.OptionButton optScaffold
Caption = "Put Up"
Height = 315
Index = 0
Left = 180
TabIndex = 5
Top = 180
Width = 1095
End
End
Begin VB.ListBox lstScaffold
Height = 2010
Left = 180
TabIndex = 0
TabStop = 0 'False
Top = 480
Width = 5055
End
Begin VB.Label lblDown
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Down"
Height = 195
Left = 1815
TabIndex = 40
Top = 2520
Width = 420
End
Begin VB.Label lblUP
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Up"
Height = 195
Left = 765
TabIndex = 39
Top = 2520
Width = 210
End
Begin VB.Label lblPayAmt
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Pay Amount:"
Height = 195
Left = 5760
TabIndex = 36
Top = 2100
Width = 900
End
Begin VB.Label lblCrew1
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Crew:"
Height = 195
Left = 5340
TabIndex = 32
Top = 1140
Width = 405
End
Begin VB.Label lblPercent
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Percentage Done:"
Height = 195
Left = 5355
TabIndex = 29
Top = 1800
Width = 1305
End
Begin VB.Label lblL108
Alignment = 1 'Right Justify
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 = 195
Left = 6720
TabIndex = 25
Top = 3060
Width = 360
End
Begin VB.Label lblL68
Alignment = 1 'Right Justify
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 = 195
Left = 6720
TabIndex = 24
Top = 2700
Width = 360
End
Begin VB.Label lblFrames
Caption = "Frame Count"
Height = 195
Left = 5760
TabIndex = 23
Top = 2400
Width = 1035
End
Begin VB.Label lbl108
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "10'8"":"
Height = 195
Left = 5730
TabIndex = 22
Top = 3060
Width = 420
End
Begin VB.Label lbl68
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "6'8"":"
Height = 195
Left = 5820
TabIndex = 19
Top = 2700
Width = 330
End
Begin VB.Label lblArea
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Area:"
Height = 195
Left = 5355
TabIndex = 18
Top = 900
Width = 375
End
Begin VB.Label lblYards
BorderStyle = 1 'Fixed Single
Height = 315
Left = 5460
TabIndex = 12
Top = 60
Width = 1275
End
Begin VB.Label lblNotes
AutoSize = -1 'True
Caption = "Notes"
Height = 195
Left = 180
TabIndex = 11
Top = 2580
Width = 420
End
Begin VB.Label lblProjCode
BorderStyle = 1 'Fixed Single
Height = 315
Left = 180
TabIndex = 8
Top = 60
Width = 1095
End
Begin VB.Label lblLotNo
BorderStyle = 1 'Fixed Single
Caption = " "
Height = 315
Left = 3780
TabIndex = 3
Top = 60
Width = 1635
End
Begin VB.Label lblProject
BorderStyle = 1 'Fixed Single
Caption = " "
Height = 315
Left = 1320
TabIndex = 2
Top = 60
Width = 2415
End
Begin VB.Label lblDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Date:"
Height = 195
Left = 5340
TabIndex = 1
Top = 540
Width = 390
End
End
Attribute VB_Name = "frmScafPay"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRS As Recordset
Dim moRSProj As Recordset
Dim moRSCREW As Recordset
Dim moRSTIME As Recordset
Dim moRSSCAF As Recordset
Dim mintPRCREW As Integer
Dim mboolAdding As Boolean, mstrAREA As String, mboolUP As Boolean, mintFRAMES As Integer
Dim mstrWTYPE As String, mstrWDone As String
Private Sub cmdAdd_Click()
' cmdAdd.Enabled = False
cmdSave.Enabled = True
' cmdDelete.Enabled = False
mboolAdding = True
Call FormClear
End Sub
Private Sub cmdDelete_Click()
Dim strSQL As String, strYN As String
On Error GoTo Error_EH
strYN = MsgBox("Are You Sure You Want To Delete?", vbCritical + vbYesNo, "Delete?")
If strYN = vbNo Then
Exit Sub
End If
moRSCREW.Delete
Call ScaffoldLoad
' cmdAdd.Enabled = True
cmdSave.Enabled = False
' cmdDelete.Enabled = False
Exit Sub
Error_EH:
gstrMODULE = "Form Scaffold - Module cmdDelete"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdSave_Click()
Dim dblPRAMT As Double, intFRAMES As Integer ', dblPRAMT As Double
If txtPayAmt = "" Or txtPayAmt = "0" Then
If optScaffold(0) Then
intFRAMES = CInt(txt68) + CInt(txt108)
dblPRAMT = intFRAMES * Field2Str2(txtPrimRate)
txtPayAmt = dblPRAMT
txtPercentDone = "100"
mboolUP = True
mintFRAMES = intFRAMES
ElseIf optScaffold(1) Then
intFRAMES = CInt(txt68) + CInt(txt108)
dblPRAMT = intFRAMES * Field2Str2(txtFin2Rate)
txtPayAmt = dblPRAMT
txtPercentDone = "100"
mboolUP = False
mintFRAMES = intFRAMES
End If
End If
' cmdAdd.Enabled = True
cmdSave.Enabled = False
' cmdDelete.Enabled = False
Call FormSave
Call cmdExit_Click
End Sub
Private Sub MarkPaid()
Dim intBOOKMARK As Integer
intBOOKMARK = lstScaffold.ListIndex
moRSCREW!pdamt = 0
moRSCREW!paid = vbChecked
moRSCREW.Update
Call ScaffoldLoad
lstScaffold.ListIndex = intBOOKMARK
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer
Dim strSQL As String
On Error GoTo Error_EH
mintPRCREW = Field2Str2(txtCrewNo)
mboolAdding = True
Call CrewLoad
Call ScaffoldLoad
Call ProjLoad
If lstScaffold.ListIndex <> -1 Then
If FormFindCrew() Then
Call FormShowCrew
End If
End If
If lstScaffold.ListCount = 0 Then
intResponse = MsgBox("No Scaffolding Information, You Cannot Pay?", vbOKOnly + vbQuestion, "No Records")
Unload Me
End If
Exit Sub
Error_EH:
gstrMODULE = "FormScaffold - Module Form_Activate"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim ShiftDown, AltDown, CtrlDown
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 = vbKeyP Then ' Display key combinations.
If CtrlDown Then
Call MarkPaid
End If
Exit Sub
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{TAB}"
KeyAscii = 0
End If
End Sub
Private Sub Form_Load()
On Error GoTo Error_EH
' mintPRCREW = Field2Str2(txtCrewNo)
' Call CrewLoad
' Call ScaffoldLoad
' Call ProjLoad
If lstScaffold.ListIndex <> -1 Then
If FormFindCrew() Then
Call FormShowCrew
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "FormScaffold - Module Form_Load"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub ScaffoldLoad()
Dim oRS As Recordset
Dim strSQL As String
Dim strLine As String, strCREW As String
Dim strPAID As String, strAMT As String
On Error GoTo Error_EH
' strSQL = "SELECT crew, scaf_date, Scaf_id, up, down from tblScaffold WHERE Lot_id = " & gintLOTID & " ORDER BY Scaf_date"
strSQL = "SELECT * from tblScaffold WHERE Lot_id = " & gintLOTID & " AND PRCREW = " & gintCREWID & " ORDER BY Scaf_date"
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstScaffold.Clear
Do Until oRS.EOF
With lstScaffold
cboSCrew.ListIndex = oRS!crew - 1
If oRS!paid Then
strPAID = "PD"
Else
strPAID = " "
End If
strAMT = Format(Field2Str2(oRS!pdamt), "#,#")
If oRS!up Then
strLine = Field2Str(oRS!scaf_date) & " " & "UP " & " " & cboSCrew.Text & vbTab & strPAID & vbTab & strAMT
ElseIf oRS!down Then
strLine = Field2Str(oRS!scaf_date) & " " & "DOWN" & " " & cboSCrew.Text & vbTab & strPAID & vbTab & strAMT
Else
strLine = "INVALID SCAFFOLD ENTRY - FIX"
End If
.AddItem strLine
.ItemData(.NewIndex) = oRS!scaf_id
End With
oRS.MoveNext
Loop
If lstScaffold.ListCount Then
lstScaffold.ListIndex = 0
Else
lstScaffold.ListIndex = -1
Call FormClear
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Scaffold - Module ScaffoldLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Function FormFindCrew() As Boolean
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblScaffold "
strSQL = strSQL & "WHERE Scaf_Id = " & lstScaffold.ItemData(lstScaffold.ListIndex)
Set moRSCREW = New Recordset
moRSCREW.Open strSQL, goConn, adOpenDynamic, adLockOptimistic
If moRSCREW.EOF Then
FormFindCrew = False
Else
FormFindCrew = True
End If
Exit Function
Error_EH:
gstrMODULE = "FormScaffold - Module FormFindCrew"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub FormShowCrew()
Dim strSQL As String
Dim oRS As Recordset
On Error GoTo Error_EH
Call GetCrew
With moRSCREW
cboSCrew.ListIndex = Field2Integer(!crew) - 1
dtpScaffold.Value = Field2Str(!scaf_date)
txtNotes = Field2Str(!notes)
' txtHrs = Field2Str(!hrs)
' txtMin = Field2Str(!Min)
txt68 = Field2Str2(!frame6)
txt108 = Field2Str2(!frame10)
mstrAREA = Field2Str(!Area)
If !paid Then
chkPaid = vbChecked
chkPaid.BackColor = &HFFFF&
Else
chkPaid = vbUnchecked
chkPaid.BackColor = &H8000000F
End If
If mstrAREA = "W" Then
cboArea.Text = "West"
ElseIf mstrAREA = "N" Then
cboArea.Text = "North"
ElseIf mstrAREA = "S" Then
cboArea.Text = "South"
ElseIf mstrAREA = "X" Then
cboArea.Text = "Xtra"
ElseIf mstrAREA = "2" Then
cboArea.Text = "2-North"
ElseIf mstrAREA = "3" Then
cboArea.Text = "3-North"
ElseIf mstrAREA = "4" Then
cboArea.Text = "4-South"
ElseIf mstrAREA = "5" Then
cboArea.Text = "5-West"
Else
cboArea.ListIndex = -1
End If
If !up Then
optScaffold(0).Value = True
ElseIf !down Then
optScaffold(1).Value = True
Else
optScaffold(0).Value = False
optScaffold(1).Value = False
End If
If !Single Then
optStory(1).Value = True
ElseIf !Double Then
optStory(0).Value = True
Else
optStory(0).Value = False
optStory(1).Value = False
End If
End With
Exit Sub
Error_EH:
gstrMODULE = "FormScaffold - Module FormShowCrew"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormClear()
dtpScaffold.Value = Date
cboSCrew.ListIndex = -1
txtNotes = ""
' txtHrs = 0
' txtMin = 0
cboArea.ListIndex = -1
optStory(0).Value = False
optStory(1).Value = False
optScaffold(0).Value = False
optScaffold(1).Value = False
End Sub
Private Sub FieldsSave()
'Dim strLOT As String, test As String
On Error GoTo Error_EH
With moRSTIME
!PROJ_ID = gintPROJID
!Lot_ID = gintLOTID
!lot_no = Str2Field(moRS!lot_no)
!paydt = Date
!C_USER = gstrLOGIN
!pct_done = Integer2Field(txtPercentDone)
!pay_id = gintPAYID
!proj_lot = Trim(Str2Field(lblProjCode)) & " " & Trim(Str2Field(lblLotNo))
!yd_rate = Double2Field(txtPrimRate)
!fin2_Rate = Double2Field(txtFin2Rate)
!mtl_Rate = 0
!ponum = 0
!scafid = moRSCREW!scaf_id
!up = mboolUP
!frames = mintFRAMES
!crew = Integer2Field(txtCrewNo)
!pay_amt = Str2Field(txtPayAmt)
' !notes = Str2Field(txtNotes)
!pay_type = "C"
If optScaffold(0) Then
!WorkDone = "Y"
ElseIf optScaffold(1) Then
!WorkDone = "Z"
End If
!U_USER = gstrLOGIN
!Update = Date
End With
moRSTIME.Update
moRSCREW!pdamt = Str2Field(txtPayAmt)
moRSCREW!paid = vbChecked
moRSCREW.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 FormSave()
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT * FROM tblTIME WHERE idnum = 1"
Set moRSTIME = New Recordset
moRSTIME.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If mboolAdding Then
moRSTIME.AddNew
End If
' Store the controls to the recordset
Call FieldsSave
' moRSMemo!payroll = Str2Field(txtLotNotes)
' moRSMemo.Update
Exit Sub
Error_EH:
Call ErrorHandler(moRSTIME.ActiveConnection)
Exit Sub
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim intResponse As Integer, strMSG As String
On Error GoTo Error_EH
If cmdSave.Enabled Then
strMSG = "Scaffold 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
Exit Sub
End Select
End If
If moRSCREW.State = adStateOpen Then
moRSCREW.Close
End If
Exit Sub
Error_EH:
If Err = 3219 Then
Resume Next
End If
End Sub
Private Sub lstScaffold_Click()
On Error GoTo Error_EH
If lstScaffold.ListIndex <> -1 Then
If FormFindCrew() Then
Call FormShowCrew
Else
lstScaffold.Clear
Call FormClear
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form Crews - Module lstScaffold_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstScaffold_DblClick()
If chkPaid Then
MsgBox "This Lot Has Already Been Paid", vbOKOnly, "Already Paid"
Exit Sub
End If
' cmdAdd.Enabled = False
cmdSave.Enabled = True
' cmdDelete.Enabled = True
End Sub
Private Sub txtNotes_LostFocus()
txtNotes = UCase(txtNotes)
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
strSQL = "SELECT Lot_no, Lot_id, Sq_Yd, Scaf6, Scaf10 FROM tblLotInfo WHERE lot_id = " & gintLOTID
Set moRS = New Recordset
moRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lblProjCode = Field2Str(moRSProj!Proj_Code)
lblProject = Field2Str(moRSProj!Proj_Desc)
lblLotNo = Field2Str(moRS!lot_no)
lblYards = Field2Str(moRS!sq_yd)
lblL68 = Field2Str2(moRS!Scaf6)
lblL108 = Field2Str2(moRS!scaf10)
End Sub
Private Sub CrewLoad()
Dim oRSRCrew As Recordset
Dim strSQL As String, intRows As Integer
Dim row, col As Long
On Error GoTo Error_EH
strSQL = "SELECT Crew_ID, Name FROM tblSC_Crew"
Set oRSRCrew = New Recordset
oRSRCrew.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
oRSRCrew.MoveLast
oRSRCrew.MoveFirst
intRows = oRSRCrew.RecordCount
Do Until oRSRCrew.EOF
cboSCrew.AddItem oRSRCrew("Name")
cboSCrew.ItemData(cboSCrew.NewIndex) = Field2Long(oRSRCrew("CREW_ID"))
oRSRCrew.MoveNext
Loop
oRSRCrew.Close
Exit Sub
Error_EH:
gstrMODULE = "Form Scaffold - Module CrewLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub GetCrew()
Dim oRS As Recordset
Dim strSQL As String, lngFind As Long
' strSQL = "SELECT * from tblcrew WHERE crew_id = " & mintPRCREW
strSQL = "SELECT * from tblcrewrate WHERE Proj_ID = 99999 and crew_id = " & mintPRCREW
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
If Not oRS.EOF Then
txtCrewName = oRS!Crew_Boss
txtPrimRate = Field2Str2(oRS!lath_skip)
txtFin2Rate = Field2Str2(oRS!sand)
End If
oRS.Close
End Sub
Private Sub txtPercentDone_GotFocus()
If txtPercentDone = "" Then
txtPercentDone = "100"
End If
Call FieldSelect(txtPercentDone)
End Sub
Private Sub txtPercentDone_LostFocus()
Dim dblPRAMT As Double, intFRAMES As Integer ', dblPRAMT As Double
If optScaffold(0) Then
intFRAMES = CInt(txt68) + CInt(txt108)
dblPRAMT = intFRAMES * Field2Str2(txtPrimRate)
txtPayAmt = dblPRAMT
' txtPercentDone = "100"
mboolUP = True
mintFRAMES = intFRAMES
ElseIf optScaffold(1) Then
intFRAMES = CInt(txt68) + CInt(txt108)
dblPRAMT = intFRAMES * Field2Str2(txtFin2Rate)
txtPayAmt = dblPRAMT
' txtPercentDone = "100"
mboolUP = False
mintFRAMES = intFRAMES
End If
End Sub
Reference in New Issue View Git Blame Copy Permalink