Files
claudetools/clients/valleywide/app-modernization/source-code/Orders-VWP_Current-2020/frmScafList.frm
Mike Swanson fccf9f9468 sync: auto-sync from GURU-5070 at 2026-06-14 05:33:01
Author: Mike Swanson
Machine: GURU-5070
Timestamp: 2026-06-14 05:33:01
2026-06-14 05:34:46 -07:00

1284 lines
36 KiB
Plaintext

VERSION 5.00
Object = "{00025600-0000-0000-C000-000000000046}#5.2#0"; "Crystl32.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmScafList
Caption = "Scaffold List"
ClientHeight = 6345
ClientLeft = 60
ClientTop = 345
ClientWidth = 11850
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 6345
ScaleWidth = 11850
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txt108
Height = 315
Left = 7620
TabIndex = 42
Top = 4800
Width = 435
End
Begin VB.TextBox txt68
Height = 315
Left = 6360
TabIndex = 41
Top = 4800
Width = 435
End
Begin VB.TextBox txtHrs
Alignment = 1 'Right Justify
Height = 315
Left = 7020
MaxLength = 2
TabIndex = 11
Top = 4200
Width = 435
End
Begin VB.TextBox txtMin
Alignment = 1 'Right Justify
Height = 315
Left = 7620
MaxLength = 2
TabIndex = 12
Top = 4200
Width = 435
End
Begin VB.ComboBox cboSCrew
Height = 315
Left = 960
Style = 2 'Dropdown List
TabIndex = 8
Top = 4620
Width = 2535
End
Begin VB.Frame fraUPDown
Caption = "Scaffold Action"
Height = 855
Left = 8520
TabIndex = 19
Top = 4140
Width = 1515
Begin VB.OptionButton optScaffold
Caption = "Put Up"
Height = 375
Index = 0
Left = 180
TabIndex = 13
Top = 180
Width = 1095
End
Begin VB.OptionButton optScaffold
Caption = "Take Down"
Height = 315
Index = 1
Left = 180
TabIndex = 14
Top = 480
Width = 1155
End
End
Begin VB.Frame fraStory
Caption = "House Size"
Height = 855
Left = 10200
TabIndex = 20
Top = 4140
Width = 1515
Begin VB.OptionButton optStory
Caption = "Two Story"
Height = 195
Index = 0
Left = 180
TabIndex = 15
Top = 240
Width = 1095
End
Begin VB.OptionButton optStory
Caption = "Single Story"
Height = 255
Index = 1
Left = 180
TabIndex = 16
Top = 480
Width = 1155
End
End
Begin VB.TextBox txtSeq
Alignment = 1 'Right Justify
Height = 315
Left = 4560
MaxLength = 2
TabIndex = 10
Top = 4620
Width = 615
End
Begin VB.CommandButton cmdDelete
Caption = "&Delete Scaffold"
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 = 10620
TabIndex = 28
TabStop = 0 'False
Top = 3480
Width = 1200
End
Begin Crystal.CrystalReport crRepair
Left = 10200
Top = 120
_ExtentX = 741
_ExtentY = 741
_Version = 348160
WindowControlBox= -1 'True
WindowMaxButton = -1 'True
WindowMinButton = -1 'True
PrintFileLinesPerPage= 60
End
Begin VB.CommandButton cmdPrint
Caption = "&Print Daily Sheet"
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 = 9300
TabIndex = 27
TabStop = 0 'False
Top = 3480
Width = 1275
End
Begin VB.CommandButton cmdGetLot
Caption = "&Get Lot"
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 = 7980
TabIndex = 26
TabStop = 0 'False
Top = 3480
Width = 1275
End
Begin VB.ListBox lstProject
Height = 2595
Left = 7080
Sorted = -1 'True
TabIndex = 25
Top = 600
Visible = 0 'False
Width = 4695
End
Begin VB.ListBox lstLot
Height = 2790
Left = 7080
Sorted = -1 'True
TabIndex = 24
Top = 600
Visible = 0 'False
Width = 4695
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 = 6660
TabIndex = 23
TabStop = 0 'False
Top = 3480
Width = 1275
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 = 495
Left = 5340
TabIndex = 18
Top = 3480
Width = 1275
End
Begin VB.ComboBox cboDArea
Height = 315
ItemData = "frmScafList.frx":0000
Left = 4560
List = "frmScafList.frx":001C
Style = 2 'Dropdown List
TabIndex = 9
Top = 4260
Width = 1215
End
Begin VB.TextBox txtNotes
Height = 975
Left = 960
MultiLine = -1 'True
TabIndex = 17
Top = 5220
Width = 10755
End
Begin VB.TextBox txtScheduled
Height = 315
Left = 960
MaxLength = 10
TabIndex = 7
Top = 4260
Width = 1215
End
Begin VB.ComboBox cboArea
Height = 315
ItemData = "frmScafList.frx":005D
Left = 4260
List = "frmScafList.frx":0079
Style = 2 'Dropdown List
TabIndex = 4
TabStop = 0 'False
Top = 120
Width = 1155
End
Begin VB.ListBox lstScaffold
Height = 2790
Left = 180
TabIndex = 2
TabStop = 0 'False
Top = 600
Width = 6795
End
Begin MSComCtl2.DTPicker dtpScaffold
Height = 315
Left = 1320
TabIndex = 0
TabStop = 0 'False
Top = 120
Width = 1515
_ExtentX = 2672
_ExtentY = 556
_Version = 393216
Format = 48234497
CurrentDate = 36892
MaxDate = 55153
MinDate = 36892
End
Begin VB.Label lblL10
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 = 8100
TabIndex = 44
Top = 4860
Width = 315
End
Begin VB.Label lblL6
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 = 6840
TabIndex = 43
Top = 4860
Width = 315
End
Begin VB.Label lbl108
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "10'8"":"
Height = 195
Left = 7200
TabIndex = 40
Top = 4860
Width = 420
End
Begin VB.Label lbl68
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "6'8"":"
Height = 195
Left = 6000
TabIndex = 39
Top = 4860
Width = 330
End
Begin VB.Label lblFrames
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Frames Used"
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 = 6660
TabIndex = 38
Top = 4560
Width = 1110
End
Begin VB.Label lblNotes
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Notes:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Left = 180
TabIndex = 37
Top = 5220
Width = 690
End
Begin VB.Label lblTime
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Time:"
Height = 195
Left = 6540
TabIndex = 36
Top = 4260
Width = 390
End
Begin VB.Label lblHrs
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Hrs"
Height = 195
Left = 7140
TabIndex = 35
Top = 4020
Width = 240
End
Begin VB.Label lblMin
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Min"
Height = 195
Left = 7740
TabIndex = 34
Top = 4020
Width = 255
End
Begin VB.Label lblColon
Caption = ":"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 555
Left = 7500
TabIndex = 33
Top = 4080
Width = 135
End
Begin VB.Label lblCrew
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Crew:"
Height = 195
Left = 420
TabIndex = 32
Top = 4680
Width = 405
End
Begin VB.Label lblSequence
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Sequence:"
Height = 195
Left = 3600
TabIndex = 31
Top = 4680
Width = 780
End
Begin VB.Label lblLot
Height = 255
Left = 3240
TabIndex = 30
Top = 3840
Width = 675
End
Begin VB.Label lblProject
Height = 255
Left = 180
TabIndex = 29
Top = 3840
Width = 2835
End
Begin VB.Label lblDArea
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Area:"
Height = 195
Left = 4005
TabIndex = 22
Top = 4380
Width = 375
End
Begin VB.Label lblAreaDef
Caption = "Nothing in the 'List Area' will display all Scaffolding for the selected Date. Press the Delete Key to Clear."
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 5520
TabIndex = 21
Top = 60
Width = 4635
End
Begin VB.Label lblScheduled
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Scheduled:"
Height = 195
Left = 120
TabIndex = 6
Top = 4380
Width = 810
End
Begin VB.Label lblProjectLot
BorderStyle = 1 'Fixed Single
Height = 315
Left = 180
TabIndex = 5
Top = 3480
Width = 3735
End
Begin VB.Label lblArea
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "List Area:"
Height = 195
Left = 3435
TabIndex = 3
Top = 180
Width = 660
End
Begin VB.Label lblRDate
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Scaffold Date:"
Height = 195
Left = 240
TabIndex = 1
Top = 180
Width = 1020
End
End
Attribute VB_Name = "frmScafList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim moRSScaffold As Recordset
Dim moRS As Recordset, moRSProj As Recordset
Dim mintPRCREW As Integer
Dim mboolSHOW As Boolean, mboolAdding As Boolean
Dim mintSCAFFOLDID As Integer, mintBOOKMARK As Integer
Dim mstrPROJLOT As String
Private Sub ScaffoldLoad()
Dim oRS As Recordset
Dim strSQL As String
Dim strTYPE As String, strTYPE2 As String
Dim strLine As String
On Error GoTo Error_EH
If cboArea.ListIndex = -1 Then
strSQL = "SELECT Scaf_ID, seq, proj_id, lot_id, area, up, down, single, double, Proj_lot from tblscaffold WHERE Scaf_date = #" & CDate(dtpScaffold.Value) & "# ORDER BY Area, seq"
Else
strSQL = "SELECT Scaf_ID, seq, proj_id, lot_id, area, up, down, single, double, Proj_lot from tblScaffold WHERE Scaf_Date = #" & CDate(dtpScaffold.Value) & "# and Area = '" & Left(cboArea.Text, 1) & "' ORDER BY seq"
End If
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
lstScaffold.Clear
Do Until oRS.EOF
With lstScaffold
gintLOTID = Field2Str2(oRS!Lot_id)
' Call GetLotInfo
If oRS!up Then
strTYPE = "UP "
ElseIf oRS!down Then
strTYPE = "DOWN "
End If
If oRS!Single Then
strTYPE2 = "SINGLE "
ElseIf oRS!Double Then
strTYPE2 = "DOUBLE "
Else
strTYPE2 = "UNKNOWN"
End If
strLine = ""
strLine = Field2Str(oRS!Area) & " " & strTYPE & " " '& vbTab 'Field2Str(oRS!seq) & vbTab
strLine = strLine & strTYPE2 & vbTab & Field2Str(oRS!proj_lot)
' strLine = strLine & strTYPE2 & vbTab & mstrPROJLOT 'Field2Str(oRS!proj_lot)
.AddItem strLine
.ItemData(.NewIndex) = Field2Long(oRS!scaf_id)
End With
oRS.MoveNext
Loop
oRS.Close
If lstScaffold.ListCount Then
lstScaffold.ListIndex = 0
mintSCAFFOLDID = lstScaffold.ItemData(lstScaffold.ListIndex)
Else
mintSCAFFOLDID = 0
End If
Exit Sub
Error_EH:
gstrMODULE = "Form ScafList - Module ScaffoldLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
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 Field2Str(oRSRCrew!Name)
cboSCrew.ItemData(cboSCrew.NewIndex) = Field2Long(oRSRCrew("CREW_ID"))
oRSRCrew.MoveNext
Loop
oRSRCrew.Close
Exit Sub
Error_EH:
gstrMODULE = "Form ScafList - Module CrewLoad"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cboArea_Click()
Call ScaffoldLoad
End Sub
Private Sub cboArea_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDelete Then
cboArea.ListIndex = -1
End If
End Sub
Private Sub cboSCrew_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDelete Then
cboSCrew.ListIndex = -1
End If
End Sub
Private Sub cmdAdd_Click()
mboolAdding = True
Call FormClear
Call ProjectSelect
cmdExit.Caption = "&Cancel"
cmdExit.Enabled = True
cmdSave.Enabled = True
' cmdAdd.Enabled = False
lstScaffold.Enabled = False
lstProject.SetFocus
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
gconACTION = 3
strSQL = "DELETE * FROM tblScaffold WHERE scaf_id = " & lstScaffold.ItemData(lstScaffold.ListIndex)
goConn.Execute strSQL
' strSQL = "DELETE * FROM tblLotMatrl WHERE Lot_id = " & gintLOTID
' goConn.Execute strSQL
' moRS.Delete
gstrFLAG = "D"
Call LotChange(mstrPROJLOT, "Delete Repair")
Call ScaffoldLoad
Exit Sub
Error_EH:
gstrMODULE = "Form ScafList - Module cmdDelete"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdGetLot_Click()
Call GetLotInfo
Call cmdSave_Click
End Sub
Private Sub cmdPrint_Click()
Dim strSQL As String, strMONTH As String, strYEAR As String, strDAY As String
On Error GoTo Error_EH
If Len(cboArea.Text) = 0 Then
MsgBox "You Must Select A Value In The 'List Area' Field", vbOKOnly, "No Area Of Town Selected"
Exit Sub
End If
strMONTH = Format(Month(dtpScaffold.Value), "00")
strDAY = Format(Day(dtpScaffold.Value), "00")
strYEAR = Year(dtpScaffold.Value)
gintPRINT = 1
frmReport.Show 1
strSQL = "{tblScaffold.scaf_date} = date(" & strYEAR & "," & strMONTH & "," & strDAY & ") and {tblScaffold.area} = '" & Left(cboArea.Text, 1) & "'"
crRepair.ReportFileName = App.Path & "\DailyScaffold.rpt"
crRepair.SelectionFormula = strSQL
' crRepair.Destination = crptToWindow
crRepair.CopiesToPrinter = gintCOPY
crRepair.Destination = gintDEST
crRepair.Action = 1
Exit Sub
Error_EH:
gstrMODULE = "Form ScafList - Module cmdPrint_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub cmdSave_Click()
mintBOOKMARK = lstScaffold.ListIndex
If Len(cboDArea.Text) = 0 Then
MsgBox "You Must Enter The Area Of Town Before Saving", vbOKOnly, "Select An Area"
cboDArea.SetFocus
Exit Sub
End If
Call FormSave
lstScaffold.Enabled = True
cmdSave.Enabled = False
' cmdAdd.Enabled = True
If mintBOOKMARK <> 0 Then
lstScaffold.ListIndex = mintBOOKMARK
End If
End Sub
Private Sub dtpScaffold_Change()
Call ScaffoldLoad
If FormFind() Then
Call FormShow
Else
Call FormClear
End If
End Sub
Private Sub Form_Activate()
Dim intResponse As Integer
Dim strSQL As String
' If lstScaffold.ListCount = 0 Then
' intResponse = MsgBox("No Scaffold schedule, do you wish to add one?", vbYesNo + vbQuestion, "Add Records")
' If intResponse = vbYes Then
' strSQL = "SELECT * FROM tblScaffold WHERE Scaf_id = 1"
' Set moRSScaffold = New Recordset
' moRSScaffold.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
' Call cmdAdd_Click
' Else
' Unload Me
' End If
' End If
Exit Sub
Error_EH:
gstrMODULE = "Form ScafList - Module Form_Activate"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = 4 Then
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()
Dim strSQL As String
Dim oRS As Recordset
On Error GoTo Error_EH
Set moRSScaffold = New Recordset
dtpScaffold.Value = Date
Call CrewLoad
Call ScaffoldLoad
If FormFind() Then
Call FormShow
Else
Call FormClear
End If
Exit Sub
Error_EH:
gstrMODULE = "Form ScafList - Module Form_Load"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Function FormFind() As Boolean
Dim strSQL As String, strPlan As String, strMEMO As String
On Error GoTo Error_EH
strSQL = "SELECT * "
strSQL = strSQL & "FROM tblScaffold "
strSQL = strSQL & "WHERE Scaf_ID = " & mintSCAFFOLDID
' If moRSScaffold.State = adStateOpen Then
' moRSScaffold.Close
' End If
Set moRSScaffold = New Recordset
moRSScaffold.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
If moRSScaffold.EOF Then
FormFind = False
Else
FormFind = True
gintLOTID = Field2Str2(moRSScaffold!Lot_id)
gintPROJID = Field2Str2(moRSScaffold!proj_id)
End If
Exit Function
Error_EH:
gstrMODULE = "Form ScafList - Module FormFind"
Call ErrorHandler2
gstrMODULE = ""
Exit Function
End Function
Private Sub FormShow()
Dim mstrAREA As String
Dim strSQL As String
Dim oRS As Recordset
On Error GoTo Error_EH
lblProject.Caption = ""
lblLot.Caption = ""
mboolSHOW = True
strSQL = "Select Proj_Desc FROM tblProject WHERE proj_id = " & gintPROJID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
lblProject.Caption = Field2Str(oRS!proj_desc)
strSQL = "Select Lot_no, scaf6, scaf10 FROM tblLotInfo WHERE Lot_id = " & gintLOTID
Set oRS = New Recordset
oRS.Open strSQL, goConn, adOpenKeyset, adLockOptimistic
lblLot.Caption = Field2Str(oRS!lot_no)
lblL6 = Field2Str2(oRS!Scaf6)
lblL10 = Field2Str2(oRS!scaf10)
With moRSScaffold
txtScheduled = Field2Str(!scaf_date)
txtSeq = Field2Str2(!seq)
txtNotes = Field2Str(!notes)
txt68 = Field2Str2(!frame6)
txt108 = Field2Str2(!frame10)
mstrAREA = Field2Str(!Area)
If mstrAREA = "W" Then
cboDArea.Text = "West"
ElseIf mstrAREA = "N" Then
cboDArea.Text = "North"
ElseIf mstrAREA = "S" Then
cboDArea.Text = "South"
ElseIf mstrAREA = "X" Then
cboDArea.Text = "Xtra"
ElseIf mstrAREA = "2" Then
cboDArea.Text = "2-North"
ElseIf mstrAREA = "3" Then
cboDArea.Text = "3-North"
ElseIf mstrAREA = "4" Then
cboDArea.Text = "4-South"
ElseIf mstrAREA = "5" Then
cboDArea.Text = "5-West"
Else
cboDArea.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
cboSCrew.ListIndex = Field2Integer(!crew) - 1
lblProjectLot.Caption = Field2Str(!proj_lot)
End With
' Call GetLotInfo
mboolSHOW = False
Exit Sub
Error_EH:
If Err = 3021 Then
MsgBox "No Project Was Found = Be Sure To Click The Get Lot Button", vbOKOnly, "No Project"
Resume Next
End If
gstrMODULE = "Form ScafList - Module FormShow"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FieldsSave()
Dim strLOT As String
On Error GoTo Error_EH
If mboolAdding Then
moRSScaffold.AddNew
moRSScaffold!C_USER = gstrLOGIN
moRSScaffold!proj_id = gintPROJID
moRSScaffold!Lot_id = gintLOTID
moRSScaffold!proj_lot = Field2Str(lblProjectLot.Caption)
End If
With moRSScaffold
!U_USER = gstrLOGIN
!U_date = Date
If cboSCrew.ListIndex = -1 Then
!crew = 0
mintPRCREW = 0
Else
!crew = cboSCrew.ItemData(cboSCrew.ListIndex)
Call GetCrew
End If
!prcrew = mintPRCREW
!scaf_date = Str2Field(txtScheduled)
!hrs = Str2Field(txtHrs)
!Min = Str2Field(txtMin)
!notes = Str2Field(txtNotes)
!up = Field2CheckBox(optScaffold(0))
!down = Field2CheckBox(optScaffold(1))
!Single = Field2CheckBox(optStory(1))
!Double = Field2CheckBox(optStory(0))
!Area = Left((cboDArea.Text), 1)
!seq = Field2Str2(txtSeq)
!frame6 = Field2Str2(txt68)
!frame10 = Field2Str2(txt108)
!proj_lot = lblProjectLot.Caption
!proj_id = gintPROJID
End With
moRSScaffold.Update
If mboolAdding Then
Call ScaffoldLoad
' Call PlanMatLoad
' Call POptLoad
If FormFind() Then
Call FormShow 'xxxxxxxxxxxxxxxxxx
Else
Call FormClear
End If
End If
Exit Sub
Error_EH:
If Err.Number = -2147467259 Then
' MsgBox "Duplicate Lot Record - This will not be saved - ReEnter", , "Duplicate Record"
' strLOT = InputBox("Enter a New Lot Number", "Fix Duplicate")
' If Len(strLOT) > 0 Then
' moRS!lot_no = Field2Str(strLOT)
' moRS.Update
' txtLotNo = Field2Str(strLOT)
' End If
Call ErrorHandler(moRSScaffold.ActiveConnection)
'' Resume Next\
Exit Sub
End If
gstrMODULE = "Form ScafList - Module FieldsSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub FormClear()
cboSCrew.ListIndex = -1
txtNotes = ""
txtHrs = 0
txtMin = 0
txtSeq = 0
txtScheduled = ""
optStory(0).Value = False
optStory(1).Value = False
optScaffold(0).Value = False
optScaffold(1).Value = False
cboDArea.ListIndex = -1
lblProjectLot = ""
lblProject = ""
lblLot = ""
End Sub
Private Sub FormSave()
Dim strName As String
On Error GoTo Error_EH
' If mboolAdding Then
' moRSScaffold.AddNew
' moRSScaffold!proj_id = gintPROJID
' moRSScaffold!lot_id = gintLOTID
' moRSScaffold!proj_lot = mstrPROJLOT
' End If
' Store the controls to the recordset
Call FieldsSave
moRSScaffold.Update
If mboolAdding Then
mboolAdding = False
End If
Call ScaffoldLoad
Exit Sub
Error_EH:
gstrMODULE = "Form ScafList - Module FormSave"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If moRSScaffold.State = adStateOpen Then
moRSScaffold.Close
End If
End Sub
Private Sub lstLot_DblClick()
Dim lngPOS As Long, strSQL As String
Dim oRS As Recordset
lngPOS = InStr(1, lstLot.Text, vbTab, 1)
gintLOTID = lstLot.ItemData(lstLot.ListIndex)
mstrPROJLOT = mstrPROJLOT & " - " & Left(lstLot.Text, lngPOS - 1)
lblProjectLot = mstrPROJLOT
' strSQL = "SELECT owner, address, lot_id FROM tblLotInfo WHERE lot_id = " & gintLOTID
' Set oRS = New Recordset
' oRS.Open strSQL, goConn, adOpenForwardOnly, adLockReadOnly
' moRS.MovePrevious
' txtHName = Field2Str(oRS!Owner)
' txtHAddress = Field2Str(oRS!address)
lstLot.Visible = False
End Sub
Private Sub lstProject_DblClick()
gintPROJID = lstProject.ItemData(lstProject.ListIndex)
mstrPROJLOT = lstProject.Text
lstProject.Visible = False
Call LotSelect
lstLot.SetFocus
End Sub
Private Sub lstScaffold_Click()
On Error GoTo Error_EH
If lstScaffold.ListIndex <> -1 Then
mintSCAFFOLDID = lstScaffold.ItemData(lstScaffold.ListIndex)
If FormFind() Then
Call FormShow
Else
Call FormClear
End If
End If
Exit Sub
Error_EH:
gstrMODULE = "Form ScafList - Module lstScaffold_Click"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub lstScaffold_DblClick()
' cmdAdd.Enabled = False
cmdSave.Enabled = True
End Sub
Private Sub txtHrs_GotFocus()
Call FieldSelect(txtHrs)
End Sub
Private Sub txtMin_GotFocus()
Call FieldSelect(txtMin)
End Sub
Private Sub txtScheduled_GotFocus()
Call FieldSelect(txtScheduled)
End Sub
Private Sub txtScheduled_LostFocus()
Dim lngPOS As Long
lngPOS = InStr(1, txtScheduled, "/", 1)
If lngPOS = 0 Then
If Len(txtScheduled) > 0 Then
txtScheduled = Format(txtScheduled, "00/00/####")
If Not IsDate(txtScheduled) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtScheduled.SetFocus
End If
End If
Else
If Not IsDate(txtScheduled) Then
MsgBox "The Date You Entered is not Valid - ReEnter"
txtScheduled.SetFocus
Else
Exit Sub
End If
End If
End Sub
Private Sub GetLotInfo()
Dim strSQL As String, strSELECT As String
strSQL = "SELECT * FROM tblLotInfo WHERE lot_id = " & gintLOTID
Set moRS = New Recordset
moRS.Open strSQL, goConn, adOpenForwardOnly, adLockOptimistic
If Not moRS.EOF Then
' strSELECT = "SELECT * FROM tblProject WHERE proj_id = " & Field2Integer(moRS!proj_id)
strSELECT = "SELECT * FROM tblProject WHERE proj_id = " & Field2Long(moRS!proj_id)
Set moRSProj = New Recordset
moRSProj.Open strSELECT, goConn, adOpenForwardOnly, adLockOptimistic
End If
gintPROJID = moRSProj!proj_id
mstrPROJLOT = Trim(Field2Str(moRSProj!proj_desc)) & " - " & Trim(Field2Str(moRS!lot_no))
lblProjectLot = mstrPROJLOT
End Sub
Private Sub LotSelect()
Dim strSQL As String, strLine As String
On Error GoTo Error_EH
strSQL = "SELECT Lot_no, address, owner, lot_id FROM tblLotInfo WHERE proj_id = " & gintPROJID
Set moRS = New Recordset
moRS.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
lstLot.Visible = True
lstLot.Clear
Do Until moRS.EOF
strLine = ""
strLine = Field2Str(moRS!lot_no) & vbTab & Field2Str(moRS!address)
lstLot.AddItem strLine
lstLot.ItemData(lstLot.NewIndex) = Field2Long(moRS!Lot_id)
moRS.MoveNext
Loop
' cboRCrew.ListIndex = 0
Exit Sub
Error_EH:
gstrMODULE = "Form ScafList - Module LotSelect"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub ProjectSelect()
Dim oRS As Recordset
Dim strSQL As String
On Error GoTo Error_EH
strSQL = "SELECT Proj_id, Proj_Desc FROM tblProject"
Set oRS = New Recordset
oRS.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
lstProject.Visible = True
lstProject.Clear
Do Until oRS.EOF
lstProject.AddItem oRS!proj_desc
lstProject.ItemData(lstProject.NewIndex) = Field2Long(oRS!proj_id)
oRS.MoveNext
Loop
oRS.Close
Exit Sub
Error_EH:
gstrMODULE = "Form ScafList - Module ProjectSelect"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub
Private Sub txtSeq_GotFocus()
Call FieldSelect(txtSeq)
End Sub
Private Sub GetCrew()
Dim oRS As Recordset
Dim strSQL As String, intRows As Integer
Dim row, col As Long
On Error GoTo Error_EH
strSQL = "SELECT Crew_ID, PRCREW FROM tblSC_Crew WHERE Crew_ID =" & cboSCrew.ItemData(cboSCrew.ListIndex)
Set oRS = New Recordset
oRS.Open strSQL, goConn, _
adOpenForwardOnly, adLockReadOnly
If Not oRS.EOF Then
mintPRCREW = Field2Str2(oRS!prcrew)
Else
mintPRCREW = 0
End If
' Do Until oRSRCrew.EOF
' cboSCrew.AddItem oRSRCrew("Name")
' cboSCrew.ItemData(cboSCrew.NewIndex) = Field2Long(oRSRCrew("CREW_ID"))
' oRSRCrew.MoveNext
' Loop
oRS.Close
Exit Sub
Error_EH:
gstrMODULE = "Form ScafList - Module GETCREW"
Call ErrorHandler2
gstrMODULE = ""
Exit Sub
End Sub